purescript 0.9.2 → 0.9.3

raw patch · 57 files changed

+497/−400 lines, 57 filesdep +http-clientdep ~protolude

Dependencies added: http-client

Dependency ranges changed: protolude

Files

• CONTRIBUTORS.md +1/−0
• examples/passing/2252.purs +15/−0
• purescript.cabal +5/−4
• src/Language/PureScript/AST/Binders.hs +1/−1
• src/Language/PureScript/AST/Declarations.hs +156/−12
• src/Language/PureScript/AST/Literals.hs +1/−1
• src/Language/PureScript/AST/Operators.hs +2/−2
• src/Language/PureScript/AST/SourcePos.hs +2/−2
• src/Language/PureScript/AST/Traversals.hs +1/−1
• src/Language/PureScript/Bundle.hs +3/−3
• src/Language/PureScript/CodeGen/JS.hs +11/−6
• src/Language/PureScript/CodeGen/JS/AST.hs +3/−3
• src/Language/PureScript/CodeGen/JS/Common.hs +1/−1
• src/Language/PureScript/Comments.hs +1/−1
• src/Language/PureScript/CoreFn/Binders.hs +1/−1
• src/Language/PureScript/CoreFn/Expr.hs +3/−3
• src/Language/PureScript/CoreFn/Meta.hs +2/−2
• src/Language/PureScript/CoreFn/Module.hs +1/−1
• src/Language/PureScript/Docs/AsMarkdown.hs +1/−1
• src/Language/PureScript/Docs/Convert.hs +1/−1
• src/Language/PureScript/Environment.hs +7/−8
• src/Language/PureScript/Errors.hs +58/−164
• src/Language/PureScript/Externs.hs +7/−7
• src/Language/PureScript/Ide/Command.hs +0/−1
• src/Language/PureScript/Ide/Externs.hs +0/−1
• src/Language/PureScript/Ide/Imports.hs +0/−1
• src/Language/PureScript/Ide/Pursuit.hs +2/−2
• src/Language/PureScript/Ide/Rebuild.hs +0/−1
• src/Language/PureScript/Ide/SourceFile.hs +0/−1
• src/Language/PureScript/Ide/State.hs +0/−1
• src/Language/PureScript/Ide/Types.hs +0/−1
• src/Language/PureScript/Ide/Util.hs +1/−1
• src/Language/PureScript/Interactive.hs +1/−1
• src/Language/PureScript/Interactive/Completion.hs +1/−1
• src/Language/PureScript/Interactive/Printer.hs +8/−5
• src/Language/PureScript/Kinds.hs +1/−1
• src/Language/PureScript/Make.hs +4/−3
• src/Language/PureScript/Names.hs +5/−5
• src/Language/PureScript/Parser/Lexer.hs +1/−1
• src/Language/PureScript/Pretty/Values.hs +1/−1
• src/Language/PureScript/Publish.hs +2/−2
• src/Language/PureScript/Sugar/Names/Env.hs +4/−4
• src/Language/PureScript/Sugar/Operators.hs +2/−2
• src/Language/PureScript/Sugar/TypeClasses.hs +1/−2
• src/Language/PureScript/TypeChecker.hs +5/−5
• src/Language/PureScript/TypeChecker/Entailment.hs +21/−19
• src/Language/PureScript/TypeChecker/Kinds.hs +2/−2
• src/Language/PureScript/TypeChecker/Monad.hs +68/−27
• src/Language/PureScript/TypeChecker/Subsumption.hs +4/−3
• src/Language/PureScript/TypeChecker/Types.hs +60/−66
• src/Language/PureScript/TypeChecker/Unify.hs +9/−5
• src/Language/PureScript/TypeClassDictionaries.hs +2/−2
• src/Language/PureScript/Types.hs +4/−4
• stack.yaml +1/−1
• tests/Language/PureScript/Ide/ImportsSpec.hs +1/−1
• tests/Language/PureScript/Ide/Integration.hs +1/−1
• tests/TestPscPublish.hs +1/−1

@@ -27,6 +27,7 @@ - [@faineance](https://github.com/faineance) My existing contributions and all future contributions until further notice are Copyright faineance, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@garyb](https://github.com/garyb) (Gary Burgess) My existing contributions and all future contributions until further notice are Copyright Gary Burgess, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@hdgarrood](https://github.com/hdgarrood) (Harry Garrood) My existing contributions and all future contributions until further notice are Copyright Harry Garrood, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).+- [@ilovezfs](https://github.com/ilovezfs) - My existing contributions and all future contributions until further notice are Copyright ilovezfs, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license - [@izgzhen](https://github.com/izgzhen) (Zhen Zhang) My existing contributions and all future contributions until further notice are Copyright Zhen Zhang, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@jacereda](https://github.com/jacereda) (Jorge Acereda) My existing contributions and all future contributions until further notice are Copyright Jorge Acereda, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@japesinator](https://github.com/japesinator) (JP Smith) My existing contributions and all future contributions until further notice are Copyright JP Smith, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

@@ -0,0 +1,15 @@+module Main where+	+import Control.Monad.Eff.Console (log)++data T a = T+	 +ti :: T Int+ti = T++t :: forall a. T a+t = T++xs = [ti, t, t]++main = log "Done"

@@ -1,5 +1,5 @@ name: purescript-version: 0.9.2+version: 0.9.3 cabal-version: >=1.8 build-type: Simple license: MIT@@ -116,6 +116,7 @@                    fsnotify >= 0.2.1,                    Glob >= 0.7 && < 0.8,                    haskeline >= 0.7.0.0,+                   http-client >= 0.4.30 && <0.5,                    http-types -any,                    language-javascript == 0.6.*,                    lifted-base >= 0.2.3 && < 0.2.4,@@ -128,7 +129,7 @@                    pipes >= 4.0.0 && < 4.3.0,                    pipes-http -any,                    process >= 1.2.0 && < 1.5,-                   protolude >= 0.1.5,+                   protolude >= 0.1.6,                    regex-tdfa -any,                    safe >= 0.3.9 && < 0.4,                    semigroups >= 0.16.2 && < 0.19,@@ -449,7 +450,7 @@                        mtl -any,                        network -any,                        optparse-applicative >= 0.12.1,-                       protolude >= 0.1.5,+                       protolude >= 0.1.6,                        stm -any,                        text -any,                        transformers -any,@@ -491,7 +492,7 @@                    optparse-applicative -any,                    parsec -any,                    process -any,-                   protolude >= 0.1.5,+                   protolude >= 0.1.6,                    silently -any,                    stm -any,                    text -any,

@@ -61,7 +61,7 @@   -- A binder with a type annotation   --   | TypedBinder Type Binder-  deriving (Show, Read, Eq)+  deriving (Show, Eq)  -- | -- Collect all names introduced in binders in an expression

@@ -22,14 +22,156 @@ import Language.PureScript.TypeClassDictionaries import Language.PureScript.Comments import Language.PureScript.Environment+import qualified Language.PureScript.Bundle as Bundle +import qualified Text.Parsec as P++-- | A map of locally-bound names in scope.+type Context = [(Ident, Type)]++-- | A type of error messages+data SimpleErrorMessage+  = ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)+  | ErrorParsingModule P.ParseError+  | MissingFFIModule ModuleName+  | MultipleFFIModules ModuleName [FilePath]+  | UnnecessaryFFIModule ModuleName FilePath+  | MissingFFIImplementations ModuleName [Ident]+  | UnusedFFIImplementations ModuleName [Ident]+  | InvalidFFIIdentifier ModuleName String+  | CannotGetFileInfo FilePath+  | CannotReadFile FilePath+  | CannotWriteFile FilePath+  | InfiniteType Type+  | InfiniteKind Kind+  | MultipleValueOpFixities (OpName 'ValueOpName)+  | MultipleTypeOpFixities (OpName 'TypeOpName)+  | OrphanTypeDeclaration Ident+  | RedefinedModule ModuleName [SourceSpan]+  | RedefinedIdent Ident+  | OverlappingNamesInLet+  | UnknownName (Qualified Name)+  | UnknownImport ModuleName Name+  | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)+  | UnknownExport Name+  | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)+  | ScopeConflict Name [ModuleName]+  | ScopeShadowing Name (Maybe ModuleName) [ModuleName]+  | DeclConflict Name Name+  | ExportConflict (Qualified Name) (Qualified Name)+  | DuplicateModuleName ModuleName+  | DuplicateTypeArgument String+  | InvalidDoBind+  | InvalidDoLet+  | CycleInDeclaration Ident+  | CycleInTypeSynonym (Maybe (ProperName 'TypeName))+  | CycleInModules [ModuleName]+  | NameIsUndefined Ident+  | UndefinedTypeVariable (ProperName 'TypeName)+  | PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))+  | EscapedSkolem (Maybe Expr)+  | TypesDoNotUnify Type Type+  | KindsDoNotUnify Kind Kind+  | ConstrainedTypeUnified Type Type+  | OverlappingInstances (Qualified (ProperName 'ClassName)) [Type] [Qualified Ident]+  | NoInstanceFound Constraint+  | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]+  | CannotDerive (Qualified (ProperName 'ClassName)) [Type]+  | CannotFindDerivingType (ProperName 'TypeName)+  | DuplicateLabel String (Maybe Expr)+  | DuplicateValueDeclaration Ident+  | ArgListLengthsDiffer Ident+  | OverlappingArgNames (Maybe Ident)+  | MissingClassMember Ident+  | ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))+  | ExpectedType Type Kind+  | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName))+  | ExprDoesNotHaveType Expr Type+  | PropertyIsMissing String+  | AdditionalProperty String+  | CannotApplyFunction Type Expr+  | TypeSynonymInstance+  | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]+  | InvalidNewtype (ProperName 'TypeName)+  | InvalidInstanceHead Type+  | TransitiveExportError DeclarationRef [DeclarationRef]+  | TransitiveDctorExportError DeclarationRef (ProperName 'ConstructorName)+  | ShadowedName Ident+  | ShadowedTypeVar String+  | UnusedTypeVar String+  | WildcardInferredType Type Context+  | HoleInferredType String Type Context+  | MissingTypeDeclaration Ident Type+  | OverlappingPattern [[Binder]] Bool+  | IncompleteExhaustivityCheck+  | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)+  | ImportHidingModule ModuleName+  | UnusedImport ModuleName+  | UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]+  | UnusedDctorImport (ProperName 'TypeName)+  | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]+  | DuplicateSelectiveImport ModuleName+  | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)+  | DuplicateImportRef Name+  | DuplicateExportRef Name+  | IntOutOfRange Integer String Integer Integer+  | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]+  | ImplicitImport ModuleName [DeclarationRef]+  | HidingImport ModuleName [DeclarationRef]+  | CaseBinderLengthDiffers Int [Binder]+  | IncorrectAnonymousArgument+  | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)+  | DeprecatedRequirePath+  | CannotGeneralizeRecursiveFunction Ident Type+  deriving (Show)++-- | Error message hints, providing more detailed information about failure.+data ErrorMessageHint+  = ErrorUnifyingTypes Type Type+  | ErrorInExpression Expr+  | ErrorInModule ModuleName+  | ErrorInInstance (Qualified (ProperName 'ClassName)) [Type]+  | ErrorInSubsumption Type Type+  | ErrorCheckingAccessor Expr String+  | ErrorCheckingType Expr Type+  | ErrorCheckingKind Type+  | ErrorCheckingGuard+  | ErrorInferringType Expr+  | ErrorInApplication Expr Type Expr+  | ErrorInDataConstructor (ProperName 'ConstructorName)+  | ErrorInTypeConstructor (ProperName 'TypeName)+  | ErrorInBindingGroup [Ident]+  | ErrorInDataBindingGroup+  | ErrorInTypeSynonym (ProperName 'TypeName)+  | ErrorInValueDeclaration Ident+  | ErrorInTypeDeclaration Ident+  | ErrorInForeignImport Ident+  | ErrorSolvingConstraint Constraint+  | PositionedError SourceSpan+  deriving (Show)++-- | Categories of hints+data HintCategory+  = ExprHint+  | KindHint+  | CheckHint+  | PositionHint+  | SolverHint+  | OtherHint+  deriving (Show, Eq)++data ErrorMessage = ErrorMessage+  [ErrorMessageHint]+  SimpleErrorMessage+  deriving (Show)+ -- | -- A module declaration, consisting of comments about the module, a module name, -- a list of declarations, and a list of the declarations that are -- explicitly exported. If the export list is Nothing, everything is exported. -- data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])-  deriving (Show, Read)+  deriving (Show)  -- | Return a module's name. getModuleName :: Module -> ModuleName@@ -88,7 +230,7 @@   -- A declaration reference with source position information   --   | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef-  deriving (Show, Read)+  deriving (Show)  instance Eq DeclarationRef where   (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'@@ -149,7 +291,7 @@   -- An import with a list of references to hide: `import M hiding (foo)`   --   | Hiding [DeclarationRef]-  deriving (Eq, Show, Read)+  deriving (Eq, Show)  isImplicit :: ImportDeclarationType -> Bool isImplicit Implicit = True@@ -216,15 +358,15 @@   -- A declaration with source position information   --   | PositionedDeclaration SourceSpan [Comment] Declaration-  deriving (Show, Read)+  deriving (Show)  data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)-  deriving (Eq, Ord, Show, Read)+  deriving (Eq, Ord, Show)  data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)-  deriving (Eq, Ord, Show, Read)+  deriving (Eq, Ord, Show) -pattern ValueFixityDeclaration :: Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration +pattern ValueFixityDeclaration :: Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration pattern ValueFixityDeclaration fixity name op = FixityDeclaration (Left (ValueFixity fixity name op))  pattern TypeFixityDeclaration :: Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration@@ -236,7 +378,7 @@   = DerivedInstance   -- | This is a regular (explicit) instance   | ExplicitInstance [Declaration]-  deriving (Show, Read)+  deriving (Show)  mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)@@ -421,7 +563,9 @@   -- at superclass implementations when searching for a dictionary, the type class name and   -- instance type, and the type class dictionaries in scope.   ---  | TypeClassDictionary Constraint (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))+  | TypeClassDictionary Constraint+                        (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))+                        [ErrorMessageHint]   -- |   -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.   --@@ -442,7 +586,7 @@   -- A value with source position information   --   | PositionedValue SourceSpan [Comment] Expr-  deriving (Show, Read)+  deriving (Show)  -- | -- An alternative in a case statement@@ -456,7 +600,7 @@     -- The result expression or a collect of guarded expressions     --   , caseAlternativeResult :: Either [(Guard, Expr)] Expr-  } deriving (Show, Read)+  } deriving (Show)  -- | -- A statement in a do-notation block@@ -478,7 +622,7 @@   -- A do notation element with source position information   --   | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement-  deriving (Show, Read)+  deriving (Show)  $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef) $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)

