4828b5d · rowtype-yoga/purescript-native

src/Language/PureScript/AST/Binders.hs+1−1

compare with golang

unifiedsplit

@@ -61,7 +61,7 @@ data Binder

61 -- A binder with a type annotation

62 --

63 | TypedBinder Type Binder

64− deriving (Show, Read, Eq)

64+ deriving (Show, Eq)

65

66-- |

67-- Collect all names introduced in binders in an expression

src/Language/PureScript/AST/Declarations.hs+153−12

@@ -22,6 +22,145 @@ import Language.PureScript.Kinds

22import Language.PureScript.TypeClassDictionaries

23import Language.PureScript.Comments

24import Language.PureScript.Environment

25+import qualified Language.PureScript.Bundle as Bundle

26+

27+import qualified Text.Parsec as P

28+

29+-- | A type of error messages

30+data SimpleErrorMessage

31+ = ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)

32+ | ErrorParsingModule P.ParseError

33+ | MissingFFIModule ModuleName

34+ | MultipleFFIModules ModuleName [FilePath]

35+ | UnnecessaryFFIModule ModuleName FilePath

36+ | MissingFFIImplementations ModuleName [Ident]

37+ | UnusedFFIImplementations ModuleName [Ident]

38+ | InvalidFFIIdentifier ModuleName String

39+ | CannotGetFileInfo FilePath

40+ | CannotReadFile FilePath

41+ | CannotWriteFile FilePath

42+ | InfiniteType Type

43+ | InfiniteKind Kind

44+ | MultipleValueOpFixities (OpName 'ValueOpName)

45+ | MultipleTypeOpFixities (OpName 'TypeOpName)

46+ | OrphanTypeDeclaration Ident

47+ | RedefinedModule ModuleName [SourceSpan]

48+ | RedefinedIdent Ident

49+ | OverlappingNamesInLet

50+ | UnknownName (Qualified Name)

51+ | UnknownImport ModuleName Name

52+ | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)

53+ | UnknownExport Name

54+ | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)

55+ | ScopeConflict Name [ModuleName]

56+ | ScopeShadowing Name (Maybe ModuleName) [ModuleName]

57+ | DeclConflict Name Name

58+ | ExportConflict (Qualified Name) (Qualified Name)

59+ | DuplicateModuleName ModuleName

60+ | DuplicateTypeArgument String

61+ | InvalidDoBind

62+ | InvalidDoLet

63+ | CycleInDeclaration Ident

64+ | CycleInTypeSynonym (Maybe (ProperName 'TypeName))

65+ | CycleInModules [ModuleName]

66+ | NameIsUndefined Ident

67+ | UndefinedTypeVariable (ProperName 'TypeName)

68+ | PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))

69+ | EscapedSkolem (Maybe Expr)

70+ | TypesDoNotUnify Type Type

71+ | KindsDoNotUnify Kind Kind

72+ | ConstrainedTypeUnified Type Type

73+ | OverlappingInstances (Qualified (ProperName 'ClassName)) [Type] [Qualified Ident]

74+ | NoInstanceFound Constraint

75+ | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]

76+ | CannotDerive (Qualified (ProperName 'ClassName)) [Type]

77+ | CannotFindDerivingType (ProperName 'TypeName)

78+ | DuplicateLabel String (Maybe Expr)

79+ | DuplicateValueDeclaration Ident

80+ | ArgListLengthsDiffer Ident

81+ | OverlappingArgNames (Maybe Ident)

82+ | MissingClassMember Ident

83+ | ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))

84+ | ExpectedType Type Kind

85+ | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName))

86+ | ExprDoesNotHaveType Expr Type

87+ | PropertyIsMissing String

88+ | AdditionalProperty String

89+ | CannotApplyFunction Type Expr

90+ | TypeSynonymInstance

91+ | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]

92+ | InvalidNewtype (ProperName 'TypeName)

93+ | InvalidInstanceHead Type

94+ | TransitiveExportError DeclarationRef [DeclarationRef]

95+ | TransitiveDctorExportError DeclarationRef (ProperName 'ConstructorName)

96+ | ShadowedName Ident

97+ | ShadowedTypeVar String

98+ | UnusedTypeVar String

99+ | WildcardInferredType Type

100+ | HoleInferredType String Type [(Ident, Type)]

101+ | MissingTypeDeclaration Ident Type

102+ | OverlappingPattern [[Binder]] Bool

103+ | IncompleteExhaustivityCheck

104+ | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)

105+ | ImportHidingModule ModuleName

106+ | UnusedImport ModuleName

107+ | UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]

108+ | UnusedDctorImport (ProperName 'TypeName)

109+ | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]

110+ | DuplicateSelectiveImport ModuleName

111+ | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)

112+ | DuplicateImportRef Name

113+ | DuplicateExportRef Name

114+ | IntOutOfRange Integer String Integer Integer

115+ | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]

116+ | ImplicitImport ModuleName [DeclarationRef]

117+ | HidingImport ModuleName [DeclarationRef]

118+ | CaseBinderLengthDiffers Int [Binder]

119+ | IncorrectAnonymousArgument

120+ | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)

121+ | DeprecatedRequirePath

122+ | CannotGeneralizeRecursiveFunction Ident Type

123+ deriving (Show)

124+

125+-- | Error message hints, providing more detailed information about failure.

126+data ErrorMessageHint

127+ = ErrorUnifyingTypes Type Type

128+ | ErrorInExpression Expr

129+ | ErrorInModule ModuleName

130+ | ErrorInInstance (Qualified (ProperName 'ClassName)) [Type]

131+ | ErrorInSubsumption Type Type

132+ | ErrorCheckingAccessor Expr String

133+ | ErrorCheckingType Expr Type

134+ | ErrorCheckingKind Type

135+ | ErrorCheckingGuard

136+ | ErrorInferringType Expr

137+ | ErrorInApplication Expr Type Expr

138+ | ErrorInDataConstructor (ProperName 'ConstructorName)

139+ | ErrorInTypeConstructor (ProperName 'TypeName)

140+ | ErrorInBindingGroup [Ident]

141+ | ErrorInDataBindingGroup

142+ | ErrorInTypeSynonym (ProperName 'TypeName)

143+ | ErrorInValueDeclaration Ident

144+ | ErrorInTypeDeclaration Ident

145+ | ErrorInForeignImport Ident

146+ | ErrorSolvingConstraint Constraint

147+ | PositionedError SourceSpan

148+ deriving (Show)

149+

150+-- | Categories of hints

151+data HintCategory

152+ = ExprHint

153+ | KindHint

154+ | CheckHint

155+ | PositionHint

156+ | SolverHint

157+ | OtherHint

158+ deriving (Show, Eq)

159+

160+data ErrorMessage = ErrorMessage

161+ [ErrorMessageHint]

162+ SimpleErrorMessage

163+ deriving (Show)

25

164

26-- |

165-- |

27-- A module declaration, consisting of comments about the module, a module name,

166-- A module declaration, consisting of comments about the module, a module name,

@@ -29,7 +168,7 @@ import Language.PureScript.Environment

29-- explicitly exported. If the export list is Nothing, everything is exported.

168-- explicitly exported. If the export list is Nothing, everything is exported.

30--

169--

31data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])

170data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])

32− deriving (Show, Read)

171+ deriving (Show)

33

172

34-- | Return a module's name.

173-- | Return a module's name.

35getModuleName :: Module -> ModuleName

174getModuleName :: Module -> ModuleName

@@ -88,7 +227,7 @@ data DeclarationRef

88 -- A declaration reference with source position information

227 -- A declaration reference with source position information

89 --

228 --

90 | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef

229 | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef

91− deriving (Show, Read)

230+ deriving (Show)

92

231

93instance Eq DeclarationRef where

232instance Eq DeclarationRef where

94 (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'

233 (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'

@@ -149,7 +288,7 @@ data ImportDeclarationType

149 -- An import with a list of references to hide: `import M hiding (foo)`

288 -- An import with a list of references to hide: `import M hiding (foo)`

150 --

289 --

151 | Hiding [DeclarationRef]

290 | Hiding [DeclarationRef]

152− deriving (Eq, Show, Read)

291+ deriving (Eq, Show)

153

292

154isImplicit :: ImportDeclarationType -> Bool

293isImplicit :: ImportDeclarationType -> Bool

155isImplicit Implicit = True

294isImplicit Implicit = True

@@ -216,15 +355,15 @@ data Declaration

216 -- A declaration with source position information

355 -- A declaration with source position information

217 --

356 --

218 | PositionedDeclaration SourceSpan [Comment] Declaration

357 | PositionedDeclaration SourceSpan [Comment] Declaration

219− deriving (Show, Read)

358+ deriving (Show)

220

359

221data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)

360data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)

222− deriving (Eq, Ord, Show, Read)

361+ deriving (Eq, Ord, Show)

223

362

224data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)

