Skip to content

Commit 6dc0e2e

Browse files
hdgarroodhdgarrood
authored
Add a bunch of NFData instances (purescript#2817)
I also added derived Generic instances in order to be able to define the NFData instances without having to write the necessary code by hand; I expect I'll do it incorrectly if I try to do it by hand. I am mainly doing this because I want to use it to help diagnose bugs like purescript#2772 but I also think it might come in handy in real code at some point too; e.g. if we ever want to store these types in Pursuit's database.
1 parent 20d4a2d commit 6dc0e2e

10 files changed

Lines changed: 152 additions & 39 deletions

File tree

‎src/Language/PureScript/AST/Operators.hs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,13 @@
1+
{-# LANGUAGE DeriveGeneric #-}
12
-- |
23
-- Operators fixity and associativity
34
--
45
module Language.PureScript.AST.Operators where
56

67
import Prelude.Compat
78

9+
import GHC.Generics (Generic)
10+
import Control.DeepSeq (NFData)
811
import Data.Aeson ((.=))
912
import qualified Data.Aeson as A
1013

@@ -19,7 +22,9 @@ type Precedence = Integer
1922
-- Associativity for infix operators
2023
--
2124
data Associativity = Infixl | Infixr | Infix
22-
deriving (Show, Eq, Ord)
25+
deriving (Show, Eq, Ord, Generic)
26+
27+
instance NFData Associativity
2328

2429
showAssoc :: Associativity -> String
2530
showAssoc Infixl = "infixl"
@@ -42,7 +47,9 @@ instance A.FromJSON Associativity where
4247
-- Fixity data for infix operators
4348
--
4449
data Fixity = Fixity Associativity Precedence
45-
deriving (Show, Eq, Ord)
50+
deriving (Show, Eq, Ord, Generic)
51+
52+
instance NFData Fixity
4653

4754
instance A.ToJSON Fixity where
4855
toJSON (Fixity associativity precedence) =

‎src/Language/PureScript/AST/SourcePos.hs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,13 @@
1+
{-# LANGUAGE DeriveGeneric #-}
12
-- |
23
-- Source position information
34
--
45
module Language.PureScript.AST.SourcePos where
56

67
import Prelude.Compat
78

9+
import GHC.Generics (Generic)
10+
import Control.DeepSeq (NFData)
811
import Data.Aeson ((.=), (.:))
912
import qualified Data.Aeson as A
1013
import Data.Monoid
@@ -23,7 +26,9 @@ data SourcePos = SourcePos
2326
-- Column number
2427
--
2528
, sourcePosColumn :: Int
26-
} deriving (Show, Eq, Ord)
29+
} deriving (Show, Eq, Ord, Generic)
30+
31+
instance NFData SourcePos
2732

2833
displaySourcePos :: SourcePos -> Text
2934
displaySourcePos sp =
@@ -51,7 +56,9 @@ data SourceSpan = SourceSpan
5156
-- End of the span
5257
--
5358
, spanEnd :: SourcePos
54-
} deriving (Show, Eq, Ord)
59+
} deriving (Show, Eq, Ord, Generic)
60+
61+
instance NFData SourceSpan
5562

5663
displayStartEndPos :: SourceSpan -> Text
5764
displayStartEndPos sp =

‎src/Language/PureScript/Docs/Types.hs‎

Lines changed: 46 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
13
module Language.PureScript.Docs.Types
24
( module Language.PureScript.Docs.Types
35
, module ReExports
@@ -7,6 +9,8 @@ module Language.PureScript.Docs.Types
79
import Protolude hiding (to, from)
810
import Prelude (String, unlines, lookup)
911

12+
import GHC.Generics (Generic)
13+
import Control.DeepSeq (NFData)
1014
import Control.Arrow ((***))
1115

1216
import Data.Aeson ((.=))
@@ -55,10 +59,14 @@ data Package a = Package
5559
-- ^ The version of the PureScript compiler which was used to generate
5660
-- this data. We store this in order to reject packages which are too old.
5761
}
58-
deriving (Show, Eq, Ord)
62+
deriving (Show, Eq, Ord, Generic)
63+
64+
instance NFData a => NFData (Package a)
5965

6066
data NotYetKnown = NotYetKnown
61-
deriving (Show, Eq, Ord)
67+
deriving (Show, Eq, Ord, Generic)
68+
69+
instance NFData NotYetKnown
6270

6371
type UploadedPackage = Package NotYetKnown
6472
type VerifiedPackage = Package GithubUser
@@ -111,7 +119,9 @@ data Module = Module
111119
-- Re-exported values from other modules
112120
, modReExports :: [(InPackage P.ModuleName, [Declaration])]
113121
}
114-
deriving (Show, Eq, Ord)
122+
deriving (Show, Eq, Ord, Generic)
123+
124+
instance NFData Module
115125