@@ -34,4 +34,4 @@   -- An object literal   --   | ObjectLiteral [(String, a)]-  deriving (Eq, Ord, Show, Read, Functor)+  deriving (Eq, Ord, Show, Functor)

@@ -21,7 +21,7 @@ -- Associativity for infix operators -- data Associativity = Infixl | Infixr | Infix-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  showAssoc :: Associativity -> String showAssoc Infixl = "infixl"@@ -44,7 +44,7 @@ -- Fixity data for infix operators -- data Fixity = Fixity Associativity Precedence-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  instance A.ToJSON Fixity where   toJSON (Fixity associativity precedence) =

@@ -22,7 +22,7 @@     -- Column number     --   , sourcePosColumn :: Int-  } deriving (Show, Read, Eq, Ord)+  } deriving (Show, Eq, Ord)  displaySourcePos :: SourcePos -> String displaySourcePos sp =@@ -50,7 +50,7 @@     -- End of the span     --   , spanEnd :: SourcePos-  } deriving (Show, Read, Eq, Ord)+  } deriving (Show, Eq, Ord)  displayStartEndPos :: SourceSpan -> String displayStartEndPos sp =

@@ -582,7 +582,7 @@   forDecls (TypeDeclaration _ ty) = f ty   forDecls _ = mempty -  forValues (TypeClassDictionary c _) = mconcat (map f (constraintArgs c))+  forValues (TypeClassDictionary c _ _) = mconcat (map f (constraintArgs c))   forValues (SuperClassDictionary _ tys) = mconcat (map f tys)   forValues (TypedValue _ _ ty) = f ty   forValues _ = mempty

@@ -43,20 +43,20 @@   | UnableToParseModule String   | UnsupportedExport   | ErrorInModule ModuleIdentifier ErrorMessage-  deriving (Show, Read)+  deriving (Show)  -- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules. data ModuleType   = Regular   | Foreign-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  showModuleType :: ModuleType -> String showModuleType Regular = "Regular" showModuleType Foreign = "Foreign"  -- | A module is identified by its module name and its type.-data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Read, Eq, Ord)+data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)  moduleName :: ModuleIdentifier -> String moduleName (ModuleIdentifier name _) = name

@@ -27,7 +27,9 @@ import Language.PureScript.CodeGen.JS.Optimizer import Language.PureScript.CoreFn import Language.PureScript.Crash-import Language.PureScript.Errors+import Language.PureScript.Errors (ErrorMessageHint(..), SimpleErrorMessage(..),+                                   MultipleErrors(..), rethrow,+                                   errorMessage, rethrowWithPosition, addHint) import Language.PureScript.Names import Language.PureScript.Options import Language.PureScript.Traversals (sndM)@@ -280,15 +282,18 @@   extendObj obj sts = do     newObj <- freshName     key <- freshName+    evaluatedObj <- freshName     let       jsKey = JSVar Nothing key       jsNewObj = JSVar Nothing newObj-      block = JSBlock Nothing (objAssign:copy:extend ++ [JSReturn Nothing jsNewObj])+      jsEvaluatedObj = JSVar Nothing evaluatedObj+      block = JSBlock Nothing (evaluate:objAssign:copy:extend ++ [JSReturn Nothing jsNewObj])+      evaluate = JSVariableIntroduction Nothing evaluatedObj (Just obj)       objAssign = JSVariableIntroduction Nothing newObj (Just $ JSObjectLiteral Nothing [])-      copy = JSForIn Nothing key obj $ JSBlock Nothing [JSIfElse Nothing cond assign Nothing]-      cond = JSApp Nothing (JSAccessor Nothing "hasOwnProperty" obj) [jsKey]-      assign = JSBlock Nothing [JSAssignment Nothing (JSIndexer Nothing jsKey jsNewObj) (JSIndexer Nothing jsKey obj)]-      stToAssign (s, js) = JSAssignment Nothing (JSAccessor Nothing s jsNewObj) js+      copy = JSForIn Nothing key jsEvaluatedObj $ JSBlock Nothing [JSIfElse Nothing cond assign Nothing]+      cond = JSApp Nothing (JSAccessor Nothing "hasOwnProperty" jsEvaluatedObj) [jsKey]+      assign = JSBlock Nothing [JSAssignment Nothing (JSIndexer Nothing jsKey jsNewObj) (JSIndexer Nothing jsKey jsEvaluatedObj)]+      stToAssign (s, js) = JSAssignment Nothing (accessorString s jsNewObj) js       extend = map stToAssign sts     return $ JSApp Nothing (JSFunction Nothing Nothing [] block) [] 

@@ -35,7 +35,7 @@   -- Constructor   --   | JSNew-  deriving (Show, Read, Eq)+  deriving (Show, Eq)  -- | -- Built-in binary operators@@ -117,7 +117,7 @@   -- Bitwise right shift with zero-fill   --   | ZeroFillShiftRight-  deriving (Show, Read, Eq)+  deriving (Show, Eq)  -- | -- Data type for simplified Javascript expressions@@ -238,7 +238,7 @@   -- |   -- Commented Javascript   ---  | JSComment (Maybe SourceSpan) [Comment] JS deriving (Show, Read, Eq)+  | JSComment (Maybe SourceSpan) [Comment] JS deriving (Show, Eq)  withSourceSpan :: SourceSpan -> JS -> JS withSourceSpan withSpan = go

@@ -35,7 +35,7 @@ -- Test if a string is a valid JS identifier without escaping. -- identNeedsEscaping :: String -> Bool-identNeedsEscaping s = s /= identToJs (Ident s)+identNeedsEscaping s = s /= identToJs (Ident s) || null s  -- | -- Attempts to find a human-readable name for a symbol, if none has been specified returns the

@@ -12,6 +12,6 @@ data Comment   = LineComment String   | BlockComment String-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Comment)

@@ -31,7 +31,7 @@   -- |   -- A binder which binds its input to an identifier   ---  | NamedBinder a Ident (Binder a) deriving (Show, Read, Functor)+  | NamedBinder a Ident (Binder a) deriving (Show, Functor)   extractBinderAnn :: Binder a -> a

@@ -51,7 +51,7 @@   -- A let binding   --   | Let a [Bind a] (Expr a)-  deriving (Show, Read, Functor)+  deriving (Show, Functor)  -- | -- A let or module binding.@@ -64,7 +64,7 @@   -- |   -- Mutually recursive binding group for several values   ---  | Rec [((a, Ident), Expr a)] deriving (Show, Read, Functor)+  | Rec [((a, Ident), Expr a)] deriving (Show, Functor)  -- | -- A guard is just a boolean-valued expression that appears alongside a set of binders@@ -83,7 +83,7 @@     -- The result expression or a collect of guarded expressions     --   , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)-  } deriving (Show, Read)+  } deriving (Show)  instance Functor CaseAlternative where 

@@ -26,7 +26,7 @@   -- |   -- The contained reference is for a foreign member   ---  | IsForeign deriving (Show, Read, Eq)+  | IsForeign deriving (Show, Eq)  -- | -- Data constructor metadata@@ -39,4 +39,4 @@   -- |   -- The constructor is for a type with multiple construcors   ---  | SumType deriving (Show, Read, Eq)+  | SumType deriving (Show, Eq)