363data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)

225− deriving (Eq, Ord, Show, Read)

364+ deriving (Eq, Ord, Show)

226

365

227−pattern ValueFixityDeclaration :: Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration

366+pattern ValueFixityDeclaration :: Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration

228pattern ValueFixityDeclaration fixity name op = FixityDeclaration (Left (ValueFixity fixity name op))

367pattern ValueFixityDeclaration fixity name op = FixityDeclaration (Left (ValueFixity fixity name op))

229

368

230pattern TypeFixityDeclaration :: Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration

369pattern TypeFixityDeclaration :: Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration

@@ -236,7 +375,7 @@ data TypeInstanceBody

236 = DerivedInstance

375 = DerivedInstance

237 -- | This is a regular (explicit) instance

376 -- | This is a regular (explicit) instance

238 | ExplicitInstance [Declaration]

377 | ExplicitInstance [Declaration]

239− deriving (Show, Read)

378+ deriving (Show)

240

379

241mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody

380mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody

242mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)

381mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)

@@ -421,7 +560,9 @@ data Expr

421 -- at superclass implementations when searching for a dictionary, the type class name and

560 -- at superclass implementations when searching for a dictionary, the type class name and

422 -- instance type, and the type class dictionaries in scope.

561 -- instance type, and the type class dictionaries in scope.

423 --

562 --

563+ | TypeClassDictionary Constraint

424− | TypeClassDictionary Constraint (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))

564+ (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))

565+ [ErrorMessageHint]

425 -- |

566 -- |

426 -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.

567 -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.

427 --

568 --

@@ -442,7 +583,7 @@ data Expr

442 -- A value with source position information

583 -- A value with source position information

443 --

584 --

444 | PositionedValue SourceSpan [Comment] Expr

585 | PositionedValue SourceSpan [Comment] Expr

445− deriving (Show, Read)

586+ deriving (Show)

446

587

447-- |

588-- |

448-- An alternative in a case statement

589-- An alternative in a case statement

@@ -456,7 +597,7 @@ data CaseAlternative = CaseAlternative

456 -- The result expression or a collect of guarded expressions

597 -- The result expression or a collect of guarded expressions

457 --

598 --

458 , caseAlternativeResult :: Either [(Guard, Expr)] Expr

599 , caseAlternativeResult :: Either [(Guard, Expr)] Expr

459− } deriving (Show, Read)

600+ } deriving (Show)

460

601

461-- |

602-- |

462-- A statement in a do-notation block

603-- A statement in a do-notation block

@@ -478,7 +619,7 @@ data DoNotationElement

478 -- A do notation element with source position information

619 -- A do notation element with source position information

479 --

620 --

480 | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement

621 | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement

481− deriving (Show, Read)

622+ deriving (Show)

482

623

483$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)

624$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)

484$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)

625$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)

src/Language/PureScript/AST/Literals.hs+1−1

@@ -34,4 +34,4 @@ data Literal a

34 -- An object literal

35 --

36 | ObjectLiteral [(String, a)]

37− deriving (Eq, Ord, Show, Read, Functor)

37+ deriving (Eq, Ord, Show, Functor)

src/Language/PureScript/AST/Operators.hs+2−2

@@ -21,7 +21,7 @@ type Precedence = Integer

21-- Associativity for infix operators

22--

23data Associativity = Infixl | Infixr | Infix

24− deriving (Show, Read, Eq, Ord)

24+ deriving (Show, Eq, Ord)

25

26showAssoc :: Associativity -> String

27showAssoc Infixl = "infixl"

@@ -44,7 +44,7 @@ instance A.FromJSON Associativity where

44-- Fixity data for infix operators

45--

46data Fixity = Fixity Associativity Precedence

47− deriving (Show, Read, Eq, Ord)

47+ deriving (Show, Eq, Ord)

48

49instance A.ToJSON Fixity where

50 toJSON (Fixity associativity precedence) =

src/Language/PureScript/AST/SourcePos.hs+2−2

@@ -22,7 +22,7 @@ data SourcePos = SourcePos

22 -- Column number

23 --

24 , sourcePosColumn :: Int

25− } deriving (Show, Read, Eq, Ord)

25+ } deriving (Show, Eq, Ord)

26

27displaySourcePos :: SourcePos -> String

28displaySourcePos sp =

@@ -50,7 +50,7 @@ data SourceSpan = SourceSpan

50 -- End of the span

51 --

52 , spanEnd :: SourcePos

53− } deriving (Show, Read, Eq, Ord)

53+ } deriving (Show, Eq, Ord)

54

55displayStartEndPos :: SourceSpan -> String

56displayStartEndPos sp =

src/Language/PureScript/AST/Traversals.hs+1−1

@@ -582,7 +582,7 @@ accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (con

582 forDecls (TypeDeclaration _ ty) = f ty

583 forDecls _ = mempty

584

585− forValues (TypeClassDictionary c _) = mconcat (map f (constraintArgs c))

585+ forValues (TypeClassDictionary c _ _) = mconcat (map f (constraintArgs c))

586 forValues (SuperClassDictionary _ tys) = mconcat (map f tys)

587 forValues (TypedValue _ _ ty) = f ty

588 forValues _ = mempty

src/Language/PureScript/Bundle.hs+3−3

@@ -43,20 +43,20 @@ data ErrorMessage

43 | UnableToParseModule String

44 | UnsupportedExport

45 | ErrorInModule ModuleIdentifier ErrorMessage

46− deriving (Show, Read)

46+ deriving (Show)

47

48-- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.

49data ModuleType

50 = Regular

51 | Foreign

52− deriving (Show, Read, Eq, Ord)

52+ deriving (Show, Eq, Ord)

53

54showModuleType :: ModuleType -> String

55showModuleType Regular = "Regular"

56showModuleType Foreign = "Foreign"

57

58-- | A module is identified by its module name and its type.

59−data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Read, Eq, Ord)

59+data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)

60

61moduleName :: ModuleIdentifier -> String

62moduleName (ModuleIdentifier name _) = name

src/Language/PureScript/CodeGen/JS.hs+3−1

@@ -27,7 +27,9 @@ import Language.PureScript.CodeGen.JS.Common as Common

27import Language.PureScript.CodeGen.JS.Optimizer

28import Language.PureScript.CoreFn

29import Language.PureScript.Crash

30−import Language.PureScript.Errors

30+import Language.PureScript.Errors (ErrorMessageHint(..), SimpleErrorMessage(..),

31+ MultipleErrors(..), rethrow,

32+ errorMessage, rethrowWithPosition, addHint)

31import Language.PureScript.Names

33import Language.PureScript.Names

32import Language.PureScript.Options

34import Language.PureScript.Options

33import Language.PureScript.Traversals (sndM)

35import Language.PureScript.Traversals (sndM)

src/Language/PureScript/CodeGen/JS/AST.hs+3−3

@@ -35,7 +35,7 @@ data UnaryOperator

35 -- Constructor

36 --

37 | JSNew

38− deriving (Show, Read, Eq)

38+ deriving (Show, Eq)

39

40-- |

41-- Built-in binary operators

@@ -117,7 +117,7 @@ data BinaryOperator

117 -- Bitwise right shift with zero-fill

118 --

119 | ZeroFillShiftRight

120− deriving (Show, Read, Eq)

120+ deriving (Show, Eq)

121

122-- |

123-- Data type for simplified Javascript expressions

@@ -238,7 +238,7 @@ data JS

238 -- |

239 -- Commented Javascript

240 --

241− | JSComment (Maybe SourceSpan) [Comment] JS deriving (Show, Read, Eq)

241+ | JSComment (Maybe SourceSpan) [Comment] JS deriving (Show, Eq)

242

243withSourceSpan :: SourceSpan -> JS -> JS

244withSourceSpan withSpan = go

src/Language/PureScript/Comments.hs+1−1

@@ -12,6 +12,6 @@ import Data.Aeson.TH

12data Comment

13 = LineComment String

14 | BlockComment String

15− deriving (Show, Read, Eq, Ord)

15+ deriving (Show, Eq, Ord)

16

17$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Comment)

src/Language/PureScript/CoreFn/Binders.hs+1−1

@@ -31,7 +31,7 @@ data Binder a

31 -- |

32 -- A binder which binds its input to an identifier

33 --

34− | NamedBinder a Ident (Binder a) deriving (Show, Read, Functor)

34+ | NamedBinder a Ident (Binder a) deriving (Show, Functor)

35

36

37extractBinderAnn :: Binder a -> a

src/Language/PureScript/CoreFn/Expr.hs+3−3

@@ -51,7 +51,7 @@ data Expr a

51 -- A let binding

52 --

53 | Let a [Bind a] (Expr a)

54− deriving (Show, Read, Functor)