116126
data Declaration = Declaration
117127
{ declTitle :: Text
@@ -120,7 +130,9 @@ data Declaration = Declaration
120130
, declChildren :: [ChildDeclaration]
121131
, declInfo :: DeclarationInfo
122132
}
123-
deriving (Show, Eq, Ord)
133+
deriving (Show, Eq, Ord, Generic)
134+
135+
instance NFData Declaration
124136

125137
-- |
126138
-- A value of this type contains information that is specific to a particular
@@ -170,7 +182,9 @@ data DeclarationInfo
170182
-- A kind declaration
171183
--
172184
| ExternKindDeclaration
173-
deriving (Show, Eq, Ord)
185+
deriving (Show, Eq, Ord, Generic)
186+
187+
instance NFData DeclarationInfo
174188

175189
convertFundepsToStrings :: [(Text, Maybe P.Kind)] -> [P.FunctionalDependency] -> [([Text], [Text])]
176190
convertFundepsToStrings args fundeps =
@@ -265,7 +279,9 @@ data ChildDeclaration = ChildDeclaration
265279
, cdeclSourceSpan :: Maybe P.SourceSpan
266280
, cdeclInfo :: ChildDeclarationInfo
267281
}
268-
deriving (Show, Eq, Ord)
282+
deriving (Show, Eq, Ord, Generic)
283+
284+
instance NFData ChildDeclaration
269285

270286
data ChildDeclarationInfo
271287
-- |
@@ -284,7 +300,9 @@ data ChildDeclarationInfo
284300
-- example, `pure` from `Applicative` would be `forall a. a -> f a`.
285301
--
286302
| ChildTypeClassMember P.Type
287-
deriving (Show, Eq, Ord)
303+
deriving (Show, Eq, Ord, Generic)
304+
305+
instance NFData ChildDeclarationInfo
288306

289307
childDeclInfoToString :: ChildDeclarationInfo -> Text
290308
childDeclInfoToString (ChildInstance _ _) = "instance"
@@ -319,11 +337,15 @@ isDataConstructor ChildDeclaration{..} =
319337

320338
newtype GithubUser
321339
= GithubUser { runGithubUser :: Text }
322-
deriving (Show, Eq, Ord)
340+
deriving (Show, Eq, Ord, Generic)
341+
342+
instance NFData GithubUser
323343

324344
newtype GithubRepo
325345
= GithubRepo { runGithubRepo :: Text }
326-
deriving (Show, Eq, Ord)
346+
deriving (Show, Eq, Ord, Generic)
347+
348+
instance NFData GithubRepo
327349

328350
data PackageError
329351
= CompilerTooOld Version Version
@@ -337,12 +359,16 @@ data PackageError
337359
| InvalidKind Text
338360
| InvalidDataDeclType Text
339361
| InvalidTime
340-
deriving (Show, Eq, Ord)
362+
deriving (Show, Eq, Ord, Generic)
363+
364+
instance NFData PackageError
341365

342366
data InPackage a
343367
= Local a
344368
| FromDep PackageName a
345-
deriving (Show, Eq, Ord)
369+
deriving (Show, Eq, Ord, Generic)
370+
371+
instance NFData a => NFData (InPackage a)
346372

347373
instance Functor InPackage where
348374
fmap f (Local x) = Local (f x)
@@ -370,14 +396,18 @@ data LinksContext = LinksContext
370396
, ctxVersion :: Version
371397
, ctxVersionTag :: Text
372398
}
373-
deriving (Show, Eq, Ord)
399+
deriving (Show, Eq, Ord, Generic)
400+
401+
instance NFData LinksContext
374402

375403
data DocLink = DocLink
376404
{ linkLocation :: LinkLocation
377405
, linkTitle :: Text
378406
, linkNamespace :: Namespace
379407
}
380-
deriving (Show, Eq, Ord)
408+
deriving (Show, Eq, Ord, Generic)
409+
410+
instance NFData DocLink
381411

382412
data LinkLocation
383413
-- | A link to a declaration in the same module.
@@ -397,7 +427,9 @@ data LinkLocation
397427
-- module. In this case we only need to store the module that the builtin
398428
-- comes from (at the time of writing, this will only ever be "Prim").
399429
| BuiltinModule P.ModuleName
400-
deriving (Show, Eq, Ord)
430+
deriving (Show, Eq, Ord, Generic)
431+
432+
instance NFData LinkLocation
401433

402434
-- | Given a links context, the current module name, the namespace of a thing
403435
-- to link to, its title, and its containing module, attempt to create a

‎src/Language/PureScript/Environment.hs‎

Lines changed: 25 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,12 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
13
module Language.PureScript.Environment where
24

35
import Prelude.Compat
46
import Protolude (ordNub)
57