@@ -17,6 +17,6 @@   , moduleExports :: [Ident]   , moduleForeign :: [ForeignDecl]   , moduleDecls :: [Bind a]-  } deriving (Show, Read)+  } deriving (Show)  type ForeignDecl = (Ident, Type)

@@ -110,7 +110,7 @@ data First   = First   | NotFirst-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  type Docs = Writer [String] () 

@@ -158,7 +158,7 @@     either (err . ("failed to parse Ident: " ++)) id . runParser P.parseIdent    lookupName name =-    let key = (modName m, name)+    let key = P.Qualified (Just (modName m)) name     in case Map.lookup key (P.names env) of       Just (ty, _, _) ->         ty

@@ -25,7 +25,7 @@   -- |   -- Value names currently in scope   ---    names :: M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)+    names :: M.Map (Qualified Ident) (Type, NameKind, NameVisibility)   -- |   -- Type names currently in scope   --@@ -46,7 +46,7 @@   -- Type classes   --   , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])-  } deriving (Show, Read)+  } deriving (Show)  -- | -- The initial environment with no values and only the default javascript types defined@@ -65,7 +65,7 @@   -- |   -- The name is defined in the another binding group, or has been made visible by a function binder   ---  | Defined deriving (Show, Read, Eq)+  | Defined deriving (Show, Eq)  -- | -- A flag for whether a name is for an private or public value - only public values will be@@ -85,7 +85,7 @@   -- A name for member introduced by foreign import   --   | External-  deriving (Show, Read, Eq)+  deriving (Show, Eq)  -- | -- The kinds of a type@@ -111,7 +111,7 @@   -- A scoped type variable   --   | ScopedTypeVar-  deriving (Show, Read, Eq)+  deriving (Show, Eq)  -- | -- The type ('data' or 'newtype') of a data type declaration@@ -125,7 +125,7 @@   -- A newtype constructor   --   | Newtype-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  showDataDeclType :: DataDeclType -> String showDataDeclType Data = "data"@@ -273,7 +273,6 @@ -- Finds information about values from the current environment. -- lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)-lookupValue env (Qualified (Just mn) ident) = (mn, ident) `M.lookup` names env-lookupValue _ _ = Nothing+lookupValue env ident = ident `M.lookup` names env  $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''TypeKind)

@@ -1,7 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} -module Language.PureScript.Errors where+module Language.PureScript.Errors+  ( module Language.PureScript.AST+  , module Language.PureScript.Errors+  ) where  import Prelude.Compat @@ -14,6 +17,7 @@ import Data.Char (isSpace) import Data.Either (lefts, rights) import Data.Foldable (fold)+import Data.Functor.Identity (Identity(..)) import Data.List (intercalate, transpose, nub, nubBy, sortBy, partition) import Data.Maybe (maybeToList, fromMaybe, mapMaybe) import Data.Ord (comparing)@@ -21,7 +25,6 @@  import Language.PureScript.AST import Language.PureScript.Crash-import Language.PureScript.Kinds import Language.PureScript.Names import Language.PureScript.Pretty import Language.PureScript.Traversals@@ -37,137 +40,6 @@ import qualified Text.PrettyPrint.Boxes as Box import Text.Parsec.Error (Message(..)) --- | A type of error messages-data SimpleErrorMessage-  = ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)-  | ErrorParsingModule P.ParseError-  | MissingFFIModule ModuleName-  | MultipleFFIModules ModuleName [FilePath]-  | UnnecessaryFFIModule ModuleName FilePath-  | MissingFFIImplementations ModuleName [Ident]-  | UnusedFFIImplementations ModuleName [Ident]-  | InvalidFFIIdentifier ModuleName String-  | CannotGetFileInfo FilePath-  | CannotReadFile FilePath-  | CannotWriteFile FilePath-  | InfiniteType Type-  | InfiniteKind Kind-  | MultipleValueOpFixities (OpName 'ValueOpName)-  | MultipleTypeOpFixities (OpName 'TypeOpName)-  | OrphanTypeDeclaration Ident-  | RedefinedModule ModuleName [SourceSpan]-  | RedefinedIdent Ident-  | OverlappingNamesInLet-  | UnknownName (Qualified Name)-  | UnknownImport ModuleName Name-  | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)-  | UnknownExport Name-  | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)-  | ScopeConflict Name [ModuleName]-  | ScopeShadowing Name (Maybe ModuleName) [ModuleName]-  | DeclConflict Name Name-  | ExportConflict (Qualified Name) (Qualified Name)-  | DuplicateModuleName ModuleName-  | DuplicateTypeArgument String-  | InvalidDoBind-  | InvalidDoLet-  | CycleInDeclaration Ident-  | CycleInTypeSynonym (Maybe (ProperName 'TypeName))-  | CycleInModules [ModuleName]-  | NameIsUndefined Ident-  | UndefinedTypeVariable (ProperName 'TypeName)-  | PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))-  | EscapedSkolem (Maybe Expr)-  | TypesDoNotUnify Type Type-  | KindsDoNotUnify Kind Kind-  | ConstrainedTypeUnified Type Type-  | OverlappingInstances (Qualified (ProperName 'ClassName)) [Type] [Qualified Ident]-  | NoInstanceFound Constraint-  | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]-  | CannotDerive (Qualified (ProperName 'ClassName)) [Type]-  | CannotFindDerivingType (ProperName 'TypeName)-  | DuplicateLabel String (Maybe Expr)-  | DuplicateValueDeclaration Ident-  | ArgListLengthsDiffer Ident-  | OverlappingArgNames (Maybe Ident)-  | MissingClassMember Ident-  | ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))-  | ExpectedType Type Kind-  | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName))-  | ExprDoesNotHaveType Expr Type-  | PropertyIsMissing String-  | AdditionalProperty String-  | CannotApplyFunction Type Expr-  | TypeSynonymInstance-  | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]-  | InvalidNewtype (ProperName 'TypeName)-  | InvalidInstanceHead Type-  | TransitiveExportError DeclarationRef [DeclarationRef]-  | TransitiveDctorExportError DeclarationRef (ProperName 'ConstructorName)-  | ShadowedName Ident-  | ShadowedTypeVar String-  | UnusedTypeVar String-  | WildcardInferredType Type-  | HoleInferredType String Type [(Ident, Type)]-  | MissingTypeDeclaration Ident Type-  | OverlappingPattern [[Binder]] Bool-  | IncompleteExhaustivityCheck-  | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)-  | ImportHidingModule ModuleName-  | UnusedImport ModuleName-  | UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]-  | UnusedDctorImport (ProperName 'TypeName)-  | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]-  | DuplicateSelectiveImport ModuleName-  | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)-  | DuplicateImportRef Name-  | DuplicateExportRef Name-  | IntOutOfRange Integer String Integer Integer-  | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]-  | ImplicitImport ModuleName [DeclarationRef]-  | HidingImport ModuleName [DeclarationRef]-  | CaseBinderLengthDiffers Int [Binder]-  | IncorrectAnonymousArgument-  | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)-  | DeprecatedRequirePath-  | CannotGeneralizeRecursiveFunction Ident Type-  deriving (Show)---- | Error message hints, providing more detailed information about failure.-data ErrorMessageHint-  = ErrorUnifyingTypes Type Type-  | ErrorInExpression Expr-  | ErrorInModule ModuleName-  | ErrorInInstance (Qualified (ProperName 'ClassName)) [Type]-  | ErrorInSubsumption Type Type-  | ErrorCheckingAccessor Expr String-  | ErrorCheckingType Expr Type-  | ErrorCheckingKind Type-  | ErrorCheckingGuard-  | ErrorInferringType Expr-  | ErrorInApplication Expr Type Expr-  | ErrorInDataConstructor (ProperName 'ConstructorName)-  | ErrorInTypeConstructor (ProperName 'TypeName)-  | ErrorInBindingGroup [Ident]-  | ErrorInDataBindingGroup-  | ErrorInTypeSynonym (ProperName 'TypeName)-  | ErrorInValueDeclaration Ident-  | ErrorInTypeDeclaration Ident-  | ErrorInForeignImport Ident-  | PositionedError SourceSpan-  deriving Show---- | Categories of hints-data HintCategory-  = ExprHint-  | KindHint-  | CheckHint-  | PositionHint-  | OtherHint-  deriving (Show, Eq)--data ErrorMessage = ErrorMessage [ErrorMessageHint] SimpleErrorMessage deriving (Show)- newtype ErrorSuggestion = ErrorSuggestion String  -- | Get the source span for an error@@ -321,8 +193,12 @@  -- | Add a hint to an error message addHint :: ErrorMessageHint -> MultipleErrors -> MultipleErrors-addHint hint = onErrorMessages $ \(ErrorMessage hints se) -> ErrorMessage (hint : hints) se+addHint hint = addHints [hint] +-- | Add hints to an error message+addHints :: [ErrorMessageHint] -> MultipleErrors -> MultipleErrors+addHints hints = onErrorMessages $ \(ErrorMessage hints' se) -> ErrorMessage (hints ++ hints') se+ -- | A map from rigid type variable name/unknown variable pairs to new variables. data TypeMap = TypeMap   { umSkolemMap   :: M.Map Int (String, Int, Maybe SourceSpan)@@ -368,7 +244,10 @@       Just (_, s', _) -> return (Skolem name s' sko ss)   replaceTypes other = return other -onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage+onTypesInErrorMessage :: (Type -> Type) -> ErrorMessage -> ErrorMessage+onTypesInErrorMessage f = runIdentity . onTypesInErrorMessageM (Identity . f)++onTypesInErrorMessageM :: Applicative m => (Type -> m Type) -> ErrorMessage -> m ErrorMessage onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse gHint hints <*> gSimple simple   where   gSimple (InfiniteType t) = InfiniteType <$> f t@@ -383,11 +262,10 @@   gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts   gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k   gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts-  gSimple (WildcardInferredType ty) = WildcardInferredType <$> f ty-  gSimple (HoleInferredType name ty env) = HoleInferredType name <$> f ty <*> traverse (sndM f) env+  gSimple (WildcardInferredType ty ctx) = WildcardInferredType <$> f ty <*> traverse (sndM f) ctx+  gSimple (HoleInferredType name ty ctx) = HoleInferredType name <$> f ty <*> traverse (sndM f) ctx   gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty   gSimple (CannotGeneralizeRecursiveFunction nm ty) = CannotGeneralizeRecursiveFunction nm <$> f ty-   gSimple other = pure other    gHint (ErrorInSubsumption t1 t2) = ErrorInSubsumption <$> f t1 <*> f t2@@ -396,6 +274,7 @@   gHint (ErrorCheckingKind t) = ErrorCheckingKind <$> f t   gHint (ErrorInApplication e1 t1 e2) = ErrorInApplication e1 <$> f t1 <*> pure e2   gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts+  gHint (ErrorSolvingConstraint con) = ErrorSolvingConstraint <$> overConstraintArgs (traverse f) con   gHint other = pure other  wikiUri :: ErrorMessage -> String@@ -413,7 +292,7 @@   ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)   HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing   MissingTypeDeclaration ident ty -> suggest $ showIdent ident ++ " :: " ++ prettyPrintType ty-  WildcardInferredType ty -> suggest $ prettyPrintType ty+  WildcardInferredType ty _ -> suggest $ prettyPrintType ty   _ -> Nothing    where@@ -845,24 +724,14 @@       paras [ line "hiding imports cannot be used to hide modules."             , line $ "An attempt was made to hide the import of " ++ markCode (runModuleName name)             ]-    renderSimpleErrorMessage (WildcardInferredType ty) =-      paras [ line "Wildcard type definition has the inferred type "-            , markCodeBox $ indent $ typeAsBox ty-            ]-    renderSimpleErrorMessage (HoleInferredType name ty env) =+    renderSimpleErrorMessage (WildcardInferredType ty ctx) =+      paras $ [ line "Wildcard type definition has the inferred type "+              , markCodeBox $ indent $ typeAsBox ty+              ] ++ renderContext ctx+    renderSimpleErrorMessage (HoleInferredType name ty ctx) =       paras $ [ line $ "Hole '" ++ markCode name ++ "' has the inferred type "               , markCodeBox $ indent $ typeAsBox ty-              ] ++ if null env then [] else envInfo-      where-        envInfo :: [Box.Box]-        envInfo = [ line "in the following context:"-                  , indent $ paras-                      [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")-                                          , markCodeBox $ typeAsBox ty'-                                          ]-                      | (ident, ty') <- take 5 env-                      ]-                  ]+              ] ++ renderContext ctx     renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =       paras [ line $ "No type declaration was provided for the top-level declaration of " ++ markCode (showIdent ident) ++ "."             , line "It is good practice to provide type declarations as a form of documentation."@@ -1062,11 +931,31 @@       paras [ detail             , line $ "in foreign import " ++ markCode (showIdent nm)             ]+    renderHint (ErrorSolvingConstraint (Constraint nm ts _)) detail =+      paras [ detail+            , line "while solving type class constriant"+            , markCodeBox $ indent $ Box.hsep 1 Box.left+                [ line (showQualified runProperName nm)+                , Box.vcat Box.left (map typeAtomAsBox ts)+                ]+            ]     renderHint (PositionedError srcSpan) detail =       paras [ line $ "at " ++ displaySourceSpan srcSpan             , detail             ] +    renderContext :: Context -> [Box.Box]+    renderContext [] = []+    renderContext ctx =+      [ line "in the following context:"+      , indent $ paras+          [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")+                              , markCodeBox $ typeAsBox ty'+                              ]+          | (ident, ty') <- take 5 ctx+          ]+      ]+     printName :: Qualified Name -> String     printName qn = nameType (disqualify qn) ++ " " ++ markCode (runName qn) @@ -1139,6 +1028,10 @@       where       isUnifyHint ErrorUnifyingTypes{} = True       isUnifyHint _ = False+    stripRedudantHints NoInstanceFound{} = stripFirst isSolverHint+      where+      isSolverHint ErrorSolvingConstraint{} = True+      isSolverHint _ = False     stripRedudantHints _ = id      stripFirst :: (ErrorMessageHint -> Bool) -> [ErrorMessageHint] -> [ErrorMessageHint]@@ -1150,15 +1043,16 @@     stripFirst _ [] = []    hintCategory :: ErrorMessageHint -> HintCategory-  hintCategory ErrorCheckingType{}  = ExprHint-  hintCategory ErrorInferringType{} = ExprHint-  hintCategory ErrorInExpression{}  = ExprHint-  hintCategory ErrorUnifyingTypes{} = CheckHint-  hintCategory ErrorInSubsumption{} = CheckHint-  hintCategory ErrorInApplication{} = CheckHint-  hintCategory ErrorCheckingKind{}  = CheckHint-  hintCategory PositionedError{}    = PositionHint-  hintCategory _                    = OtherHint+  hintCategory ErrorCheckingType{}      = ExprHint+  hintCategory ErrorInferringType{}     = ExprHint+  hintCategory ErrorInExpression{}      = ExprHint+  hintCategory ErrorUnifyingTypes{}     = CheckHint+  hintCategory ErrorInSubsumption{}     = CheckHint+  hintCategory ErrorInApplication{}     = CheckHint+  hintCategory ErrorCheckingKind{}      = CheckHint+  hintCategory ErrorSolvingConstraint{} = SolverHint+  hintCategory PositionedError{}        = PositionHint+  hintCategory _                        = OtherHint  -- Pretty print and export declaration prettyPrintExport :: DeclarationRef -> String