54+ deriving (Show, Functor)

55

56-- |

57-- A let or module binding.

@@ -64,7 +64,7 @@ data Bind a

64 -- |

65 -- Mutually recursive binding group for several values

66 --

67− | Rec [((a, Ident), Expr a)] deriving (Show, Read, Functor)

67+ | Rec [((a, Ident), Expr a)] deriving (Show, Functor)

68

69-- |

70-- A guard is just a boolean-valued expression that appears alongside a set of binders

@@ -83,7 +83,7 @@ data CaseAlternative a = CaseAlternative

83 -- The result expression or a collect of guarded expressions

84 --

85 , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)

86− } deriving (Show, Read)

86+ } deriving (Show)

87

88instance Functor CaseAlternative where

89

src/Language/PureScript/CoreFn/Meta.hs+2−2

@@ -26,7 +26,7 @@ data Meta

26 -- |

27 -- The contained reference is for a foreign member

28 --

29− | IsForeign deriving (Show, Read, Eq)

29+ | IsForeign deriving (Show, Eq)

30

31-- |

32-- Data constructor metadata

@@ -39,4 +39,4 @@ data ConstructorType

39 -- |

40 -- The constructor is for a type with multiple construcors

41 --

42− | SumType deriving (Show, Read, Eq)

42+ | SumType deriving (Show, Eq)

src/Language/PureScript/CoreFn/Module.hs+1−1

@@ -17,6 +17,6 @@ data Module a = Module

17 , moduleExports :: [Ident]

18 , moduleForeign :: [ForeignDecl]

19 , moduleDecls :: [Bind a]

20− } deriving (Show, Read)

20+ } deriving (Show)

21

22type ForeignDecl = (Ident, Type)

src/Language/PureScript/Docs/AsMarkdown.hs+1−1

@@ -110,7 +110,7 @@ childToString f decl@ChildDeclaration{..} =

110data First

111 = First

112 | NotFirst

113− deriving (Show, Read, Eq, Ord)

113+ deriving (Show, Eq, Ord)

114

115type Docs = Writer [String] ()

116

src/Language/PureScript/Environment.hs+5−5

@@ -46,7 +46,7 @@ data Environment = Environment {

46 -- Type classes

47 --

48 , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])

49− } deriving (Show, Read)

49+ } deriving (Show)

50

51-- |

52-- The initial environment with no values and only the default javascript types defined

@@ -65,7 +65,7 @@ data NameVisibility

65 -- |

66 -- The name is defined in the another binding group, or has been made visible by a function binder

67 --

68− | Defined deriving (Show, Read, Eq)

68+ | Defined deriving (Show, Eq)

69

70-- |

71-- A flag for whether a name is for an private or public value - only public values will be

@@ -85,7 +85,7 @@ data NameKind

85 -- A name for member introduced by foreign import

86 --

87 | External

88− deriving (Show, Read, Eq)

88+ deriving (Show, Eq)

89

90-- |

91-- The kinds of a type

@@ -111,7 +111,7 @@ data TypeKind

111 -- A scoped type variable

112 --

113 | ScopedTypeVar

114− deriving (Show, Read, Eq)

114+ deriving (Show, Eq)

115

116-- |

117-- The type ('data' or 'newtype') of a data type declaration

@@ -125,7 +125,7 @@ data DataDeclType

125 -- A newtype constructor

126 --

127 | Newtype

128− deriving (Show, Read, Eq, Ord)

128+ deriving (Show, Eq, Ord)

129

130showDataDeclType :: DataDeclType -> String

131showDataDeclType Data = "data"

src/Language/PureScript/Errors.hs+32−143

@@ -1,7 +1,10 @@

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE NamedFieldPuns #-}

3

4−module Language.PureScript.Errors where

4+module Language.PureScript.Errors

5+ ( module Language.PureScript.AST

6+ , module Language.PureScript.Errors

7+ ) where

5

8

6import Prelude.Compat

9import Prelude.Compat

7

10

@@ -21,7 +24,6 @@ import qualified Data.Map as M

21

24

22import Language.PureScript.AST

25import Language.PureScript.AST

23import Language.PureScript.Crash

26import Language.PureScript.Crash

24−import Language.PureScript.Kinds

25import Language.PureScript.Names

27import Language.PureScript.Names

26import Language.PureScript.Pretty

28import Language.PureScript.Pretty

27import Language.PureScript.Traversals

29import Language.PureScript.Traversals

@@ -37,137 +39,6 @@ import qualified Text.Parsec.Error as PE

37import qualified Text.PrettyPrint.Boxes as Box

39import qualified Text.PrettyPrint.Boxes as Box

38import Text.Parsec.Error (Message(..))

40import Text.Parsec.Error (Message(..))

39

41

40−-- | A type of error messages

41−data SimpleErrorMessage

42− = ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)

43− | ErrorParsingModule P.ParseError

44− | MissingFFIModule ModuleName

45− | MultipleFFIModules ModuleName [FilePath]

46− | UnnecessaryFFIModule ModuleName FilePath

47− | MissingFFIImplementations ModuleName [Ident]

48− | UnusedFFIImplementations ModuleName [Ident]

49− | InvalidFFIIdentifier ModuleName String

50− | CannotGetFileInfo FilePath

51− | CannotReadFile FilePath

52− | CannotWriteFile FilePath

53− | InfiniteType Type

54− | InfiniteKind Kind

55− | MultipleValueOpFixities (OpName 'ValueOpName)

56− | MultipleTypeOpFixities (OpName 'TypeOpName)

57− | OrphanTypeDeclaration Ident

58− | RedefinedModule ModuleName [SourceSpan]

59− | RedefinedIdent Ident

60− | OverlappingNamesInLet

61− | UnknownName (Qualified Name)

62− | UnknownImport ModuleName Name

63− | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)

64− | UnknownExport Name

65− | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)

66− | ScopeConflict Name [ModuleName]

67− | ScopeShadowing Name (Maybe ModuleName) [ModuleName]

68− | DeclConflict Name Name

69− | ExportConflict (Qualified Name) (Qualified Name)

70− | DuplicateModuleName ModuleName

71− | DuplicateTypeArgument String

72− | InvalidDoBind

73− | InvalidDoLet

74− | CycleInDeclaration Ident

75− | CycleInTypeSynonym (Maybe (ProperName 'TypeName))

76− | CycleInModules [ModuleName]

77− | NameIsUndefined Ident

78− | UndefinedTypeVariable (ProperName 'TypeName)

79− | PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))

80− | EscapedSkolem (Maybe Expr)

81− | TypesDoNotUnify Type Type

82− | KindsDoNotUnify Kind Kind

83− | ConstrainedTypeUnified Type Type

84− | OverlappingInstances (Qualified (ProperName 'ClassName)) [Type] [Qualified Ident]

85− | NoInstanceFound Constraint

86− | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]

87− | CannotDerive (Qualified (ProperName 'ClassName)) [Type]

88− | CannotFindDerivingType (ProperName 'TypeName)

89− | DuplicateLabel String (Maybe Expr)

90− | DuplicateValueDeclaration Ident

91− | ArgListLengthsDiffer Ident

92− | OverlappingArgNames (Maybe Ident)

93− | MissingClassMember Ident

94− | ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))

95− | ExpectedType Type Kind

96− | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName))

97− | ExprDoesNotHaveType Expr Type

98− | PropertyIsMissing String

99− | AdditionalProperty String

100− | CannotApplyFunction Type Expr

101− | TypeSynonymInstance

102− | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]

103− | InvalidNewtype (ProperName 'TypeName)

104− | InvalidInstanceHead Type

105− | TransitiveExportError DeclarationRef [DeclarationRef]

106− | TransitiveDctorExportError DeclarationRef (ProperName 'ConstructorName)

107− | ShadowedName Ident

108− | ShadowedTypeVar String

109− | UnusedTypeVar String

110− | WildcardInferredType Type

111− | HoleInferredType String Type [(Ident, Type)]

112− | MissingTypeDeclaration Ident Type

113− | OverlappingPattern [[Binder]] Bool

114− | IncompleteExhaustivityCheck

115− | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)

116− | ImportHidingModule ModuleName

117− | UnusedImport ModuleName

118− | UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]

119− | UnusedDctorImport (ProperName 'TypeName)

120− | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]

121− | DuplicateSelectiveImport ModuleName

122− | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)

123− | DuplicateImportRef Name

124− | DuplicateExportRef Name

125− | IntOutOfRange Integer String Integer Integer

126− | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]

127− | ImplicitImport ModuleName [DeclarationRef]

128− | HidingImport ModuleName [DeclarationRef]

129− | CaseBinderLengthDiffers Int [Binder]

130− | IncorrectAnonymousArgument

131− | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)

132− | DeprecatedRequirePath

133− | CannotGeneralizeRecursiveFunction Ident Type