8+
import GHC.Generics (Generic)
9+
import Control.DeepSeq (NFData)
610
import Data.Aeson ((.=), (.:))
711
import qualified Data.Aeson as A
812
import qualified Data.Map as M
@@ -38,7 +42,9 @@ data Environment = Environment
3842
-- ^ Type classes
3943
, kinds :: S.Set (Qualified (ProperName 'KindName))
4044
-- ^ Kinds in scope
41-
} deriving Show
45+
} deriving (Show, Generic)
46+
47+
instance NFData Environment
4248

4349
-- | Information about a type class
4450
data TypeClassData = TypeClassData
@@ -59,7 +65,9 @@ data TypeClassData = TypeClassData
5965
-- typeClassArguments and typeClassDependencies.
6066
, typeClassCoveringSets :: S.Set (S.Set Int)
6167
-- ^ A sets of arguments that can be used to infer all other arguments.
62-
} deriving Show
68+
} deriving (Show, Generic)
69+
70+
instance NFData TypeClassData
6371

6472
-- | A functional dependency indicates a relationship between two sets of
6573
-- type arguments in a class declaration.
@@ -68,7 +76,9 @@ data FunctionalDependency = FunctionalDependency
6876
-- ^ the type arguments which determine the determined type arguments
6977
, fdDetermined :: [Int]
7078
-- ^ the determined type arguments
71-
} deriving Show
79+
} deriving (Show, Generic)
80+
81+
instance NFData FunctionalDependency
7282

7383
instance A.FromJSON FunctionalDependency where
7484
parseJSON = A.withObject "FunctionalDependency" $ \o ->
@@ -164,7 +174,9 @@ data NameVisibility
164174
-- ^ The name is defined in the current binding group, but is not visible
165175
| Defined
166176
-- ^ The name is defined in the another binding group, or has been made visible by a function binder
167-
deriving (Show, Eq)
177+
deriving (Show, Eq, Generic)
178+
179+
instance NFData NameVisibility
168180

169181
-- | A flag for whether a name is for an private or public value - only public values will be
170182
-- included in a generated externs file.
@@ -176,7 +188,9 @@ data NameKind
176188
-- ^ A public value for a module member or foreing import declaration
177189
| External
178190
-- ^ A name for member introduced by foreign import
179-
deriving (Show, Eq)
191+
deriving (Show, Eq, Generic)
192+
193+
instance NFData NameKind
180194

181195
-- | The kinds of a type
182196
data TypeKind
@@ -190,7 +204,9 @@ data TypeKind
190204
-- ^ A local type variable
191205
| ScopedTypeVar
192206
-- ^ A scoped type variable
193-
deriving (Show, Eq)
207+
deriving (Show, Eq, Generic)
208+
209+
instance NFData TypeKind
194210

195211
instance A.ToJSON TypeKind where
196212
toJSON (DataType args ctors) =
@@ -221,7 +237,9 @@ data DataDeclType
221237
-- ^ A standard data constructor
222238
| Newtype
223239
-- ^ A newtype constructor
224-
deriving (Show, Eq, Ord)
240+
deriving (Show, Eq, Ord, Generic)
241+
242+
instance NFData DataDeclType
225243

226244
showDataDeclType :: DataDeclType -> Text
227245
showDataDeclType Data = "data"

‎src/Language/PureScript/Kinds.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,11 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
13
module Language.PureScript.Kinds where
24

35
import Prelude.Compat
46

7+
import GHC.Generics (Generic)
8+
import Control.DeepSeq (NFData)
59
import Data.Text (Text)
610
import qualified Data.Text as T
711
import Data.Aeson.BetterErrors (Parse, key, asText, asIntegral, nth, fromAesonParser, toAesonParser, throwCustomError)
@@ -21,7 +25,9 @@ data Kind
2125
| FunKind Kind Kind
2226
-- | A named kind
2327
| NamedKind (Qualified (ProperName 'KindName))
24-
deriving (Show, Eq, Ord)
28+
deriving (Show, Eq, Ord, Generic)
29+
30+
instance NFData Kind
2531

2632
-- This is equivalent to the derived Aeson ToJSON instance, except that we
2733
-- write it out manually so that we can define a parser which is

‎src/Language/PureScript/Label.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,11 @@
11
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
24
module Language.PureScript.Label (Label(..)) where
35

46
import Prelude.Compat hiding (lex)
7+
import GHC.Generics (Generic)
8+
import Control.DeepSeq (NFData)
59
import Data.Monoid ()
610
import Data.String (IsString(..))
711
import qualified Data.Aeson as A
@@ -13,4 +17,6 @@ import Language.PureScript.PSString (PSString)
1317
-- because records are indexable by PureScript strings at runtime.
1418
--
1519
newtype Label = Label { runLabel :: PSString }
16-
deriving (Show, Eq, Ord, IsString, Monoid, A.ToJSON, A.FromJSON)
20+
deriving (Show, Eq, Ord, IsString, Monoid, A.ToJSON, A.FromJSON, Generic)
21+
22+
instance NFData Label

0 commit comments

Comments
 (0)