@@ -50,7 +50,7 @@   , efTypeFixities :: [ExternsTypeFixity]   -- | List of type and value declaration   , efDeclarations :: [ExternsDeclaration]-  } deriving (Show, Read)+  } deriving (Show)  -- | A module import in an externs file data ExternsImport = ExternsImport@@ -61,7 +61,7 @@   , eiImportType :: ImportDeclarationType   -- | The imported-as name, for qualified imports   , eiImportedAs :: Maybe ModuleName-  } deriving (Show, Read)+  } deriving (Show)  -- | A fixity declaration in an externs file data ExternsFixity = ExternsFixity@@ -74,7 +74,7 @@   , efOperator :: OpName 'ValueOpName   -- | The value the operator is an alias for   , efAlias :: Qualified (Either Ident (ProperName 'ConstructorName))-  } deriving (Show, Read)+  } deriving (Show)  -- | A type fixity declaration in an externs file data ExternsTypeFixity = ExternsTypeFixity@@ -87,7 +87,7 @@   , efTypeOperator :: OpName 'TypeOpName   -- | The value the operator is an alias for   , efTypeAlias :: Qualified (ProperName 'TypeName)-  } deriving (Show, Read)+  } deriving (Show)  -- | A type or value declaration appearing in an externs file data ExternsDeclaration =@@ -130,7 +130,7 @@       , edInstanceTypes :: [Type]       , edInstanceConstraints :: Maybe [Constraint]       }-  deriving (Show, Read)+  deriving (Show)  -- | Convert an externs file back into a module applyExternsFileToEnvironment :: ExternsFile -> Environment -> Environment@@ -140,7 +140,7 @@   applyDecl env (EDType pn kind tyKind) = env { types = M.insert (qual pn) (kind, tyKind) (types env) }   applyDecl env (EDTypeSynonym pn args ty) = env { typeSynonyms = M.insert (qual pn) (args, ty) (typeSynonyms env) }   applyDecl env (EDDataConstructor pn dTy tNm ty nms) = env { dataConstructors = M.insert (qual pn) (dTy, tNm, ty, nms) (dataConstructors env) }-  applyDecl env (EDValue ident ty) = env { names = M.insert (efModuleName, ident) (ty, External, Defined) (names env) }+  applyDecl env (EDValue ident ty) = env { names = M.insert (Qualified (Just efModuleName) ident) (ty, External, Defined) (names env) }   applyDecl env (EDClass pn args members cs) = env { typeClasses = M.insert (qual pn) (args, members, cs) (typeClasses env) }   applyDecl env (EDInstance className ident tys cs) = env { typeClassDictionaries = updateMap (updateMap (M.insert (qual ident) dict) className) (Just efModuleName) (typeClassDictionaries env) }     where@@ -201,7 +201,7 @@                             ]       _ -> internalError "toExternsDeclaration: Invalid input"   toExternsDeclaration (ValueRef ident)-    | Just (ty, _, _) <- (mn, ident) `M.lookup` names env+    | Just (ty, _, _) <- Qualified (Just mn) ident `M.lookup` names env     = [ EDValue ident ty ]   toExternsDeclaration (TypeClassRef className)     | Just (args, members, implies) <- Qualified (Just mn) className `M.lookup` typeClasses env

@@ -24,7 +24,6 @@ import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types-import           System.FilePath  data Command     = Load [P.ModuleName]

@@ -33,7 +33,6 @@ import           Language.PureScript.Ide.Util  import qualified Language.PureScript           as P-import           System.FilePath  readExternFile :: (MonadIO m, MonadError PscIdeError m) =>                   FilePath -> m P.ExternsFile

@@ -40,7 +40,6 @@ import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           System.FilePath  data Import = Import P.ModuleName P.ImportDeclarationType  (Maybe P.ModuleName)               deriving (Eq, Show)

@@ -19,7 +19,7 @@   , findPackagesForModuleIdent   ) where -import           Protolude+import           Protolude                     hiding (fromStrict)  import qualified Control.Exception             as E import           Data.Aeson@@ -36,7 +36,7 @@ queryPursuit :: Text -> IO ByteString queryPursuit q = do   let qClean = T.dropWhileEnd (== '.') q-  req' <- parseUrl "http://pursuit.purescript.org/search"+  req' <- parseRequest "http://pursuit.purescript.org/search"   let req = req'         { queryString= "q=" <> (fromString . T.unpack) qClean         , requestHeaders=[(hAccept, "application/json")]

@@ -22,7 +22,6 @@ import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util import           System.IO.UTF8                  (readUTF8File)-import           System.FilePath  -- | Given a filepath performs the following steps: --

@@ -26,7 +26,6 @@ import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.Util import           Language.PureScript.Ide.Types-import           System.FilePath import           System.IO.UTF8                       (readUTF8File)  parseModule

@@ -44,7 +44,6 @@ import           Language.PureScript.Ide.Util import qualified Language.PureScript as P import           System.Clock-import           System.FilePath  -- | Resets all State inside psc-ide resetIdeState :: Ide m => m ()

@@ -25,7 +25,6 @@ import qualified Language.PureScript.Errors.JSON      as P import qualified Language.PureScript as P import           Language.PureScript.Ide.Conversions-import           System.FilePath import           Text.Parsec as Parsec import           Text.Parsec.Text 

@@ -27,7 +27,7 @@   , module Language.PureScript.Ide.Conversions   ) where -import           Protolude+import           Protolude                     hiding (decodeUtf8, encodeUtf8) import           Data.Aeson import qualified Data.Text                     as T import           Data.Text.Lazy.Encoding       (decodeUtf8, encodeUtf8)

@@ -234,7 +234,7 @@   case e of     Left errs -> printErrors errs     Right (_, env') ->-      case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of+      case M.lookup (P.mkQualified (P.Ident "it") (P.ModuleName [P.ProperName "$PSCI"])) (P.names env') of         Just (ty, _, _) -> liftIO . putStrLn . P.prettyPrintType $ ty         Nothing -> liftIO $ putStrLn "Could not find type" 

@@ -91,7 +91,7 @@   | CtxIdentifier   | CtxType   | CtxFixed String-  deriving (Show, Read)+  deriving (Show)  -- | -- Decide what kind of completion we need based on input. This function expects