134− deriving (Show)

135−

136−-- | Error message hints, providing more detailed information about failure.

137−data ErrorMessageHint

138− = ErrorUnifyingTypes Type Type

139− | ErrorInExpression Expr

140− | ErrorInModule ModuleName

141− | ErrorInInstance (Qualified (ProperName 'ClassName)) [Type]

142− | ErrorInSubsumption Type Type

143− | ErrorCheckingAccessor Expr String

144− | ErrorCheckingType Expr Type

145− | ErrorCheckingKind Type

146− | ErrorCheckingGuard

147− | ErrorInferringType Expr

148− | ErrorInApplication Expr Type Expr

149− | ErrorInDataConstructor (ProperName 'ConstructorName)

150− | ErrorInTypeConstructor (ProperName 'TypeName)

151− | ErrorInBindingGroup [Ident]

152− | ErrorInDataBindingGroup

153− | ErrorInTypeSynonym (ProperName 'TypeName)

154− | ErrorInValueDeclaration Ident

155− | ErrorInTypeDeclaration Ident

156− | ErrorInForeignImport Ident

157− | PositionedError SourceSpan

158− deriving Show

159−

160−-- | Categories of hints

161−data HintCategory

162− = ExprHint

163− | KindHint

164− | CheckHint

165− | PositionHint

166− | OtherHint

167− deriving (Show, Eq)

168−

169−data ErrorMessage = ErrorMessage [ErrorMessageHint] SimpleErrorMessage deriving (Show)

170−

171newtype ErrorSuggestion = ErrorSuggestion String

42newtype ErrorSuggestion = ErrorSuggestion String

172

43

173-- | Get the source span for an error

44-- | Get the source span for an error

@@ -321,7 +192,11 @@ onErrorMessages f = MultipleErrors . map f . runMultipleErrors

321

192

322-- | Add a hint to an error message

193-- | Add a hint to an error message

323addHint :: ErrorMessageHint -> MultipleErrors -> MultipleErrors

194addHint :: ErrorMessageHint -> MultipleErrors -> MultipleErrors

195+addHint hint = addHints [hint]

196+

197+-- | Add hints to an error message

198+addHints :: [ErrorMessageHint] -> MultipleErrors -> MultipleErrors

324−addHint hint = onErrorMessages $ \(ErrorMessage hints se) -> ErrorMessage (hint : hints) se

199+addHints hints = onErrorMessages $ \(ErrorMessage hints' se) -> ErrorMessage (hints ++ hints') se

325

200

326-- | A map from rigid type variable name/unknown variable pairs to new variables.

201-- | A map from rigid type variable name/unknown variable pairs to new variables.

327data TypeMap = TypeMap

202data TypeMap = TypeMap

@@ -396,6 +271,7 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

396 gHint (ErrorCheckingKind t) = ErrorCheckingKind <$> f t

271 gHint (ErrorCheckingKind t) = ErrorCheckingKind <$> f t

397 gHint (ErrorInApplication e1 t1 e2) = ErrorInApplication e1 <$> f t1 <*> pure e2

272 gHint (ErrorInApplication e1 t1 e2) = ErrorInApplication e1 <$> f t1 <*> pure e2

398 gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts

273 gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts

274+ gHint (ErrorSolvingConstraint con) = ErrorSolvingConstraint <$> overConstraintArgs (traverse f) con

399 gHint other = pure other

275 gHint other = pure other

400

276

401wikiUri :: ErrorMessage -> String

277wikiUri :: ErrorMessage -> String

@@ -1062,6 +938,14 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

1062 paras [ detail

938 paras [ detail

1063 , line $ "in foreign import " ++ markCode (showIdent nm)

939 , line $ "in foreign import " ++ markCode (showIdent nm)

1064 ]

940 ]

941+ renderHint (ErrorSolvingConstraint (Constraint nm ts _)) detail =

942+ paras [ detail

943+ , line "while solving type class constriant"

944+ , markCodeBox $ indent $ Box.hsep 1 Box.left

945+ [ line (showQualified runProperName nm)

946+ , Box.vcat Box.left (map typeAtomAsBox ts)

947+ ]

948+ ]

1065 renderHint (PositionedError srcSpan) detail =

949 renderHint (PositionedError srcSpan) detail =

1066 paras [ line $ "at " ++ displaySourceSpan srcSpan

950 paras [ line $ "at " ++ displaySourceSpan srcSpan

1067 , detail

951 , detail

@@ -1139,6 +1023,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

1139 where

1023 where

1140 isUnifyHint ErrorUnifyingTypes{} = True

1024 isUnifyHint ErrorUnifyingTypes{} = True

1141 isUnifyHint _ = False

1025 isUnifyHint _ = False

1026+ stripRedudantHints NoInstanceFound{} = stripFirst isSolverHint

1027+ where

1028+ isSolverHint ErrorSolvingConstraint{} = True

1029+ isSolverHint _ = False

1142 stripRedudantHints _ = id

1030 stripRedudantHints _ = id

1143

1031

1144 stripFirst :: (ErrorMessageHint -> Bool) -> [ErrorMessageHint] -> [ErrorMessageHint]

1032 stripFirst :: (ErrorMessageHint -> Bool) -> [ErrorMessageHint] -> [ErrorMessageHint]

@@ -1150,15 +1038,16 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

1150 stripFirst _ [] = []

1038 stripFirst _ [] = []

1151

1039

1152 hintCategory :: ErrorMessageHint -> HintCategory

1040 hintCategory :: ErrorMessageHint -> HintCategory

1153− hintCategory ErrorCheckingType{} = ExprHint

1041+ hintCategory ErrorCheckingType{} = ExprHint

1154− hintCategory ErrorInferringType{} = ExprHint

1042+ hintCategory ErrorInferringType{} = ExprHint

1155− hintCategory ErrorInExpression{} = ExprHint

1043+ hintCategory ErrorInExpression{} = ExprHint

1156− hintCategory ErrorUnifyingTypes{} = CheckHint

1044+ hintCategory ErrorUnifyingTypes{} = CheckHint

1157− hintCategory ErrorInSubsumption{} = CheckHint

1045+ hintCategory ErrorInSubsumption{} = CheckHint

1158− hintCategory ErrorInApplication{} = CheckHint

1046+ hintCategory ErrorInApplication{} = CheckHint

1159− hintCategory ErrorCheckingKind{} = CheckHint

1047+ hintCategory ErrorCheckingKind{} = CheckHint

1048+ hintCategory ErrorSolvingConstraint{} = SolverHint

1160− hintCategory PositionedError{} = PositionHint

1049+ hintCategory PositionedError{} = PositionHint

1161− hintCategory _ = OtherHint

1050+ hintCategory _ = OtherHint

1162

1051

1163-- Pretty print and export declaration

1052-- Pretty print and export declaration

1164prettyPrintExport :: DeclarationRef -> String

1053prettyPrintExport :: DeclarationRef -> String

src/Language/PureScript/Externs.hs+5−5

@@ -50,7 +50,7 @@ data ExternsFile = ExternsFile

50 , efTypeFixities :: [ExternsTypeFixity]

51 -- | List of type and value declaration

52 , efDeclarations :: [ExternsDeclaration]

53− } deriving (Show, Read)

53+ } deriving (Show)

54

55-- | A module import in an externs file

56data ExternsImport = ExternsImport

@@ -61,7 +61,7 @@ data ExternsImport = ExternsImport

61 , eiImportType :: ImportDeclarationType

62 -- | The imported-as name, for qualified imports

63 , eiImportedAs :: Maybe ModuleName

64− } deriving (Show, Read)

64+ } deriving (Show)

65

66-- | A fixity declaration in an externs file

67data ExternsFixity = ExternsFixity

@@ -74,7 +74,7 @@ data ExternsFixity = ExternsFixity

74 , efOperator :: OpName 'ValueOpName

75 -- | The value the operator is an alias for

76 , efAlias :: Qualified (Either Ident (ProperName 'ConstructorName))

77− } deriving (Show, Read)

77+ } deriving (Show)

78

79-- | A type fixity declaration in an externs file

80data ExternsTypeFixity = ExternsTypeFixity

@@ -87,7 +87,7 @@ data ExternsTypeFixity = ExternsTypeFixity

87 , efTypeOperator :: OpName 'TypeOpName

88 -- | The value the operator is an alias for

89 , efTypeAlias :: Qualified (ProperName 'TypeName)

90− } deriving (Show, Read)

90+ } deriving (Show)

91

92-- | A type or value declaration appearing in an externs file

93data ExternsDeclaration =

@@ -130,7 +130,7 @@ data ExternsDeclaration =

130 , edInstanceTypes :: [Type]

131 , edInstanceConstraints :: Maybe [Constraint]

132 }

133− deriving (Show, Read)

133+ deriving (Show)

134

135-- | Convert an externs file back into a module

136applyExternsFileToEnvironment :: ExternsFile -> Environment -> Environment

src/Language/PureScript/Interactive/Completion.hs+1−1

@@ -91,7 +91,7 @@ data CompletionContext

91 | CtxIdentifier

92 | CtxType

93 | CtxFixed String

94− deriving (Show, Read)

94+ deriving (Show)

95

96-- |

97-- Decide what kind of completion we need based on input. This function expects

src/Language/PureScript/Kinds.hs+1−1

@@ -20,7 +20,7 @@ data Kind

20 | FunKind Kind Kind

21 -- | Type-level strings

22 | Symbol

23− deriving (Show, Read, Eq, Ord)

23+ deriving (Show, Eq, Ord)

24

25$(A.deriveJSON A.defaultOptions ''Kind)

26

src/Language/PureScript/Make.hs+2−2

@@ -85,7 +85,7 @@ import qualified Text.Parsec as Parsec

85-- | Progress messages from the make process

86data ProgressMessage

87 = CompilingModule ModuleName

88− deriving (Show, Read, Eq, Ord)

88+ deriving (Show, Eq, Ord)

89

90-- | Render a progress message

91renderProgressMessage :: ProgressMessage -> String

@@ -129,7 +129,7 @@ data RebuildPolicy

129 -- | Never rebuild this module

130 = RebuildNever

131 -- | Always rebuild this module

132− | RebuildAlways deriving (Show, Read, Eq, Ord)

132+ | RebuildAlways deriving (Show, Eq, Ord)

133

134-- | Rebuild a single module

135rebuildModule :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

src/Language/PureScript/Names.hs+5−5

@@ -64,7 +64,7 @@ data Ident

64 -- A generated name for an identifier

65 --

66 | GenIdent (Maybe String) Integer

67− deriving (Show, Read, Eq, Ord)

67+ deriving (Show, Eq, Ord)

68

69runIdent :: Ident -> String

70runIdent (Ident i) = i

@@ -84,7 +84,7 @@ freshIdent' = GenIdent Nothing <$> fresh

84-- Operator alias names.

85--

86newtype OpName (a :: OpNameType) = OpName { runOpName :: String }

87− deriving (Show, Read, Eq, Ord)

87+ deriving (Show, Eq, Ord)

88

89instance ToJSON (OpName a) where

90 toJSON = toJSON . runOpName

@@ -104,7 +104,7 @@ data OpNameType = ValueOpName | TypeOpName

104-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.

105--

106newtype ProperName (a :: ProperNameType) = ProperName { runProperName :: String }

107− deriving (Show, Read, Eq, Ord)

107+ deriving (Show, Eq, Ord)

108

109instance ToJSON (ProperName a) where

110 toJSON = toJSON . runProperName

@@ -129,7 +129,7 @@ coerceProperName = ProperName . runProperName

129-- Module names

130--

131newtype ModuleName = ModuleName [ProperName 'Namespace]

132− deriving (Show, Read, Eq, Ord)

132+ deriving (Show, Eq, Ord)

133

134runModuleName :: ModuleName -> String

135runModuleName (ModuleName pns) = intercalate "." (runProperName `map` pns)

@@ -146,7 +146,7 @@ moduleNameFromString = ModuleName . splitProperNames

146-- A qualified name, i.e. a name with an optional module name

147--

148data Qualified a = Qualified (Maybe ModuleName) a

149− deriving (Show, Read, Eq, Ord, Functor)

149+ deriving (Show, Eq, Ord, Functor)

150

151showQualified :: (a -> String) -> Qualified a -> String

152showQualified f (Qualified Nothing a) = f a

src/Language/PureScript/Parser/Lexer.hs+1−1

@@ -104,7 +104,7 @@ data Token

104 | StringLiteral String

105 | Number (Either Integer Double)

106 | HoleLit String

107− deriving (Show, Read, Eq, Ord)

107+ deriving (Show, Eq, Ord)

108

109prettyPrintToken :: Token -> String

110prettyPrintToken LParen = "("

src/Language/PureScript/Pretty/Values.hs+1−1

@@ -60,7 +60,7 @@ prettyPrintValue d (Let ds val) =

60 (text "in " <> prettyPrintValue (d - 1) val)

61prettyPrintValue d (Do els) =

62 text "do " <> vcat left (map (prettyPrintDoNotationElement (d - 1)) els)

63−prettyPrintValue _ (TypeClassDictionary (Constraint name tys _) _) = foldl1 beforeWithSpace $ text ("#dict " ++ runProperName (disqualify name)) : map typeAtomAsBox tys

63+prettyPrintValue _ (TypeClassDictionary (Constraint name tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ runProperName (disqualify name)) : map typeAtomAsBox tys

64prettyPrintValue _ (SuperClassDictionary name _) = text $ "#dict " ++ runProperName (disqualify name)

65prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =

66 text "#dict-accessor " <> text (runProperName (disqualify className)) <> text "." <> text (showIdent ident) <> text ">"

src/Language/PureScript/Publish.hs+2−2

@@ -169,7 +169,7 @@ getModulesAndBookmarks = do

169 Left err ->

170 userError (CompileError err)

171

172−data TreeStatus = Clean | Dirty deriving (Show, Read, Eq, Ord, Enum)

172+data TreeStatus = Clean | Dirty deriving (Show, Eq, Ord, Enum)

173

174getGitWorkingTreeStatus :: PrepareM TreeStatus

175getGitWorkingTreeStatus = do

@@ -273,7 +273,7 @@ data DependencyStatus

273 | ResolvedVersion String

274 -- ^ Resolved to a version. The String argument is the resolution tag (eg,

275 -- "v0.1.0").

276− deriving (Show, Read, Eq)

276+ deriving (Show, Eq)

277

278-- Go through all bower dependencies which contain purescript code, and

279-- extract their versions.

src/Language/PureScript/Sugar/Names/Env.hs+4−4

@@ -49,7 +49,7 @@ data ImportRecord a =

49 , importSourceModule :: ModuleName

50 , importProvenance :: ImportProvenance

51 }

52− deriving (Eq, Ord, Show, Read)

52+ deriving (Eq, Ord, Show)

53

54-- |

55-- Used to track how an import was introduced into scope. This allows us to

@@ -61,7 +61,7 @@ data ImportProvenance

61 | FromExplicit

62 | Local

63 | Prim

64− deriving (Eq, Ord, Show, Read)

64+ deriving (Eq, Ord, Show)

65

66type ImportMap a = M.Map (Qualified a) [ImportRecord a]

67

@@ -104,7 +104,7 @@ data Imports = Imports

104 -- The "as" names of modules that have been imported qualified.

105 --

106 , importedQualModules :: S.Set ModuleName

107− } deriving (Show, Read)

107+ } deriving (Show)