@@ -19,9 +19,10 @@ printModuleSignatures :: P.ModuleName -> P.Environment -> String printModuleSignatures moduleName (P.Environment {..}) =     -- get relevant components of a module from environment-    let moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) names-        moduleTypeClasses = (filter (\(P.Qualified maybeName _) -> maybeName == Just moduleName) . M.keys) typeClasses-        moduleTypes = (filter (\(P.Qualified maybeName _) -> maybeName == Just moduleName) . M.keys) types+    let moduleNamesIdent = byModuleName names+        moduleTypeClasses = byModuleName typeClasses+        moduleTypes = byModuleName types+        byModuleName = filter ((== Just moduleName) . P.getQual) . M.keys    in     -- print each component@@ -33,8 +34,10 @@    where printModule's showF = Box.vsep 1 Box.left . showF -        findNameType :: M.Map (P.ModuleName, P.Ident) (P.Type, P.NameKind, P.NameVisibility) -> (P.ModuleName, P.Ident) -> (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility))-        findNameType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)+        findNameType :: M.Map (P.Qualified P.Ident) (P.Type, P.NameKind, P.NameVisibility)+                     -> P.Qualified P.Ident+                     -> (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility))+        findNameType envNames m = (P.disqualify m, M.lookup m envNames)          showNameType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> Box.Box         showNameType (mIdent, Just (mType, _, _)) = Box.text (P.showIdent mIdent ++ " :: ") Box.<> P.typeAsBox mType

@@ -20,7 +20,7 @@   | FunKind Kind Kind   -- | Type-level strings   | Symbol-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  $(A.deriveJSON A.defaultOptions ''Kind) 

@@ -36,6 +36,7 @@ import Control.Monad.Writer.Class (MonadWriter(..))  import Data.Aeson (encode, decode)+import Data.ByteString.Builder (toLazyByteString, stringUtf8) import Data.Either (partitionEithers) import Data.Foldable (for_) import Data.List (foldl', sort)@@ -85,7 +86,7 @@ -- | Progress messages from the make process data ProgressMessage   = CompilingModule ModuleName-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  -- | Render a progress message renderProgressMessage :: ProgressMessage -> String@@ -129,7 +130,7 @@   -- | Never rebuild this module   = RebuildNever   -- | Always rebuild this module-  | RebuildAlways deriving (Show, Read, Eq, Ord)+  | RebuildAlways deriving (Show, Eq, Ord)  -- | Rebuild a single module rebuildModule :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)@@ -252,7 +253,7 @@    decodeExterns :: Externs -> Maybe ExternsFile   decodeExterns bs = do-    externs <- decode (fromString bs)+    externs <- decode (toLazyByteString (stringUtf8 bs))     guard $ efVersion externs == showVersion Paths.version     return externs 

@@ -64,7 +64,7 @@   -- A generated name for an identifier   --   | GenIdent (Maybe String) Integer-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  runIdent :: Ident -> String runIdent (Ident i) = i@@ -84,7 +84,7 @@ -- Operator alias names. -- newtype OpName (a :: OpNameType) = OpName { runOpName :: String }-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  instance ToJSON (OpName a) where   toJSON = toJSON . runOpName@@ -104,7 +104,7 @@ -- Proper names, i.e. capitalized names for e.g. module names, type//data constructors. -- newtype ProperName (a :: ProperNameType) = ProperName { runProperName :: String }-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  instance ToJSON (ProperName a) where   toJSON = toJSON . runProperName@@ -129,7 +129,7 @@ -- Module names -- newtype ModuleName = ModuleName [ProperName 'Namespace]-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  runModuleName :: ModuleName -> String runModuleName (ModuleName pns) = intercalate "." (runProperName `map` pns)@@ -146,7 +146,7 @@ -- A qualified name, i.e. a name with an optional module name -- data Qualified a = Qualified (Maybe ModuleName) a-  deriving (Show, Read, Eq, Ord, Functor)+  deriving (Show, Eq, Ord, Functor)  showQualified :: (a -> String) -> Qualified a -> String showQualified f (Qualified Nothing a) = f a

@@ -104,7 +104,7 @@   | StringLiteral String   | Number (Either Integer Double)   | HoleLit String-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  prettyPrintToken :: Token -> String prettyPrintToken LParen            = "("

@@ -60,7 +60,7 @@     (text "in " <> prettyPrintValue (d - 1) val) prettyPrintValue d (Do els) =   text "do " <> vcat left (map (prettyPrintDoNotationElement (d - 1)) els)-prettyPrintValue _ (TypeClassDictionary (Constraint name tys _) _) = foldl1 beforeWithSpace $ text ("#dict " ++ runProperName (disqualify name)) : map typeAtomAsBox tys+prettyPrintValue _ (TypeClassDictionary (Constraint name tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ runProperName (disqualify name)) : map typeAtomAsBox tys prettyPrintValue _ (SuperClassDictionary name _) = text $ "#dict " ++ runProperName (disqualify name) prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =     text "#dict-accessor " <> text (runProperName (disqualify className)) <> text "." <> text (showIdent ident) <> text ">"

@@ -169,7 +169,7 @@       Left err ->         userError (CompileError err) -data TreeStatus = Clean | Dirty deriving (Show, Read, Eq, Ord, Enum)+data TreeStatus = Clean | Dirty deriving (Show, Eq, Ord, Enum)  getGitWorkingTreeStatus :: PrepareM TreeStatus getGitWorkingTreeStatus = do@@ -273,7 +273,7 @@   | ResolvedVersion String     -- ^ Resolved to a version. The String argument is the resolution tag (eg,     -- "v0.1.0").-  deriving (Show, Read, Eq)+  deriving (Show, Eq)  -- Go through all bower dependencies which contain purescript code, and -- extract their versions.

@@ -49,7 +49,7 @@     , importSourceModule :: ModuleName     , importProvenance :: ImportProvenance     }-    deriving (Eq, Ord, Show, Read)+    deriving (Eq, Ord, Show)  -- | -- Used to track how an import was introduced into scope. This allows us to@@ -61,7 +61,7 @@   | FromExplicit   | Local   | Prim-  deriving (Eq, Ord, Show, Read)+  deriving (Eq, Ord, Show)  type ImportMap a = M.Map (Qualified a) [ImportRecord a] @@ -104,7 +104,7 @@   -- The "as" names of modules that have been imported qualified.   --   , importedQualModules :: S.Set ModuleName-  } deriving (Show, Read)+  } deriving (Show)  nullImports :: Imports nullImports = Imports M.empty M.empty M.empty M.empty M.empty M.empty S.empty S.empty@@ -155,7 +155,7 @@   -- from.   --   , exportedValueOps :: M.Map (OpName 'ValueOpName) ModuleName-  } deriving (Show, Read)+  } deriving (Show)  -- | -- An empty 'Exports' value.

@@ -329,9 +329,9 @@    goExpr :: Maybe SourceSpan -> Expr -> m (Maybe SourceSpan, Expr)   goExpr _ e@(PositionedValue pos _ _) = return (Just pos, e)-  goExpr pos (TypeClassDictionary (Constraint name tys info) dicts) = do+  goExpr pos (TypeClassDictionary (Constraint name tys info) dicts hints) = do     tys' <- traverse (goType' pos) tys-    return (pos, TypeClassDictionary (Constraint name tys' info) dicts)+    return (pos, TypeClassDictionary (Constraint name tys' info) dicts hints)   goExpr pos (SuperClassDictionary cls tys) = do     tys' <- traverse (goType' pos) tys     return (pos, SuperClassDictionary cls tys')

@@ -11,9 +11,8 @@ import Prelude.Compat  import Language.PureScript.Crash-import Language.PureScript.AST hiding (isExported) import Language.PureScript.Environment-import Language.PureScript.Errors+import Language.PureScript.Errors hiding (isExported) import Language.PureScript.Kinds import Language.PureScript.Names import Language.PureScript.Externs

@@ -91,7 +91,7 @@   -> m () valueIsNotDefined moduleName name = do   env <- getEnv-  case M.lookup (moduleName, name) (names env) of+  case M.lookup (Qualified (Just moduleName) name) (names env) of     Just _ -> throwError . errorMessage $ RedefinedIdent name     Nothing -> return () @@ -104,7 +104,7 @@   -> m () addValue moduleName name ty nameKind = do   env <- getEnv-  putEnv (env { names = M.insert (moduleName, name) (ty, nameKind, Defined) (names env) })+  putEnv (env { names = M.insert (Qualified (Just moduleName) name) (ty, nameKind, Defined) (names env) })  addTypeClass   :: (MonadState CheckState m)@@ -259,9 +259,9 @@       env <- getEnv       kind <- kindOf ty       guardWith (errorMessage (ExpectedType ty kind)) $ kind == Star-      case M.lookup (moduleName, name) (names env) of+      case M.lookup (Qualified (Just moduleName) name) (names env) of         Just _ -> throwError . errorMessage $ RedefinedIdent name-        Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, External, Defined) (names env) })+        Nothing -> putEnv (env { names = M.insert (Qualified (Just moduleName) name) (ty, External, Defined) (names env) })     return d   go d@FixityDeclaration{} = return d   go d@ImportDeclaration{} = return d@@ -360,7 +360,7 @@           Just (_, _, ty, _) -> checkExport dr extract ty     return ()   checkMemberExport extract dr@(ValueRef name) = do-    ty <- lookupVariable mn (Qualified (Just mn) name)+    ty <- lookupVariable (Qualified (Just mn) name)     checkExport dr extract ty   checkMemberExport _ _ = return () 

@@ -2,7 +2,7 @@ -- Type class entailment -- module Language.PureScript.TypeChecker.Entailment-  ( Context+  ( InstanceContext   , replaceTypeClassDictionaries   ) where @@ -22,24 +22,25 @@ import Language.PureScript.Crash import Language.PureScript.Errors import Language.PureScript.Names+import Language.PureScript.TypeChecker.Monad (CheckState, withErrorMessageHint) import Language.PureScript.TypeChecker.Unify import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types import qualified Language.PureScript.Constants as C --- | The 'Context' tracks those constraints which can be satisfied.-type Context = M.Map (Maybe ModuleName)-                     (M.Map (Qualified (ProperName 'ClassName))-                            (M.Map (Qualified Ident)-                                   TypeClassDictionaryInScope))+-- | The 'InstanceContext' tracks those constraints which can be satisfied.+type InstanceContext = M.Map (Maybe ModuleName)+                         (M.Map (Qualified (ProperName 'ClassName))+                           (M.Map (Qualified Ident)+                             TypeClassDictionaryInScope))  -- | Merge two type class contexts-combineContexts :: Context -> Context -> Context+combineContexts :: InstanceContext -> InstanceContext -> InstanceContext combineContexts = M.unionWith (M.unionWith M.union)  -- | Replace type class dictionary placeholders with inferred type class dictionaries replaceTypeClassDictionaries-  :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)+  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)   => Bool   -> ModuleName   -> Expr@@ -48,7 +49,8 @@   let (_, f, _) = everywhereOnValuesTopDownM return (WriterT . go) return   in flip evalStateT M.empty . runWriterT . f   where-  go (TypeClassDictionary constraint dicts) = entails shouldGeneralize mn dicts constraint+  go (TypeClassDictionary constraint dicts hints) =+    rethrow (addHints hints) $ entails shouldGeneralize mn dicts constraint   go other = return (other, [])  -- |@@ -57,15 +59,15 @@ -- entails   :: forall m-   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)+   . (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)   => Bool   -> ModuleName-  -> Context+  -> InstanceContext   -> Constraint-  -> StateT Context m (Expr, [(Ident, Constraint)])+  -> StateT InstanceContext m (Expr, [(Ident, Constraint)]) entails shouldGeneralize moduleName context = solve   where-    forClassName :: Context -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDictionaryInScope]+    forClassName :: InstanceContext -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDictionaryInScope]     forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (Nothing : Just mn : map Just (mapMaybe ctorModules tys))     forClassName _ _ _ = internalError "forClassName: expected qualified class name" @@ -75,15 +77,15 @@     ctorModules (TypeApp ty _) = ctorModules ty     ctorModules _ = Nothing -    findDicts :: Context -> Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDictionaryInScope]+    findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDictionaryInScope]     findDicts ctx cn = maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup ctx -    solve :: Constraint -> StateT Context m (Expr, [(Ident, Constraint)])-    solve con = do+    solve :: Constraint -> StateT InstanceContext m (Expr, [(Ident, Constraint)])+    solve con = StateT . (withErrorMessageHint (ErrorSolvingConstraint con) .) . runStateT $ do       (dict, unsolved) <- go 0 con       return (dictionaryValueToValue dict, unsolved)       where-      go :: Int -> Constraint -> StateT Context m (DictionaryValue, [(Ident, Constraint)])+      go :: Int -> Constraint -> StateT InstanceContext m (DictionaryValue, [(Ident, Constraint)])       go work (Constraint className' tys' _) | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'       go work con'@(Constraint className' tys' _) = do         -- Get the inferred constraint context so far, and merge it with the global context@@ -106,7 +108,7 @@             -- Generate a fresh name for the unsolved constraint's new dictionary             ident <- freshIdent ("dict" ++ runProperName pn)             let qident = Qualified Nothing ident-            -- Store the new dictionary in the Context so that we can solve this goal in+            -- Store the new dictionary in the InstanceContext so that we can solve this goal in             -- future.             let newDict = TypeClassDictionaryInScope qident [] unsolvedClassName unsolvedTys Nothing                 newContext = M.singleton Nothing (M.singleton unsolvedClassName (M.singleton qident newDict))@@ -143,7 +145,7 @@         -- Create dictionaries for subgoals which still need to be solved by calling go recursively         -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type         -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.-        solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> StateT Context m (Maybe [DictionaryValue], [(Ident, Constraint)])+        solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> StateT InstanceContext m (Maybe [DictionaryValue], [(Ident, Constraint)])         solveSubgoals _ Nothing = return (Nothing, [])         solveSubgoals subst (Just subgoals) = do           zipped <- traverse (go (work + 1) . mapConstraintArgs (map (replaceAllTypeVars subst))) subgoals

@@ -107,7 +107,7 @@   Type ->   m (Kind, [(String, Kind)]) kindOfWithScopedVars ty =-  rethrow (addHint (ErrorCheckingKind ty)) $+  withErrorMessageHint (ErrorCheckingKind ty) $     fmap tidyUp . liftUnify $ infer ty   where   tidyUp ((k, args), sub) = ( starIfUnknown (substituteKind sub k)@@ -200,7 +200,7 @@   :: (MonadError MultipleErrors m, MonadState CheckState m)   => Type   -> m (Kind, [(String, Kind)])-infer ty = rethrow (addHint (ErrorCheckingKind ty)) $ infer' ty+infer ty = withErrorMessageHint (ErrorCheckingKind ty) $ infer' ty  infer'   :: forall m

@@ -35,18 +35,30 @@  -- | State required for type checking data CheckState = CheckState-  { checkEnv :: Environment                 -- ^ The current @Environment@-  , checkNextType :: Int                    -- ^ The next type unification variable-  , checkNextKind :: Int                    -- ^ The next kind unification variable-  , checkNextSkolem :: Int                  -- ^ The next skolem variable-  , checkNextSkolemScope :: Int             -- ^ The next skolem scope constant-  , checkCurrentModule :: Maybe ModuleName  -- ^ The current module-  , checkSubstitution :: Substitution       -- ^ The current substitution+  { checkEnv :: Environment+  -- ^ The current @Environment@+  , checkNextType :: Int+  -- ^ The next type unification variable+  , checkNextKind :: Int+  -- ^ The next kind unification variable+  , checkNextSkolem :: Int+  -- ^ The next skolem variable+  , checkNextSkolemScope :: Int+  -- ^ The next skolem scope constant+  , checkCurrentModule :: Maybe ModuleName+  -- ^ The current module+  , checkSubstitution :: Substitution+  -- ^ The current substitution+  , checkHints :: [ErrorMessageHint]+  -- ^ The current error message hint stack.+  -- This goes into state, rather than using 'rethrow',+  -- since this way, we can provide good error messages+  -- during instance resolution.   }  -- | Create an empty @CheckState@ emptyCheckState :: Environment -> CheckState-emptyCheckState env = CheckState env 0 0 0 0 Nothing emptySubstitution+emptyCheckState env = CheckState env 0 0 0 0 Nothing emptySubstitution []  -- | Unification variables type Unknown = Int@@ -54,7 +66,7 @@ -- | Temporarily bind a collection of names to values bindNames   :: MonadState CheckState m-  => M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)+  => M.Map (Qualified Ident) (Type, NameKind, NameVisibility)   -> m a   -> m a bindNames newNames action = do@@ -91,6 +103,33 @@       tell . errorMessage $ ShadowedTypeVar name   bindTypes (M.fromList (map (\(name, k) -> (Qualified (Just mn) (ProperName name), (k, ScopedTypeVar))) ks)) ma +withErrorMessageHint+  :: (MonadState CheckState m, MonadError MultipleErrors m)+  => ErrorMessageHint+  -> m a+  -> m a+withErrorMessageHint hint action = do+  orig <- get+  modify $ \st -> st { checkHints = hint : checkHints st }+  -- Need to use 'rethrow' anyway, since we have to handle regular errors+  a <- rethrow (addHint hint) action+  modify $ \st -> st { checkHints = checkHints orig }+  return a++rethrowWithPositionTC+  :: (MonadState CheckState m, MonadError MultipleErrors m)+  => SourceSpan+  -> m a+  -> m a+rethrowWithPositionTC pos = withErrorMessageHint (PositionedError pos)++warnAndRethrowWithPositionTC+  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => SourceSpan+  -> m a+  -> m a+warnAndRethrowWithPositionTC pos = rethrowWithPositionTC pos . warnWithPosition pos+ -- | Temporarily make a collection of type class dictionaries available withTypeClassDictionaries   :: MonadState CheckState m@@ -121,12 +160,11 @@ -- | Temporarily bind a collection of names to local variables bindLocalVariables   :: (MonadState CheckState m)-  => ModuleName-  -> [(Ident, Type, NameVisibility)]+  => [(Ident, Type, NameVisibility)]   -> m a   -> m a-bindLocalVariables moduleName bindings =-  bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> ((moduleName, name), (ty, Private, visibility)))+bindLocalVariables bindings =+  bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> (Qualified Nothing name, (ty, Private, visibility)))  -- | Temporarily bind a collection of names to local type variables bindLocalTypeVariables@@ -157,35 +195,32 @@ -- | Lookup the type of a value by name in the @Environment@ lookupVariable   :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m)-  => ModuleName-  -> Qualified Ident+  => Qualified Ident   -> m Type-lookupVariable currentModule (Qualified moduleName var) = do+lookupVariable qual = do   env <- getEnv-  case M.lookup (fromMaybe currentModule moduleName, var) (names env) of-    Nothing -> throwError . errorMessage $ NameIsUndefined var+  case M.lookup qual (names env) of+    Nothing -> throwError . errorMessage $ NameIsUndefined (disqualify qual)     Just (ty, _, _) -> return ty  -- | Lookup the visibility of a value by name in the @Environment@ getVisibility   :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m)-  => ModuleName-  -> Qualified Ident+  => Qualified Ident   -> m NameVisibility-getVisibility currentModule (Qualified moduleName var) = do+getVisibility qual = do   env <- getEnv-  case M.lookup (fromMaybe currentModule moduleName, var) (names env) of-    Nothing -> throwError . errorMessage $ NameIsUndefined var+  case M.lookup qual (names env) of+    Nothing -> throwError . errorMessage $ NameIsUndefined (disqualify qual)     Just (_, _, vis) -> return vis  -- | Assert that a name is visible checkVisibility   :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m)-  => ModuleName-  -> Qualified Ident+  => Qualified Ident   -> m ()-checkVisibility currentModule name@(Qualified _ var) = do-  vis <- getVisibility currentModule name+checkVisibility name@(Qualified _ var) = do+  vis <- getVisibility name   case vis of     Undefined -> throwError . errorMessage $ CycleInDeclaration var     _ -> return ()@@ -205,6 +240,12 @@ -- | Get the current @Environment@ getEnv :: (MonadState CheckState m) => m Environment getEnv = checkEnv <$> get++-- | Get locally-bound names in context, to create an error message.+getLocalContext :: MonadState CheckState m => m Context+getLocalContext = do+  env <- getEnv+  return [ (ident, ty') | ((Qualified Nothing ident@Ident{}), (ty', _, Defined)) <- M.toList (names env) ]  -- | Update the @Environment@ putEnv :: (MonadState CheckState m) => Environment -> m ()

@@ -8,7 +8,7 @@ import Prelude.Compat  import Control.Monad.Error.Class (MonadError(..))-import Control.Monad.State.Class (MonadState(..))+import Control.Monad.State.Class (MonadState(..), gets)  import Data.List (sortBy) import Data.Ord (comparing)@@ -24,7 +24,7 @@  -- | Check that one type subsumes another, rethrowing errors to provide a better error message subsumes :: (MonadError MultipleErrors m, MonadState CheckState m) => Maybe Expr -> Type -> Type -> m (Maybe Expr)-subsumes val ty1 ty2 = rethrow (addHint (ErrorInSubsumption ty1 ty2)) $ subsumes' val ty1 ty2+subsumes val ty1 ty2 = withErrorMessageHint (ErrorInSubsumption ty1 ty2) $ subsumes' val ty1 ty2  -- | Check tahat one type subsumes another subsumes' :: (MonadError MultipleErrors m, MonadState CheckState m) =>@@ -52,7 +52,8 @@   subsumes val ty1 ty2 subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do   dicts <- getTypeClassDictionaries-  subsumes' (Just $ foldl App val (map (flip TypeClassDictionary dicts) constraints)) ty1 ty2+  hints <- gets checkHints+  subsumes' (Just $ foldl App val (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) ty1 ty2 subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyRecord && f2 == tyRecord = do   let     (ts1, r1') = rowToList r1