108

109nullImports :: Imports

110nullImports = Imports M.empty M.empty M.empty M.empty M.empty M.empty S.empty S.empty

@@ -155,7 +155,7 @@ data Exports = Exports

155 -- from.

156 --

157 , exportedValueOps :: M.Map (OpName 'ValueOpName) ModuleName

158− } deriving (Show, Read)

158+ } deriving (Show)

159

160-- |

161-- An empty 'Exports' value.

src/Language/PureScript/Sugar/Operators.hs+2−2

@@ -329,9 +329,9 @@ updateTypes goType = (goDecl, goExpr, goBinder)

329

330 goExpr :: Maybe SourceSpan -> Expr -> m (Maybe SourceSpan, Expr)

331 goExpr _ e@(PositionedValue pos _ _) = return (Just pos, e)

332− goExpr pos (TypeClassDictionary (Constraint name tys info) dicts) = do

332+ goExpr pos (TypeClassDictionary (Constraint name tys info) dicts hints) = do

333 tys' <- traverse (goType' pos) tys

334− return (pos, TypeClassDictionary (Constraint name tys' info) dicts)

334+ return (pos, TypeClassDictionary (Constraint name tys' info) dicts hints)

335 goExpr pos (SuperClassDictionary cls tys) = do

336 tys' <- traverse (goType' pos) tys

337 return (pos, SuperClassDictionary cls tys')

src/Language/PureScript/Sugar/TypeClasses.hs+1−2

@@ -11,9 +11,8 @@ module Language.PureScript.Sugar.TypeClasses

11import Prelude.Compat

12

13import Language.PureScript.Crash

14−import Language.PureScript.AST hiding (isExported)

15import Language.PureScript.Environment

14import Language.PureScript.Environment

16−import Language.PureScript.Errors

15+import Language.PureScript.Errors hiding (isExported)

17import Language.PureScript.Kinds

16import Language.PureScript.Kinds

18import Language.PureScript.Names

17import Language.PureScript.Names

19import Language.PureScript.Externs

18import Language.PureScript.Externs

src/Language/PureScript/TypeChecker/Entailment.hs+6−4

@@ -22,6 +22,7 @@ import Language.PureScript.AST

22import Language.PureScript.Crash

23import Language.PureScript.Errors

24import Language.PureScript.Names

25+import Language.PureScript.TypeChecker.Monad (CheckState, withErrorMessageHint)

25import Language.PureScript.TypeChecker.Unify

26import Language.PureScript.TypeChecker.Unify

26import Language.PureScript.TypeClassDictionaries

27import Language.PureScript.TypeClassDictionaries

27import Language.PureScript.Types

28import Language.PureScript.Types

@@ -39,7 +40,7 @@ combineContexts = M.unionWith (M.unionWith M.union)

39

40

40-- | Replace type class dictionary placeholders with inferred type class dictionaries

41-- | Replace type class dictionary placeholders with inferred type class dictionaries

41replaceTypeClassDictionaries

42replaceTypeClassDictionaries

42− :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)

43+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)

43 => Bool

44 => Bool

44 -> ModuleName

45 -> ModuleName

45 -> Expr

46 -> Expr

@@ -48,7 +49,8 @@ replaceTypeClassDictionaries shouldGeneralize mn =

48 let (_, f, _) = everywhereOnValuesTopDownM return (WriterT . go) return

49 let (_, f, _) = everywhereOnValuesTopDownM return (WriterT . go) return

49 in flip evalStateT M.empty . runWriterT . f

50 in flip evalStateT M.empty . runWriterT . f

50 where

51 where

51− go (TypeClassDictionary constraint dicts) = entails shouldGeneralize mn dicts constraint

52+ go (TypeClassDictionary constraint dicts hints) =

53+ rethrow (addHints hints) $ entails shouldGeneralize mn dicts constraint

52 go other = return (other, [])

54 go other = return (other, [])

53

55

54-- |

56-- |

@@ -57,7 +59,7 @@ replaceTypeClassDictionaries shouldGeneralize mn =

57--

59--

58entails

60entails

59 :: forall m

61 :: forall m

60− . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)

62+ . (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)

61 => Bool

63 => Bool

62 -> ModuleName

64 -> ModuleName

63 -> Context

65 -> Context

@@ -79,7 +81,7 @@ entails shouldGeneralize moduleName context = solve

79 findDicts ctx cn = maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup ctx

81 findDicts ctx cn = maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup ctx

80

82

81 solve :: Constraint -> StateT Context m (Expr, [(Ident, Constraint)])

83 solve :: Constraint -> StateT Context m (Expr, [(Ident, Constraint)])

82− solve con = do

84+ solve con = StateT . (withErrorMessageHint (ErrorSolvingConstraint con) .) . runStateT $ do

83 (dict, unsolved) <- go 0 con

85 (dict, unsolved) <- go 0 con

84 return (dictionaryValueToValue dict, unsolved)

86 return (dictionaryValueToValue dict, unsolved)

85 where

87 where

src/Language/PureScript/TypeChecker/Kinds.hs+2−2

@@ -107,7 +107,7 @@ kindOfWithScopedVars ::

107 Type ->

108 m (Kind, [(String, Kind)])

109kindOfWithScopedVars ty =

110− rethrow (addHint (ErrorCheckingKind ty)) $

110+ withErrorMessageHint (ErrorCheckingKind ty) $

111 fmap tidyUp . liftUnify $ infer ty

112 where

113 tidyUp ((k, args), sub) = ( starIfUnknown (substituteKind sub k)

@@ -200,7 +200,7 @@ infer

200 :: (MonadError MultipleErrors m, MonadState CheckState m)

201 => Type

202 -> m (Kind, [(String, Kind)])

203−infer ty = rethrow (addHint (ErrorCheckingKind ty)) $ infer' ty

203+infer ty = withErrorMessageHint (ErrorCheckingKind ty) $ infer' ty

204

205infer'

206 :: forall m

src/Language/PureScript/TypeChecker/Monad.hs+47−8

@@ -35,18 +35,30 @@ emptySubstitution = Substitution M.empty M.empty

35

36-- | State required for type checking

37data CheckState = CheckState

38+ { checkEnv :: Environment

38− { checkEnv :: Environment -- ^ The current @Environment@

39+ -- ^ The current @Environment@

40+ , checkNextType :: Int

39− , checkNextType :: Int -- ^ The next type unification variable

41+ -- ^ The next type unification variable

42+ , checkNextKind :: Int

40− , checkNextKind :: Int -- ^ The next kind unification variable

43+ -- ^ The next kind unification variable

44+ , checkNextSkolem :: Int

41− , checkNextSkolem :: Int -- ^ The next skolem variable

45+ -- ^ The next skolem variable

46+ , checkNextSkolemScope :: Int

42− , checkNextSkolemScope :: Int -- ^ The next skolem scope constant

47+ -- ^ The next skolem scope constant

43− , checkCurrentModule :: Maybe ModuleName -- ^ The current module

48+ , checkCurrentModule :: Maybe ModuleName

49+ -- ^ The current module

44− , checkSubstitution :: Substitution -- ^ The current substitution

50+ , checkSubstitution :: Substitution

51+ -- ^ The current substitution

52+ , checkHints :: [ErrorMessageHint]

53+ -- ^ The current error message hint stack.

54+ -- This goes into state, rather than using 'rethrow',

55+ -- since this way, we can provide good error messages

56+ -- during instance resolution.

45 }

57 }

46

58

47-- | Create an empty @CheckState@

59-- | Create an empty @CheckState@

48emptyCheckState :: Environment -> CheckState

60emptyCheckState :: Environment -> CheckState

49−emptyCheckState env = CheckState env 0 0 0 0 Nothing emptySubstitution

61+emptyCheckState env = CheckState env 0 0 0 0 Nothing emptySubstitution []

50

62

51-- | Unification variables

63-- | Unification variables

52type Unknown = Int

64type Unknown = Int

@@ -91,6 +103,33 @@ withScopedTypeVars mn ks ma = do

91 tell . errorMessage $ ShadowedTypeVar name

103 tell . errorMessage $ ShadowedTypeVar name

92 bindTypes (M.fromList (map (\(name, k) -> (Qualified (Just mn) (ProperName name), (k, ScopedTypeVar))) ks)) ma

104 bindTypes (M.fromList (map (\(name, k) -> (Qualified (Just mn) (ProperName name), (k, ScopedTypeVar))) ks)) ma

93

105

106+withErrorMessageHint

107+ :: (MonadState CheckState m, MonadError MultipleErrors m)

108+ => ErrorMessageHint

109+ -> m a

110+ -> m a

111+withErrorMessageHint hint action = do

112+ orig <- get

113+ modify $ \st -> st { checkHints = hint : checkHints st }

114+ -- Need to use 'rethrow' anyway, since we have to handle regular errors

115+ a <- rethrow (addHint hint) action

116+ modify $ \st -> st { checkHints = checkHints orig }

117+ return a

118+

119+rethrowWithPositionTC

120+ :: (MonadState CheckState m, MonadError MultipleErrors m)

121+ => SourceSpan

122+ -> m a

123+ -> m a

124+rethrowWithPositionTC pos = withErrorMessageHint (PositionedError pos)

125+

126+warnAndRethrowWithPositionTC

127+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

128+ => SourceSpan

129+ -> m a

130+ -> m a

131+warnAndRethrowWithPositionTC pos = rethrowWithPositionTC pos . warnWithPosition pos

132+

94-- | Temporarily make a collection of type class dictionaries available

133-- | Temporarily make a collection of type class dictionaries available

95withTypeClassDictionaries

134withTypeClassDictionaries

96 :: MonadState CheckState m

135 :: MonadState CheckState m

src/Language/PureScript/TypeChecker/Subsumption.hs+4−3

@@ -8,7 +8,7 @@ module Language.PureScript.TypeChecker.Subsumption

8import Prelude.Compat

9

10import Control.Monad.Error.Class (MonadError(..))

11−import Control.Monad.State.Class (MonadState(..))

11+import Control.Monad.State.Class (MonadState(..), gets)

12

13import Data.List (sortBy)

14import Data.Ord (comparing)

@@ -24,7 +24,7 @@ import Language.PureScript.Types

24

25-- | Check that one type subsumes another, rethrowing errors to provide a better error message

26subsumes :: (MonadError MultipleErrors m, MonadState CheckState m) => Maybe Expr -> Type -> Type -> m (Maybe Expr)

27−subsumes val ty1 ty2 = rethrow (addHint (ErrorInSubsumption ty1 ty2)) $ subsumes' val ty1 ty2

27+subsumes val ty1 ty2 = withErrorMessageHint (ErrorInSubsumption ty1 ty2) $ subsumes' val ty1 ty2

28

29-- | Check tahat one type subsumes another

30subsumes' :: (MonadError MultipleErrors m, MonadState CheckState m) =>

@@ -52,7 +52,8 @@ subsumes' val ty1 (KindedType ty2 _) =

52 subsumes val ty1 ty2

53subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do

54 dicts <- getTypeClassDictionaries

55+ hints <- gets checkHints

55− subsumes' (Just $ foldl App val (map (flip TypeClassDictionary dicts) constraints)) ty1 ty2

56+ subsumes' (Just $ foldl App val (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) ty1 ty2

56subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyRecord && f2 == tyRecord = do

57subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyRecord && f2 == tyRecord = do

57 let

58 let

58 (ts1, r1') = rowToList r1

59 (ts1, r1') = rowToList r1

src/Language/PureScript/TypeChecker/Types.hs+21−16

@@ -201,7 +201,7 @@ overTypes f = let (_, f', _) = everywhereOnValues id g id in f'

201 where

202 g :: Expr -> Expr

203 g (TypedValue checkTy val t) = TypedValue checkTy val (f t)

204− g (TypeClassDictionary c sco) = TypeClassDictionary (mapConstraintArgs (map f) c) sco

204+ g (TypeClassDictionary c sco hints) = TypeClassDictionary (mapConstraintArgs (map f) c) sco hints

205 g other = other

206

207-- | Check the kind of a type, failing if it is not of kind *.

@@ -227,7 +227,8 @@ instantiatePolyTypeWithUnknowns val (ForAll ident ty _) = do

227 instantiatePolyTypeWithUnknowns val ty'

228instantiatePolyTypeWithUnknowns val (ConstrainedType constraints ty) = do

229 dicts <- getTypeClassDictionaries

230+ hints <- gets checkHints

230− instantiatePolyTypeWithUnknowns (foldl App val (map (flip TypeClassDictionary dicts) constraints)) ty

231+ instantiatePolyTypeWithUnknowns (foldl App val (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) ty

231instantiatePolyTypeWithUnknowns val ty = return (val, ty)

232instantiatePolyTypeWithUnknowns val ty = return (val, ty)

232

233

233-- | Infer a type for a value, rethrowing any error to provide a more useful error message

234-- | Infer a type for a value, rethrowing any error to provide a more useful error message

@@ -235,7 +236,7 @@ infer ::

235 (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

236 (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

236 Expr ->

237 Expr ->

237 m Expr

238 m Expr

238−infer val = rethrow (addHint (ErrorInferringType val)) $ infer' val

239+infer val = withErrorMessageHint (ErrorInferringType val) $ infer' val

239

240

240-- | Infer a type for a value

241-- | Infer a type for a value

241infer' ::

242infer' ::

@@ -267,7 +268,7 @@ infer' (ObjectUpdate o ps) = do

267 let oldTy = TypeApp tyRecord $ rowFromList (oldTys, row)

268 let oldTy = TypeApp tyRecord $ rowFromList (oldTys, row)

268 o' <- TypedValue True <$> check o oldTy <*> pure oldTy

269 o' <- TypedValue True <$> check o oldTy <*> pure oldTy

269 return $ TypedValue True (ObjectUpdate o' newVals) $ TypeApp tyRecord $ rowFromList (newTys, row)

270 return $ TypedValue True (ObjectUpdate o' newVals) $ TypeApp tyRecord $ rowFromList (newTys, row)

270−infer' (Accessor prop val) = rethrow (addHint (ErrorCheckingAccessor val prop)) $ do

271+infer' (Accessor prop val) = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do

271 field <- freshType

272 field <- freshType

272 rest <- freshType

273 rest <- freshType

273 typed <- check val (TypeApp tyRecord (RCons prop field rest))

274 typed <- check val (TypeApp tyRecord (RCons prop field rest))

@@ -290,7 +291,8 @@ infer' (Var var) = do

290 case ty of

291 case ty of

291 ConstrainedType constraints ty' -> do

292 ConstrainedType constraints ty' -> do

292 dicts <- getTypeClassDictionaries

293 dicts <- getTypeClassDictionaries

294+ hints <- gets checkHints

293− return $ TypedValue True (foldl App (Var var) (map (flip TypeClassDictionary dicts) constraints)) ty'

295+ return $ TypedValue True (foldl App (Var var) (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) ty'

294 _ -> return $ TypedValue True (Var var) ty

296 _ -> return $ TypedValue True (Var var) ty

295infer' v@(Constructor c) = do

297infer' v@(Constructor c) = do

296 env <- getEnv

298 env <- getEnv

@@ -316,7 +318,8 @@ infer' (Let ds val) = do

316 return $ TypedValue True (Let ds' val') valTy

318 return $ TypedValue True (Let ds' val') valTy

317infer' (SuperClassDictionary className tys) = do

319infer' (SuperClassDictionary className tys) = do

318 dicts <- getTypeClassDictionaries

320 dicts <- getTypeClassDictionaries

321+ hints <- gets checkHints

319− return $ TypeClassDictionary (Constraint className tys Nothing) dicts

322+ return $ TypeClassDictionary (Constraint className tys Nothing) dicts hints

320infer' (TypedValue checkType val ty) = do

323infer' (TypedValue checkType val ty) = do

321 Just moduleName <- checkCurrentModule <$> get

324 Just moduleName <- checkCurrentModule <$> get

322 (kind, args) <- kindOfWithScopedVars ty

325 (kind, args) <- kindOfWithScopedVars ty

@@ -331,7 +334,7 @@ infer' (Hole name) = do

331 let ctx = [ (ident, ty') | ((mn, ident@Ident{}), (ty', _, Defined)) <- env, mn == moduleName ]

334 let ctx = [ (ident, ty') | ((mn, ident@Ident{}), (ty', _, Defined)) <- env, mn == moduleName ]

332 tell . errorMessage $ HoleInferredType name ty ctx

335 tell . errorMessage $ HoleInferredType name ty ctx

333 return $ TypedValue True (Hole name) ty

336 return $ TypedValue True (Hole name) ty

334−infer' (PositionedValue pos c val) = warnAndRethrowWithPosition pos $ do

337+infer' (PositionedValue pos c val) = warnAndRethrowWithPositionTC pos $ do

335 TypedValue t v ty <- infer' val

338 TypedValue t v ty <- infer' val

336 return $ TypedValue t (PositionedValue pos c v) ty

339 return $ TypedValue t (PositionedValue pos c v) ty

337infer' v = internalError $ "Invalid argument to infer: " ++ show v

340infer' v = internalError $ "Invalid argument to infer: " ++ show v

@@ -368,7 +371,7 @@ inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do

368 bindNames dict $ do

371 bindNames dict $ do

369 makeBindingGroupVisible

372 makeBindingGroupVisible

370 inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j

373 inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j

371−inferLetBinding seen (PositionedDeclaration pos com d : ds) ret j = warnAndRethrowWithPosition pos $ do

374+inferLetBinding seen (PositionedDeclaration pos com d : ds) ret j = warnAndRethrowWithPositionTC pos $ do

372 (d' : ds', val') <- inferLetBinding seen (d : ds) ret j

375 (d' : ds', val') <- inferLetBinding seen (d : ds) ret j

373 return (PositionedDeclaration pos com d' : ds', val')

376 return (PositionedDeclaration pos com d' : ds', val')

374inferLetBinding _ _ _ _ = internalError "Invalid argument to inferLetBinding"

377inferLetBinding _ _ _ _ = internalError "Invalid argument to inferLetBinding"

@@ -426,7 +429,7 @@ inferBinder val (NamedBinder name binder) = do

426 m <- inferBinder val binder

429 m <- inferBinder val binder

427 return $ M.insert name val m

430 return $ M.insert name val m

428inferBinder val (PositionedBinder pos _ binder) =

431inferBinder val (PositionedBinder pos _ binder) =

429− warnAndRethrowWithPosition pos $ inferBinder val binder

432+ warnAndRethrowWithPositionTC pos $ inferBinder val binder

430-- TODO: When adding support for polymorphic types, check subsumption here,

433-- TODO: When adding support for polymorphic types, check subsumption here,

431-- change the definition of `binderRequiresMonotype`,

434-- change the definition of `binderRequiresMonotype`,

432-- and use `kindOfWithScopedVars`.

435-- and use `kindOfWithScopedVars`.

@@ -487,7 +490,7 @@ checkBinders nvals ret (CaseAlternative binders result : bs) = do

487 case result of

490 case result of

488 Left gs -> do

491 Left gs -> do

489 gs' <- forM gs $ \(grd, val) -> do

492 gs' <- forM gs $ \(grd, val) -> do

490− grd' <- rethrow (addHint ErrorCheckingGuard) $ check grd tyBoolean

493+ grd' <- withErrorMessageHint ErrorCheckingGuard $ check grd tyBoolean

491 val' <- TypedValue True <$> check val ret <*> pure ret

494 val' <- TypedValue True <$> check val ret <*> pure ret

492 return (grd', val')

495 return (grd', val')

493 return $ Left gs'

496 return $ Left gs'

@@ -505,7 +508,7 @@ check ::

505 Expr ->

508 Expr ->

506 Type ->

509 Type ->

507 m Expr

510 m Expr

508−check val ty = rethrow (addHint (ErrorCheckingType val ty)) $ check' val ty

511+check val ty = withErrorMessageHint (ErrorCheckingType val ty) $ check' val ty

509

512

510-- |

513-- |

511-- Check the type of a value

514-- Check the type of a value

@@ -599,7 +602,8 @@ check' (SuperClassDictionary className tys) _ = do

599 -- declaration gets desugared.

602 -- declaration gets desugared.

600 -}

603 -}

601 dicts <- getTypeClassDictionaries

604 dicts <- getTypeClassDictionaries

605+ hints <- gets checkHints

602− return $ TypeClassDictionary (Constraint className tys Nothing) dicts

606+ return $ TypeClassDictionary (Constraint className tys Nothing) dicts hints

603check' (TypedValue checkType val ty1) ty2 = do

607check' (TypedValue checkType val ty1) ty2 = do

604 Just moduleName <- checkCurrentModule <$> get

608 Just moduleName <- checkCurrentModule <$> get

605 (kind, args) <- kindOfWithScopedVars ty1

609 (kind, args) <- kindOfWithScopedVars ty1

@@ -638,7 +642,7 @@ check' e@(ObjectUpdate obj ps) t@(TypeApp o row) | o == tyRecord = do

638 obj' <- check obj (TypeApp tyRecord (rowFromList (us ++ remainingProps, rest)))

642 obj' <- check obj (TypeApp tyRecord (rowFromList (us ++ remainingProps, rest)))

639 ps' <- checkProperties e ps row True

643 ps' <- checkProperties e ps row True

640 return $ TypedValue True (ObjectUpdate obj' ps') t

644 return $ TypedValue True (ObjectUpdate obj' ps') t

641−check' (Accessor prop val) ty = rethrow (addHint (ErrorCheckingAccessor val prop)) $ do

645+check' (Accessor prop val) ty = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do

642 rest <- freshType

646 rest <- freshType

643 val' <- check val (TypeApp tyRecord (RCons prop ty rest))

647 val' <- check val (TypeApp tyRecord (RCons prop ty rest))

644 return $ TypedValue True (Accessor prop val') ty

648 return $ TypedValue True (Accessor prop val') ty

@@ -659,7 +663,7 @@ check' val kt@(KindedType ty kind) = do

659 checkTypeKind ty kind

663 checkTypeKind ty kind

660 val' <- check' val ty

664 val' <- check' val ty

661 return $ TypedValue True val' kt

665 return $ TypedValue True val' kt

662−check' (PositionedValue pos c val) ty = warnAndRethrowWithPosition pos $ do

666+check' (PositionedValue pos c val) ty = warnAndRethrowWithPositionTC pos $ do

663 TypedValue t v ty' <- check' val ty

667 TypedValue t v ty' <- check' val ty

664 return $ TypedValue t (PositionedValue pos c v) ty'

668 return $ TypedValue t (PositionedValue pos c v) ty'

665check' val ty = do

669check' val ty = do

@@ -713,7 +717,7 @@ checkFunctionApplication ::

713 Expr ->

717 Expr ->

714 Maybe Type ->

718 Maybe Type ->

715 m (Type, Expr)

719 m (Type, Expr)

716−checkFunctionApplication fn fnTy arg ret = rethrow (addHint (ErrorInApplication fn fnTy arg)) $ do

720+checkFunctionApplication fn fnTy arg ret = withErrorMessageHint (ErrorInApplication fn fnTy arg) $ do

717 subst <- gets checkSubstitution

721 subst <- gets checkSubstitution

718 checkFunctionApplication' fn (substituteType subst fnTy) arg (substituteType subst <$> ret)

722 checkFunctionApplication' fn (substituteType subst fnTy) arg (substituteType subst <$> ret)

719

723

@@ -749,7 +753,8 @@ checkFunctionApplication' fn (KindedType ty _) arg ret =

749 checkFunctionApplication fn ty arg ret

753 checkFunctionApplication fn ty arg ret

750checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do

754checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do

751 dicts <- getTypeClassDictionaries

755 dicts <- getTypeClassDictionaries

756+ hints <- gets checkHints

752− checkFunctionApplication' (foldl App fn (map (flip TypeClassDictionary dicts) constraints)) fnTy arg ret

757+ checkFunctionApplication' (foldl App fn (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) fnTy arg ret

753checkFunctionApplication' fn fnTy dict@TypeClassDictionary{} _ =

758checkFunctionApplication' fn fnTy dict@TypeClassDictionary{} _ =

754 return (fnTy, App fn dict)

759 return (fnTy, App fn dict)

755checkFunctionApplication' _ fnTy arg _ = throwError . errorMessage $ CannotApplyFunction fnTy arg

760checkFunctionApplication' _ fnTy arg _ = throwError . errorMessage $ CannotApplyFunction fnTy arg

src/Language/PureScript/TypeChecker/Unify.hs+1−1

@@ -80,7 +80,7 @@ unknownsInType t = everythingOnTypes (.) go t []

80unifyTypes :: (MonadError MultipleErrors m, MonadState CheckState m) => Type -> Type -> m ()

81unifyTypes t1 t2 = do

82 sub <- gets checkSubstitution

83− rethrow (addHint (ErrorUnifyingTypes t1 t2)) $ unifyTypes' (substituteType sub t1) (substituteType sub t2)

83+ withErrorMessageHint (ErrorUnifyingTypes t1 t2) $ unifyTypes' (substituteType sub t1) (substituteType sub t2)

84 where

85 unifyTypes' (TUnknown u1) (TUnknown u2) | u1 == u2 = return ()

86 unifyTypes' (TUnknown u) t = solveType u t

src/Language/PureScript/TypeClassDictionaries.hs+2−2

@@ -21,7 +21,7 @@ data TypeClassDictionaryInScope

21 -- | Type class dependencies which must be satisfied to construct this dictionary

22 , tcdDependencies :: Maybe [Constraint]

23 }

24− deriving (Show, Read)

24+ deriving (Show)

25

26-- |

27-- A simplified representation of expressions which are used to represent type

@@ -44,4 +44,4 @@ data DictionaryValue

44 -- A subclass dictionary

45 --

46 | SubclassDictionaryValue DictionaryValue (Qualified (ProperName 'ClassName)) Integer

47− deriving (Show, Read, Ord, Eq)

47+ deriving (Show, Ord, Eq)

src/Language/PureScript/Types.hs+4−4

@@ -23,7 +23,7 @@ import Language.PureScript.Names

23-- An identifier for the scope of a skolem variable

24--

25newtype SkolemScope = SkolemScope { runSkolemScope :: Int }

26− deriving (Show, Read, Eq, Ord, A.ToJSON, A.FromJSON)

26+ deriving (Show, Eq, Ord, A.ToJSON, A.FromJSON)

27

28-- |

29-- The type of types

@@ -71,7 +71,7 @@ data Type

71 -- Note: although it seems this constructor is not used, it _is_ useful,

72 -- since it prevents certain traversals from matching.

73 | ParensInType Type

74− deriving (Show, Read, Eq, Ord)

74+ deriving (Show, Eq, Ord)

75

76-- | Additional data relevant to type class constraints

77data ConstraintData

@@ -81,7 +81,7 @@ data ConstraintData

81 -- not matched, and a flag indicating whether the list was truncated or not.

82 -- Note: we use 'String' here because using 'Binder' would introduce a cyclic

83 -- dependency in the module graph.

84− deriving (Show, Read, Eq, Ord)

84+ deriving (Show, Eq, Ord)

85

86-- | A typeclass constraint

87data Constraint = Constraint

@@ -91,7 +91,7 @@ data Constraint = Constraint

91 -- ^ type arguments

92 , constraintData :: Maybe ConstraintData

93 -- ^ additional data relevant to this constraint

94− } deriving (Show, Read, Eq, Ord)

94+ } deriving (Show, Eq, Ord)

95

96mapConstraintArgs :: ([Type] -> [Type]) -> Constraint -> Constraint

97mapConstraintArgs f c = c { constraintArgs = f (constraintArgs c) }

tests/TestPscPublish.hs+1−1

@@ -30,7 +30,7 @@ data TestResult

30 = ParseFailed String

31 | Mismatch ByteString ByteString -- ^ encoding before, encoding after

32 | Pass ByteString

33− deriving (Show, Read)

33+ deriving (Show)

34

35roundTrip :: UploadedPackage -> TestResult

36roundTrip pkg =