@@ -26,7 +26,6 @@  import Prelude.Compat -import Control.Arrow (second) import Control.Monad import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (MonadState(..), gets)@@ -71,7 +70,7 @@   m [(Ident, (Expr, Type))] typesOf bindingGroupType moduleName vals = do   tys <- fmap tidyUp . escalateWarningWhen isHoleError . liftUnifyWarnings replace $ do-    (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals+    (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup (Just moduleName) vals     ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict     ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict     return (map (\x -> (False, x)) ds1 ++ map (\x -> (True, x)) ds2)@@ -117,26 +116,21 @@   tidyUp (ts, sub) = map (\(b, (i, (val, ty))) -> (b, (i, (overTypes (substituteType sub) val, substituteType sub ty)))) ts    -- Replace all the wildcards types with their inferred types-  replace sub (ErrorMessage hints (WildcardInferredType ty)) =-    ErrorMessage hints . WildcardInferredType $ substituteType sub ty-  replace sub (ErrorMessage hints (HoleInferredType name ty env)) =-    ErrorMessage hints $ HoleInferredType name (substituteType sub ty)-                                               (map (second (substituteType sub)) env)-  replace _ em = em+  replace sub = onTypesInErrorMessage (substituteType sub)    isHoleError :: ErrorMessage -> Bool   isHoleError (ErrorMessage _ HoleInferredType{}) = True   isHoleError _ = False -type TypeData = M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)+type TypeData = M.Map (Qualified Ident) (Type, NameKind, NameVisibility)  type UntypedData = [(Ident, Type)] -typeDictionaryForBindingGroup ::-  (MonadState CheckState m) =>-  ModuleName ->-  [(Ident, Expr)] ->-  m ([(Ident, Expr)], [(Ident, (Expr, Type, Bool))], TypeData, UntypedData)+typeDictionaryForBindingGroup+  :: (MonadState CheckState m)+  => Maybe ModuleName+  -> [(Ident, Expr)]+  -> m ([(Ident, Expr)], [(Ident, (Expr, Type, Bool))], TypeData, UntypedData) typeDictionaryForBindingGroup moduleName vals = do   let     -- Map each declaration to a name/value pair, with an optional type, if the declaration is typed@@ -154,15 +148,15 @@     -- Make a map of names to the unification variables of untyped declarations     untypedDict = zip (map fst untyped) untypedNames     -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking-    dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, Private, Undefined))) $ typedDict ++ untypedDict)+    dict = M.fromList (map (\(ident, ty) -> ((Qualified moduleName ident), (ty, Private, Undefined))) $ typedDict ++ untypedDict)   return (untyped, typed, dict, untypedDict) -checkTypedBindingGroupElement ::-  (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>-  ModuleName ->-  (Ident, (Expr, Type, Bool)) ->-  TypeData ->-  m (Ident, (Expr, Type))+checkTypedBindingGroupElement+  :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => ModuleName+  -> (Ident, (Expr, Type, Bool))+  -> TypeData+  -> m (Ident, (Expr, Type)) checkTypedBindingGroupElement mn (ident, (val', ty, checkType)) dict = do   -- Replace type wildcards   ty' <- replaceTypeWildcards ty@@ -176,12 +170,12 @@            else return (TypedValue False val' ty'')   return (ident, (val'', ty'')) -typeForBindingGroupElement ::-  (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>-  (Ident, Expr) ->-  TypeData ->-  UntypedData ->-  m (Ident, (Expr, Type))+typeForBindingGroupElement+  :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => (Ident, Expr)+  -> TypeData+  -> UntypedData+  -> m (Ident, (Expr, Type)) typeForBindingGroupElement (ident, val) dict untypedDict = do   -- Infer the type with the new names in scope   TypedValue _ val' ty <- bindNames dict $ infer val@@ -201,7 +195,7 @@   where   g :: Expr -> Expr   g (TypedValue checkTy val t) = TypedValue checkTy val (f t)-  g (TypeClassDictionary c sco) = TypeClassDictionary (mapConstraintArgs (map f) c) sco+  g (TypeClassDictionary c sco hints) = TypeClassDictionary (mapConstraintArgs (map f) c) sco hints   g other = other  -- | Check the kind of a type, failing if it is not of kind *.@@ -227,7 +221,8 @@   instantiatePolyTypeWithUnknowns val ty' instantiatePolyTypeWithUnknowns val (ConstrainedType constraints ty) = do    dicts <- getTypeClassDictionaries-   instantiatePolyTypeWithUnknowns (foldl App val (map (flip TypeClassDictionary dicts) constraints)) ty+   hints <- gets checkHints+   instantiatePolyTypeWithUnknowns (foldl App val (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) ty instantiatePolyTypeWithUnknowns val ty = return (val, ty)  -- | Infer a type for a value, rethrowing any error to provide a more useful error message@@ -235,7 +230,7 @@   (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>   Expr ->   m Expr-infer val = rethrow (addHint (ErrorInferringType val)) $ infer' val+infer val = withErrorMessageHint (ErrorInferringType val) $ infer' val  -- | Infer a type for a value infer' ::@@ -250,8 +245,11 @@ infer' (Literal (ArrayLiteral vals)) = do   ts <- traverse infer vals   els <- freshType-  forM_ ts $ \(TypedValue _ _ t) -> unifyTypes els t-  return $ TypedValue True (Literal (ArrayLiteral ts)) (TypeApp tyArray els)+  ts' <- forM ts $ \(TypedValue ch val t) -> do+    (val', t') <- instantiatePolyTypeWithUnknowns val t+    unifyTypes els t'+    return (TypedValue ch val' t')+  return $ TypedValue True (Literal (ArrayLiteral ts')) (TypeApp tyArray els) infer' (Literal (ObjectLiteral ps)) = do   ensureNoDuplicateProperties ps   ts <- traverse (infer . snd) ps@@ -267,15 +265,14 @@   let oldTy = TypeApp tyRecord $ rowFromList (oldTys, row)   o' <- TypedValue True <$> check o oldTy <*> pure oldTy   return $ TypedValue True (ObjectUpdate o' newVals) $ TypeApp tyRecord $ rowFromList (newTys, row)-infer' (Accessor prop val) = rethrow (addHint (ErrorCheckingAccessor val prop)) $ do+infer' (Accessor prop val) = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do   field <- freshType   rest <- freshType   typed <- check val (TypeApp tyRecord (RCons prop field rest))   return $ TypedValue True (Accessor prop typed) field infer' (Abs (Left arg) ret) = do   ty <- freshType-  Just moduleName <- checkCurrentModule <$> get-  withBindingGroupVisible $ bindLocalVariables moduleName [(arg, ty, Defined)] $ do+  withBindingGroupVisible $ bindLocalVariables [(arg, ty, Defined)] $ do     body@(TypedValue _ _ bodyTy) <- infer' ret     return $ TypedValue True (Abs (Left arg) body) $ function ty bodyTy infer' (Abs (Right _) _) = internalError "Binder was not desugared"@@ -284,13 +281,13 @@   (ret, app) <- checkFunctionApplication f' ft arg Nothing   return $ TypedValue True app ret infer' (Var var) = do-  Just moduleName <- checkCurrentModule <$> get-  checkVisibility moduleName var-  ty <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards <=< lookupVariable moduleName $ var+  checkVisibility var+  ty <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards <=< lookupVariable $ var   case ty of     ConstrainedType constraints ty' -> do       dicts <- getTypeClassDictionaries-      return $ TypedValue True (foldl App (Var var) (map (flip TypeClassDictionary dicts) constraints)) ty'+      hints <- gets checkHints+      return $ TypedValue True (foldl App (Var var) (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) ty'     _ -> return $ TypedValue True (Var var) ty infer' v@(Constructor c) = do   env <- getEnv@@ -316,7 +313,8 @@   return $ TypedValue True (Let ds' val') valTy infer' (SuperClassDictionary className tys) = do   dicts <- getTypeClassDictionaries-  return $ TypeClassDictionary (Constraint className tys Nothing) dicts+  hints <- gets checkHints+  return $ TypeClassDictionary (Constraint className tys Nothing) dicts hints infer' (TypedValue checkType val ty) = do   Just moduleName <- checkCurrentModule <$> get   (kind, args) <- kindOfWithScopedVars ty@@ -326,12 +324,10 @@   return $ TypedValue True val' ty' infer' (Hole name) = do   ty <- freshType-  env <- M.toList . names <$> getEnv-  Just moduleName <- checkCurrentModule <$> get-  let ctx = [ (ident, ty') | ((mn, ident@Ident{}), (ty', _, Defined)) <- env, mn == moduleName ]+  ctx <- getLocalContext   tell . errorMessage $ HoleInferredType name ty ctx   return $ TypedValue True (Hole name) ty-infer' (PositionedValue pos c val) = warnAndRethrowWithPosition pos $ do+infer' (PositionedValue pos c val) = warnAndRethrowWithPositionTC pos $ do   TypedValue t v ty <- infer' val   return $ TypedValue t (PositionedValue pos c v) ty infer' v = internalError $ "Invalid argument to infer: " ++ show v@@ -348,27 +344,26 @@   Just moduleName <- checkCurrentModule <$> get   (kind, args) <- kindOfWithScopedVars ty   checkTypeKind ty kind-  let dict = M.singleton (moduleName, ident) (ty, nameKind, Undefined)+  let dict = M.singleton (Qualified Nothing ident) (ty, nameKind, Undefined)   ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty   TypedValue _ val' ty'' <- if checkType then withScopedTypeVars moduleName args (bindNames dict (check val ty')) else return tv-  bindNames (M.singleton (moduleName, ident) (ty'', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] (Right (TypedValue checkType val' ty''))]) rest ret j+  bindNames (M.singleton (Qualified Nothing ident) (ty'', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] (Right (TypedValue checkType val' ty''))]) rest ret j inferLetBinding seen (ValueDeclaration ident nameKind [] (Right val) : rest) ret j = do   valTy <- freshType-  Just moduleName <- checkCurrentModule <$> get-  let dict = M.singleton (moduleName, ident) (valTy, nameKind, Undefined)+  let dict = M.singleton (Qualified Nothing ident) (valTy, nameKind, Undefined)   TypedValue _ val' valTy' <- bindNames dict $ infer val   unifyTypes valTy valTy'-  bindNames (M.singleton (moduleName, ident) (valTy', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] (Right val')]) rest ret j+  bindNames (M.singleton (Qualified Nothing ident) (valTy', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] (Right val')]) rest ret j inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do   Just moduleName <- checkCurrentModule <$> get-  (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)+  (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup Nothing (map (\(i, _, v) -> (i, v)) ds)   ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict   ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict   let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']   bindNames dict $ do     makeBindingGroupVisible     inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j-inferLetBinding seen (PositionedDeclaration pos com d : ds) ret j = warnAndRethrowWithPosition pos $ do+inferLetBinding seen (PositionedDeclaration pos com d : ds) ret j = warnAndRethrowWithPositionTC pos $ do   (d' : ds', val') <- inferLetBinding seen (d : ds) ret j   return (PositionedDeclaration pos com d' : ds', val') inferLetBinding _ _ _ _ = internalError "Invalid argument to inferLetBinding"@@ -426,7 +421,7 @@   m <- inferBinder val binder   return $ M.insert name val m inferBinder val (PositionedBinder pos _ binder) =-  warnAndRethrowWithPosition pos $ inferBinder val binder+  warnAndRethrowWithPositionTC pos $ inferBinder val binder -- TODO: When adding support for polymorphic types, check subsumption here, -- change the definition of `binderRequiresMonotype`, -- and use `kindOfWithScopedVars`.@@ -480,14 +475,13 @@ checkBinders nvals ret (CaseAlternative binders result : bs) = do   guardWith (errorMessage $ OverlappingArgNames Nothing) $     let ns = concatMap binderNames binders in length (nub ns) == length ns-  Just moduleName <- checkCurrentModule <$> get   m1 <- M.unions <$> zipWithM inferBinder nvals binders-  r <- bindLocalVariables moduleName [ (name, ty, Defined) | (name, ty) <- M.toList m1 ] $+  r <- bindLocalVariables [ (name, ty, Defined) | (name, ty) <- M.toList m1 ] $     CaseAlternative binders <$>       case result of         Left gs -> do           gs' <- forM gs $ \(grd, val) -> do-            grd' <- rethrow (addHint ErrorCheckingGuard) $ check grd tyBoolean+            grd' <- withErrorMessageHint ErrorCheckingGuard $ check grd tyBoolean             val' <- TypedValue True <$> check val ret <*> pure ret             return (grd', val')           return $ Left gs'@@ -505,7 +499,7 @@   Expr ->   Type ->   m Expr-check val ty = rethrow (addHint (ErrorCheckingType val ty)) $ check' val ty+check val ty = withErrorMessageHint (ErrorCheckingType val ty) $ check' val ty  -- | -- Check the type of a value@@ -574,8 +568,7 @@   return $ TypedValue True array t check' (Abs (Left arg) ret) ty@(TypeApp (TypeApp t argTy) retTy) = do   unifyTypes t tyFunction-  Just moduleName <- checkCurrentModule <$> get-  ret' <- withBindingGroupVisible $ bindLocalVariables moduleName [(arg, argTy, Defined)] $ check ret retTy+  ret' <- withBindingGroupVisible $ bindLocalVariables [(arg, argTy, Defined)] $ check ret retTy   return $ TypedValue True (Abs (Left arg) ret') ty check' (Abs (Right _) _) _ = internalError "Binder was not desugared" check' (App f arg) ret = do@@ -583,9 +576,8 @@   (_, app) <- checkFunctionApplication f' ft arg (Just ret)   return $ TypedValue True app ret check' v@(Var var) ty = do-  Just moduleName <- checkCurrentModule <$> get-  checkVisibility moduleName var-  repl <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< lookupVariable moduleName $ var+  checkVisibility var+  repl <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< lookupVariable $ var   ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty   v' <- subsumes (Just v) repl ty'   case v' of@@ -599,7 +591,8 @@   -- declaration gets desugared.   -}   dicts <- getTypeClassDictionaries-  return $ TypeClassDictionary (Constraint className tys Nothing) dicts+  hints <- gets checkHints+  return $ TypeClassDictionary (Constraint className tys Nothing) dicts hints check' (TypedValue checkType val ty1) ty2 = do   Just moduleName <- checkCurrentModule <$> get   (kind, args) <- kindOfWithScopedVars ty1@@ -638,7 +631,7 @@   obj' <- check obj (TypeApp tyRecord (rowFromList (us ++ remainingProps, rest)))   ps' <- checkProperties e ps row True   return $ TypedValue True (ObjectUpdate obj' ps') t-check' (Accessor prop val) ty = rethrow (addHint (ErrorCheckingAccessor val prop)) $ do+check' (Accessor prop val) ty = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do   rest <- freshType   val' <- check val (TypeApp tyRecord (RCons prop ty rest))   return $ TypedValue True (Accessor prop val') ty@@ -659,7 +652,7 @@   checkTypeKind ty kind   val' <- check' val ty   return $ TypedValue True val' kt-check' (PositionedValue pos c val) ty = warnAndRethrowWithPosition pos $ do+check' (PositionedValue pos c val) ty = warnAndRethrowWithPositionTC pos $ do   TypedValue t v ty' <- check' val ty   return $ TypedValue t (PositionedValue pos c v) ty' check' val ty = do@@ -713,7 +706,7 @@   Expr ->   Maybe Type ->   m (Type, Expr)-checkFunctionApplication fn fnTy arg ret = rethrow (addHint (ErrorInApplication fn fnTy arg)) $ do+checkFunctionApplication fn fnTy arg ret = withErrorMessageHint (ErrorInApplication fn fnTy arg) $ do   subst <- gets checkSubstitution   checkFunctionApplication' fn (substituteType subst fnTy) arg (substituteType subst <$> ret) @@ -749,7 +742,8 @@   checkFunctionApplication fn ty arg ret checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do   dicts <- getTypeClassDictionaries-  checkFunctionApplication' (foldl App fn (map (flip TypeClassDictionary dicts) constraints)) fnTy arg ret+  hints <- gets checkHints+  checkFunctionApplication' (foldl App fn (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) fnTy arg ret checkFunctionApplication' fn fnTy dict@TypeClassDictionary{} _ =   return (fnTy, App fn dict) checkFunctionApplication' _ fnTy arg _ = throwError . errorMessage $ CannotApplyFunction fnTy arg

@@ -80,7 +80,7 @@ unifyTypes :: (MonadError MultipleErrors m, MonadState CheckState m) => Type -> Type -> m () unifyTypes t1 t2 = do   sub <- gets checkSubstitution-  rethrow (addHint (ErrorUnifyingTypes t1 t2)) $ unifyTypes' (substituteType sub t1) (substituteType sub t2)+  withErrorMessageHint (ErrorUnifyingTypes t1 t2) $ unifyTypes' (substituteType sub t1) (substituteType sub t2)   where   unifyTypes' (TUnknown u1) (TUnknown u2) | u1 == u2 = return ()   unifyTypes' (TUnknown u) t = solveType u t@@ -112,9 +112,11 @@   unifyTypes' r1 r2@RCons{} = unifyRows r1 r2   unifyTypes' r1@REmpty r2 = unifyRows r1 r2   unifyTypes' r1 r2@REmpty = unifyRows r1 r2-  unifyTypes' ty1@(ConstrainedType _ _) ty2 = throwError . errorMessage $ ConstrainedTypeUnified ty1 ty2+  unifyTypes' ty1@(ConstrainedType _ _) ty2 =+    throwError . errorMessage $ ConstrainedTypeUnified ty1 ty2   unifyTypes' t3 t4@(ConstrainedType _ _) = unifyTypes' t4 t3-  unifyTypes' t3 t4 = throwError . errorMessage $ TypesDoNotUnify t3 t4+  unifyTypes' t3 t4 =+    throwError . errorMessage $ TypesDoNotUnify t3 t4  -- | -- Unify two rows, updating the current substitution@@ -147,7 +149,8 @@   unifyRows' [] REmpty [] REmpty = return ()   unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()   unifyRows' [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) | s1 == s2 = return ()-  unifyRows' _ _ _ _ = throwError . errorMessage $ TypesDoNotUnify r1 r2+  unifyRows' _ _ _ _ =+    throwError . errorMessage $ TypesDoNotUnify r1 r2  -- | -- Check that two types unify@@ -195,7 +198,8 @@   where   replace (TypeWildcard ss) = do     t <- freshType-    warnWithPosition ss $ tell . errorMessage $ WildcardInferredType t+    ctx <- getLocalContext+    warnWithPosition ss $ tell . errorMessage $ WildcardInferredType t ctx     return t   replace other = return other 

@@ -21,7 +21,7 @@     -- | Type class dependencies which must be satisfied to construct this dictionary     , tcdDependencies :: Maybe [Constraint]     }-    deriving (Show, Read)+    deriving (Show)  -- | -- A simplified representation of expressions which are used to represent type@@ -44,4 +44,4 @@   -- A subclass dictionary   --   | SubclassDictionaryValue DictionaryValue (Qualified (ProperName 'ClassName)) Integer-  deriving (Show, Read, Ord, Eq)+  deriving (Show, Ord, Eq)

@@ -23,7 +23,7 @@ -- An identifier for the scope of a skolem variable -- newtype SkolemScope = SkolemScope { runSkolemScope :: Int }-  deriving (Show, Read, Eq, Ord, A.ToJSON, A.FromJSON)+  deriving (Show, Eq, Ord, A.ToJSON, A.FromJSON)  -- | -- The type of types@@ -71,7 +71,7 @@   -- Note: although it seems this constructor is not used, it _is_ useful,   -- since it prevents certain traversals from matching.   | ParensInType Type-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  -- | Additional data relevant to type class constraints data ConstraintData@@ -81,7 +81,7 @@   -- not matched, and a flag indicating whether the list was truncated or not.   -- Note: we use 'String' here because using 'Binder' would introduce a cyclic   -- dependency in the module graph.-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Eq, Ord)  -- | A typeclass constraint data Constraint = Constraint@@ -91,7 +91,7 @@   -- ^ type arguments   , constraintData  :: Maybe ConstraintData   -- ^ additional data relevant to this constraint-  } deriving (Show, Read, Eq, Ord)+  } deriving (Show, Eq, Ord)  mapConstraintArgs :: ([Type] -> [Type]) -> Constraint -> Constraint mapConstraintArgs f c = c { constraintArgs = f (constraintArgs c) }

@@ -1,4 +1,4 @@-resolver: lts-6.1+resolver: lts-6.9 packages: - '.' extra-deps: []

@@ -3,7 +3,7 @@ module Language.PureScript.Ide.ImportsSpec where  import           Protolude-import           Unsafe                          (fromJust)+import           Data.Maybe                      (fromJust)  import qualified Language.PureScript             as P import           Language.PureScript.Ide.Imports

@@ -48,7 +48,7 @@        ) where  import           Protolude-import           Unsafe                       (fromJust)+import           Data.Maybe                   (fromJust)  import           Data.Aeson import           Data.Aeson.Types

@@ -30,7 +30,7 @@   = ParseFailed String   | Mismatch ByteString ByteString -- ^ encoding before, encoding after   | Pass ByteString-  deriving (Show, Read)+  deriving (Show)  roundTrip :: UploadedPackage -> TestResult roundTrip pkg =