purescript 0.11.5 → 0.11.6

raw patch · 73 files changed

+2691/−2512 lines, 73 filesdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson

API changes (from Hackage documentation)

- Language.PureScript.AST.Declarations: PositionedDeclaration :: SourceSpan -> [Comment] -> Declaration -> Declaration

- Language.PureScript.AST.Declarations: PositionedDeclarationRef :: SourceSpan -> [Comment] -> DeclarationRef -> DeclarationRef

- Language.PureScript.CoreFn.Ann: nullAnn :: Ann

- Language.PureScript.Ide.Util: unwrapPositioned :: Declaration -> Declaration

- Language.PureScript.Ide.Util: unwrapPositionedRef :: DeclarationRef -> DeclarationRef

- Language.PureScript.Interactive.Types: [psciLoadedFiles] :: PSCiConfig -> [FilePath]

- Language.PureScript.Sugar.Names.Env: primImports :: Imports

+ Language.PureScript.AST.Declarations: declRefSourceSpan :: DeclarationRef -> SourceSpan

+ Language.PureScript.AST.Declarations: declSourceAnn :: Declaration -> SourceAnn

+ Language.PureScript.AST.Declarations: declSourceSpan :: Declaration -> SourceSpan

+ Language.PureScript.AST.Declarations: importPrim :: Module -> Module

+ Language.PureScript.AST.SourcePos: type SourceAnn = (SourceSpan, [Comment])

+ Language.PureScript.AST.Traversals: litM :: Monad m => (a -> m a) -> Literal a -> m (Literal a)

+ Language.PureScript.CoreFn.Ann: ssAnn :: SourceSpan -> Ann

+ Language.PureScript.Errors: errorMessage' :: SourceSpan -> SimpleErrorMessage -> MultipleErrors

+ Language.PureScript.Ide.Filter: declarationTypeFilter :: [IdeDeclaration] -> Filter

+ Language.PureScript.Ide.Filter.Declaration: DataConstructor :: DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: IdeDeclaration :: DeclarationType -> IdeDeclaration

+ Language.PureScript.Ide.Filter.Declaration: Kind :: DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: Synonym :: DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: Type :: DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: TypeClass :: DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: TypeOperator :: DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: Value :: DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: ValueOperator :: DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: [declarationtype] :: IdeDeclaration -> DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: data DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: instance Data.Aeson.Types.FromJSON.FromJSON Language.PureScript.Ide.Filter.Declaration.DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: instance Data.Aeson.Types.FromJSON.FromJSON Language.PureScript.Ide.Filter.Declaration.IdeDeclaration

+ Language.PureScript.Ide.Filter.Declaration: instance GHC.Classes.Eq Language.PureScript.Ide.Filter.Declaration.DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: instance GHC.Classes.Eq Language.PureScript.Ide.Filter.Declaration.IdeDeclaration

+ Language.PureScript.Ide.Filter.Declaration: instance GHC.Classes.Ord Language.PureScript.Ide.Filter.Declaration.DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: instance GHC.Classes.Ord Language.PureScript.Ide.Filter.Declaration.IdeDeclaration

+ Language.PureScript.Ide.Filter.Declaration: instance GHC.Show.Show Language.PureScript.Ide.Filter.Declaration.DeclarationType

+ Language.PureScript.Ide.Filter.Declaration: instance GHC.Show.Show Language.PureScript.Ide.Filter.Declaration.IdeDeclaration

+ Language.PureScript.Ide.Filter.Declaration: newtype IdeDeclaration

+ Language.PureScript.Ide.Filter.Declaration: typeDeclarationForDeclaration :: IdeDeclaration -> IdeDeclaration

+ Language.PureScript.Ide.Prim: idePrimDeclarations :: [IdeDeclarationAnn]

+ Language.PureScript.Ide.State: resolveDataConstructorsForModule :: [IdeDeclarationAnn] -> [IdeDeclarationAnn]

+ Language.PureScript.Ide.Types: [_ideTypeDtors] :: IdeType -> [(ProperName ConstructorName, Type)]

+ Language.PureScript.Ide.Types: ideTypeDtors :: Lens' IdeType [(ProperName ConstructorName, Type)]

+ Language.PureScript.Interactive.Module: internalSpan :: SourceSpan

+ Language.PureScript.Interactive.Types: [psciFileGlobs] :: PSCiConfig -> [String]

+ Language.PureScript.Parser.Common: withSourceAnnF :: Parsec [PositionedToken] u (SourceAnn -> a) -> Parsec [PositionedToken] u a

+ Language.PureScript.Parser.Common: withSourceSpan' :: (SourceSpan -> a -> b) -> Parsec [PositionedToken] u a -> Parsec [PositionedToken] u b

+ Language.PureScript.Sugar.Names.Env: nullImports :: Imports

- Language.PureScript.AST.Declarations: BindingGroupDeclaration :: [(Ident, NameKind, Expr)] -> Declaration

+ Language.PureScript.AST.Declarations: BindingGroupDeclaration :: (NonEmpty ((SourceAnn, Ident), NameKind, Expr)) -> Declaration

- Language.PureScript.AST.Declarations: BoundValueDeclaration :: Binder -> Expr -> Declaration

+ Language.PureScript.AST.Declarations: BoundValueDeclaration :: SourceAnn -> Binder -> Expr -> Declaration

- Language.PureScript.AST.Declarations: DataBindingGroupDeclaration :: [Declaration] -> Declaration

+ Language.PureScript.AST.Declarations: DataBindingGroupDeclaration :: (NonEmpty Declaration) -> Declaration

- Language.PureScript.AST.Declarations: DataDeclaration :: DataDeclType -> (ProperName TypeName) -> [(Text, Maybe Kind)] -> [(ProperName ConstructorName, [Type])] -> Declaration

+ Language.PureScript.AST.Declarations: DataDeclaration :: SourceAnn -> DataDeclType -> (ProperName TypeName) -> [(Text, Maybe Kind)] -> [(ProperName ConstructorName, [Type])] -> Declaration

- Language.PureScript.AST.Declarations: ErrorInBindingGroup :: [Ident] -> ErrorMessageHint

+ Language.PureScript.AST.Declarations: ErrorInBindingGroup :: (NonEmpty Ident) -> ErrorMessageHint

- Language.PureScript.AST.Declarations: ExternDataDeclaration :: (ProperName TypeName) -> Kind -> Declaration

+ Language.PureScript.AST.Declarations: ExternDataDeclaration :: SourceAnn -> (ProperName TypeName) -> Kind -> Declaration

- Language.PureScript.AST.Declarations: ExternDeclaration :: Ident -> Type -> Declaration

+ Language.PureScript.AST.Declarations: ExternDeclaration :: SourceAnn -> Ident -> Type -> Declaration

- Language.PureScript.AST.Declarations: ExternKindDeclaration :: (ProperName KindName) -> Declaration

+ Language.PureScript.AST.Declarations: ExternKindDeclaration :: SourceAnn -> (ProperName KindName) -> Declaration

- Language.PureScript.AST.Declarations: FixityDeclaration :: (Either ValueFixity TypeFixity) -> Declaration

+ Language.PureScript.AST.Declarations: FixityDeclaration :: SourceAnn -> (Either ValueFixity TypeFixity) -> Declaration

- Language.PureScript.AST.Declarations: ImportDeclaration :: ModuleName -> ImportDeclarationType -> (Maybe ModuleName) -> Declaration

+ Language.PureScript.AST.Declarations: ImportDeclaration :: SourceAnn -> ModuleName -> ImportDeclarationType -> (Maybe ModuleName) -> Declaration

- Language.PureScript.AST.Declarations: KindRef :: (ProperName KindName) -> DeclarationRef

+ Language.PureScript.AST.Declarations: KindRef :: SourceSpan -> (ProperName KindName) -> DeclarationRef

- Language.PureScript.AST.Declarations: ModuleRef :: ModuleName -> DeclarationRef

+ Language.PureScript.AST.Declarations: ModuleRef :: SourceSpan -> ModuleName -> DeclarationRef

- Language.PureScript.AST.Declarations: ReExportRef :: ModuleName -> DeclarationRef -> DeclarationRef

+ Language.PureScript.AST.Declarations: ReExportRef :: SourceSpan -> ModuleName -> DeclarationRef -> DeclarationRef

- Language.PureScript.AST.Declarations: TypeClassDeclaration :: (ProperName ClassName) -> [(Text, Maybe Kind)] -> [Constraint] -> [FunctionalDependency] -> [Declaration] -> Declaration

+ Language.PureScript.AST.Declarations: TypeClassDeclaration :: SourceAnn -> (ProperName ClassName) -> [(Text, Maybe Kind)] -> [Constraint] -> [FunctionalDependency] -> [Declaration] -> Declaration

- Language.PureScript.AST.Declarations: TypeClassRef :: (ProperName ClassName) -> DeclarationRef

+ Language.PureScript.AST.Declarations: TypeClassRef :: SourceSpan -> (ProperName ClassName) -> DeclarationRef

- Language.PureScript.AST.Declarations: TypeDeclaration :: Ident -> Type -> Declaration

+ Language.PureScript.AST.Declarations: TypeDeclaration :: SourceAnn -> Ident -> Type -> Declaration

- Language.PureScript.AST.Declarations: TypeInstanceDeclaration :: Ident -> [Constraint] -> (Qualified (ProperName ClassName)) -> [Type] -> TypeInstanceBody -> Declaration

+ Language.PureScript.AST.Declarations: TypeInstanceDeclaration :: SourceAnn -> Ident -> [Constraint] -> (Qualified (ProperName ClassName)) -> [Type] -> TypeInstanceBody -> Declaration

- Language.PureScript.AST.Declarations: TypeInstanceRef :: Ident -> DeclarationRef

+ Language.PureScript.AST.Declarations: TypeInstanceRef :: SourceSpan -> Ident -> DeclarationRef

- Language.PureScript.AST.Declarations: TypeOpRef :: (OpName TypeOpName) -> DeclarationRef

+ Language.PureScript.AST.Declarations: TypeOpRef :: SourceSpan -> (OpName TypeOpName) -> DeclarationRef

- Language.PureScript.AST.Declarations: TypeRef :: (ProperName TypeName) -> (Maybe [ProperName ConstructorName]) -> DeclarationRef

+ Language.PureScript.AST.Declarations: TypeRef :: SourceSpan -> (ProperName TypeName) -> (Maybe [ProperName ConstructorName]) -> DeclarationRef

- Language.PureScript.AST.Declarations: TypeSynonymDeclaration :: (ProperName TypeName) -> [(Text, Maybe Kind)] -> Type -> Declaration

+ Language.PureScript.AST.Declarations: TypeSynonymDeclaration :: SourceAnn -> (ProperName TypeName) -> [(Text, Maybe Kind)] -> Type -> Declaration

- Language.PureScript.AST.Declarations: ValueDeclaration :: Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration

+ Language.PureScript.AST.Declarations: ValueDeclaration :: SourceAnn -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration

- Language.PureScript.AST.Declarations: ValueOpRef :: (OpName ValueOpName) -> DeclarationRef

+ Language.PureScript.AST.Declarations: ValueOpRef :: SourceSpan -> (OpName ValueOpName) -> DeclarationRef

- Language.PureScript.AST.Declarations: ValueRef :: Ident -> DeclarationRef

+ Language.PureScript.AST.Declarations: ValueRef :: SourceSpan -> Ident -> DeclarationRef

- Language.PureScript.AST.Declarations: addDefaultImport :: ModuleName -> Module -> Module

+ Language.PureScript.AST.Declarations: addDefaultImport :: Qualified ModuleName -> Module -> Module

- Language.PureScript.CoreFn.Ann: type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)

+ Language.PureScript.CoreFn.Ann: type Ann = (SourceSpan, [Comment], Maybe Type, Maybe Meta)

- Language.PureScript.Ide.SourceFile: extractSpans :: SourceSpan -> Declaration -> [(IdeNamespaced, SourceSpan)]

+ Language.PureScript.Ide.SourceFile: extractSpans :: Declaration -> [(IdeNamespaced, SourceSpan)]

- Language.PureScript.Ide.Types: IdeType :: ProperName TypeName -> Kind -> IdeType

+ Language.PureScript.Ide.Types: IdeType :: ProperName TypeName -> Kind -> [(ProperName ConstructorName, Type)] -> IdeType

- Language.PureScript.Interactive.Types: PSCiConfig :: [FilePath] -> Environment -> PSCiConfig

+ Language.PureScript.Interactive.Types: PSCiConfig :: [String] -> Environment -> PSCiConfig

- Language.PureScript.Linter.Exhaustive: checkExhaustiveExpr :: forall m. (MonadWriter MultipleErrors m, MonadSupply m) => Environment -> ModuleName -> Expr -> m Expr

+ Language.PureScript.Linter.Exhaustive: checkExhaustiveExpr :: forall m. (MonadWriter MultipleErrors m, MonadSupply m) => SourceSpan -> Environment -> ModuleName -> Expr -> m Expr

- Language.PureScript.Sugar.Names.Imports: resolveModuleImport :: forall m. MonadError MultipleErrors m => Env -> Imports -> (ModuleName, [(Maybe SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)]) -> m Imports

+ Language.PureScript.Sugar.Names.Imports: resolveModuleImport :: forall m. MonadError MultipleErrors m => Env -> Imports -> (ModuleName, [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)]) -> m Imports

- Language.PureScript.Sugar.Names.Imports: type ImportDef = (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)

+ Language.PureScript.Sugar.Names.Imports: type ImportDef = (SourceSpan, ImportDeclarationType, Maybe ModuleName)

- Language.PureScript.TypeChecker.Types: typesOf :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => BindingGroupType -> ModuleName -> [(Ident, Expr)] -> m [(Ident, (Expr, Type))]

+ Language.PureScript.TypeChecker.Types: typesOf :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => BindingGroupType -> ModuleName -> [((SourceAnn, Ident), Expr)] -> m [((SourceAnn, Ident), (Expr, Type))]

Files

app/Command/Docs/Tags.hs +13/−13
app/Command/Hierarchy.hs +2/−3
app/Command/REPL.hs +3/−3
app/static/pursuit.css +4/−0
examples/docs/src/ChildDeclOrder.purs +27/−0
examples/passing/2972.purs +13/−0
purescript.cabal +1053/−1049
src/Language/PureScript/AST/Declarations.hs +106/−94
src/Language/PureScript/AST/Exported.hs +17/−26
src/Language/PureScript/AST/SourcePos.hs +15/−22
src/Language/PureScript/AST/Traversals.hs +90/−102
src/Language/PureScript/CodeGen/JS.hs +8/−9
src/Language/PureScript/Constants.hs +14/−0
src/Language/PureScript/CoreFn/Ann.hs +4/−4
src/Language/PureScript/CoreFn/Desugar.hs +56/−70
src/Language/PureScript/Docs/AsHtml.hs +15/−6
src/Language/PureScript/Docs/Convert.hs +1/−5
src/Language/PureScript/Docs/Convert/Single.hs +40/−59
src/Language/PureScript/Errors.hs +18/−15
src/Language/PureScript/Externs.hs +10/−14
src/Language/PureScript/Ide.hs +12/−7
src/Language/PureScript/Ide/CaseSplit.hs +2/−3
src/Language/PureScript/Ide/Completion.hs +5/−5
src/Language/PureScript/Ide/Externs.hs +39/−28
src/Language/PureScript/Ide/Filter.hs +14/−0
src/Language/PureScript/Ide/Filter/Declaration.hs +55/−0
src/Language/PureScript/Ide/Imports.hs +14/−11
src/Language/PureScript/Ide/Prim.hs +20/−0
src/Language/PureScript/Ide/Rebuild.hs +1/−1
src/Language/PureScript/Ide/Reexports.hs +6/−6
src/Language/PureScript/Ide/SourceFile.hs +19/−26
src/Language/PureScript/Ide/State.hs +31/−4
src/Language/PureScript/Ide/Types.hs +8/−7
src/Language/PureScript/Ide/Util.hs +0/−10
src/Language/PureScript/Interactive.hs +12/−12
src/Language/PureScript/Interactive/Completion.hs +7/−10
src/Language/PureScript/Interactive/Module.hs +10/−8
src/Language/PureScript/Interactive/Parser.hs +1/−5
src/Language/PureScript/Interactive/Types.hs +1/−1
src/Language/PureScript/Linter.hs +7/−10
src/Language/PureScript/Linter/Exhaustive.hs +33/−32
src/Language/PureScript/Linter/Imports.hs +41/−46
src/Language/PureScript/Make.hs +0/−4
src/Language/PureScript/ModuleDependencies.hs +10/−8
src/Language/PureScript/Parser/Common.hs +12/−1
src/Language/PureScript/Parser/Declarations.hs +79/−69
src/Language/PureScript/Pretty/Values.hs +6/−7
src/Language/PureScript/Sugar/BindingGroups.hs +26/−33
src/Language/PureScript/Sugar/CaseDeclarations.hs +35/−41
src/Language/PureScript/Sugar/DoNotation.hs +3/−5
src/Language/PureScript/Sugar/LetPattern.hs +2/−7
src/Language/PureScript/Sugar/Names.hs +102/−74
src/Language/PureScript/Sugar/Names/Common.hs +10/−22
src/Language/PureScript/Sugar/Names/Env.hs +2/−22
src/Language/PureScript/Sugar/Names/Exports.hs +28/−34
src/Language/PureScript/Sugar/Names/Imports.hs +63/−71
src/Language/PureScript/Sugar/ObjectWildcards.hs +2/−3
src/Language/PureScript/Sugar/Operators.hs +39/−47
src/Language/PureScript/Sugar/TypeClasses.hs +29/−35
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +76/−82
src/Language/PureScript/Sugar/TypeDeclarations.hs +13/−19
src/Language/PureScript/TypeChecker.hs +67/−74
src/Language/PureScript/TypeChecker/Entailment.hs +22/−9
src/Language/PureScript/TypeChecker/Types.hs +52/−47
tests/Language/PureScript/Ide/CompletionSpec.hs +1/−1
tests/Language/PureScript/Ide/FilterSpec.hs +77/−2
tests/Language/PureScript/Ide/ImportsSpec.hs +2/−2
tests/Language/PureScript/Ide/ReexportsSpec.hs +13/−10
tests/Language/PureScript/Ide/SourceFileSpec.hs +30/−35
tests/Language/PureScript/Ide/StateSpec.hs +18/−14
tests/Language/PureScript/Ide/Test.hs +14/−2
tests/TestDocs.hs +9/−5
tests/support/bower.json +2/−1

app/Command/Docs/Tags.hs view

@@ -6,16 +6,16 @@  tags :: P.Module -> [(String, Int)] tags = map (first T.unpack) . concatMap dtags . P.exportedDeclarations-  where dtags (P.PositionedDeclaration sp _ d) = map tag $ names d-          where tag name = (name, line)-                line = P.sourcePosLine $ P.spanStart sp-        dtags _ = []-        names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames-          where consNames = map (\(cname, _) -> P.runProperName cname) dcons-        names (P.TypeDeclaration ident _) = [P.showIdent ident]-        names (P.ExternDeclaration ident _) = [P.showIdent ident]-        names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]-        names (P.TypeClassDeclaration name _ _ _ _) = [P.runProperName name]-        names (P.TypeInstanceDeclaration name _ _ _ _) = [P.showIdent name]-        names (P.ExternKindDeclaration name) = [P.runProperName name]-        names _ = []+  where+    dtags :: P.Declaration -> [(P.Text, Int)]+    dtags (P.DataDeclaration (ss, _) _ name _ dcons) = (P.runProperName name, pos ss) : consNames+      where consNames = map (\(cname, _) -> (P.runProperName cname, pos ss)) dcons+    dtags (P.TypeDeclaration (ss, _) ident _) = [(P.showIdent ident, pos ss)]+    dtags (P.ExternDeclaration (ss, _) ident _) = [(P.showIdent ident, pos ss)]+    dtags (P.TypeSynonymDeclaration (ss, _) name _ _) = [(P.runProperName name, pos ss)]+    dtags (P.TypeClassDeclaration (ss, _) name _ _ _ _) = [(P.runProperName name, pos ss)]+    dtags (P.TypeInstanceDeclaration (ss, _) name _ _ _ _) = [(P.showIdent name, pos ss)]+    dtags (P.ExternKindDeclaration (ss, _) name) = [(P.runProperName name, pos ss)]+    dtags _ = []+    pos :: P.SourceSpan -> Int+    pos = P.sourcePosLine . P.spanStart

app/Command/Hierarchy.hs view

@@ -84,10 +84,9 @@       exitSuccess  superClasses :: P.Declaration -> [SuperMap]-superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _ _) =+superClasses (P.TypeClassDeclaration _ sub _ supers@(_:_) _ _) =   fmap (\(P.Constraint (P.Qualified _ super) _ _) -> SuperMap (Right (super, sub))) supers-superClasses (P.TypeClassDeclaration sub _ _ _ _) = [SuperMap (Left sub)]-superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl+superClasses (P.TypeClassDeclaration _ sub _ _ _ _) = [SuperMap (Left sub)] superClasses _ = []  inputFile :: Parser FilePath

app/Command/REPL.hs view

@@ -57,7 +57,7 @@  -- | Command line options data PSCiOptions = PSCiOptions-  { psciInputFile         :: [FilePath]+  { psciInputGlob         :: [String]   , psciBackend           :: Backend   } @@ -310,7 +310,7 @@   where     loop :: PSCiOptions -> IO ()     loop PSCiOptions{..} = do-        inputFiles <- concat <$> traverse glob psciInputFile+        inputFiles <- concat <$> traverse glob psciInputGlob         e <- runExceptT $ do           modules <- ExceptT (loadAllModules inputFiles)           when (null modules) . liftIO $ do@@ -331,7 +331,7 @@                 historyFilename <- getHistoryFilename                 let settings = defaultSettings { historyFile = Just historyFilename }                     initialState = PSCiState [] [] (zip (map snd modules) externs)-                    config = PSCiConfig inputFiles env+                    config = PSCiConfig psciInputGlob env                     runner = flip runReaderT config                              . flip evalStateT initialState                              . runInputT (setComplete completion settings)

app/static/pursuit.css view

@@ -413,6 +413,10 @@ .decl__body .syntax {   color: #0B71B4; }+.decl__child_comments {+  margin-top: 1rem;+  margin-bottom: 1rem;+} /* Component: Dependency Link  * -------------------------------------------------------------------------- */ .deplink {

+ examples/docs/src/ChildDeclOrder.purs view

@@ -0,0 +1,27 @@+-- Tests should ensure that, in the docs:+--  - First should come before Second+--  - foo1 should be listed before foo2+--  - the instances should be listed in the same order as this source file+module ChildDeclOrder where++data Two+  = First+  | Second++class Show a where+  show :: a -> String++class Foo a where+  foo1 :: a+  foo2 :: a++instance showTwo :: Show Two where+  show _  = ""++instance fooTwo :: Foo Two where+  foo1 = First+  foo2 = Second++instance fooInt :: Foo Int where+  foo1 = 1+  foo2 = 2

+ examples/passing/2972.purs view

@@ -0,0 +1,13 @@+module Main where++import Control.Monad.Eff.Console (log)+import Prelude (class Show, show)++type I t = t++newtype Id t = Id t++instance foo :: Show (I t) => Show (Id t) where+  show (Id t) = "Done"++main = log (show (Id "other"))

purescript.cabal view

@@ -1,1049 +1,1053 @@--- This file has been generated from package.yaml by hpack version 0.17.0.------ see: https://github.com/sol/hpack--name:           purescript-version:        0.11.5-cabal-version:  >= 1.10-build-type:     Simple-license:        BSD3-license-file:   LICENSE-copyright:      (c) 2013-17 Phil Freeman, (c) 2014-17 Gary Burgess-maintainer:     Phil Freeman <paf31@cantab.net>-stability:      experimental-homepage:       http://www.purescript.org/-bug-reports:    https://github.com/purescript/purescript/issues-synopsis:       PureScript Programming Language Compiler-description:    A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript.-category:       Language-author:         Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>, Hardy Jones <jones3.hardy@gmail.com>, Harry Garrood <harry@garrood.me>, Christoph Hegemann <christoph.hegemann1337@gmail.com>---extra-source-files:-      app/static/index.html-      app/static/index.js-      app/static/normalize.css-      app/static/pursuit.css-      CONTRIBUTING.md-      CONTRIBUTORS.md-      examples/docs/bower.json-      examples/docs/bower_components/purescript-prelude/src/Prelude.purs-      examples/docs/resolutions.json-      examples/docs/src/Clash.purs-      examples/docs/src/Clash1.purs-      examples/docs/src/Clash1a.purs-      examples/docs/src/Clash2.purs-      examples/docs/src/Clash2a.purs-      examples/docs/src/ConstrainedArgument.purs-      examples/docs/src/Desugar.purs-      examples/docs/src/DocComments.purs-      examples/docs/src/DuplicateNames.purs-      examples/docs/src/Example.purs-      examples/docs/src/Example2.purs-      examples/docs/src/ExplicitTypeSignatures.purs-      examples/docs/src/ImportedTwice.purs-      examples/docs/src/ImportedTwiceA.purs-      examples/docs/src/ImportedTwiceB.purs-      examples/docs/src/MultiVirtual.purs-      examples/docs/src/MultiVirtual1.purs-      examples/docs/src/MultiVirtual2.purs-      examples/docs/src/MultiVirtual3.purs-      examples/docs/src/NewOperators.purs-      examples/docs/src/NewOperators2.purs-      examples/docs/src/NotAllCtors.purs-      examples/docs/src/ReExportedTypeClass.purs-      examples/docs/src/SolitaryTypeClassMember.purs-      examples/docs/src/SomeTypeClass.purs-      examples/docs/src/Transitive1.purs-      examples/docs/src/Transitive2.purs-      examples/docs/src/Transitive3.purs-      examples/docs/src/TypeClassWithFunDeps.purs-      examples/docs/src/TypeClassWithoutMembers.purs-      examples/docs/src/TypeClassWithoutMembersIntermediate.purs-      examples/docs/src/TypeLevelString.purs-      examples/docs/src/TypeOpAliases.purs-      examples/docs/src/UTF8.purs-      examples/docs/src/Virtual.purs-      examples/failing/1071.purs-      examples/failing/1169.purs-      examples/failing/1175.purs-      examples/failing/1310.purs-      examples/failing/1570.purs-      examples/failing/1733.purs-      examples/failing/1733/Thingy.purs-      examples/failing/1825.purs-      examples/failing/1881.purs-      examples/failing/2128-class.purs-      examples/failing/2128-instance.purs-      examples/failing/2378.purs-      examples/failing/2378/Lib.purs-      examples/failing/2379.purs-      examples/failing/2379/Lib.purs-      examples/failing/2434.purs-      examples/failing/2534.purs-      examples/failing/2542.purs-      examples/failing/2567.purs-      examples/failing/2601.purs-      examples/failing/2616.purs-      examples/failing/2806.purs-      examples/failing/2874-forall.purs-      examples/failing/2874-forall2.purs-      examples/failing/2874-wildcard.purs-      examples/failing/365.purs-      examples/failing/438.purs-      examples/failing/881.purs-      examples/failing/AnonArgument1.purs-      examples/failing/AnonArgument2.purs-      examples/failing/AnonArgument3.purs-      examples/failing/ArgLengthMismatch.purs-      examples/failing/Arrays.purs-      examples/failing/ArrayType.purs-      examples/failing/BindInDo-2.purs-      examples/failing/BindInDo.purs-      examples/failing/CannotDeriveNewtypeForData.purs-      examples/failing/CaseBinderLengthsDiffer.purs-      examples/failing/CaseDoesNotMatchAllConstructorArgs.purs-      examples/failing/ConflictingExports.purs-      examples/failing/ConflictingExports/A.purs-      examples/failing/ConflictingExports/B.purs-      examples/failing/ConflictingImports.purs-      examples/failing/ConflictingImports/A.purs-      examples/failing/ConflictingImports/B.purs-      examples/failing/ConflictingImports2.purs-      examples/failing/ConflictingImports2/A.purs-      examples/failing/ConflictingImports2/B.purs-      examples/failing/ConflictingQualifiedImports.purs-      examples/failing/ConflictingQualifiedImports/A.purs-      examples/failing/ConflictingQualifiedImports/B.purs-      examples/failing/ConflictingQualifiedImports2.purs-      examples/failing/ConflictingQualifiedImports2/A.purs-      examples/failing/ConflictingQualifiedImports2/B.purs-      examples/failing/ConstraintFailure.purs-      examples/failing/ConstraintInference.purs-      examples/failing/DctorOperatorAliasExport.purs-      examples/failing/DeclConflictClassCtor.purs-      examples/failing/DeclConflictClassSynonym.purs-      examples/failing/DeclConflictClassType.purs-      examples/failing/DeclConflictCtorClass.purs-      examples/failing/DeclConflictCtorCtor.purs-      examples/failing/DeclConflictDuplicateCtor.purs-      examples/failing/DeclConflictSynonymClass.purs-      examples/failing/DeclConflictSynonymType.purs-      examples/failing/DeclConflictTypeClass.purs-      examples/failing/DeclConflictTypeSynonym.purs-      examples/failing/DeclConflictTypeType.purs-      examples/failing/DiffKindsSameName.purs-      examples/failing/DiffKindsSameName/LibA.purs-      examples/failing/DiffKindsSameName/LibB.purs-      examples/failing/Do.purs-      examples/failing/DoNotSuggestComposition.purs-      examples/failing/DoNotSuggestComposition2.purs-      examples/failing/DuplicateDeclarationsInLet.purs-      examples/failing/DuplicateModule.purs-      examples/failing/DuplicateModule/M1.purs-      examples/failing/DuplicateProperties.purs-      examples/failing/DuplicateTypeVars.purs-      examples/failing/Eff.purs-      examples/failing/EmptyCase.purs-      examples/failing/EmptyClass.purs-      examples/failing/EmptyDo.purs-      examples/failing/ExportConflictClass.purs-      examples/failing/ExportConflictClass/A.purs-      examples/failing/ExportConflictClass/B.purs-      examples/failing/ExportConflictCtor.purs-      examples/failing/ExportConflictCtor/A.purs-      examples/failing/ExportConflictCtor/B.purs-      examples/failing/ExportConflictType.purs-      examples/failing/ExportConflictType/A.purs-      examples/failing/ExportConflictType/B.purs-      examples/failing/ExportConflictTypeOp.purs-      examples/failing/ExportConflictTypeOp/A.purs-      examples/failing/ExportConflictTypeOp/B.purs-      examples/failing/ExportConflictValue.purs-      examples/failing/ExportConflictValue/A.purs-      examples/failing/ExportConflictValue/B.purs-      examples/failing/ExportConflictValueOp.purs-      examples/failing/ExportConflictValueOp/A.purs-      examples/failing/ExportConflictValueOp/B.purs-      examples/failing/ExportExplicit.purs-      examples/failing/ExportExplicit1.purs-      examples/failing/ExportExplicit1/M1.purs-      examples/failing/ExportExplicit2.purs-      examples/failing/ExportExplicit3.purs-      examples/failing/ExportExplicit3/M1.purs-      examples/failing/ExtraRecordField.purs-      examples/failing/Foldable.purs-      examples/failing/Generalization1.purs-      examples/failing/Generalization2.purs-      examples/failing/ImportExplicit.purs-      examples/failing/ImportExplicit/M1.purs-      examples/failing/ImportExplicit2.purs-      examples/failing/ImportExplicit2/M1.purs-      examples/failing/ImportHidingModule.purs-      examples/failing/ImportHidingModule/A.purs-      examples/failing/ImportHidingModule/B.purs-      examples/failing/ImportModule.purs-      examples/failing/ImportModule/M2.purs-      examples/failing/InfiniteKind.purs-      examples/failing/InfiniteType.purs-      examples/failing/InstanceExport.purs-      examples/failing/InstanceExport/InstanceExport.purs-      examples/failing/InstanceSigsBodyIncorrect.purs-      examples/failing/InstanceSigsDifferentTypes.purs-      examples/failing/InstanceSigsIncorrectType.purs-      examples/failing/InstanceSigsOrphanTypeDeclaration.purs-      examples/failing/IntOutOfRange.purs-      examples/failing/InvalidDerivedInstance.purs-      examples/failing/InvalidDerivedInstance2.purs-      examples/failing/InvalidOperatorInBinder.purs-      examples/failing/KindError.purs-      examples/failing/KindStar.purs-      examples/failing/LeadingZeros1.purs-      examples/failing/LeadingZeros2.purs-      examples/failing/Let.purs-      examples/failing/LetPatterns1.purs-      examples/failing/LetPatterns2.purs-      examples/failing/LetPatterns3.purs-      examples/failing/LetPatterns4.purs-      examples/failing/MissingClassExport.purs-      examples/failing/MissingClassMemberExport.purs-      examples/failing/MissingRecordField.purs-      examples/failing/MPTCs.purs-      examples/failing/MultipleErrors.purs-      examples/failing/MultipleErrors2.purs-      examples/failing/MultipleTypeOpFixities.purs-      examples/failing/MultipleValueOpFixities.purs-      examples/failing/MutRec.purs-      examples/failing/MutRec2.purs-      examples/failing/NewtypeInstance.purs-      examples/failing/NewtypeInstance2.purs-      examples/failing/NewtypeInstance3.purs-      examples/failing/NewtypeInstance4.purs-      examples/failing/NewtypeInstance5.purs-      examples/failing/NewtypeInstance6.purs-      examples/failing/NewtypeMultiArgs.purs-      examples/failing/NewtypeMultiCtor.purs-      examples/failing/NonExhaustivePatGuard.purs-      examples/failing/NonWildcardNewtypeInstance.purs-      examples/failing/NullaryAbs.purs-      examples/failing/Object.purs-      examples/failing/OperatorAliasNoExport.purs-      examples/failing/OperatorSections.purs-      examples/failing/OrphanInstance.purs-      examples/failing/OrphanInstance/Class.purs-      examples/failing/OrphanInstanceFunDepCycle.purs-      examples/failing/OrphanInstanceFunDepCycle/Lib.purs-      examples/failing/OrphanInstanceNullary.purs-      examples/failing/OrphanInstanceNullary/Lib.purs-      examples/failing/OrphanInstanceWithDetermined.purs-      examples/failing/OrphanInstanceWithDetermined/Lib.purs-      examples/failing/OrphanTypeDecl.purs-      examples/failing/OverlappingArguments.purs-      examples/failing/OverlappingBinders.purs-      examples/failing/OverlappingVars.purs-      examples/failing/ProgrammableTypeErrors.purs-      examples/failing/ProgrammableTypeErrorsTypeString.purs-      examples/failing/Rank2Types.purs-      examples/failing/RequiredHiddenType.purs-      examples/failing/Reserved.purs-      examples/failing/RowConstructors1.purs-      examples/failing/RowConstructors2.purs-      examples/failing/RowConstructors3.purs-      examples/failing/RowInInstanceNotDetermined0.purs-      examples/failing/RowInInstanceNotDetermined1.purs-      examples/failing/RowInInstanceNotDetermined2.purs-      examples/failing/SkolemEscape.purs-      examples/failing/SkolemEscape2.purs-      examples/failing/SuggestComposition.purs-      examples/failing/Superclasses1.purs-      examples/failing/Superclasses2.purs-      examples/failing/Superclasses3.purs-      examples/failing/Superclasses5.purs-      examples/failing/TooFewClassInstanceArgs.purs-      examples/failing/TopLevelCaseNoArgs.purs-      examples/failing/TransitiveDctorExport.purs-      examples/failing/TransitiveSynonymExport.purs-      examples/failing/TypeClasses2.purs-      examples/failing/TypeClassInstances.purs-      examples/failing/TypedBinders.purs-      examples/failing/TypedBinders2.purs-      examples/failing/TypedBinders3.purs-      examples/failing/TypedHole.purs-      examples/failing/TypeError.purs-      examples/failing/TypeOperatorAliasNoExport.purs-      examples/failing/TypeSynonyms.purs-      examples/failing/TypeSynonyms2.purs-      examples/failing/TypeSynonyms3.purs-      examples/failing/TypeSynonyms4.purs-      examples/failing/TypeSynonyms5.purs-      examples/failing/TypeWildcards1.purs-      examples/failing/TypeWildcards2.purs-      examples/failing/TypeWildcards3.purs-      examples/failing/UnderscoreModuleName.purs-      examples/failing/UnknownType.purs-      examples/failing/UnusableTypeClassMethod.purs-      examples/failing/UnusableTypeClassMethodConflictingIdent.purs-      examples/failing/UnusableTypeClassMethodSynonym.purs-      examples/passing/1110.purs-      examples/passing/1185.purs-      examples/passing/1335.purs-      examples/passing/1570.purs-      examples/passing/1664.purs-      examples/passing/1697.purs-      examples/passing/1807.purs-      examples/passing/1881.purs-      examples/passing/1991.purs-      examples/passing/2018.purs-      examples/passing/2018/A.purs-      examples/passing/2018/B.purs-      examples/passing/2049.purs-      examples/passing/2136.purs-      examples/passing/2138.purs-      examples/passing/2138/Lib.purs-      examples/passing/2172.js-      examples/passing/2172.purs-      examples/passing/2252.purs-      examples/passing/2288.purs-      examples/passing/2378.purs-      examples/passing/2438.purs-      examples/passing/2609.purs-      examples/passing/2609/Eg.purs-      examples/passing/2616.purs-      examples/passing/2626.purs-      examples/passing/2663.purs-      examples/passing/2689.purs-      examples/passing/2695.purs-      examples/passing/2756.purs-      examples/passing/2787.purs-      examples/passing/2795.purs-      examples/passing/2806.purs-      examples/passing/652.purs-      examples/passing/810.purs-      examples/passing/862.purs-      examples/passing/922.purs-      examples/passing/Applicative.purs-      examples/passing/ArrayType.purs-      examples/passing/Auto.purs-      examples/passing/AutoPrelude.purs-      examples/passing/AutoPrelude2.purs-      examples/passing/BindersInFunctions.purs-      examples/passing/BindingGroups.purs-      examples/passing/BlockString.purs-      examples/passing/CaseInDo.purs-      examples/passing/CaseInputWildcard.purs-      examples/passing/CaseMultipleExpressions.purs-      examples/passing/CaseStatement.purs-      examples/passing/CheckFunction.purs-      examples/passing/CheckSynonymBug.purs-      examples/passing/CheckTypeClass.purs-      examples/passing/Church.purs-      examples/passing/ClassRefSyntax.purs-      examples/passing/ClassRefSyntax/Lib.purs-      examples/passing/Collatz.purs-      examples/passing/Comparisons.purs-      examples/passing/Conditional.purs-      examples/passing/Console.purs-      examples/passing/ConstraintInference.purs-      examples/passing/ConstraintParens.purs-      examples/passing/ConstraintParsingIssue.purs-      examples/passing/ContextSimplification.purs-      examples/passing/DataAndType.purs-      examples/passing/DctorName.purs-      examples/passing/DctorOperatorAlias.purs-      examples/passing/DctorOperatorAlias/List.purs-      examples/passing/DeepArrayBinder.purs-      examples/passing/DeepCase.purs-      examples/passing/DeriveNewtype.purs-      examples/passing/DeriveWithNestedSynonyms.purs-      examples/passing/Deriving.purs-      examples/passing/DerivingFunctor.purs-      examples/passing/Do.purs-      examples/passing/Dollar.purs-      examples/passing/DuplicateProperties.purs-      examples/passing/Eff.purs-      examples/passing/EmptyDataDecls.purs-      examples/passing/EmptyRow.purs-      examples/passing/EmptyTypeClass.purs-      examples/passing/EntailsKindedType.purs-      examples/passing/EqOrd.purs-      examples/passing/ExplicitImportReExport.purs-      examples/passing/ExplicitImportReExport/Bar.purs-      examples/passing/ExplicitImportReExport/Foo.purs-      examples/passing/ExplicitOperatorSections.purs-      examples/passing/ExportedInstanceDeclarations.purs-      examples/passing/ExportExplicit.purs-      examples/passing/ExportExplicit/M1.purs-      examples/passing/ExportExplicit2.purs-      examples/passing/ExportExplicit2/M1.purs-      examples/passing/ExtendedInfixOperators.purs-      examples/passing/Fib.purs-      examples/passing/FieldConsPuns.purs-      examples/passing/FieldPuns.purs-      examples/passing/FinalTagless.purs-      examples/passing/ForeignKind.purs-      examples/passing/ForeignKind/Lib.purs-      examples/passing/FunctionalDependencies.purs-      examples/passing/Functions.purs-      examples/passing/Functions2.purs-      examples/passing/FunctionScope.purs-      examples/passing/FunWithFunDeps.js-      examples/passing/FunWithFunDeps.purs-      examples/passing/Generalization1.purs-      examples/passing/GenericsRep.purs-      examples/passing/Guards.purs-      examples/passing/HasOwnProperty.purs-      examples/passing/HoistError.purs-      examples/passing/IfThenElseMaybe.purs-      examples/passing/IfWildcard.purs-      examples/passing/ImplicitEmptyImport.purs-      examples/passing/Import.purs-      examples/passing/Import/M1.purs-      examples/passing/Import/M2.purs-      examples/passing/ImportExplicit.purs-      examples/passing/ImportExplicit/M1.purs-      examples/passing/ImportHiding.purs-      examples/passing/ImportQualified.purs-      examples/passing/ImportQualified/M1.purs-      examples/passing/InferRecFunWithConstrainedArgument.purs-      examples/passing/InstanceBeforeClass.purs-      examples/passing/InstanceSigs.purs-      examples/passing/InstanceSigsGeneral.purs-      examples/passing/IntAndChar.purs-      examples/passing/iota.purs-      examples/passing/JSReserved.purs-      examples/passing/KindedType.purs-      examples/passing/LargeSumType.purs-      examples/passing/Let.purs-      examples/passing/Let2.purs-      examples/passing/LetInInstance.purs-      examples/passing/LetPattern.purs-      examples/passing/LiberalTypeSynonyms.purs-      examples/passing/Match.purs-      examples/passing/Module.purs-      examples/passing/Module/M1.purs-      examples/passing/Module/M2.purs-      examples/passing/ModuleDeps.purs-      examples/passing/ModuleDeps/M1.purs-      examples/passing/ModuleDeps/M2.purs-      examples/passing/ModuleDeps/M3.purs-      examples/passing/ModuleExport.purs-      examples/passing/ModuleExport/A.purs-      examples/passing/ModuleExportDupes.purs-      examples/passing/ModuleExportDupes/A.purs-      examples/passing/ModuleExportDupes/B.purs-      examples/passing/ModuleExportDupes/C.purs-      examples/passing/ModuleExportExcluded.purs-      examples/passing/ModuleExportExcluded/A.purs-      examples/passing/ModuleExportQualified.purs-      examples/passing/ModuleExportQualified/A.purs-      examples/passing/ModuleExportSelf.purs-      examples/passing/ModuleExportSelf/A.purs-      examples/passing/Monad.purs-      examples/passing/MonadState.purs-      examples/passing/MPTCs.purs-      examples/passing/MultiArgFunctions.purs-      examples/passing/MutRec.purs-      examples/passing/MutRec2.purs-      examples/passing/MutRec3.purs-      examples/passing/NakedConstraint.purs-      examples/passing/NamedPatterns.purs-      examples/passing/NegativeBinder.purs-      examples/passing/NegativeIntInRange.purs-      examples/passing/Nested.purs-      examples/passing/NestedRecordUpdate.purs-      examples/passing/NestedRecordUpdateWildcards.purs-      examples/passing/NestedTypeSynonyms.purs-      examples/passing/NestedWhere.purs-      examples/passing/Newtype.purs-      examples/passing/NewtypeClass.purs-      examples/passing/NewtypeEff.purs-      examples/passing/NewtypeInstance.purs-      examples/passing/NewtypeWithRecordUpdate.purs-      examples/passing/NonConflictingExports.purs-      examples/passing/NonConflictingExports/A.purs-      examples/passing/NonOrphanInstanceFunDepExtra.purs-      examples/passing/NonOrphanInstanceFunDepExtra/Lib.purs-      examples/passing/NonOrphanInstanceMulti.purs-      examples/passing/NonOrphanInstanceMulti/Lib.purs-      examples/passing/NumberLiterals.purs-      examples/passing/ObjectGetter.purs-      examples/passing/Objects.purs-      examples/passing/ObjectSynonym.purs-      examples/passing/ObjectUpdate.purs-      examples/passing/ObjectUpdate2.purs-      examples/passing/ObjectUpdater.purs-      examples/passing/ObjectWildcards.purs-      examples/passing/OneConstructor.purs-      examples/passing/OperatorAlias.purs-      examples/passing/OperatorAliasElsewhere.purs-      examples/passing/OperatorAliasElsewhere/Def.purs-      examples/passing/OperatorAssociativity.purs-      examples/passing/OperatorInlining.purs-      examples/passing/Operators.purs-      examples/passing/Operators/Other.purs-      examples/passing/OperatorSections.purs-      examples/passing/OptimizerBug.purs-      examples/passing/OptionalQualified.purs-      examples/passing/OverlappingInstances.purs-      examples/passing/OverlappingInstances2.purs-      examples/passing/OverlappingInstances3.purs-      examples/passing/ParensInTypedBinder.purs-      examples/passing/PartialFunction.purs-      examples/passing/Patterns.purs-      examples/passing/PendingConflictingImports.purs-      examples/passing/PendingConflictingImports/A.purs-      examples/passing/PendingConflictingImports/B.purs-      examples/passing/PendingConflictingImports2.purs-      examples/passing/PendingConflictingImports2/A.purs-      examples/passing/Person.purs-      examples/passing/PolyLabels.js-      examples/passing/PolyLabels.purs-      examples/passing/PrimedTypeName.purs-      examples/passing/QualifiedNames.purs-      examples/passing/QualifiedNames/Either.purs-      examples/passing/QualifiedQualifiedImports.purs-      examples/passing/Rank2Data.purs-      examples/passing/Rank2Object.purs-      examples/passing/Rank2Types.purs-      examples/passing/Rank2TypeSynonym.purs-      examples/passing/RebindableSyntax.purs-      examples/passing/Recursion.purs-      examples/passing/RedefinedFixity.purs-      examples/passing/RedefinedFixity/M1.purs-      examples/passing/RedefinedFixity/M2.purs-      examples/passing/RedefinedFixity/M3.purs-      examples/passing/ReExportQualified.purs-      examples/passing/ReExportQualified/A.purs-      examples/passing/ReExportQualified/B.purs-      examples/passing/ReExportQualified/C.purs-      examples/passing/ReservedWords.purs-      examples/passing/ResolvableScopeConflict.purs-      examples/passing/ResolvableScopeConflict/A.purs-      examples/passing/ResolvableScopeConflict/B.purs-      examples/passing/ResolvableScopeConflict2.purs-      examples/passing/ResolvableScopeConflict2/A.purs-      examples/passing/ResolvableScopeConflict3.purs-      examples/passing/ResolvableScopeConflict3/A.purs-      examples/passing/RowConstructors.purs-      examples/passing/RowInInstanceHeadDetermined.purs-      examples/passing/RowPolyInstanceContext.purs-      examples/passing/RowsInInstanceContext.purs-      examples/passing/RowUnion.js-      examples/passing/RowUnion.purs-      examples/passing/RuntimeScopeIssue.purs-      examples/passing/s.purs-      examples/passing/ScopedTypeVariables.purs-      examples/passing/Sequence.purs-      examples/passing/SequenceDesugared.purs-      examples/passing/ShadowedModuleName.purs-      examples/passing/ShadowedModuleName/Test.purs-      examples/passing/ShadowedName.purs-      examples/passing/ShadowedRename.purs-      examples/passing/ShadowedTCO.purs-      examples/passing/ShadowedTCOLet.purs-      examples/passing/SignedNumericLiterals.purs-      examples/passing/SolvingAppendSymbol.purs-      examples/passing/SolvingCompareSymbol.purs-      examples/passing/SolvingIsSymbol.purs-      examples/passing/SolvingIsSymbol/Lib.purs-      examples/passing/Stream.purs-      examples/passing/StringEdgeCases.purs-      examples/passing/StringEdgeCases/Records.purs-      examples/passing/StringEdgeCases/Symbols.purs-      examples/passing/StringEscapes.purs-      examples/passing/Superclasses1.purs-      examples/passing/Superclasses3.purs-      examples/passing/TailCall.purs-      examples/passing/TCO.purs-      examples/passing/TCOCase.purs-      examples/passing/Tick.purs-      examples/passing/TopLevelCase.purs-      examples/passing/TransitiveImport.purs-      examples/passing/TransitiveImport/Middle.purs-      examples/passing/TransitiveImport/Test.purs-      examples/passing/TypeClasses.purs-      examples/passing/TypeClassesInOrder.purs-      examples/passing/TypeClassesWithOverlappingTypeVariables.purs-      examples/passing/TypeClassMemberOrderChange.purs-      examples/passing/TypedBinders.purs-      examples/passing/TypeDecl.purs-      examples/passing/TypedWhere.purs-      examples/passing/TypeOperators.purs-      examples/passing/TypeOperators/A.purs-      examples/passing/TypeSynonymInData.purs-      examples/passing/TypeSynonyms.purs-      examples/passing/TypeWildcards.purs-      examples/passing/TypeWildcardsRecordExtension.purs-      examples/passing/TypeWithoutParens.purs-      examples/passing/TypeWithoutParens/Lib.purs-      examples/passing/UnderscoreIdent.purs-      examples/passing/UnicodeIdentifier.purs-      examples/passing/UnicodeOperators.purs-      examples/passing/UnicodeType.purs-      examples/passing/UnifyInTypeInstanceLookup.purs-      examples/passing/Unit.purs-      examples/passing/UnknownInTypeClassLookup.purs-      examples/passing/UntupledConstraints.purs-      examples/passing/UsableTypeClassMethods.purs-      examples/passing/UTF8Sourcefile.purs-      examples/passing/Where.purs-      examples/passing/WildcardInInstance.purs-      examples/passing/WildcardType.purs-      examples/psci/BasicEval.purs-      examples/psci/Multiline.purs-      examples/warning/2140.purs-      examples/warning/2383.purs-      examples/warning/2411.purs-      examples/warning/2542.purs-      examples/warning/CustomWarning.purs-      examples/warning/CustomWarning2.purs-      examples/warning/CustomWarning3.purs-      examples/warning/DuplicateExportRef.purs-      examples/warning/DuplicateImport.purs-      examples/warning/DuplicateImportRef.purs-      examples/warning/DuplicateSelectiveImport.purs-      examples/warning/HidingImport.purs-      examples/warning/ImplicitImport.purs-      examples/warning/ImplicitQualifiedImport.purs-      examples/warning/MissingTypeDeclaration.purs-      examples/warning/NewtypeInstance.purs-      examples/warning/NewtypeInstance2.purs-      examples/warning/NewtypeInstance3.purs-      examples/warning/NewtypeInstance4.purs-      examples/warning/OverlappingInstances.purs-      examples/warning/OverlappingPattern.purs-      examples/warning/ScopeShadowing.purs-      examples/warning/ShadowedBinderPatternGuard.purs-      examples/warning/ShadowedNameParens.purs-      examples/warning/ShadowedTypeVar.purs-      examples/warning/UnnecessaryFFIModule.js-      examples/warning/UnnecessaryFFIModule.purs-      examples/warning/UnusedDctorExplicitImport.purs-      examples/warning/UnusedDctorImportAll.purs-      examples/warning/UnusedDctorImportExplicit.purs-      examples/warning/UnusedExplicitImport.purs-      examples/warning/UnusedExplicitImportTypeOp.purs-      examples/warning/UnusedExplicitImportTypeOp/Lib.purs-      examples/warning/UnusedExplicitImportValOp.purs-      examples/warning/UnusedFFIImplementations.js-      examples/warning/UnusedFFIImplementations.purs-      examples/warning/UnusedImport.purs-      examples/warning/UnusedTypeVar.purs-      examples/warning/WildcardInferredType.purs-      INSTALL.md-      README.md-      stack.yaml-      tests/support/bower.json-      tests/support/package.json-      tests/support/prelude-resolutions.json-      tests/support/psci/Sample.purs-      tests/support/pscide/src/ImportsSpec.purs-      tests/support/pscide/src/ImportsSpec1.purs-      tests/support/pscide/src/MatcherSpec.purs-      tests/support/pscide/src/RebuildSpecDep.purs-      tests/support/pscide/src/RebuildSpecSingleModule.fail-      tests/support/pscide/src/RebuildSpecSingleModule.purs-      tests/support/pscide/src/RebuildSpecWithDeps.purs-      tests/support/pscide/src/RebuildSpecWithForeign.js-      tests/support/pscide/src/RebuildSpecWithForeign.purs-      tests/support/pscide/src/RebuildSpecWithHiddenIdent.purs-      tests/support/pscide/src/RebuildSpecWithMissingForeign.fail-      tests/support/setup-win.cmd--source-repository head-    type: git-    location: https://github.com/purescript/purescript--flag release-    description: Mark this build as a release build: prevents inclusion of extra info e.g. commit SHA in --version output)--    manual: False-    default: False--library-    build-depends:-          aeson >=1.0 && <1.1-        , aeson-better-errors >=0.8-        , ansi-terminal >=0.6.2 && <0.7-        , base >=4.8 && <5-        , base-compat >=0.6.0-        , blaze-html >=0.8.1 && <0.9-        , bower-json >=1.0.0.1 && <1.1-        , boxes >=0.1.4 && <0.2.0-        , bytestring-        , cheapskate >=0.1 && <0.2-        , clock-        , containers-        , data-ordlist >=0.4.7.0-        , deepseq-        , directory >=1.2.3-        , dlist-        , edit-distance-        , filepath-        , fsnotify >=0.2.1-        , Glob >=0.7 && <0.8-        , haskeline >=0.7.0.0-        , http-client >=0.4.30 && <0.6.0-        , http-types-        , language-javascript >=0.6.0.9 && <0.7-        , lens ==4.*-        , lifted-base >=0.2.3 && <0.2.4-        , monad-control >=1.0.0.0 && <1.1-        , monad-logger >=0.3 && <0.4-        , mtl >=2.1.0 && <2.3.0-        , parallel >=3.2 && <3.3-        , parsec >=3.1.10-        , pattern-arrows >=0.0.2 && <0.1-        , pipes >=4.0.0 && <4.4.0-        , pipes-http-        , process >=1.2.0 && <1.5-        , protolude >=0.1.6-        , regex-tdfa-        , safe >=0.3.9 && <0.4-        , scientific >=0.3.4.9 && <0.4-        , semigroups >=0.16.2 && <0.19-        , sourcemap >=0.1.6-        , spdx ==0.2.*-        , split-        , stm >=0.2.4.0-        , stringsearch-        , syb-        , text-        , time-        , transformers >=0.3.0 && <0.6-        , transformers-base >=0.4.0 && <0.5-        , transformers-compat >=0.3.0-        , unordered-containers-        , utf8-string >=1 && <2-        , vector-    exposed-modules:-          Control.Monad.Logger-          Control.Monad.Supply-          Control.Monad.Supply.Class-          Language.PureScript-          Language.PureScript.AST-          Language.PureScript.AST.Binders-          Language.PureScript.AST.Declarations-          Language.PureScript.AST.Exported-          Language.PureScript.AST.Literals-          Language.PureScript.AST.Operators-          Language.PureScript.AST.SourcePos-          Language.PureScript.AST.Traversals-          Language.PureScript.Bundle-          Language.PureScript.CodeGen-          Language.PureScript.CodeGen.JS-          Language.PureScript.CodeGen.JS.Common-          Language.PureScript.CodeGen.JS.Printer-          Language.PureScript.Comments-          Language.PureScript.Constants-          Language.PureScript.CoreFn-          Language.PureScript.CoreFn.Ann-          Language.PureScript.CoreFn.Binders-          Language.PureScript.CoreFn.Desugar-          Language.PureScript.CoreFn.Expr-          Language.PureScript.CoreFn.Meta-          Language.PureScript.CoreFn.Module-          Language.PureScript.CoreFn.ToJSON-          Language.PureScript.CoreFn.Traversals-          Language.PureScript.CoreImp-          Language.PureScript.CoreImp.AST-          Language.PureScript.CoreImp.Optimizer-          Language.PureScript.CoreImp.Optimizer.Blocks-          Language.PureScript.CoreImp.Optimizer.Common-          Language.PureScript.CoreImp.Optimizer.Inliner-          Language.PureScript.CoreImp.Optimizer.MagicDo-          Language.PureScript.CoreImp.Optimizer.TCO-          Language.PureScript.CoreImp.Optimizer.Unused-          Language.PureScript.Crash-          Language.PureScript.Docs-          Language.PureScript.Docs.AsHtml-          Language.PureScript.Docs.AsMarkdown-          Language.PureScript.Docs.Convert-          Language.PureScript.Docs.Convert.ReExports-          Language.PureScript.Docs.Convert.Single-          Language.PureScript.Docs.ParseInPackage-          Language.PureScript.Docs.Prim-          Language.PureScript.Docs.Render-          Language.PureScript.Docs.RenderedCode-          Language.PureScript.Docs.RenderedCode.RenderKind-          Language.PureScript.Docs.RenderedCode.RenderType-          Language.PureScript.Docs.RenderedCode.Types-          Language.PureScript.Docs.Types-          Language.PureScript.Docs.Utils.MonoidExtras-          Language.PureScript.Environment-          Language.PureScript.Errors-          Language.PureScript.Errors.JSON-          Language.PureScript.Externs-          Language.PureScript.Ide-          Language.PureScript.Ide.CaseSplit-          Language.PureScript.Ide.Command-          Language.PureScript.Ide.Completion-          Language.PureScript.Ide.Error-          Language.PureScript.Ide.Externs-          Language.PureScript.Ide.Filter-          Language.PureScript.Ide.Imports-          Language.PureScript.Ide.Logging-          Language.PureScript.Ide.Matcher-          Language.PureScript.Ide.Pursuit-          Language.PureScript.Ide.Rebuild-          Language.PureScript.Ide.Reexports-          Language.PureScript.Ide.SourceFile-          Language.PureScript.Ide.State-          Language.PureScript.Ide.Types-          Language.PureScript.Ide.Util-          Language.PureScript.Ide.Watcher-          Language.PureScript.Interactive-          Language.PureScript.Interactive.Completion-          Language.PureScript.Interactive.Directive-          Language.PureScript.Interactive.IO-          Language.PureScript.Interactive.Message-          Language.PureScript.Interactive.Module-          Language.PureScript.Interactive.Parser-          Language.PureScript.Interactive.Printer-          Language.PureScript.Interactive.Types-          Language.PureScript.Kinds-          Language.PureScript.Label-          Language.PureScript.Linter-          Language.PureScript.Linter.Exhaustive-          Language.PureScript.Linter.Imports-          Language.PureScript.Make-          Language.PureScript.ModuleDependencies-          Language.PureScript.Names-          Language.PureScript.Options-          Language.PureScript.Parser-          Language.PureScript.Parser.Common-          Language.PureScript.Parser.Declarations-          Language.PureScript.Parser.Kinds-          Language.PureScript.Parser.Lexer-          Language.PureScript.Parser.State-          Language.PureScript.Parser.Types-          Language.PureScript.Pretty-          Language.PureScript.Pretty.Common-          Language.PureScript.Pretty.Kinds-          Language.PureScript.Pretty.Types-          Language.PureScript.Pretty.Values-          Language.PureScript.PSString-          Language.PureScript.Publish-          Language.PureScript.Publish.BoxesHelpers-          Language.PureScript.Publish.ErrorsWarnings-          Language.PureScript.Publish.Utils-          Language.PureScript.Renamer-          Language.PureScript.Sugar-          Language.PureScript.Sugar.BindingGroups-          Language.PureScript.Sugar.CaseDeclarations-          Language.PureScript.Sugar.DoNotation-          Language.PureScript.Sugar.LetPattern-          Language.PureScript.Sugar.Names-          Language.PureScript.Sugar.Names.Common-          Language.PureScript.Sugar.Names.Env-          Language.PureScript.Sugar.Names.Exports-          Language.PureScript.Sugar.Names.Imports-          Language.PureScript.Sugar.ObjectWildcards-          Language.PureScript.Sugar.Operators-          Language.PureScript.Sugar.Operators.Binders-          Language.PureScript.Sugar.Operators.Common-          Language.PureScript.Sugar.Operators.Expr-          Language.PureScript.Sugar.Operators.Types-          Language.PureScript.Sugar.TypeClasses-          Language.PureScript.Sugar.TypeClasses.Deriving-          Language.PureScript.Sugar.TypeDeclarations-          Language.PureScript.Traversals-          Language.PureScript.TypeChecker-          Language.PureScript.TypeChecker.Entailment-          Language.PureScript.TypeChecker.Kinds-          Language.PureScript.TypeChecker.Monad-          Language.PureScript.TypeChecker.Skolems-          Language.PureScript.TypeChecker.Subsumption-          Language.PureScript.TypeChecker.Synonyms-          Language.PureScript.TypeChecker.Types-          Language.PureScript.TypeChecker.TypeSearch-          Language.PureScript.TypeChecker.Unify-          Language.PureScript.TypeClassDictionaries-          Language.PureScript.Types-          System.IO.UTF8-    other-modules:-          Paths_purescript-    hs-source-dirs:-          src-    default-extensions: ConstraintKinds DataKinds DeriveFunctor EmptyDataDecls FlexibleContexts KindSignatures LambdaCase MultiParamTypeClasses NoImplicitPrelude PatternGuards PatternSynonyms RankNTypes RecordWildCards OverloadedStrings ScopedTypeVariables TupleSections ViewPatterns-    default-language: Haskell2010-    ghc-options: -Wall -O2--executable purs-    build-depends:-          aeson >=1.0 && <1.1-        , aeson-better-errors >=0.8-        , ansi-terminal >=0.6.2 && <0.7-        , base >=4.8 && <5-        , base-compat >=0.6.0-        , blaze-html >=0.8.1 && <0.9-        , bower-json >=1.0.0.1 && <1.1-        , boxes >=0.1.4 && <0.2.0-        , bytestring-        , cheapskate >=0.1 && <0.2-        , clock-        , containers-        , data-ordlist >=0.4.7.0-        , deepseq-        , directory >=1.2.3-        , dlist-        , edit-distance-        , filepath-        , fsnotify >=0.2.1-        , Glob >=0.7 && <0.8-        , haskeline >=0.7.0.0-        , http-client >=0.4.30 && <0.6.0-        , http-types-        , language-javascript >=0.6.0.9 && <0.7-        , lens ==4.*-        , lifted-base >=0.2.3 && <0.2.4-        , monad-control >=1.0.0.0 && <1.1-        , monad-logger >=0.3 && <0.4-        , mtl >=2.1.0 && <2.3.0-        , parallel >=3.2 && <3.3-        , parsec >=3.1.10-        , pattern-arrows >=0.0.2 && <0.1-        , pipes >=4.0.0 && <4.4.0-        , pipes-http-        , process >=1.2.0 && <1.5-        , protolude >=0.1.6-        , regex-tdfa-        , safe >=0.3.9 && <0.4-        , scientific >=0.3.4.9 && <0.4-        , semigroups >=0.16.2 && <0.19-        , sourcemap >=0.1.6-        , spdx ==0.2.*-        , split-        , stm >=0.2.4.0-        , stringsearch-        , syb-        , text-        , time-        , transformers >=0.3.0 && <0.6-        , transformers-base >=0.4.0 && <0.5-        , transformers-compat >=0.3.0-        , unordered-containers-        , utf8-string >=1 && <2-        , vector-        , ansi-wl-pprint-        , file-embed-        , network-        , optparse-applicative >=0.13.0-        , purescript-        , wai ==3.*-        , wai-websockets ==3.*-        , warp ==3.*-        , websockets >=0.9 && <0.11-    if flag(release)-        cpp-options: -DRELEASE-    else-        build-depends:-              gitrev >=1.2.0 && <1.3-    main-is: Main.hs-    hs-source-dirs:-          app-    other-modules:-          Command.Bundle-          Command.Compile-          Command.Docs-          Command.Docs.Ctags-          Command.Docs.Etags-          Command.Docs.Html-          Command.Docs.Tags-          Command.Hierarchy-          Command.Ide-          Command.Publish-          Command.REPL-          Version-    default-language: Haskell2010-    ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N--test-suite tests-    build-depends:-          aeson >=1.0 && <1.1-        , aeson-better-errors >=0.8-        , ansi-terminal >=0.6.2 && <0.7-        , base >=4.8 && <5-        , base-compat >=0.6.0-        , blaze-html >=0.8.1 && <0.9-        , bower-json >=1.0.0.1 && <1.1-        , boxes >=0.1.4 && <0.2.0-        , bytestring-        , cheapskate >=0.1 && <0.2-        , clock-        , containers-        , data-ordlist >=0.4.7.0-        , deepseq-        , directory >=1.2.3-        , dlist-        , edit-distance-        , filepath-        , fsnotify >=0.2.1-        , Glob >=0.7 && <0.8-        , haskeline >=0.7.0.0-        , http-client >=0.4.30 && <0.6.0-        , http-types-        , language-javascript >=0.6.0.9 && <0.7-        , lens ==4.*-        , lifted-base >=0.2.3 && <0.2.4-        , monad-control >=1.0.0.0 && <1.1-        , monad-logger >=0.3 && <0.4-        , mtl >=2.1.0 && <2.3.0-        , parallel >=3.2 && <3.3-        , parsec >=3.1.10-        , pattern-arrows >=0.0.2 && <0.1-        , pipes >=4.0.0 && <4.4.0-        , pipes-http-        , process >=1.2.0 && <1.5-        , protolude >=0.1.6-        , regex-tdfa-        , safe >=0.3.9 && <0.4-        , scientific >=0.3.4.9 && <0.4-        , semigroups >=0.16.2 && <0.19-        , sourcemap >=0.1.6-        , spdx ==0.2.*-        , split-        , stm >=0.2.4.0-        , stringsearch-        , syb-        , text-        , time-        , transformers >=0.3.0 && <0.6-        , transformers-base >=0.4.0 && <0.5-        , transformers-compat >=0.3.0-        , unordered-containers-        , utf8-string >=1 && <2-        , vector-        , purescript-        , hspec-        , hspec-discover-        , HUnit-        , silently-    ghc-options: -Wall-    type: exitcode-stdio-1.0-    main-is: Main.hs-    other-modules:-          Language.PureScript.Ide.CompletionSpec-          Language.PureScript.Ide.FilterSpec-          Language.PureScript.Ide.ImportsSpec-          Language.PureScript.Ide.MatcherSpec-          Language.PureScript.Ide.RebuildSpec-          Language.PureScript.Ide.ReexportsSpec-          Language.PureScript.Ide.SourceFileSpec-          Language.PureScript.Ide.StateSpec-          Language.PureScript.Ide.Test-          PscIdeSpec-          TestCompiler-          TestDocs-          TestPrimDocs-          TestPsci-          TestPsci.CommandTest-          TestPsci.CompletionTest-          TestPsci.EvalTest-          TestPsci.TestEnv-          TestPscIde-          TestPscPublish-          TestUtils-    default-language: Haskell2010-    hs-source-dirs:-          tests+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           purescript+version:        0.11.6+synopsis:       PureScript Programming Language Compiler+description:    A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript.+category:       Language+stability:      experimental+homepage:       http://www.purescript.org/+bug-reports:    https://github.com/purescript/purescript/issues+author:         Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>, Hardy Jones <jones3.hardy@gmail.com>, Harry Garrood <harry@garrood.me>, Christoph Hegemann <christoph.hegemann1337@gmail.com>++maintainer:     Phil Freeman <paf31@cantab.net>+copyright:      (c) 2013-17 Phil Freeman, (c) 2014-17 Gary Burgess+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    app/static/index.html+    app/static/index.js+    app/static/normalize.css+    app/static/pursuit.css+    CONTRIBUTING.md+    CONTRIBUTORS.md+    examples/docs/bower.json+    examples/docs/bower_components/purescript-prelude/src/Prelude.purs+    examples/docs/resolutions.json+    examples/docs/src/ChildDeclOrder.purs+    examples/docs/src/Clash.purs+    examples/docs/src/Clash1.purs+    examples/docs/src/Clash1a.purs+    examples/docs/src/Clash2.purs+    examples/docs/src/Clash2a.purs+    examples/docs/src/ConstrainedArgument.purs+    examples/docs/src/Desugar.purs+    examples/docs/src/DocComments.purs+    examples/docs/src/DuplicateNames.purs+    examples/docs/src/Example.purs+    examples/docs/src/Example2.purs+    examples/docs/src/ExplicitTypeSignatures.purs+    examples/docs/src/ImportedTwice.purs+    examples/docs/src/ImportedTwiceA.purs+    examples/docs/src/ImportedTwiceB.purs+    examples/docs/src/MultiVirtual.purs+    examples/docs/src/MultiVirtual1.purs+    examples/docs/src/MultiVirtual2.purs+    examples/docs/src/MultiVirtual3.purs+    examples/docs/src/NewOperators.purs+    examples/docs/src/NewOperators2.purs+    examples/docs/src/NotAllCtors.purs+    examples/docs/src/ReExportedTypeClass.purs+    examples/docs/src/SolitaryTypeClassMember.purs+    examples/docs/src/SomeTypeClass.purs+    examples/docs/src/Transitive1.purs+    examples/docs/src/Transitive2.purs+    examples/docs/src/Transitive3.purs+    examples/docs/src/TypeClassWithFunDeps.purs+    examples/docs/src/TypeClassWithoutMembers.purs+    examples/docs/src/TypeClassWithoutMembersIntermediate.purs+    examples/docs/src/TypeLevelString.purs+    examples/docs/src/TypeOpAliases.purs+    examples/docs/src/UTF8.purs+    examples/docs/src/Virtual.purs+    examples/failing/1071.purs+    examples/failing/1169.purs+    examples/failing/1175.purs+    examples/failing/1310.purs+    examples/failing/1570.purs+    examples/failing/1733.purs+    examples/failing/1733/Thingy.purs+    examples/failing/1825.purs+    examples/failing/1881.purs+    examples/failing/2128-class.purs+    examples/failing/2128-instance.purs+    examples/failing/2378.purs+    examples/failing/2378/Lib.purs+    examples/failing/2379.purs+    examples/failing/2379/Lib.purs+    examples/failing/2434.purs+    examples/failing/2534.purs+    examples/failing/2542.purs+    examples/failing/2567.purs+    examples/failing/2601.purs+    examples/failing/2616.purs+    examples/failing/2806.purs+    examples/failing/2874-forall.purs+    examples/failing/2874-forall2.purs+    examples/failing/2874-wildcard.purs+    examples/failing/365.purs+    examples/failing/438.purs+    examples/failing/881.purs+    examples/failing/AnonArgument1.purs+    examples/failing/AnonArgument2.purs+    examples/failing/AnonArgument3.purs+    examples/failing/ArgLengthMismatch.purs+    examples/failing/Arrays.purs+    examples/failing/ArrayType.purs+    examples/failing/BindInDo-2.purs+    examples/failing/BindInDo.purs+    examples/failing/CannotDeriveNewtypeForData.purs+    examples/failing/CaseBinderLengthsDiffer.purs+    examples/failing/CaseDoesNotMatchAllConstructorArgs.purs+    examples/failing/ConflictingExports.purs+    examples/failing/ConflictingExports/A.purs+    examples/failing/ConflictingExports/B.purs+    examples/failing/ConflictingImports.purs+    examples/failing/ConflictingImports/A.purs+    examples/failing/ConflictingImports/B.purs+    examples/failing/ConflictingImports2.purs+    examples/failing/ConflictingImports2/A.purs+    examples/failing/ConflictingImports2/B.purs+    examples/failing/ConflictingQualifiedImports.purs+    examples/failing/ConflictingQualifiedImports/A.purs+    examples/failing/ConflictingQualifiedImports/B.purs+    examples/failing/ConflictingQualifiedImports2.purs+    examples/failing/ConflictingQualifiedImports2/A.purs+    examples/failing/ConflictingQualifiedImports2/B.purs+    examples/failing/ConstraintFailure.purs+    examples/failing/ConstraintInference.purs+    examples/failing/DctorOperatorAliasExport.purs+    examples/failing/DeclConflictClassCtor.purs+    examples/failing/DeclConflictClassSynonym.purs+    examples/failing/DeclConflictClassType.purs+    examples/failing/DeclConflictCtorClass.purs+    examples/failing/DeclConflictCtorCtor.purs+    examples/failing/DeclConflictDuplicateCtor.purs+    examples/failing/DeclConflictSynonymClass.purs+    examples/failing/DeclConflictSynonymType.purs+    examples/failing/DeclConflictTypeClass.purs+    examples/failing/DeclConflictTypeSynonym.purs+    examples/failing/DeclConflictTypeType.purs+    examples/failing/DiffKindsSameName.purs+    examples/failing/DiffKindsSameName/LibA.purs+    examples/failing/DiffKindsSameName/LibB.purs+    examples/failing/Do.purs+    examples/failing/DoNotSuggestComposition.purs+    examples/failing/DoNotSuggestComposition2.purs+    examples/failing/DuplicateDeclarationsInLet.purs+    examples/failing/DuplicateModule.purs+    examples/failing/DuplicateModule/M1.purs+    examples/failing/DuplicateProperties.purs+    examples/failing/DuplicateTypeVars.purs+    examples/failing/Eff.purs+    examples/failing/EmptyCase.purs+    examples/failing/EmptyClass.purs+    examples/failing/EmptyDo.purs+    examples/failing/ExportConflictClass.purs+    examples/failing/ExportConflictClass/A.purs+    examples/failing/ExportConflictClass/B.purs+    examples/failing/ExportConflictCtor.purs+    examples/failing/ExportConflictCtor/A.purs+    examples/failing/ExportConflictCtor/B.purs+    examples/failing/ExportConflictType.purs+    examples/failing/ExportConflictType/A.purs+    examples/failing/ExportConflictType/B.purs+    examples/failing/ExportConflictTypeOp.purs+    examples/failing/ExportConflictTypeOp/A.purs+    examples/failing/ExportConflictTypeOp/B.purs+    examples/failing/ExportConflictValue.purs+    examples/failing/ExportConflictValue/A.purs+    examples/failing/ExportConflictValue/B.purs+    examples/failing/ExportConflictValueOp.purs+    examples/failing/ExportConflictValueOp/A.purs+    examples/failing/ExportConflictValueOp/B.purs+    examples/failing/ExportExplicit.purs+    examples/failing/ExportExplicit1.purs+    examples/failing/ExportExplicit1/M1.purs+    examples/failing/ExportExplicit2.purs+    examples/failing/ExportExplicit3.purs+    examples/failing/ExportExplicit3/M1.purs+    examples/failing/ExtraRecordField.purs+    examples/failing/Foldable.purs+    examples/failing/Generalization1.purs+    examples/failing/Generalization2.purs+    examples/failing/ImportExplicit.purs+    examples/failing/ImportExplicit/M1.purs+    examples/failing/ImportExplicit2.purs+    examples/failing/ImportExplicit2/M1.purs+    examples/failing/ImportHidingModule.purs+    examples/failing/ImportHidingModule/A.purs+    examples/failing/ImportHidingModule/B.purs+    examples/failing/ImportModule.purs+    examples/failing/ImportModule/M2.purs+    examples/failing/InfiniteKind.purs+    examples/failing/InfiniteType.purs+    examples/failing/InstanceExport.purs+    examples/failing/InstanceExport/InstanceExport.purs+    examples/failing/InstanceSigsBodyIncorrect.purs+    examples/failing/InstanceSigsDifferentTypes.purs+    examples/failing/InstanceSigsIncorrectType.purs+    examples/failing/InstanceSigsOrphanTypeDeclaration.purs+    examples/failing/IntOutOfRange.purs+    examples/failing/InvalidDerivedInstance.purs+    examples/failing/InvalidDerivedInstance2.purs+    examples/failing/InvalidOperatorInBinder.purs+    examples/failing/KindError.purs+    examples/failing/KindStar.purs+    examples/failing/LeadingZeros1.purs+    examples/failing/LeadingZeros2.purs+    examples/failing/Let.purs+    examples/failing/LetPatterns1.purs+    examples/failing/LetPatterns2.purs+    examples/failing/LetPatterns3.purs+    examples/failing/LetPatterns4.purs+    examples/failing/MissingClassExport.purs+    examples/failing/MissingClassMemberExport.purs+    examples/failing/MissingRecordField.purs+    examples/failing/MPTCs.purs+    examples/failing/MultipleErrors.purs+    examples/failing/MultipleErrors2.purs+    examples/failing/MultipleTypeOpFixities.purs+    examples/failing/MultipleValueOpFixities.purs+    examples/failing/MutRec.purs+    examples/failing/MutRec2.purs+    examples/failing/NewtypeInstance.purs+    examples/failing/NewtypeInstance2.purs+    examples/failing/NewtypeInstance3.purs+    examples/failing/NewtypeInstance4.purs+    examples/failing/NewtypeInstance5.purs+    examples/failing/NewtypeInstance6.purs+    examples/failing/NewtypeMultiArgs.purs+    examples/failing/NewtypeMultiCtor.purs+    examples/failing/NonExhaustivePatGuard.purs+    examples/failing/NonWildcardNewtypeInstance.purs+    examples/failing/NullaryAbs.purs+    examples/failing/Object.purs+    examples/failing/OperatorAliasNoExport.purs+    examples/failing/OperatorSections.purs+    examples/failing/OrphanInstance.purs+    examples/failing/OrphanInstance/Class.purs+    examples/failing/OrphanInstanceFunDepCycle.purs+    examples/failing/OrphanInstanceFunDepCycle/Lib.purs+    examples/failing/OrphanInstanceNullary.purs+    examples/failing/OrphanInstanceNullary/Lib.purs+    examples/failing/OrphanInstanceWithDetermined.purs+    examples/failing/OrphanInstanceWithDetermined/Lib.purs+    examples/failing/OrphanTypeDecl.purs+    examples/failing/OverlappingArguments.purs+    examples/failing/OverlappingBinders.purs+    examples/failing/OverlappingVars.purs+    examples/failing/ProgrammableTypeErrors.purs+    examples/failing/ProgrammableTypeErrorsTypeString.purs+    examples/failing/Rank2Types.purs+    examples/failing/RequiredHiddenType.purs+    examples/failing/Reserved.purs+    examples/failing/RowConstructors1.purs+    examples/failing/RowConstructors2.purs+    examples/failing/RowConstructors3.purs+    examples/failing/RowInInstanceNotDetermined0.purs+    examples/failing/RowInInstanceNotDetermined1.purs+    examples/failing/RowInInstanceNotDetermined2.purs+    examples/failing/SkolemEscape.purs+    examples/failing/SkolemEscape2.purs+    examples/failing/SuggestComposition.purs+    examples/failing/Superclasses1.purs+    examples/failing/Superclasses2.purs+    examples/failing/Superclasses3.purs+    examples/failing/Superclasses5.purs+    examples/failing/TooFewClassInstanceArgs.purs+    examples/failing/TopLevelCaseNoArgs.purs+    examples/failing/TransitiveDctorExport.purs+    examples/failing/TransitiveSynonymExport.purs+    examples/failing/TypeClasses2.purs+    examples/failing/TypeClassInstances.purs+    examples/failing/TypedBinders.purs+    examples/failing/TypedBinders2.purs+    examples/failing/TypedBinders3.purs+    examples/failing/TypedHole.purs+    examples/failing/TypeError.purs+    examples/failing/TypeOperatorAliasNoExport.purs+    examples/failing/TypeSynonyms.purs+    examples/failing/TypeSynonyms2.purs+    examples/failing/TypeSynonyms3.purs+    examples/failing/TypeSynonyms4.purs+    examples/failing/TypeSynonyms5.purs+    examples/failing/TypeWildcards1.purs+    examples/failing/TypeWildcards2.purs+    examples/failing/TypeWildcards3.purs+    examples/failing/UnderscoreModuleName.purs+    examples/failing/UnknownType.purs+    examples/failing/UnusableTypeClassMethod.purs+    examples/failing/UnusableTypeClassMethodConflictingIdent.purs+    examples/failing/UnusableTypeClassMethodSynonym.purs+    examples/passing/1110.purs+    examples/passing/1185.purs+    examples/passing/1335.purs+    examples/passing/1570.purs+    examples/passing/1664.purs+    examples/passing/1697.purs+    examples/passing/1807.purs+    examples/passing/1881.purs+    examples/passing/1991.purs+    examples/passing/2018.purs+    examples/passing/2018/A.purs+    examples/passing/2018/B.purs+    examples/passing/2049.purs+    examples/passing/2136.purs+    examples/passing/2138.purs+    examples/passing/2138/Lib.purs+    examples/passing/2172.js+    examples/passing/2172.purs+    examples/passing/2252.purs+    examples/passing/2288.purs+    examples/passing/2378.purs+    examples/passing/2438.purs+    examples/passing/2609.purs+    examples/passing/2609/Eg.purs+    examples/passing/2616.purs+    examples/passing/2626.purs+    examples/passing/2663.purs+    examples/passing/2689.purs+    examples/passing/2695.purs+    examples/passing/2756.purs+    examples/passing/2787.purs+    examples/passing/2795.purs+    examples/passing/2806.purs+    examples/passing/2972.purs+    examples/passing/652.purs+    examples/passing/810.purs+    examples/passing/862.purs+    examples/passing/922.purs+    examples/passing/Applicative.purs+    examples/passing/ArrayType.purs+    examples/passing/Auto.purs+    examples/passing/AutoPrelude.purs+    examples/passing/AutoPrelude2.purs+    examples/passing/BindersInFunctions.purs+    examples/passing/BindingGroups.purs+    examples/passing/BlockString.purs+    examples/passing/CaseInDo.purs+    examples/passing/CaseInputWildcard.purs+    examples/passing/CaseMultipleExpressions.purs+    examples/passing/CaseStatement.purs+    examples/passing/CheckFunction.purs+    examples/passing/CheckSynonymBug.purs+    examples/passing/CheckTypeClass.purs+    examples/passing/Church.purs+    examples/passing/ClassRefSyntax.purs+    examples/passing/ClassRefSyntax/Lib.purs+    examples/passing/Collatz.purs+    examples/passing/Comparisons.purs+    examples/passing/Conditional.purs+    examples/passing/Console.purs+    examples/passing/ConstraintInference.purs+    examples/passing/ConstraintParens.purs+    examples/passing/ConstraintParsingIssue.purs+    examples/passing/ContextSimplification.purs+    examples/passing/DataAndType.purs+    examples/passing/DctorName.purs+    examples/passing/DctorOperatorAlias.purs+    examples/passing/DctorOperatorAlias/List.purs+    examples/passing/DeepArrayBinder.purs+    examples/passing/DeepCase.purs+    examples/passing/DeriveNewtype.purs+    examples/passing/DeriveWithNestedSynonyms.purs+    examples/passing/Deriving.purs+    examples/passing/DerivingFunctor.purs+    examples/passing/Do.purs+    examples/passing/Dollar.purs+    examples/passing/DuplicateProperties.purs+    examples/passing/Eff.purs+    examples/passing/EmptyDataDecls.purs+    examples/passing/EmptyRow.purs+    examples/passing/EmptyTypeClass.purs+    examples/passing/EntailsKindedType.purs+    examples/passing/EqOrd.purs+    examples/passing/ExplicitImportReExport.purs+    examples/passing/ExplicitImportReExport/Bar.purs+    examples/passing/ExplicitImportReExport/Foo.purs+    examples/passing/ExplicitOperatorSections.purs+    examples/passing/ExportedInstanceDeclarations.purs+    examples/passing/ExportExplicit.purs+    examples/passing/ExportExplicit/M1.purs+    examples/passing/ExportExplicit2.purs+    examples/passing/ExportExplicit2/M1.purs+    examples/passing/ExtendedInfixOperators.purs+    examples/passing/Fib.purs+    examples/passing/FieldConsPuns.purs+    examples/passing/FieldPuns.purs+    examples/passing/FinalTagless.purs+    examples/passing/ForeignKind.purs+    examples/passing/ForeignKind/Lib.purs+    examples/passing/FunctionalDependencies.purs+    examples/passing/Functions.purs+    examples/passing/Functions2.purs+    examples/passing/FunctionScope.purs+    examples/passing/FunWithFunDeps.js+    examples/passing/FunWithFunDeps.purs+    examples/passing/Generalization1.purs+    examples/passing/GenericsRep.purs+    examples/passing/Guards.purs+    examples/passing/HasOwnProperty.purs+    examples/passing/HoistError.purs+    examples/passing/IfThenElseMaybe.purs+    examples/passing/IfWildcard.purs+    examples/passing/ImplicitEmptyImport.purs+    examples/passing/Import.purs+    examples/passing/Import/M1.purs+    examples/passing/Import/M2.purs+    examples/passing/ImportExplicit.purs+    examples/passing/ImportExplicit/M1.purs+    examples/passing/ImportHiding.purs+    examples/passing/ImportQualified.purs+    examples/passing/ImportQualified/M1.purs+    examples/passing/InferRecFunWithConstrainedArgument.purs+    examples/passing/InstanceBeforeClass.purs+    examples/passing/InstanceSigs.purs+    examples/passing/InstanceSigsGeneral.purs+    examples/passing/IntAndChar.purs+    examples/passing/iota.purs+    examples/passing/JSReserved.purs+    examples/passing/KindedType.purs+    examples/passing/LargeSumType.purs+    examples/passing/Let.purs+    examples/passing/Let2.purs+    examples/passing/LetInInstance.purs+    examples/passing/LetPattern.purs+    examples/passing/LiberalTypeSynonyms.purs+    examples/passing/Match.purs+    examples/passing/Module.purs+    examples/passing/Module/M1.purs+    examples/passing/Module/M2.purs+    examples/passing/ModuleDeps.purs+    examples/passing/ModuleDeps/M1.purs+    examples/passing/ModuleDeps/M2.purs+    examples/passing/ModuleDeps/M3.purs+    examples/passing/ModuleExport.purs+    examples/passing/ModuleExport/A.purs+    examples/passing/ModuleExportDupes.purs+    examples/passing/ModuleExportDupes/A.purs+    examples/passing/ModuleExportDupes/B.purs+    examples/passing/ModuleExportDupes/C.purs+    examples/passing/ModuleExportExcluded.purs+    examples/passing/ModuleExportExcluded/A.purs+    examples/passing/ModuleExportQualified.purs+    examples/passing/ModuleExportQualified/A.purs+    examples/passing/ModuleExportSelf.purs+    examples/passing/ModuleExportSelf/A.purs+    examples/passing/Monad.purs+    examples/passing/MonadState.purs+    examples/passing/MPTCs.purs+    examples/passing/MultiArgFunctions.purs+    examples/passing/MutRec.purs+    examples/passing/MutRec2.purs+    examples/passing/MutRec3.purs+    examples/passing/NakedConstraint.purs+    examples/passing/NamedPatterns.purs+    examples/passing/NegativeBinder.purs+    examples/passing/NegativeIntInRange.purs+    examples/passing/Nested.purs+    examples/passing/NestedRecordUpdate.purs+    examples/passing/NestedRecordUpdateWildcards.purs+    examples/passing/NestedTypeSynonyms.purs+    examples/passing/NestedWhere.purs+    examples/passing/Newtype.purs+    examples/passing/NewtypeClass.purs+    examples/passing/NewtypeEff.purs+    examples/passing/NewtypeInstance.purs+    examples/passing/NewtypeWithRecordUpdate.purs+    examples/passing/NonConflictingExports.purs+    examples/passing/NonConflictingExports/A.purs+    examples/passing/NonOrphanInstanceFunDepExtra.purs+    examples/passing/NonOrphanInstanceFunDepExtra/Lib.purs+    examples/passing/NonOrphanInstanceMulti.purs+    examples/passing/NonOrphanInstanceMulti/Lib.purs+    examples/passing/NumberLiterals.purs+    examples/passing/ObjectGetter.purs+    examples/passing/Objects.purs+    examples/passing/ObjectSynonym.purs+    examples/passing/ObjectUpdate.purs+    examples/passing/ObjectUpdate2.purs+    examples/passing/ObjectUpdater.purs+    examples/passing/ObjectWildcards.purs+    examples/passing/OneConstructor.purs+    examples/passing/OperatorAlias.purs+    examples/passing/OperatorAliasElsewhere.purs+    examples/passing/OperatorAliasElsewhere/Def.purs+    examples/passing/OperatorAssociativity.purs+    examples/passing/OperatorInlining.purs+    examples/passing/Operators.purs+    examples/passing/Operators/Other.purs+    examples/passing/OperatorSections.purs+    examples/passing/OptimizerBug.purs+    examples/passing/OptionalQualified.purs+    examples/passing/OverlappingInstances.purs+    examples/passing/OverlappingInstances2.purs+    examples/passing/OverlappingInstances3.purs+    examples/passing/ParensInTypedBinder.purs+    examples/passing/PartialFunction.purs+    examples/passing/Patterns.purs+    examples/passing/PendingConflictingImports.purs+    examples/passing/PendingConflictingImports/A.purs+    examples/passing/PendingConflictingImports/B.purs+    examples/passing/PendingConflictingImports2.purs+    examples/passing/PendingConflictingImports2/A.purs+    examples/passing/Person.purs+    examples/passing/PolyLabels.js+    examples/passing/PolyLabels.purs+    examples/passing/PrimedTypeName.purs+    examples/passing/QualifiedNames.purs+    examples/passing/QualifiedNames/Either.purs+    examples/passing/QualifiedQualifiedImports.purs+    examples/passing/Rank2Data.purs+    examples/passing/Rank2Object.purs+    examples/passing/Rank2Types.purs+    examples/passing/Rank2TypeSynonym.purs+    examples/passing/RebindableSyntax.purs+    examples/passing/Recursion.purs+    examples/passing/RedefinedFixity.purs+    examples/passing/RedefinedFixity/M1.purs+    examples/passing/RedefinedFixity/M2.purs+    examples/passing/RedefinedFixity/M3.purs+    examples/passing/ReExportQualified.purs+    examples/passing/ReExportQualified/A.purs+    examples/passing/ReExportQualified/B.purs+    examples/passing/ReExportQualified/C.purs+    examples/passing/ReservedWords.purs+    examples/passing/ResolvableScopeConflict.purs+    examples/passing/ResolvableScopeConflict/A.purs+    examples/passing/ResolvableScopeConflict/B.purs+    examples/passing/ResolvableScopeConflict2.purs+    examples/passing/ResolvableScopeConflict2/A.purs+    examples/passing/ResolvableScopeConflict3.purs+    examples/passing/ResolvableScopeConflict3/A.purs+    examples/passing/RowConstructors.purs+    examples/passing/RowInInstanceHeadDetermined.purs+    examples/passing/RowPolyInstanceContext.purs+    examples/passing/RowsInInstanceContext.purs+    examples/passing/RowUnion.js+    examples/passing/RowUnion.purs+    examples/passing/RuntimeScopeIssue.purs+    examples/passing/s.purs+    examples/passing/ScopedTypeVariables.purs+    examples/passing/Sequence.purs+    examples/passing/SequenceDesugared.purs+    examples/passing/ShadowedModuleName.purs+    examples/passing/ShadowedModuleName/Test.purs+    examples/passing/ShadowedName.purs+    examples/passing/ShadowedRename.purs+    examples/passing/ShadowedTCO.purs+    examples/passing/ShadowedTCOLet.purs+    examples/passing/SignedNumericLiterals.purs+    examples/passing/SolvingAppendSymbol.purs+    examples/passing/SolvingCompareSymbol.purs+    examples/passing/SolvingIsSymbol.purs+    examples/passing/SolvingIsSymbol/Lib.purs+    examples/passing/Stream.purs+    examples/passing/StringEdgeCases.purs+    examples/passing/StringEdgeCases/Records.purs+    examples/passing/StringEdgeCases/Symbols.purs+    examples/passing/StringEscapes.purs+    examples/passing/Superclasses1.purs+    examples/passing/Superclasses3.purs+    examples/passing/TailCall.purs+    examples/passing/TCO.purs+    examples/passing/TCOCase.purs+    examples/passing/Tick.purs+    examples/passing/TopLevelCase.purs+    examples/passing/TransitiveImport.purs+    examples/passing/TransitiveImport/Middle.purs+    examples/passing/TransitiveImport/Test.purs+    examples/passing/TypeClasses.purs+    examples/passing/TypeClassesInOrder.purs+    examples/passing/TypeClassesWithOverlappingTypeVariables.purs+    examples/passing/TypeClassMemberOrderChange.purs+    examples/passing/TypedBinders.purs+    examples/passing/TypeDecl.purs+    examples/passing/TypedWhere.purs+    examples/passing/TypeOperators.purs+    examples/passing/TypeOperators/A.purs+    examples/passing/TypeSynonymInData.purs+    examples/passing/TypeSynonyms.purs+    examples/passing/TypeWildcards.purs+    examples/passing/TypeWildcardsRecordExtension.purs+    examples/passing/TypeWithoutParens.purs+    examples/passing/TypeWithoutParens/Lib.purs+    examples/passing/UnderscoreIdent.purs+    examples/passing/UnicodeIdentifier.purs+    examples/passing/UnicodeOperators.purs+    examples/passing/UnicodeType.purs+    examples/passing/UnifyInTypeInstanceLookup.purs+    examples/passing/Unit.purs+    examples/passing/UnknownInTypeClassLookup.purs+    examples/passing/UntupledConstraints.purs+    examples/passing/UsableTypeClassMethods.purs+    examples/passing/UTF8Sourcefile.purs+    examples/passing/Where.purs+    examples/passing/WildcardInInstance.purs+    examples/passing/WildcardType.purs+    examples/psci/BasicEval.purs+    examples/psci/Multiline.purs+    examples/warning/2140.purs+    examples/warning/2383.purs+    examples/warning/2411.purs+    examples/warning/2542.purs+    examples/warning/CustomWarning.purs+    examples/warning/CustomWarning2.purs+    examples/warning/CustomWarning3.purs+    examples/warning/DuplicateExportRef.purs+    examples/warning/DuplicateImport.purs+    examples/warning/DuplicateImportRef.purs+    examples/warning/DuplicateSelectiveImport.purs+    examples/warning/HidingImport.purs+    examples/warning/ImplicitImport.purs+    examples/warning/ImplicitQualifiedImport.purs+    examples/warning/MissingTypeDeclaration.purs+    examples/warning/NewtypeInstance.purs+    examples/warning/NewtypeInstance2.purs+    examples/warning/NewtypeInstance3.purs+    examples/warning/NewtypeInstance4.purs+    examples/warning/OverlappingInstances.purs+    examples/warning/OverlappingPattern.purs+    examples/warning/ScopeShadowing.purs+    examples/warning/ShadowedBinderPatternGuard.purs+    examples/warning/ShadowedNameParens.purs+    examples/warning/ShadowedTypeVar.purs+    examples/warning/UnnecessaryFFIModule.js+    examples/warning/UnnecessaryFFIModule.purs+    examples/warning/UnusedDctorExplicitImport.purs+    examples/warning/UnusedDctorImportAll.purs+    examples/warning/UnusedDctorImportExplicit.purs+    examples/warning/UnusedExplicitImport.purs+    examples/warning/UnusedExplicitImportTypeOp.purs+    examples/warning/UnusedExplicitImportTypeOp/Lib.purs+    examples/warning/UnusedExplicitImportValOp.purs+    examples/warning/UnusedFFIImplementations.js+    examples/warning/UnusedFFIImplementations.purs+    examples/warning/UnusedImport.purs+    examples/warning/UnusedTypeVar.purs+    examples/warning/WildcardInferredType.purs+    INSTALL.md+    README.md+    stack.yaml+    tests/support/bower.json+    tests/support/package.json+    tests/support/prelude-resolutions.json+    tests/support/psci/Sample.purs+    tests/support/pscide/src/ImportsSpec.purs+    tests/support/pscide/src/ImportsSpec1.purs+    tests/support/pscide/src/MatcherSpec.purs+    tests/support/pscide/src/RebuildSpecDep.purs+    tests/support/pscide/src/RebuildSpecSingleModule.fail+    tests/support/pscide/src/RebuildSpecSingleModule.purs+    tests/support/pscide/src/RebuildSpecWithDeps.purs+    tests/support/pscide/src/RebuildSpecWithForeign.js+    tests/support/pscide/src/RebuildSpecWithForeign.purs+    tests/support/pscide/src/RebuildSpecWithHiddenIdent.purs+    tests/support/pscide/src/RebuildSpecWithMissingForeign.fail+    tests/support/setup-win.cmd++source-repository head+  type: git+  location: https://github.com/purescript/purescript++flag release+  description: Mark this build as a release build: prevents inclusion of extra info e.g. commit SHA in --version output)++  manual: False+  default: False++library+  hs-source-dirs:+      src+  default-extensions: ConstraintKinds DataKinds DeriveFunctor EmptyDataDecls FlexibleContexts KindSignatures LambdaCase MultiParamTypeClasses NoImplicitPrelude PatternGuards PatternSynonyms RankNTypes RecordWildCards OverloadedStrings ScopedTypeVariables TupleSections ViewPatterns+  ghc-options: -Wall -O2+  build-depends:+      aeson >=1.0 && <1.2+    , aeson-better-errors >=0.8+    , ansi-terminal >=0.6.2 && <0.7+    , base >=4.8 && <5+    , base-compat >=0.6.0+    , blaze-html >=0.8.1 && <0.9+    , bower-json >=1.0.0.1 && <1.1+    , boxes >=0.1.4 && <0.2.0+    , bytestring+    , cheapskate >=0.1 && <0.2+    , clock+    , containers+    , data-ordlist >=0.4.7.0+    , deepseq+    , directory >=1.2.3+    , dlist+    , edit-distance+    , filepath+    , fsnotify >=0.2.1+    , Glob >=0.7 && <0.8+    , haskeline >=0.7.0.0+    , http-client >=0.4.30 && <0.6.0+    , http-types+    , language-javascript >=0.6.0.9 && <0.7+    , lens ==4.*+    , lifted-base >=0.2.3 && <0.2.4+    , monad-control >=1.0.0.0 && <1.1+    , monad-logger >=0.3 && <0.4+    , mtl >=2.1.0 && <2.3.0+    , parallel >=3.2 && <3.3+    , parsec >=3.1.10+    , pattern-arrows >=0.0.2 && <0.1+    , pipes >=4.0.0 && <4.4.0+    , pipes-http+    , process >=1.2.0 && <1.5+    , protolude >=0.1.6+    , regex-tdfa+    , safe >=0.3.9 && <0.4+    , scientific >=0.3.4.9 && <0.4+    , semigroups >=0.16.2 && <0.19+    , sourcemap >=0.1.6+    , spdx ==0.2.*+    , split+    , stm >=0.2.4.0+    , stringsearch+    , syb+    , text+    , time+    , transformers >=0.3.0 && <0.6+    , transformers-base >=0.4.0 && <0.5+    , transformers-compat >=0.3.0+    , unordered-containers+    , utf8-string >=1 && <2+    , vector+  exposed-modules:+      Control.Monad.Logger+      Control.Monad.Supply+      Control.Monad.Supply.Class+      Language.PureScript+      Language.PureScript.AST+      Language.PureScript.AST.Binders+      Language.PureScript.AST.Declarations+      Language.PureScript.AST.Exported+      Language.PureScript.AST.Literals+      Language.PureScript.AST.Operators+      Language.PureScript.AST.SourcePos+      Language.PureScript.AST.Traversals+      Language.PureScript.Bundle+      Language.PureScript.CodeGen+      Language.PureScript.CodeGen.JS+      Language.PureScript.CodeGen.JS.Common+      Language.PureScript.CodeGen.JS.Printer+      Language.PureScript.Comments+      Language.PureScript.Constants+      Language.PureScript.CoreFn+      Language.PureScript.CoreFn.Ann+      Language.PureScript.CoreFn.Binders+      Language.PureScript.CoreFn.Desugar+      Language.PureScript.CoreFn.Expr+      Language.PureScript.CoreFn.Meta+      Language.PureScript.CoreFn.Module+      Language.PureScript.CoreFn.ToJSON+      Language.PureScript.CoreFn.Traversals+      Language.PureScript.CoreImp+      Language.PureScript.CoreImp.AST+      Language.PureScript.CoreImp.Optimizer+      Language.PureScript.CoreImp.Optimizer.Blocks+      Language.PureScript.CoreImp.Optimizer.Common+      Language.PureScript.CoreImp.Optimizer.Inliner+      Language.PureScript.CoreImp.Optimizer.MagicDo+      Language.PureScript.CoreImp.Optimizer.TCO+      Language.PureScript.CoreImp.Optimizer.Unused+      Language.PureScript.Crash+      Language.PureScript.Docs+      Language.PureScript.Docs.AsHtml+      Language.PureScript.Docs.AsMarkdown+      Language.PureScript.Docs.Convert+      Language.PureScript.Docs.Convert.ReExports+      Language.PureScript.Docs.Convert.Single+      Language.PureScript.Docs.ParseInPackage+      Language.PureScript.Docs.Prim+      Language.PureScript.Docs.Render+      Language.PureScript.Docs.RenderedCode+      Language.PureScript.Docs.RenderedCode.RenderKind+      Language.PureScript.Docs.RenderedCode.RenderType+      Language.PureScript.Docs.RenderedCode.Types+      Language.PureScript.Docs.Types+      Language.PureScript.Docs.Utils.MonoidExtras+      Language.PureScript.Environment+      Language.PureScript.Errors+      Language.PureScript.Errors.JSON+      Language.PureScript.Externs+      Language.PureScript.Ide+      Language.PureScript.Ide.CaseSplit+      Language.PureScript.Ide.Command+      Language.PureScript.Ide.Completion+      Language.PureScript.Ide.Error+      Language.PureScript.Ide.Externs+      Language.PureScript.Ide.Filter+      Language.PureScript.Ide.Filter.Declaration+      Language.PureScript.Ide.Imports+      Language.PureScript.Ide.Logging+      Language.PureScript.Ide.Matcher+      Language.PureScript.Ide.Prim+      Language.PureScript.Ide.Pursuit+      Language.PureScript.Ide.Rebuild+      Language.PureScript.Ide.Reexports+      Language.PureScript.Ide.SourceFile+      Language.PureScript.Ide.State+      Language.PureScript.Ide.Types+      Language.PureScript.Ide.Util+      Language.PureScript.Ide.Watcher+      Language.PureScript.Interactive+      Language.PureScript.Interactive.Completion+      Language.PureScript.Interactive.Directive+      Language.PureScript.Interactive.IO+      Language.PureScript.Interactive.Message+      Language.PureScript.Interactive.Module+      Language.PureScript.Interactive.Parser+      Language.PureScript.Interactive.Printer+      Language.PureScript.Interactive.Types+      Language.PureScript.Kinds+      Language.PureScript.Label+      Language.PureScript.Linter+      Language.PureScript.Linter.Exhaustive+      Language.PureScript.Linter.Imports+      Language.PureScript.Make+      Language.PureScript.ModuleDependencies+      Language.PureScript.Names+      Language.PureScript.Options+      Language.PureScript.Parser+      Language.PureScript.Parser.Common+      Language.PureScript.Parser.Declarations+      Language.PureScript.Parser.Kinds+      Language.PureScript.Parser.Lexer+      Language.PureScript.Parser.State+      Language.PureScript.Parser.Types+      Language.PureScript.Pretty+      Language.PureScript.Pretty.Common+      Language.PureScript.Pretty.Kinds+      Language.PureScript.Pretty.Types+      Language.PureScript.Pretty.Values+      Language.PureScript.PSString+      Language.PureScript.Publish+      Language.PureScript.Publish.BoxesHelpers+      Language.PureScript.Publish.ErrorsWarnings+      Language.PureScript.Publish.Utils+      Language.PureScript.Renamer+      Language.PureScript.Sugar+      Language.PureScript.Sugar.BindingGroups+      Language.PureScript.Sugar.CaseDeclarations+      Language.PureScript.Sugar.DoNotation+      Language.PureScript.Sugar.LetPattern+      Language.PureScript.Sugar.Names+      Language.PureScript.Sugar.Names.Common+      Language.PureScript.Sugar.Names.Env+      Language.PureScript.Sugar.Names.Exports+      Language.PureScript.Sugar.Names.Imports+      Language.PureScript.Sugar.ObjectWildcards+      Language.PureScript.Sugar.Operators+      Language.PureScript.Sugar.Operators.Binders+      Language.PureScript.Sugar.Operators.Common+      Language.PureScript.Sugar.Operators.Expr+      Language.PureScript.Sugar.Operators.Types+      Language.PureScript.Sugar.TypeClasses+      Language.PureScript.Sugar.TypeClasses.Deriving+      Language.PureScript.Sugar.TypeDeclarations+      Language.PureScript.Traversals+      Language.PureScript.TypeChecker+      Language.PureScript.TypeChecker.Entailment+      Language.PureScript.TypeChecker.Kinds+      Language.PureScript.TypeChecker.Monad+      Language.PureScript.TypeChecker.Skolems+      Language.PureScript.TypeChecker.Subsumption+      Language.PureScript.TypeChecker.Synonyms+      Language.PureScript.TypeChecker.Types+      Language.PureScript.TypeChecker.TypeSearch+      Language.PureScript.TypeChecker.Unify+      Language.PureScript.TypeClassDictionaries+      Language.PureScript.Types+      System.IO.UTF8+  other-modules:+      Paths_purescript+  default-language: Haskell2010++executable purs+  main-is: Main.hs+  hs-source-dirs:+      app+  ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson >=1.0 && <1.2+    , aeson-better-errors >=0.8+    , ansi-terminal >=0.6.2 && <0.7+    , base >=4.8 && <5+    , base-compat >=0.6.0+    , blaze-html >=0.8.1 && <0.9+    , bower-json >=1.0.0.1 && <1.1+    , boxes >=0.1.4 && <0.2.0+    , bytestring+    , cheapskate >=0.1 && <0.2+    , clock+    , containers+    , data-ordlist >=0.4.7.0+    , deepseq+    , directory >=1.2.3+    , dlist+    , edit-distance+    , filepath+    , fsnotify >=0.2.1+    , Glob >=0.7 && <0.8+    , haskeline >=0.7.0.0+    , http-client >=0.4.30 && <0.6.0+    , http-types+    , language-javascript >=0.6.0.9 && <0.7+    , lens ==4.*+    , lifted-base >=0.2.3 && <0.2.4+    , monad-control >=1.0.0.0 && <1.1+    , monad-logger >=0.3 && <0.4+    , mtl >=2.1.0 && <2.3.0+    , parallel >=3.2 && <3.3+    , parsec >=3.1.10+    , pattern-arrows >=0.0.2 && <0.1+    , pipes >=4.0.0 && <4.4.0+    , pipes-http+    , process >=1.2.0 && <1.5+    , protolude >=0.1.6+    , regex-tdfa+    , safe >=0.3.9 && <0.4+    , scientific >=0.3.4.9 && <0.4+    , semigroups >=0.16.2 && <0.19+    , sourcemap >=0.1.6+    , spdx ==0.2.*+    , split+    , stm >=0.2.4.0+    , stringsearch+    , syb+    , text+    , time+    , transformers >=0.3.0 && <0.6+    , transformers-base >=0.4.0 && <0.5+    , transformers-compat >=0.3.0+    , unordered-containers+    , utf8-string >=1 && <2+    , vector+    , ansi-wl-pprint+    , file-embed+    , network+    , optparse-applicative >=0.13.0+    , purescript+    , wai ==3.*+    , wai-websockets ==3.*+    , warp ==3.*+    , websockets >=0.9 && <0.11+  if flag(release)+    cpp-options: -DRELEASE+  else+    build-depends:+        gitrev >=1.2.0 && <1.3+  other-modules:+      Command.Bundle+      Command.Compile+      Command.Docs+      Command.Docs.Ctags+      Command.Docs.Etags+      Command.Docs.Html+      Command.Docs.Tags+      Command.Hierarchy+      Command.Ide+      Command.Publish+      Command.REPL+      Version+  default-language: Haskell2010++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      tests+  ghc-options: -Wall+  build-depends:+      aeson >=1.0 && <1.2+    , aeson-better-errors >=0.8+    , ansi-terminal >=0.6.2 && <0.7+    , base >=4.8 && <5+    , base-compat >=0.6.0+    , blaze-html >=0.8.1 && <0.9+    , bower-json >=1.0.0.1 && <1.1+    , boxes >=0.1.4 && <0.2.0+    , bytestring+    , cheapskate >=0.1 && <0.2+    , clock+    , containers+    , data-ordlist >=0.4.7.0+    , deepseq+    , directory >=1.2.3+    , dlist+    , edit-distance+    , filepath+    , fsnotify >=0.2.1+    , Glob >=0.7 && <0.8+    , haskeline >=0.7.0.0+    , http-client >=0.4.30 && <0.6.0+    , http-types+    , language-javascript >=0.6.0.9 && <0.7+    , lens ==4.*+    , lifted-base >=0.2.3 && <0.2.4+    , monad-control >=1.0.0.0 && <1.1+    , monad-logger >=0.3 && <0.4+    , mtl >=2.1.0 && <2.3.0+    , parallel >=3.2 && <3.3+    , parsec >=3.1.10+    , pattern-arrows >=0.0.2 && <0.1+    , pipes >=4.0.0 && <4.4.0+    , pipes-http+    , process >=1.2.0 && <1.5+    , protolude >=0.1.6+    , regex-tdfa+    , safe >=0.3.9 && <0.4+    , scientific >=0.3.4.9 && <0.4+    , semigroups >=0.16.2 && <0.19+    , sourcemap >=0.1.6+    , spdx ==0.2.*+    , split+    , stm >=0.2.4.0+    , stringsearch+    , syb+    , text+    , time+    , transformers >=0.3.0 && <0.6+    , transformers-base >=0.4.0 && <0.5+    , transformers-compat >=0.3.0+    , unordered-containers+    , utf8-string >=1 && <2+    , vector+    , purescript+    , hspec+    , hspec-discover+    , HUnit+    , silently+  other-modules:+      Language.PureScript.Ide.CompletionSpec+      Language.PureScript.Ide.FilterSpec+      Language.PureScript.Ide.ImportsSpec+      Language.PureScript.Ide.MatcherSpec+      Language.PureScript.Ide.RebuildSpec+      Language.PureScript.Ide.ReexportsSpec+      Language.PureScript.Ide.SourceFileSpec+      Language.PureScript.Ide.StateSpec+      Language.PureScript.Ide.Test+      PscIdeSpec+      TestCompiler+      TestDocs+      TestPrimDocs+      TestPsci+      TestPsci.CommandTest+      TestPsci.CompletionTest+      TestPsci.EvalTest+      TestPsci.TestEnv+      TestPscIde+      TestPscPublish+      TestUtils+  default-language: Haskell2010

src/Language/PureScript/AST/Declarations.hs view

@@ -14,6 +14,7 @@ import Data.Aeson.TH import qualified Data.Map as M import Data.Text (Text)+import qualified Data.List.NonEmpty as NEL  import Language.PureScript.AST.Binders import Language.PureScript.AST.Literals@@ -28,6 +29,7 @@ import Language.PureScript.Comments import Language.PureScript.Environment import qualified Language.PureScript.Bundle as Bundle+import qualified Language.PureScript.Constants as C  import qualified Text.Parsec as P @@ -182,7 +184,7 @@   | ErrorInApplication Expr Type Expr   | ErrorInDataConstructor (ProperName 'ConstructorName)   | ErrorInTypeConstructor (ProperName 'TypeName)-  | ErrorInBindingGroup [Ident]+  | ErrorInBindingGroup (NEL.NonEmpty Ident)   | ErrorInDataBindingGroup [ProperName 'TypeName]   | ErrorInTypeSynonym (ProperName 'TypeName)   | ErrorInValueDeclaration Ident@@ -227,15 +229,24 @@ -- | -- Add an import declaration for a module if it does not already explicitly import it. ---addDefaultImport :: ModuleName -> Module -> Module-addDefaultImport toImport m@(Module ss coms mn decls exps)  =+addDefaultImport :: Qualified ModuleName -> Module -> Module+addDefaultImport (Qualified toImportAs toImport) m@(Module ss coms mn decls exps) =   if isExistingImport `any` decls || mn == toImport then m-  else Module ss coms mn (ImportDeclaration toImport Implicit Nothing : decls) exps+  else Module ss coms mn (ImportDeclaration (ss, []) toImport Implicit toImportAs : decls) exps   where-  isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True-  isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d+  isExistingImport (ImportDeclaration _ mn' _ as') | mn' == toImport && as' == toImportAs = True   isExistingImport _ = False +-- | Adds import declarations to a module for an implicit Prim import and Prim+-- | qualified as Prim, as necessary.+importPrim :: Module -> Module+importPrim =+  let+    primModName = ModuleName [ProperName C.prim]+  in+    addDefaultImport (Qualified Nothing primModName)+      . addDefaultImport (Qualified (Just primModName) primModName)+ -- | -- An item in a list of explicit imports or exports --@@ -243,120 +254,116 @@   -- |   -- A type constructor with data constructors   ---  = TypeRef (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])+  = TypeRef SourceSpan (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])   -- |   -- A type operator   ---  | TypeOpRef (OpName 'TypeOpName)+  | TypeOpRef SourceSpan (OpName 'TypeOpName)   -- |   -- A value   ---  | ValueRef Ident+  | ValueRef SourceSpan Ident   -- |   -- A value-level operator   ---  | ValueOpRef (OpName 'ValueOpName)+  | ValueOpRef SourceSpan (OpName 'ValueOpName)   -- |   -- A type class   ---  | TypeClassRef (ProperName 'ClassName)+  | TypeClassRef SourceSpan (ProperName 'ClassName)   -- |   -- A type class instance, created during typeclass desugaring (name, class name, instance types)   ---  | TypeInstanceRef Ident+  | TypeInstanceRef SourceSpan Ident   -- |   -- A module, in its entirety   ---  | ModuleRef ModuleName+  | ModuleRef SourceSpan ModuleName   -- |   -- A named kind   ---  | KindRef (ProperName 'KindName)+  | KindRef SourceSpan (ProperName 'KindName)   -- |   -- A value re-exported from another module. These will be inserted during   -- elaboration in name desugaring.   ---  | ReExportRef ModuleName DeclarationRef-  -- |-  -- A declaration reference with source position information-  ---  | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef+  | ReExportRef SourceSpan ModuleName DeclarationRef   deriving (Show)  instance Eq DeclarationRef where-  (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'-  (TypeOpRef name) == (TypeOpRef name') = name == name'-  (ValueRef name) == (ValueRef name') = name == name'-  (ValueOpRef name) == (ValueOpRef name') = name == name'-  (TypeClassRef name) == (TypeClassRef name') = name == name'-  (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'-  (ModuleRef name) == (ModuleRef name') = name == name'-  (KindRef name) == (KindRef name') = name == name'-  (ReExportRef mn ref) == (ReExportRef mn' ref') = mn == mn' && ref == ref'-  (PositionedDeclarationRef _ _ r) == r' = r == r'-  r == (PositionedDeclarationRef _ _ r') = r == r'+  (TypeRef _ name dctors) == (TypeRef _ name' dctors') = name == name' && dctors == dctors'+  (TypeOpRef _ name) == (TypeOpRef _ name') = name == name'+  (ValueRef _ name) == (ValueRef _ name') = name == name'+  (ValueOpRef _ name) == (ValueOpRef _ name') = name == name'+  (TypeClassRef _ name) == (TypeClassRef _ name') = name == name'+  (TypeInstanceRef _ name) == (TypeInstanceRef _ name') = name == name'+  (ModuleRef _ name) == (ModuleRef _ name') = name == name'+  (KindRef _ name) == (KindRef _ name') = name == name'+  (ReExportRef _ mn ref) == (ReExportRef _ mn' ref') = mn == mn' && ref == ref'   _ == _ = False  -- enable sorting lists of explicitly imported refs when suggesting imports in linting, IDE, etc. -- not an Ord because this implementation is not consistent with its Eq instance. -- think of it as a notion of contextual, not inherent, ordering. compDecRef :: DeclarationRef -> DeclarationRef -> Ordering-compDecRef (TypeRef name _) (TypeRef name' _) = compare name name'-compDecRef (TypeOpRef name) (TypeOpRef name') = compare name name'-compDecRef (ValueRef ident) (ValueRef ident') = compare ident ident'-compDecRef (ValueOpRef name) (ValueOpRef name') = compare name name'-compDecRef (TypeClassRef name) (TypeClassRef name') = compare name name'-compDecRef (TypeInstanceRef ident) (TypeInstanceRef ident') = compare ident ident'-compDecRef (ModuleRef name) (ModuleRef name') = compare name name'-compDecRef (KindRef name) (KindRef name') = compare name name'-compDecRef (ReExportRef name _) (ReExportRef name' _) = compare name name'-compDecRef (PositionedDeclarationRef _ _ ref) ref' = compDecRef ref ref'-compDecRef ref (PositionedDeclarationRef _ _ ref') = compDecRef ref ref'+compDecRef (TypeRef _ name _) (TypeRef _ name' _) = compare name name'+compDecRef (TypeOpRef _ name) (TypeOpRef _ name') = compare name name'+compDecRef (ValueRef _ ident) (ValueRef _ ident') = compare ident ident'+compDecRef (ValueOpRef _ name) (ValueOpRef _ name') = compare name name'+compDecRef (TypeClassRef _ name) (TypeClassRef _ name') = compare name name'+compDecRef (TypeInstanceRef _ ident) (TypeInstanceRef _ ident') = compare ident ident'+compDecRef (ModuleRef _ name) (ModuleRef _ name') = compare name name'+compDecRef (KindRef _ name) (KindRef _ name') = compare name name'+compDecRef (ReExportRef _ name _) (ReExportRef _ name' _) = compare name name' compDecRef ref ref' = compare   (orderOf ref) (orderOf ref')     where       orderOf :: DeclarationRef -> Int-      orderOf (TypeClassRef _) = 0-      orderOf (TypeOpRef _) = 1-      orderOf (TypeRef _ _) = 2-      orderOf (ValueRef _) = 3-      orderOf (ValueOpRef _) = 4-      orderOf (KindRef _) = 5+      orderOf TypeClassRef{} = 0+      orderOf TypeOpRef{} = 1+      orderOf TypeRef{} = 2+      orderOf ValueRef{} = 3+      orderOf ValueOpRef{} = 4+      orderOf KindRef{} = 5       orderOf _ = 6 +declRefSourceSpan :: DeclarationRef -> SourceSpan+declRefSourceSpan (TypeRef ss _ _) = ss+declRefSourceSpan (TypeOpRef ss _) = ss+declRefSourceSpan (ValueRef ss _) = ss+declRefSourceSpan (ValueOpRef ss _) = ss+declRefSourceSpan (TypeClassRef ss _) = ss+declRefSourceSpan (TypeInstanceRef ss _) = ss+declRefSourceSpan (ModuleRef ss _) = ss+declRefSourceSpan (KindRef ss _) = ss+declRefSourceSpan (ReExportRef ss _ _) = ss+ getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])-getTypeRef (TypeRef name dctors) = Just (name, dctors)-getTypeRef (PositionedDeclarationRef _ _ r) = getTypeRef r+getTypeRef (TypeRef _ name dctors) = Just (name, dctors) getTypeRef _ = Nothing  getTypeOpRef :: DeclarationRef -> Maybe (OpName 'TypeOpName)-getTypeOpRef (TypeOpRef op) = Just op-getTypeOpRef (PositionedDeclarationRef _ _ r) = getTypeOpRef r+getTypeOpRef (TypeOpRef _ op) = Just op getTypeOpRef _ = Nothing  getValueRef :: DeclarationRef -> Maybe Ident-getValueRef (ValueRef name) = Just name-getValueRef (PositionedDeclarationRef _ _ r) = getValueRef r+getValueRef (ValueRef _ name) = Just name getValueRef _ = Nothing  getValueOpRef :: DeclarationRef -> Maybe (OpName 'ValueOpName)-getValueOpRef (ValueOpRef op) = Just op-getValueOpRef (PositionedDeclarationRef _ _ r) = getValueOpRef r+getValueOpRef (ValueOpRef _ op) = Just op getValueOpRef _ = Nothing  getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)-getTypeClassRef (TypeClassRef name) = Just name-getTypeClassRef (PositionedDeclarationRef _ _ r) = getTypeClassRef r+getTypeClassRef (TypeClassRef _ name) = Just name getTypeClassRef _ = Nothing  getKindRef :: DeclarationRef -> Maybe (ProperName 'KindName)-getKindRef (KindRef name) = Just name-getKindRef (PositionedDeclarationRef _ _ r) = getKindRef r+getKindRef (KindRef _ name) = Just name getKindRef _ = Nothing  isModuleRef :: DeclarationRef -> Bool-isModuleRef (PositionedDeclarationRef _ _ r) = isModuleRef r-isModuleRef (ModuleRef _) = True+isModuleRef ModuleRef{} = True isModuleRef _ = False  -- |@@ -392,63 +399,59 @@   -- |   -- A data type declaration (data or newtype, name, arguments, data constructors)   ---  = DataDeclaration DataDeclType (ProperName 'TypeName) [(Text, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]+  = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]   -- |   -- A minimal mutually recursive set of data type declarations   ---  | DataBindingGroupDeclaration [Declaration]+  | DataBindingGroupDeclaration (NEL.NonEmpty Declaration)   -- |   -- A type synonym declaration (name, arguments, type)   ---  | TypeSynonymDeclaration (ProperName 'TypeName) [(Text, Maybe Kind)] Type+  | TypeSynonymDeclaration SourceAnn (ProperName 'TypeName) [(Text, Maybe Kind)] Type   -- |   -- A type declaration for a value (name, ty)   ---  | TypeDeclaration Ident Type+  | TypeDeclaration SourceAnn Ident Type   -- |   -- A value declaration (name, top-level binders, optional guard, value)   ---  | ValueDeclaration Ident NameKind [Binder] [GuardedExpr]+  | ValueDeclaration SourceAnn Ident NameKind [Binder] [GuardedExpr]   -- |   -- A declaration paired with pattern matching in let-in expression (binder, optional guard, value)-  | BoundValueDeclaration Binder Expr+  | BoundValueDeclaration SourceAnn Binder Expr   -- |   -- A minimal mutually recursive set of value declarations   ---  | BindingGroupDeclaration [(Ident, NameKind, Expr)]+  | BindingGroupDeclaration (NEL.NonEmpty ((SourceAnn, Ident), NameKind, Expr))   -- |   -- A foreign import declaration (name, type)   ---  | ExternDeclaration Ident Type+  | ExternDeclaration SourceAnn Ident Type   -- |   -- A data type foreign import (name, kind)   ---  | ExternDataDeclaration (ProperName 'TypeName) Kind+  | ExternDataDeclaration SourceAnn (ProperName 'TypeName) Kind   -- |   -- A foreign kind import (name)   ---  | ExternKindDeclaration (ProperName 'KindName)+  | ExternKindDeclaration SourceAnn (ProperName 'KindName)   -- |   -- A fixity declaration   ---  | FixityDeclaration (Either ValueFixity TypeFixity)+  | FixityDeclaration SourceAnn (Either ValueFixity TypeFixity)   -- |   -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)   ---  | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)+  | ImportDeclaration SourceAnn ModuleName ImportDeclarationType (Maybe ModuleName)   -- |   -- A type class declaration (name, argument, implies, member declarations)   ---  | TypeClassDeclaration (ProperName 'ClassName) [(Text, Maybe Kind)] [Constraint] [FunctionalDependency] [Declaration]+  | TypeClassDeclaration SourceAnn (ProperName 'ClassName) [(Text, Maybe Kind)] [Constraint] [FunctionalDependency] [Declaration]   -- |   -- A type instance declaration (name, dependencies, class name, instance types, member   -- declarations)   ---  | TypeInstanceDeclaration Ident [Constraint] (Qualified (ProperName 'ClassName)) [Type] TypeInstanceBody-  -- |-  -- A declaration with source position information-  ---  | PositionedDeclaration SourceSpan [Comment] Declaration+  | TypeInstanceDeclaration SourceAnn Ident [Constraint] (Qualified (ProperName 'ClassName)) [Type] TypeInstanceBody   deriving (Show)  data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)@@ -457,11 +460,11 @@ data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)   deriving (Eq, Ord, Show) -pattern ValueFixityDeclaration :: Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration-pattern ValueFixityDeclaration fixity name op = FixityDeclaration (Left (ValueFixity fixity name op))+pattern ValueFixityDeclaration :: SourceAnn -> Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration+pattern ValueFixityDeclaration sa fixity name op = FixityDeclaration sa (Left (ValueFixity fixity name op)) -pattern TypeFixityDeclaration :: Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration-pattern TypeFixityDeclaration fixity name op = FixityDeclaration (Right (TypeFixity fixity name op))+pattern TypeFixityDeclaration :: SourceAnn -> Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration+pattern TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (TypeFixity fixity name op))  -- | The members of a type class instance declaration data TypeInstanceBody@@ -484,12 +487,30 @@ traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds traverseTypeInstanceBody _ other = pure other +declSourceAnn :: Declaration -> SourceAnn+declSourceAnn (DataDeclaration sa _ _ _ _) = sa+declSourceAnn (DataBindingGroupDeclaration ds) = declSourceAnn (NEL.head ds)+declSourceAnn (TypeSynonymDeclaration sa _ _ _) = sa+declSourceAnn (TypeDeclaration sa _ _) = sa+declSourceAnn (ValueDeclaration sa _ _ _ _) = sa+declSourceAnn (BoundValueDeclaration sa _ _) = sa+declSourceAnn (BindingGroupDeclaration ds) = let ((sa, _), _, _) = NEL.head ds in sa+declSourceAnn (ExternDeclaration sa _ _) = sa+declSourceAnn (ExternDataDeclaration sa _ _) = sa+declSourceAnn (ExternKindDeclaration sa _) = sa+declSourceAnn (FixityDeclaration sa _) = sa+declSourceAnn (ImportDeclaration sa _ _ _) = sa+declSourceAnn (TypeClassDeclaration sa _ _ _ _ _) = sa+declSourceAnn (TypeInstanceDeclaration sa _ _ _ _ _) = sa++declSourceSpan :: Declaration -> SourceSpan+declSourceSpan = fst . declSourceAnn+ -- | -- Test if a declaration is a value declaration -- isValueDecl :: Declaration -> Bool isValueDecl ValueDeclaration{} = True-isValueDecl (PositionedDeclaration _ _ d) = isValueDecl d isValueDecl _ = False  -- |@@ -498,7 +519,6 @@ isDataDecl :: Declaration -> Bool isDataDecl DataDeclaration{} = True isDataDecl TypeSynonymDeclaration{} = True-isDataDecl (PositionedDeclaration _ _ d) = isDataDecl d isDataDecl _ = False  -- |@@ -506,7 +526,6 @@ -- isImportDecl :: Declaration -> Bool isImportDecl ImportDeclaration{} = True-isImportDecl (PositionedDeclaration _ _ d) = isImportDecl d isImportDecl _ = False  -- |@@ -514,7 +533,6 @@ -- isExternDataDecl :: Declaration -> Bool isExternDataDecl ExternDataDeclaration{} = True-isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d isExternDataDecl _ = False  -- |@@ -522,7 +540,6 @@ -- isExternKindDecl :: Declaration -> Bool isExternKindDecl ExternKindDeclaration{} = True-isExternKindDecl (PositionedDeclaration _ _ d) = isExternKindDecl d isExternKindDecl _ = False  -- |@@ -530,12 +547,10 @@ -- isFixityDecl :: Declaration -> Bool isFixityDecl FixityDeclaration{} = True-isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d isFixityDecl _ = False  getFixityDecl :: Declaration -> Maybe (Either ValueFixity TypeFixity)-getFixityDecl (FixityDeclaration fixity) = Just fixity-getFixityDecl (PositionedDeclaration _ _ d) = getFixityDecl d+getFixityDecl (FixityDeclaration _ fixity) = Just fixity getFixityDecl _ = Nothing  -- |@@ -543,7 +558,6 @@ -- isExternDecl :: Declaration -> Bool isExternDecl ExternDeclaration{} = True-isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d isExternDecl _ = False  -- |@@ -551,7 +565,6 @@ -- isTypeClassInstanceDeclaration :: Declaration -> Bool isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True-isTypeClassInstanceDeclaration (PositionedDeclaration _ _ d) = isTypeClassInstanceDeclaration d isTypeClassInstanceDeclaration _ = False  -- |@@ -559,7 +572,6 @@ -- isTypeClassDeclaration :: Declaration -> Bool isTypeClassDeclaration TypeClassDeclaration{} = True-isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d isTypeClassDeclaration _ = False  -- |

src/Language/PureScript/AST/Exported.hs view

@@ -38,11 +38,9 @@ -- it unchanged. -- filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration-filterDataConstructors exps (DataDeclaration dType tyName tyArgs dctors) =-  DataDeclaration dType tyName tyArgs $+filterDataConstructors exps (DataDeclaration sa dType tyName tyArgs dctors) =+  DataDeclaration sa dType tyName tyArgs $     filter (isDctorExported tyName exps . fst) dctors-filterDataConstructors exps (PositionedDeclaration srcSpan coms d) =-  PositionedDeclaration srcSpan coms (filterDataConstructors exps d) filterDataConstructors _ other = other  -- |@@ -85,20 +83,18 @@   checkQual q = isQualified q && not (isQualifiedWith mn q)    typeName :: DeclarationRef -> Maybe (ProperName 'TypeName)-  typeName (TypeRef n _) = Just n-  typeName (PositionedDeclarationRef _ _ r) = typeName r+  typeName (TypeRef _ n _) = Just n   typeName _ = Nothing    typeClassName :: DeclarationRef -> Maybe (ProperName 'ClassName)-  typeClassName (TypeClassRef n) = Just n-  typeClassName (PositionedDeclarationRef _ _ r) = typeClassName r+  typeClassName (TypeClassRef _ n) = Just n   typeClassName _ = Nothing  -- | -- Get all type and type class names referenced by a type instance declaration. -- typeInstanceConstituents :: Declaration -> [Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))]-typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _) =+typeInstanceConstituents (TypeInstanceDeclaration _ _ constraints className tys _) =   Left className : (concatMap fromConstraint constraints ++ concatMap fromType tys)   where @@ -111,7 +107,6 @@   go (ConstrainedType c _) = fromConstraint c   go _ = [] -typeInstanceConstituents (PositionedDeclaration _ _ d) = typeInstanceConstituents d typeInstanceConstituents _ = []  @@ -124,21 +119,18 @@ isExported :: Maybe [DeclarationRef] -> Declaration -> Bool isExported Nothing _ = True isExported _ TypeInstanceDeclaration{} = True-isExported exps (PositionedDeclaration _ _ d) = isExported exps d isExported (Just exps) decl = any (matches decl) exps   where-  matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'-  matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'-  matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'-  matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'-  matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'-  matches (ExternKindDeclaration ident) (KindRef ident') = ident == ident'-  matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'-  matches (TypeClassDeclaration ident _ _ _ _) (TypeClassRef ident') = ident == ident'-  matches (ValueFixityDeclaration _ _ op) (ValueOpRef op') = op == op'-  matches (TypeFixityDeclaration _ _ op) (TypeOpRef op') = op == op'-  matches (PositionedDeclaration _ _ d) r = d `matches` r-  matches d (PositionedDeclarationRef _ _ r) = d `matches` r+  matches (TypeDeclaration _ ident _) (ValueRef _ ident') = ident == ident'+  matches (ValueDeclaration _ ident _ _ _) (ValueRef _ ident') = ident == ident'+  matches (ExternDeclaration _ ident _) (ValueRef _ ident') = ident == ident'+  matches (DataDeclaration _ _ ident _ _) (TypeRef _ ident' _) = ident == ident'+  matches (ExternDataDeclaration _ ident _) (TypeRef _ ident' _) = ident == ident'+  matches (ExternKindDeclaration _ ident) (KindRef _ ident') = ident == ident'+  matches (TypeSynonymDeclaration _ ident _ _) (TypeRef _ ident' _) = ident == ident'+  matches (TypeClassDeclaration _ ident _ _ _ _) (TypeClassRef _ ident') = ident == ident'+  matches (ValueFixityDeclaration _ _ _ op) (ValueOpRef _ op') = op == op'+  matches (TypeFixityDeclaration _ _ _ op) (TypeOpRef _ op') = op == op'   matches _ _ = False  -- |@@ -149,7 +141,6 @@ isDctorExported _ Nothing _ = True isDctorExported ident (Just exps) ctor = test `any` exps   where-  test (PositionedDeclarationRef _ _ d) = test d-  test (TypeRef ident' Nothing) = ident == ident'-  test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors+  test (TypeRef _ ident' Nothing) = ident == ident'+  test (TypeRef _ ident' (Just ctors)) = ident == ident' && ctor `elem` ctors   test _ = False

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

@@ -6,27 +6,25 @@  import Prelude.Compat -import GHC.Generics (Generic) import Control.DeepSeq (NFData) import Data.Aeson ((.=), (.:))-import qualified Data.Aeson as A import Data.Monoid-import qualified Data.Text as T import Data.Text (Text)+import GHC.Generics (Generic)+import Language.PureScript.Comments+import qualified Data.Aeson as A+import qualified Data.Text as T import System.FilePath (makeRelative) --- |--- Source position information---+-- | Source annotation - position information and comments.+type SourceAnn = (SourceSpan, [Comment])++-- | Source position information data SourcePos = SourcePos-  { -- |-    -- Line number-    ---    sourcePosLine :: Int-    -- |-    -- Column number-    --+  { sourcePosLine :: Int+    -- ^ Line number   , sourcePosColumn :: Int+    -- ^ Column number   } deriving (Show, Eq, Ord, Generic)  instance NFData SourcePos@@ -46,17 +44,12 @@     return $ SourcePos line col  data SourceSpan = SourceSpan-  { -- |-    -- Source name-    ---    spanName :: String-    -- |-    -- Start of the span-    --+  { spanName :: String+    -- ^ Source name   , spanStart :: SourcePos-    -- End of the span-    --+    -- ^ Start of the span   , spanEnd :: SourcePos+    -- ^ End of the span   } deriving (Show, Eq, Ord, Generic)  instance NFData SourceSpan

src/Language/PureScript/AST/Traversals.hs view

@@ -10,6 +10,7 @@ import Data.Foldable (fold) import Data.List (mapAccumL) import Data.Maybe (mapMaybe)+import qualified Data.List.NonEmpty as NEL import qualified Data.Set as S  import Language.PureScript.AST.Binders@@ -33,8 +34,13 @@                -> GuardedExpr                -> GuardedExpr mapGuardedExpr f g (GuardedExpr guards rhs) =-  GuardedExpr (map f guards) (g rhs)+  GuardedExpr (fmap f guards) (g rhs) +litM :: Monad m => (a -> m a) -> Literal a -> m (Literal a)+litM go (ObjectLiteral as) = ObjectLiteral <$> traverse (sndM go) as+litM go (ArrayLiteral as) = ArrayLiteral <$> traverse go as+litM _ other = pure other+ everywhereOnValues   :: (Declaration -> Declaration)   -> (Expr -> Expr)@@ -46,13 +52,12 @@ everywhereOnValues f g h = (f', g', h')   where   f' :: Declaration -> Declaration-  f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))-  f' (ValueDeclaration name nameKind bs val) = f (ValueDeclaration name nameKind (map h' bs) (map (mapGuardedExpr handleGuard g') val))-  f' (BoundValueDeclaration b expr) = f (BoundValueDeclaration (h' b) (g' expr))-  f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))-  f' (TypeClassDeclaration name args implies deps ds) = f (TypeClassDeclaration name args implies deps (map f' ds))-  f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (mapTypeInstanceBody (map f') ds))-  f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))+  f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (fmap f' ds))+  f' (ValueDeclaration sa name nameKind bs val) = f (ValueDeclaration sa name nameKind (fmap h' bs) (fmap (mapGuardedExpr handleGuard g') val))+  f' (BoundValueDeclaration sa b expr) = f (BoundValueDeclaration sa (h' b) (g' expr))+  f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (fmap (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))+  f' (TypeClassDeclaration sa name args implies deps ds) = f (TypeClassDeclaration sa name args implies deps (fmap f' ds))+  f' (TypeInstanceDeclaration sa name cs className args ds) = f (TypeInstanceDeclaration sa name cs className args (mapTypeInstanceBody (fmap f') ds))   f' other = f other    g' :: Expr -> Expr@@ -62,20 +67,20 @@   g' (Parens v) = g (Parens (g' v))   g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))   g' (Accessor prop v) = g (Accessor prop (g' v))-  g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))+  g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (fmap (fmap g') vs))   g' (ObjectUpdateNested obj vs) = g (ObjectUpdateNested (g' obj) (fmap g' vs))   g' (Abs binder v) = g (Abs (h' binder) (g' v))   g' (App v1 v2) = g (App (g' v1) (g' v2))   g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))-  g' (Case vs alts) = g (Case (map g' vs) (map handleCaseAlternative alts))+  g' (Case vs alts) = g (Case (fmap g' vs) (fmap handleCaseAlternative alts))   g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)-  g' (Let ds v) = g (Let (map f' ds) (g' v))-  g' (Do es) = g (Do (map handleDoNotationElement es))+  g' (Let ds v) = g (Let (fmap f' ds) (g' v))+  g' (Do es) = g (Do (fmap handleDoNotationElement es))   g' (PositionedValue pos com v) = g (PositionedValue pos com (g' v))   g' other = g other    h' :: Binder -> Binder-  h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))+  h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (fmap h' bs))   h' (BinaryNoParensBinder b1 b2 b3) = h (BinaryNoParensBinder (h' b1) (h' b2) (h' b3))   h' (ParensInBinder b) = h (ParensInBinder (h' b))   h' (LiteralBinder l) = h (LiteralBinder (lit h' l))@@ -85,20 +90,20 @@   h' other = h other    lit :: (a -> a) -> Literal a -> Literal a-  lit go (ArrayLiteral as) = ArrayLiteral (map go as)-  lit go (ObjectLiteral as) = ObjectLiteral (map (fmap go) as)+  lit go (ArrayLiteral as) = ArrayLiteral (fmap go as)+  lit go (ObjectLiteral as) = ObjectLiteral (fmap (fmap go) as)   lit _ other = other    handleCaseAlternative :: CaseAlternative -> CaseAlternative   handleCaseAlternative ca =-    ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)-       , caseAlternativeResult = map (mapGuardedExpr handleGuard g') (caseAlternativeResult ca)+    ca { caseAlternativeBinders = fmap h' (caseAlternativeBinders ca)+       , caseAlternativeResult = fmap (mapGuardedExpr handleGuard g') (caseAlternativeResult ca)        }    handleDoNotationElement :: DoNotationElement -> DoNotationElement   handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)   handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)-  handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)+  handleDoNotationElement (DoNotationLet ds) = DoNotationLet (fmap f' ds)   handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e)    handleGuard :: Guard -> Guard@@ -120,16 +125,15 @@    f' :: Declaration -> m Declaration   f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f' <=< f) ds-  f' (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> traverse (h' <=< h) bs <*> traverse (guardedExprM handleGuard (g' <=< g)) val+  f' (ValueDeclaration sa name nameKind bs val) = ValueDeclaration sa name nameKind <$> traverse (h' <=< h) bs <*> traverse (guardedExprM handleGuard (g' <=< g)) val   f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds-  f' (TypeClassDeclaration name args implies deps ds) = TypeClassDeclaration name args implies deps <$> traverse (f' <=< f) ds-  f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds-  f' (BoundValueDeclaration b expr) = BoundValueDeclaration <$> h' b <*> g' expr-  f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')+  f' (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f' <=< f) ds+  f' (TypeInstanceDeclaration sa name cs className args ds) = TypeInstanceDeclaration sa name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds+  f' (BoundValueDeclaration sa b expr) = BoundValueDeclaration sa <$> h' b <*> g' expr   f' other = f other    g' :: Expr -> m Expr-  g' (Literal l) = Literal <$> lit (g >=> g') l+  g' (Literal l) = Literal <$> litM (g >=> g') l   g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')   g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')   g' (Parens v) = Parens <$> (g v >>= g')@@ -148,7 +152,7 @@   g' other = g other    h' :: Binder -> m Binder-  h' (LiteralBinder l) = LiteralBinder <$> lit (h >=> h') l+  h' (LiteralBinder l) = LiteralBinder <$> litM (h >=> h') l   h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> traverse (h' <=< h) bs   h' (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> (h b1 >>= h') <*> (h b2 >>= h') <*> (h b3 >>= h')   h' (ParensInBinder b) = ParensInBinder <$> (h b >>= h')@@ -157,11 +161,6 @@   h' (TypedBinder t b) = TypedBinder t <$> (h b >>= h')   h' other = h other -  lit :: (a -> m a) -> Literal a -> m (Literal a)-  lit go (ObjectLiteral as) = ObjectLiteral <$> traverse (sndM go) as-  lit go (ArrayLiteral as) = ArrayLiteral <$> traverse go as-  lit _ other = pure other-   handleCaseAlternative :: CaseAlternative -> m CaseAlternative   handleCaseAlternative (CaseAlternative bs val) =     CaseAlternative@@ -193,16 +192,15 @@    f' :: Declaration -> m Declaration   f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> traverse f' ds) >>= f-  f' (ValueDeclaration name nameKind bs val) = (ValueDeclaration name nameKind <$> traverse h' bs <*> traverse (guardedExprM handleGuard g') val) >>= f+  f' (ValueDeclaration sa name nameKind bs val) = (ValueDeclaration sa name nameKind <$> traverse h' bs <*> traverse (guardedExprM handleGuard g') val) >>= f   f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f-  f' (BoundValueDeclaration b expr) = (BoundValueDeclaration <$> h' b <*> g' expr) >>= f-  f' (TypeClassDeclaration name args implies deps ds) = (TypeClassDeclaration name args implies deps <$> traverse f' ds) >>= f-  f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse f') ds) >>= f-  f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f+  f' (BoundValueDeclaration sa b expr) = (BoundValueDeclaration sa <$> h' b <*> g' expr) >>= f+  f' (TypeClassDeclaration sa name args implies deps ds) = (TypeClassDeclaration sa name args implies deps <$> traverse f' ds) >>= f+  f' (TypeInstanceDeclaration sa name cs className args ds) = (TypeInstanceDeclaration sa name cs className args <$> traverseTypeInstanceBody (traverse f') ds) >>= f   f' other = f other    g' :: Expr -> m Expr-  g' (Literal l) = (Literal <$> lit g' l) >>= g+  g' (Literal l) = (Literal <$> litM g' l) >>= g   g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g   g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g   g' (Parens v) = (Parens <$> g' v) >>= g@@ -221,7 +219,7 @@   g' other = g other    h' :: Binder -> m Binder-  h' (LiteralBinder l) = (LiteralBinder <$> lit h' l) >>= h+  h' (LiteralBinder l) = (LiteralBinder <$> litM h' l) >>= h   h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> traverse h' bs) >>= h   h' (BinaryNoParensBinder b1 b2 b3) = (BinaryNoParensBinder <$> h' b1 <*> h' b2 <*> h' b3) >>= h   h' (ParensInBinder b) = (ParensInBinder <$> h' b) >>= h@@ -230,11 +228,6 @@   h' (TypedBinder t b) = (TypedBinder t <$> h' b) >>= h   h' other = h other -  lit :: (a -> m a) -> Literal a -> m (Literal a)-  lit go (ObjectLiteral as) = ObjectLiteral <$> traverse (sndM go) as-  lit go (ArrayLiteral as) = ArrayLiteral <$> traverse go as-  lit _ other = pure other-   handleCaseAlternative :: CaseAlternative -> m CaseAlternative   handleCaseAlternative (CaseAlternative bs val) =     CaseAlternative@@ -269,13 +262,12 @@   where    f' :: Declaration -> r-  f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (map f' ds)-  f' d@(ValueDeclaration _ _ bs val) = foldl (<>) (f d) (map h' bs ++ concatMap (\(GuardedExpr grd v) -> map k' grd ++ [g' v]) val)-  f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)-  f' d@(TypeClassDeclaration _ _ _ _ ds) = foldl (<>) (f d) (map f' ds)-  f' d@(TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (map f' ds)-  f' d@(BoundValueDeclaration b expr) = f d <> h' b <> g' expr-  f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1+  f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (fmap f' ds)+  f' d@(ValueDeclaration _ _ _ bs val) = foldl (<>) (f d) (fmap h' bs ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) val)+  f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (fmap (\(_, _, val) -> g' val) ds)+  f' d@(TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>) (f d) (fmap f' ds)+  f' d@(TypeInstanceDeclaration _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (fmap f' ds)+  f' d@(BoundValueDeclaration _ b expr) = f d <> h' b <> g' expr   f' d = f d    g' :: Expr -> r@@ -285,21 +277,21 @@   g' v@(Parens v1) = g v <> g' v1   g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1   g' v@(Accessor _ v1) = g v <> g' v1-  g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)+  g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (fmap (g' . snd) vs)   g' v@(ObjectUpdateNested obj vs) = foldl (<>) (g v <> g' obj) (fmap g' vs)   g' v@(Abs b v1) = g v <> h' b <> g' v1   g' v@(App v1 v2) = g v <> g' v1 <> g' v2   g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3-  g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)+  g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (fmap g' vs)) (fmap i' alts)   g' v@(TypedValue _ v1 _) = g v <> g' v1-  g' v@(Let ds v1) = foldl (<>) (g v) (map f' ds) <> g' v1-  g' v@(Do es) = foldl (<>) (g v) (map j' es)+  g' v@(Let ds v1) = foldl (<>) (g v) (fmap f' ds) <> g' v1+  g' v@(Do es) = foldl (<>) (g v) (fmap j' es)   g' v@(PositionedValue _ _ v1) = g v <> g' v1   g' v = g v    h' :: Binder -> r   h' b@(LiteralBinder l) = lit (h b) h' l-  h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)+  h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (fmap h' bs)   h' b@(BinaryNoParensBinder b1 b2 b3) = h b <> h' b1 <> h' b2 <> h' b3   h' b@(ParensInBinder b1) = h b <> h' b1   h' b@(NamedBinder _ b1) = h b <> h' b1@@ -308,18 +300,18 @@   h' b = h b    lit :: r -> (a -> r) -> Literal a -> r-  lit r go (ArrayLiteral as) = foldl (<>) r (map go as)-  lit r go (ObjectLiteral as) = foldl (<>) r (map (go . snd) as)+  lit r go (ArrayLiteral as) = foldl (<>) r (fmap go as)+  lit r go (ObjectLiteral as) = foldl (<>) r (fmap (go . snd) as)   lit r _ _ = r    i' :: CaseAlternative -> r   i' ca@(CaseAlternative bs gs) =-    foldl (<>) (i ca) (map h' bs ++ concatMap (\(GuardedExpr grd val) -> map k' grd ++ [g' val]) gs)+    foldl (<>) (i ca) (fmap h' bs ++ concatMap (\(GuardedExpr grd val) -> fmap k' grd ++ [g' val]) gs)    j' :: DoNotationElement -> r   j' e@(DoNotationValue v) = j e <> g' v   j' e@(DoNotationBind b v) = j e <> h' b <> g' v-  j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)+  j' e@(DoNotationLet ds) = foldl (<>) (j e) (fmap f' ds)   j' e@(PositionedDoNotationElement _ _ e1) = j e <> j' e1    k' :: Guard -> r@@ -348,12 +340,11 @@   f'' s d = let (s', r) = f s d in r <> f' s' d    f' :: s -> Declaration -> r-  f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (map (f'' s) ds)-  f' s (ValueDeclaration _ _ bs val) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(GuardedExpr grd v) -> map (k' s) grd ++ [g'' s v]) val)-  f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)-  f' s (TypeClassDeclaration _ _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)-  f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (map (f'' s) ds)-  f' s (PositionedDeclaration _ _ d1) = f'' s d1+  f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (fmap (f'' s) ds)+  f' s (ValueDeclaration _ _ _ bs val) = foldl (<>) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) val)+  f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (fmap (\(_, _, val) -> g'' s val) ds)+  f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>) r0 (fmap (f'' s) ds)+  f' s (TypeInstanceDeclaration _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (fmap (f'' s) ds)   f' _ _ = r0    g'' :: s -> Expr -> r@@ -366,15 +357,15 @@   g' s (Parens v1) = g'' s v1   g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1   g' s (Accessor _ v1) = g'' s v1-  g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)+  g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (fmap (g'' s . snd) vs)   g' s (ObjectUpdateNested obj vs) = foldl (<>) (g'' s obj) (fmap (g'' s) vs)   g' s (Abs binder v1) = h'' s binder <> g'' s v1   g' s (App v1 v2) = g'' s v1 <> g'' s v2   g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3-  g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (map (g'' s) vs)) (map (i'' s) alts)+  g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts)   g' s (TypedValue _ v1 _) = g'' s v1-  g' s (Let ds v1) = foldl (<>) r0 (map (f'' s) ds) <> g'' s v1-  g' s (Do es) = foldl (<>) r0 (map (j'' s) es)+  g' s (Let ds v1) = foldl (<>) r0 (fmap (f'' s) ds) <> g'' s v1+  g' s (Do es) = foldl (<>) r0 (fmap (j'' s) es)   g' s (PositionedValue _ _ v1) = g'' s v1   g' _ _ = r0 @@ -383,7 +374,7 @@    h' :: s -> Binder -> r   h' s (LiteralBinder l) = lit h'' s l-  h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)+  h' s (ConstructorBinder _ bs) = foldl (<>) r0 (fmap (h'' s) bs)   h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <> h'' s b2 <> h'' s b3   h' s (ParensInBinder b) = h'' s b   h' s (NamedBinder _ b1) = h'' s b1@@ -392,15 +383,15 @@   h' _ _ = r0    lit :: (s -> a -> r) -> s -> Literal a -> r-  lit go s (ArrayLiteral as) = foldl (<>) r0 (map (go s) as)-  lit go s (ObjectLiteral as) = foldl (<>) r0 (map (go s . snd) as)+  lit go s (ArrayLiteral as) = foldl (<>) r0 (fmap (go s) as)+  lit go s (ObjectLiteral as) = foldl (<>) r0 (fmap (go s . snd) as)   lit _ _ _ = r0    i'' :: s -> CaseAlternative -> r   i'' s ca = let (s', r) = i s ca in r <> i' s' ca    i' :: s -> CaseAlternative -> r-  i' s (CaseAlternative bs gs) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(GuardedExpr grd val) -> map (k' s) grd ++ [g'' s val]) gs)+  i' s (CaseAlternative bs gs) = foldl (<>) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd val) -> fmap (k' s) grd ++ [g'' s val]) gs)    j'' :: s -> DoNotationElement -> r   j'' s e = let (s', r) = j s e in r <> j' s' e@@ -408,7 +399,7 @@   j' :: s -> DoNotationElement -> r   j' s (DoNotationValue v) = g'' s v   j' s (DoNotationBind b v) = h'' s b <> g'' s v-  j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)+  j' s (DoNotationLet ds) = foldl (<>) r0 (fmap (f'' s) ds)   j' s (PositionedDoNotationElement _ _ e1) = j'' s e1    k' :: s -> Guard -> r@@ -435,11 +426,10 @@   f'' s = uncurry f' <=< f s    f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f'' s) ds-  f' s (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val+  f' s (ValueDeclaration sa name nameKind bs val) = ValueDeclaration sa name nameKind <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val   f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (thirdM (g'' s)) ds-  f' s (TypeClassDeclaration name args implies deps ds) = TypeClassDeclaration name args implies deps <$> traverse (f'' s) ds-  f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds-  f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1+  f' s (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f'' s) ds+  f' s (TypeInstanceDeclaration sa name cs className args ds) = TypeInstanceDeclaration sa name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds   f' _ other = return other    g'' s = uncurry g' <=< g s@@ -516,18 +506,17 @@    f' :: S.Set Ident -> Declaration -> r   f' s (DataBindingGroupDeclaration ds) =-    let s' = S.union s (S.fromList (mapMaybe getDeclIdent ds))+    let s' = S.union s (S.fromList (mapMaybe getDeclIdent (NEL.toList ds)))     in foldMap (f'' s') ds-  f' s (ValueDeclaration name _ bs val) =+  f' s (ValueDeclaration _ name _ bs val) =     let s' = S.insert name s         s'' = S.union s' (S.fromList (concatMap binderNames bs))     in foldMap (h'' s') bs <> foldMap (l' s'') val   f' s (BindingGroupDeclaration ds) =-    let s' = S.union s (S.fromList (map (\(name, _, _) -> name) ds))+    let s' = S.union s (S.fromList (NEL.toList (fmap (\((_, name), _, _) -> name) ds)))     in foldMap (\(_, _, val) -> g'' s' val) ds-  f' s (TypeClassDeclaration _ _ _ _ ds) = foldMap (f'' s) ds-  f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds-  f' s (PositionedDeclaration _ _ d) = f'' s d+  f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldMap (f'' s) ds+  f' s (TypeInstanceDeclaration _ _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds   f' _ _ = mempty    g'' :: S.Set Ident -> Expr -> r@@ -607,9 +596,8 @@     in r <> l' s' (GuardedExpr gs e)    getDeclIdent :: Declaration -> Maybe Ident-  getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d-  getDeclIdent (ValueDeclaration ident _ _ _) = Just ident-  getDeclIdent (TypeDeclaration ident _) = Just ident+  getDeclIdent (ValueDeclaration _ ident _ _ _) = Just ident+  getDeclIdent (TypeDeclaration _ ident _) = Just ident   getDeclIdent _ = Nothing  accumTypes@@ -623,16 +611,16 @@      ) accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)   where-  forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)-  forDecls (ExternDeclaration _ ty) = f ty-  forDecls (TypeClassDeclaration _ _ implies _ _) = mconcat (concatMap (map f . constraintArgs) implies)-  forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . constraintArgs) cs) `mappend` mconcat (map f tys)-  forDecls (TypeSynonymDeclaration _ _ ty) = f ty-  forDecls (TypeDeclaration _ ty) = f ty+  forDecls (DataDeclaration _ _ _ _ dctors) = mconcat (concatMap (fmap f . snd) dctors)+  forDecls (ExternDeclaration _ _ ty) = f ty+  forDecls (TypeClassDeclaration _ _ _ implies _ _) = mconcat (concatMap (fmap f . constraintArgs) implies)+  forDecls (TypeInstanceDeclaration _ _ cs _ tys _) = mconcat (concatMap (fmap f . constraintArgs) cs) `mappend` mconcat (fmap f tys)+  forDecls (TypeSynonymDeclaration _ _ _ ty) = f ty+  forDecls (TypeDeclaration _ _ ty) = f ty   forDecls _ = mempty -  forValues (TypeClassDictionary c _ _) = mconcat (map f (constraintArgs c))-  forValues (DeferredDictionary _ tys) = mconcat (map f tys)+  forValues (TypeClassDictionary c _ _) = mconcat (fmap f (constraintArgs c))+  forValues (DeferredDictionary _ tys) = mconcat (fmap f tys)   forValues (TypedValue _ _ ty) = f ty   forValues _ = mempty @@ -647,21 +635,21 @@      ) accumKinds f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)   where-  forDecls (DataDeclaration _ _ args dctors) =+  forDecls (DataDeclaration _ _ _ args dctors) =     foldMap (foldMap f . snd) args `mappend`     foldMap (foldMap forTypes . snd) dctors-  forDecls (TypeClassDeclaration _ args implies _ _) =+  forDecls (TypeClassDeclaration _ _ args implies _ _) =     foldMap (foldMap f . snd) args `mappend`     foldMap (foldMap forTypes . constraintArgs) implies-  forDecls (TypeInstanceDeclaration _ cs _ tys _) =+  forDecls (TypeInstanceDeclaration _ _ cs _ tys _) =     foldMap (foldMap forTypes . constraintArgs) cs `mappend`     foldMap forTypes tys-  forDecls (TypeSynonymDeclaration _ args ty) =+  forDecls (TypeSynonymDeclaration _ _ args ty) =     foldMap (foldMap f . snd) args `mappend`     forTypes ty-  forDecls (TypeDeclaration _ ty) = forTypes ty-  forDecls (ExternDeclaration _ ty) = forTypes ty-  forDecls (ExternDataDeclaration _ kn) = f kn+  forDecls (TypeDeclaration _ _ ty) = forTypes ty+  forDecls (ExternDeclaration _ _ ty) = forTypes ty+  forDecls (ExternDataDeclaration _ _ kn) = f kn   forDecls _ = mempty    forValues (TypeClassDictionary c _ _) = foldMap forTypes (constraintArgs c)@@ -680,5 +668,5 @@   where   g :: Expr -> Expr   g (TypedValue checkTy val t) = TypedValue checkTy val (f t)-  g (TypeClassDictionary c sco hints) = TypeClassDictionary (mapConstraintArgs (map f) c) sco hints+  g (TypeClassDictionary c sco hints) = TypeClassDictionary (mapConstraintArgs (fmap f) c) sco hints   g other = other

src/Language/PureScript/CodeGen/JS.hs view

@@ -146,13 +146,12 @@     js <- valueToJs val     withPos ss $ AST.VariableIntroduction Nothing (identToJs ident) (Just js) -  withPos :: Maybe SourceSpan -> AST -> m AST-  withPos (Just ss) js = do+  withPos :: SourceSpan -> AST -> m AST+  withPos ss js = do     withSM <- asks optionsSourceMaps     return $ if withSM       then withSourceSpan ss js       else js-  withPos Nothing js = return js    -- | Generate code in the simplified JavaScript intermediate representation for a variable based on a   -- PureScript identifier.@@ -177,7 +176,7 @@    valueToJs' :: Expr Ann -> m AST   valueToJs' (Literal (pos, _, _, _) l) =-    maybe id rethrowWithPosition pos $ literalToValueJS l+    rethrowWithPosition pos $ literalToValueJS l   valueToJs' (Var (_, _, _, Just (IsConstructor _ [])) name) =     return $ accessorString "value" $ qualifiedToJS id name   valueToJs' (Var (_, _, _, Just (IsConstructor _ _)) name) =@@ -222,9 +221,9 @@   valueToJs' (Var (_, _, _, Just IsForeign) ident) =     internalError $ "Encountered an unqualified reference to a foreign ident " ++ T.unpack (showQualified showIdent ident)   valueToJs' (Var _ ident) = return $ varToJs ident-  valueToJs' (Case (maybeSpan, _, _, _) values binders) = do+  valueToJs' (Case (ss, _, _, _) values binders) = do     vals <- mapM valueToJs values-    bindersToJs maybeSpan binders vals+    bindersToJs ss binders vals   valueToJs' (Let _ ds val) = do     ds' <- concat <$> mapM bindToJs ds     ret <- valueToJs val@@ -299,8 +298,8 @@    -- | Generate code in the simplified JavaScript intermediate representation for pattern match binders   -- and guards.-  bindersToJs :: Maybe SourceSpan -> [CaseAlternative Ann] -> [AST] -> m AST-  bindersToJs maybeSpan binders vals = do+  bindersToJs :: SourceSpan -> [CaseAlternative Ann] -> [AST] -> m AST+  bindersToJs ss binders vals = do     valNames <- replicateM (length vals) freshName     let assignments = zipWith (AST.VariableIntroduction Nothing) valNames (map Just vals)     jss <- forM binders $ \(CaseAlternative bs result) -> do@@ -320,7 +319,7 @@       failedPatternError names = AST.Unary Nothing AST.New $ AST.App Nothing (AST.Var Nothing "Error") [AST.Binary Nothing AST.Add (AST.StringLiteral Nothing $ mkString failedPatternMessage) (AST.ArrayLiteral Nothing $ zipWith valueError names vals)]        failedPatternMessage :: Text-      failedPatternMessage = "Failed pattern match" <> maybe "" (((" at " <> runModuleName mn <> " ") <>) . displayStartEndPos) maybeSpan <> ": "+      failedPatternMessage = "Failed pattern match at " <> runModuleName mn <> " " <> displayStartEndPos ss <> ": "        valueError :: Text -> AST -> AST       valueError _ l@(AST.NumericLiteral _ _) = l

src/Language/PureScript/Constants.hs view

@@ -359,6 +359,20 @@ orderingGT :: Qualified (ProperName 'TypeName) orderingGT = Qualified (Just typeDataOrdering) (ProperName "GT") +-- Type.Row++pattern TypeRow :: ModuleName+pattern TypeRow = ModuleName [ProperName "Type", ProperName "Row"]++pattern RowToList :: Qualified (ProperName 'ClassName)+pattern RowToList = Qualified (Just TypeRow) (ProperName "RowToList")++pattern RowListNil :: Qualified (ProperName 'TypeName)+pattern RowListNil = Qualified (Just TypeRow) (ProperName "Nil")++pattern RowListCons :: Qualified (ProperName 'TypeName)+pattern RowListCons = Qualified (Just TypeRow) (ProperName "Cons")+ -- Main module  main :: forall a. (IsString a) => a

src/Language/PureScript/CoreFn/Ann.hs view

@@ -10,13 +10,13 @@ -- |
 -- Type alias for basic annotations
 --
-type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)
+type Ann = (SourceSpan, [Comment], Maybe Type, Maybe Meta)
 
 -- |
--- Initial annotation with no metadata
+-- An annotation empty of metadata aside from a source span.
 --
-nullAnn :: Ann
-nullAnn = (Nothing, [], Nothing, Nothing)
+ssAnn :: SourceSpan -> Ann
+ssAnn ss = (ss, [], Nothing, Nothing)
 
 -- |
 -- Remove the comments from an annotation

src/Language/PureScript/CoreFn/Desugar.hs view

@@ -9,6 +9,7 @@ import Data.List (sort, sortBy) import Data.Maybe (mapMaybe) import Data.Tuple (swap)+import qualified Data.List.NonEmpty as NEL import qualified Data.Map as M  import Language.PureScript.AST.Literals@@ -32,63 +33,52 @@ moduleToCoreFn :: Environment -> A.Module -> Module Ann moduleToCoreFn _ (A.Module _ _ _ _ Nothing) =   internalError "Module exports were not elaborated before moduleToCoreFn"-moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =-  let imports = mapMaybe importToCoreFn decls ++ findQualModules decls-      imports' = keepPositionedImports imports+moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =+  let imports = mapMaybe importToCoreFn decls ++ fmap (ssAnn modSS,) (findQualModules decls)+      imports' = dedupeImports imports       exps' = ordNub $ concatMap exportToCoreFn exps       externs = ordNub $ mapMaybe externToCoreFn decls-      decls' = concatMap (declToCoreFn Nothing []) decls+      decls' = concatMap declToCoreFn decls   in Module coms mn imports' exps' externs decls'    where -  -- | Remove duplicate imports favoring the ones containing source span-  -- information-  keepPositionedImports :: [(Ann, ModuleName)] -> [(Ann, ModuleName)]-  keepPositionedImports =-      map swap . M.toList . M.fromListWith preferSSpan . map swap-    where-      preferSSpan x y-        | hasSS x = x-        | otherwise = y--      hasSS :: Ann -> Bool-      hasSS (Just _, _, _, _) = True-      hasSS _ = False+  -- | Remove duplicate imports+  dedupeImports :: [(Ann, ModuleName)] -> [(Ann, ModuleName)]+  dedupeImports = fmap swap . M.toList . M.fromListWith const . fmap swap -  ssA :: Maybe SourceSpan -> Ann+  ssA :: SourceSpan -> Ann   ssA ss = (ss, [], Nothing, Nothing)    -- | Desugars member declarations from AST to CoreFn representation.-  declToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Declaration -> [Bind Ann]-  declToCoreFn ss com (A.DataDeclaration Newtype _ _ [(ctor, _)]) =+  declToCoreFn :: A.Declaration -> [Bind Ann]+  declToCoreFn (A.DataDeclaration (ss, com) Newtype _ _ [(ctor, _)]) =     [NonRec (ssA ss) (properToIdent ctor) $-      Abs (ss, com, Nothing, Just IsNewtype) (Ident "x") (Var nullAnn $ Qualified Nothing (Ident "x"))]-  declToCoreFn _ _ d@(A.DataDeclaration Newtype _ _ _) =+      Abs (ss, com, Nothing, Just IsNewtype) (Ident "x") (Var (ssAnn ss) $ Qualified Nothing (Ident "x"))]+  declToCoreFn d@(A.DataDeclaration _ Newtype _ _ _) =     error $ "Found newtype with multiple constructors: " ++ show d-  declToCoreFn ss com (A.DataDeclaration Data tyName _ ctors) =-    flip map ctors $ \(ctor, _) ->+  declToCoreFn (A.DataDeclaration (ss, com) Data tyName _ ctors) =+    flip fmap ctors $ \(ctor, _) ->       let (_, _, _, fields) = lookupConstructor env (Qualified (Just mn) ctor)       in NonRec (ssA ss) (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields-  declToCoreFn ss _   (A.DataBindingGroupDeclaration ds) = concatMap (declToCoreFn ss []) ds-  declToCoreFn ss com (A.ValueDeclaration name _ _ [A.MkUnguarded e]) =+  declToCoreFn (A.DataBindingGroupDeclaration ds) =+    concatMap declToCoreFn ds+  declToCoreFn (A.ValueDeclaration (ss, com) name _ _ [A.MkUnguarded e]) =     [NonRec (ssA ss) name (exprToCoreFn ss com Nothing e)]-  declToCoreFn ss _   (A.BindingGroupDeclaration ds) =-    [Rec $ map (\(name, _, e) -> ((ssA ss, name), exprToCoreFn ss [] Nothing e)) ds]-  declToCoreFn ss com (A.TypeClassDeclaration name _ supers _ members) =-    [NonRec (ssA ss) (properToIdent name) $ mkTypeClassConstructor ss com supers members]-  declToCoreFn _  com (A.PositionedDeclaration ss com1 d) =-    declToCoreFn (Just ss) (com ++ com1) d-  declToCoreFn _ _ _ = []+  declToCoreFn (A.BindingGroupDeclaration ds) =+    [Rec . NEL.toList $ fmap (\(((ss, com), name), _, e) -> ((ssA ss, name), exprToCoreFn ss com Nothing e)) ds]+  declToCoreFn (A.TypeClassDeclaration sa@(ss, _) name _ supers _ members) =+    [NonRec (ssA ss) (properToIdent name) $ mkTypeClassConstructor sa supers members]+  declToCoreFn _ = []    -- | Desugars expressions from AST to CoreFn representation.-  exprToCoreFn :: Maybe SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann+  exprToCoreFn :: SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann   exprToCoreFn ss com ty (A.Literal lit) =     Literal (ss, com, ty, Nothing) (fmap (exprToCoreFn ss com Nothing) lit)   exprToCoreFn ss com ty (A.Accessor name v) =     Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)   exprToCoreFn ss com ty (A.ObjectUpdate obj vs) =-    ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ map (second (exprToCoreFn ss [] Nothing)) vs+    ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ fmap (second (exprToCoreFn ss [] Nothing)) vs   exprToCoreFn ss com ty (A.Abs (A.VarBinder name) v) =     Abs (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)   exprToCoreFn _ _ _ (A.Abs _ _) =@@ -99,34 +89,34 @@     Var (ss, com, ty, getValueMeta ident) ident   exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =     Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]-      [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]-                        (Right $ exprToCoreFn Nothing [] Nothing v2)-      , CaseAlternative [NullBinder nullAnn]-                        (Right $ exprToCoreFn Nothing [] Nothing v3) ]+      [ CaseAlternative [LiteralBinder (ssAnn ss) $ BooleanLiteral True]+                        (Right $ exprToCoreFn ss [] Nothing v2)+      , CaseAlternative [NullBinder (ssAnn ss)]+                        (Right $ exprToCoreFn ss [] Nothing v3) ]   exprToCoreFn ss com ty (A.Constructor name) =     Var (ss, com, ty, Just $ getConstructorMeta name) $ fmap properToIdent name   exprToCoreFn ss com ty (A.Case vs alts) =-    Case (ss, com, ty, Nothing) (map (exprToCoreFn ss [] Nothing) vs) (map (altToCoreFn ss) alts)+    Case (ss, com, ty, Nothing) (fmap (exprToCoreFn ss [] Nothing) vs) (fmap (altToCoreFn ss) alts)   exprToCoreFn ss com _ (A.TypedValue _ v ty) =     exprToCoreFn ss com (Just ty) v   exprToCoreFn ss com ty (A.Let ds v) =-    Let (ss, com, ty, Nothing) (concatMap (declToCoreFn ss []) ds) (exprToCoreFn ss [] Nothing v)+    Let (ss, com, ty, Nothing) (concatMap declToCoreFn ds) (exprToCoreFn ss [] Nothing v)   exprToCoreFn ss com ty (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ lit@(A.Literal (A.ObjectLiteral _)) _)) =     exprToCoreFn ss com ty (A.TypeClassDictionaryConstructorApp name lit)   exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.Literal (A.ObjectLiteral vs))) =-    let args = map (exprToCoreFn ss [] Nothing . snd) $ sortBy (compare `on` fst) vs+    let args = fmap (exprToCoreFn ss [] Nothing . snd) $ sortBy (compare `on` fst) vs         ctor = Var (ss, [], Nothing, Just IsTypeClassConstructor) (fmap properToIdent name)     in foldl (App (ss, com, Nothing, Nothing)) ctor args   exprToCoreFn ss com ty  (A.TypeClassDictionaryAccessor _ ident) =     Abs (ss, com, ty, Nothing) (Ident "dict")-      (Accessor nullAnn (mkString $ runIdent ident) (Var nullAnn $ Qualified Nothing (Ident "dict")))+      (Accessor (ssAnn ss) (mkString $ runIdent ident) (Var (ssAnn ss) $ Qualified Nothing (Ident "dict")))   exprToCoreFn _ com ty (A.PositionedValue ss com1 v) =-    exprToCoreFn (Just ss) (com ++ com1) ty v+    exprToCoreFn ss (com ++ com1) ty v   exprToCoreFn _ _ _ e =     error $ "Unexpected value in exprToCoreFn mn: " ++ show e    -- | Desugars case alternatives from AST to CoreFn representation.-  altToCoreFn :: Maybe SourceSpan -> A.CaseAlternative -> CaseAlternative Ann+  altToCoreFn :: SourceSpan -> A.CaseAlternative -> CaseAlternative Ann   altToCoreFn ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn ss []) bs) (go vs)     where     go :: [A.GuardedExpr] -> Either [(Guard Ann, Expr Ann)] (Expr Ann)@@ -142,7 +132,7 @@     guardToExpr _ = internalError "Guard not correctly desugared"    -- | Desugars case binders from AST to CoreFn representation.-  binderToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann+  binderToCoreFn :: SourceSpan -> [Comment] -> A.Binder -> Binder Ann   binderToCoreFn ss com (A.LiteralBinder lit) =     LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit)   binderToCoreFn ss com A.NullBinder =@@ -151,11 +141,11 @@     VarBinder (ss, com, Nothing, Nothing) name   binderToCoreFn ss com (A.ConstructorBinder dctor@(Qualified mn' _) bs) =     let (_, tctor, _, _) = lookupConstructor env dctor-    in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (map (binderToCoreFn ss []) bs)+    in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (fmap (binderToCoreFn ss []) bs)   binderToCoreFn ss com (A.NamedBinder name b) =     NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)   binderToCoreFn _ com (A.PositionedBinder ss com1 b) =-    binderToCoreFn (Just ss) (com ++ com1) b+    binderToCoreFn ss (com ++ com1) b   binderToCoreFn ss com (A.TypedBinder _ b) =     binderToCoreFn ss com b   binderToCoreFn _ _ A.OpBinder{} =@@ -196,15 +186,15 @@ -- | Find module names from qualified references to values. This is used to -- ensure instances are imported from any module that is referenced by the -- current module, not just from those that are imported explicitly (#667).-findQualModules :: [A.Declaration] -> [(Ann, ModuleName)]+findQualModules :: [A.Declaration] -> [ModuleName] findQualModules decls =   let (f, _, _, _, _) = everythingOnValues (++) fqDecls fqValues fqBinders (const []) (const [])-  in map (nullAnn,) $ f `concatMap` decls+  in f `concatMap` decls   where   fqDecls :: A.Declaration -> [ModuleName]-  fqDecls (A.TypeInstanceDeclaration _ _ q _ _) = getQual' q-  fqDecls (A.ValueFixityDeclaration _ q _) = getQual' q-  fqDecls (A.TypeFixityDeclaration _ q _) = getQual' q+  fqDecls (A.TypeInstanceDeclaration _ _ _ q _ _) = getQual' q+  fqDecls (A.ValueFixityDeclaration _ _ q _) = getQual' q+  fqDecls (A.TypeFixityDeclaration _ _ q _) = getQual' q   fqDecls _ = []    fqValues :: A.Expr -> [ModuleName]@@ -225,40 +215,36 @@  -- | Desugars import declarations from AST to CoreFn representation. importToCoreFn :: A.Declaration -> Maybe (Ann, ModuleName)-importToCoreFn (A.ImportDeclaration name _ _) = Just (nullAnn, name)-importToCoreFn (A.PositionedDeclaration ss _ d) =-  ((,) (Just ss, [], Nothing, Nothing) . snd) <$> importToCoreFn d+importToCoreFn (A.ImportDeclaration (ss, com) name _ _) = Just ((ss, com, Nothing, Nothing), name) importToCoreFn _ = Nothing  -- | Desugars foreign declarations from AST to CoreFn representation. externToCoreFn :: A.Declaration -> Maybe ForeignDecl-externToCoreFn (A.ExternDeclaration name ty) = Just (name, ty)-externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d+externToCoreFn (A.ExternDeclaration _ name ty) = Just (name, ty) externToCoreFn _ = Nothing  -- | Desugars export declarations references from AST to CoreFn representation. -- CoreFn modules only export values, so all data constructors, class -- constructor, instances and values are flattened into one list. exportToCoreFn :: A.DeclarationRef -> [Ident]-exportToCoreFn (A.TypeRef _ (Just dctors)) = map properToIdent dctors-exportToCoreFn (A.ValueRef name) = [name]-exportToCoreFn (A.TypeClassRef name) = [properToIdent name]-exportToCoreFn (A.TypeInstanceRef name) = [name]-exportToCoreFn (A.PositionedDeclarationRef _ _ d) = exportToCoreFn d+exportToCoreFn (A.TypeRef _ _ (Just dctors)) = fmap properToIdent dctors+exportToCoreFn (A.ValueRef _ name) = [name]+exportToCoreFn (A.TypeClassRef _ name) = [properToIdent name]+exportToCoreFn (A.TypeInstanceRef _ name) = [name] exportToCoreFn _ = []  -- | Makes a typeclass dictionary constructor function. The returned expression -- is a function that accepts the superclass instances and member -- implementations and returns a record for the instance dictionary.-mkTypeClassConstructor :: Maybe SourceSpan -> [Comment] -> [Constraint] -> [A.Declaration] -> Expr Ann-mkTypeClassConstructor ss com [] [] = Literal (ss, com, Nothing, Just IsTypeClassConstructor) (ObjectLiteral [])-mkTypeClassConstructor ss com supers members =-  let args@(a:as) = sort $ map typeClassMemberName members ++ superClassDictionaryNames supers-      props = [ (mkString arg, Var nullAnn $ Qualified Nothing (Ident arg)) | arg <- args ]-      dict = Literal nullAnn (ObjectLiteral props)+mkTypeClassConstructor :: SourceAnn -> [Constraint] -> [A.Declaration] -> Expr Ann+mkTypeClassConstructor (ss, com) [] [] = Literal (ss, com, Nothing, Just IsTypeClassConstructor) (ObjectLiteral [])+mkTypeClassConstructor (ss, com) supers members =+  let args@(a:as) = sort $ fmap typeClassMemberName members ++ superClassDictionaryNames supers+      props = [ (mkString arg, Var (ssAnn ss) $ Qualified Nothing (Ident arg)) | arg <- args ]+      dict = Literal (ssAnn ss) (ObjectLiteral props)   in Abs (ss, com, Nothing, Just IsTypeClassConstructor)          (Ident a)-         (foldr (Abs nullAnn . Ident) dict as)+         (foldr (Abs (ssAnn ss) . Ident) dict as)  -- | Converts a ProperName to an Ident. properToIdent :: ProperName a -> Ident

src/Language/PureScript/Docs/AsHtml.hs view

@@ -163,12 +163,17 @@  renderChildren :: HtmlRenderContext -> [ChildDeclaration] -> Html renderChildren _ [] = return ()-renderChildren r xs = ul $ mapM_ go xs+renderChildren r xs = ul $ mapM_ item xs   where-  go decl = item decl . code . codeAsHtml r . Render.renderChildDeclaration $ decl-  item decl = let fragment = makeFragment (childDeclInfoNamespace (cdeclInfo decl)) (cdeclTitle decl)-              in  li ! A.id (v (T.drop 1 fragment))+  item decl =+    li ! A.id (v (T.drop 1 (fragment decl))) $ do+      renderCode decl+      for_ (cdeclComments decl) $ \coms ->+        H.div ! A.class_ "decl__child_comments" $ renderMarkdown coms +  fragment decl = makeFragment (childDeclInfoNamespace (cdeclInfo decl)) (cdeclTitle decl)+  renderCode = code . codeAsHtml r . Render.renderChildDeclaration+ codeAsHtml :: HtmlRenderContext -> RenderedCode -> Html codeAsHtml r = outputWith elemAsHtml   where@@ -184,8 +189,9 @@         Link mn ->           let             class_ = if startsWithUpper name then "ctor" else "ident"+            target = if ns == TypeLevel then "type (" <> name <> ")" else name           in-            linkToDecl ns name mn (withClass class_ (text name))+            linkToDecl ns target mn (withClass class_ (text name))         NoLink ->           text name @@ -293,10 +299,13 @@ partitionChildren ::   [ChildDeclaration] ->   ([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])-partitionChildren = foldl go ([], [], [])+partitionChildren =+  reverseAll . foldl go ([], [], [])   where   go (instances, dctors, members) rcd =     case cdeclInfo rcd of       ChildInstance _ _      -> (rcd : instances, dctors, members)       ChildDataConstructor _ -> (instances, rcd : dctors, members)       ChildTypeClassMember _ -> (instances, dctors, rcd : members)++  reverseAll (xs, ys, zs) = (reverse xs, reverse ys, reverse zs)

src/Language/PureScript/Docs/Convert.hs view

@@ -20,7 +20,6 @@ import Language.PureScript.Docs.Convert.Single (convertSingleModule) import Language.PureScript.Docs.Types import qualified Language.PureScript as P-import qualified Language.PureScript.Constants as C  import Web.Bower.PackageMeta (PackageName) @@ -87,11 +86,8 @@   m ([Module], P.Env) convertModulesWithEnv withPackage =   P.sortModules-    >>> fmap (fst >>> map importPrim)+    >>> fmap (fst >>> map P.importPrim)     >=> convertSorted withPackage--importPrim :: P.Module -> P.Module-importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])  -- | -- Convert a sorted list of modules, returning both the list of converted

src/Language/PureScript/Docs/Convert/Single.hs view

@@ -82,66 +82,63 @@     d { declChildren = declChildren d ++ [child] }  getDeclarationTitle :: P.Declaration -> Maybe Text-getDeclarationTitle (P.ValueDeclaration name _ _ _) = Just (P.showIdent name)-getDeclarationTitle (P.ExternDeclaration name _) = Just (P.showIdent name)-getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name)-getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name)-getDeclarationTitle (P.ExternKindDeclaration name) = Just (P.runProperName name)-getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)-getDeclarationTitle (P.TypeClassDeclaration name _ _ _ _) = Just (P.runProperName name)-getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name)-getDeclarationTitle (P.TypeFixityDeclaration _ _ op) = Just ("type " <> P.showOp op)-getDeclarationTitle (P.ValueFixityDeclaration _ _ op) = Just (P.showOp op)-getDeclarationTitle (P.PositionedDeclaration _ _ d) = getDeclarationTitle d+getDeclarationTitle (P.ValueDeclaration _ name _ _ _) = Just (P.showIdent name)+getDeclarationTitle (P.ExternDeclaration _ name _) = Just (P.showIdent name)+getDeclarationTitle (P.DataDeclaration _ _ name _ _) = Just (P.runProperName name)+getDeclarationTitle (P.ExternDataDeclaration _ name _) = Just (P.runProperName name)+getDeclarationTitle (P.ExternKindDeclaration _ name) = Just (P.runProperName name)+getDeclarationTitle (P.TypeSynonymDeclaration _ name _ _) = Just (P.runProperName name)+getDeclarationTitle (P.TypeClassDeclaration _ name _ _ _ _) = Just (P.runProperName name)+getDeclarationTitle (P.TypeInstanceDeclaration _ name _ _ _ _) = Just (P.showIdent name)+getDeclarationTitle (P.TypeFixityDeclaration _ _ _ op) = Just ("type " <> P.showOp op)+getDeclarationTitle (P.ValueFixityDeclaration _ _ _ op) = Just (P.showOp op) getDeclarationTitle _ = Nothing  -- | Create a basic Declaration value.-mkDeclaration :: Text -> DeclarationInfo -> Declaration-mkDeclaration title info =+mkDeclaration :: P.SourceAnn -> Text -> DeclarationInfo -> Declaration+mkDeclaration (ss, com) title info =   Declaration { declTitle      = title-              , declComments   = Nothing-              , declSourceSpan = Nothing+              , declComments   = convertComments com+              , declSourceSpan = Just ss -- TODO: make this non-optional when we next break the format               , declChildren   = []               , declInfo       = info               } -basicDeclaration :: Text -> DeclarationInfo -> Maybe IntermediateDeclaration-basicDeclaration title info = Just $ Right $ mkDeclaration title info+basicDeclaration :: P.SourceAnn -> Text -> DeclarationInfo -> Maybe IntermediateDeclaration+basicDeclaration sa title = Just . Right . mkDeclaration sa title  convertDeclaration :: P.Declaration -> Text -> Maybe IntermediateDeclaration-convertDeclaration (P.ValueDeclaration _ _ _ [P.MkUnguarded (P.TypedValue _ _ ty)]) title =-  basicDeclaration title (ValueDeclaration ty)-convertDeclaration P.ValueDeclaration{} title =+convertDeclaration (P.ValueDeclaration sa _ _ _ [P.MkUnguarded (P.TypedValue _ _ ty)]) title =+  basicDeclaration sa title (ValueDeclaration ty)+convertDeclaration (P.ValueDeclaration sa _ _ _ _) title =   -- If no explicit type declaration was provided, insert a wildcard, so that   -- the actual type will be added during type checking.-  basicDeclaration title (ValueDeclaration P.TypeWildcard{})-convertDeclaration (P.ExternDeclaration _ ty) title =-  basicDeclaration title (ValueDeclaration ty)-convertDeclaration (P.DataDeclaration dtype _ args ctors) title =-  Just (Right (mkDeclaration title info) { declChildren = children })+  basicDeclaration sa title (ValueDeclaration P.TypeWildcard{})+convertDeclaration (P.ExternDeclaration sa _ ty) title =+  basicDeclaration sa title (ValueDeclaration ty)+convertDeclaration (P.DataDeclaration sa dtype _ args ctors) title =+  Just (Right (mkDeclaration sa title info) { declChildren = children })   where   info = DataDeclaration dtype args   children = map convertCtor ctors   convertCtor (ctor', tys) =     ChildDeclaration (P.runProperName ctor') Nothing Nothing (ChildDataConstructor tys)-convertDeclaration (P.ExternDataDeclaration _ kind') title =-  basicDeclaration title (ExternDataDeclaration kind')-convertDeclaration (P.ExternKindDeclaration _) title =-  basicDeclaration title ExternKindDeclaration-convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =-  basicDeclaration title (TypeSynonymDeclaration args ty)-convertDeclaration (P.TypeClassDeclaration _ args implies fundeps ds) title =-  Just (Right (mkDeclaration title info) { declChildren = children })+convertDeclaration (P.ExternDataDeclaration sa _ kind') title =+  basicDeclaration sa title (ExternDataDeclaration kind')+convertDeclaration (P.ExternKindDeclaration sa _) title =+  basicDeclaration sa title ExternKindDeclaration+convertDeclaration (P.TypeSynonymDeclaration sa _ args ty) title =+  basicDeclaration sa title (TypeSynonymDeclaration args ty)+convertDeclaration (P.TypeClassDeclaration sa _ args implies fundeps ds) title =+  Just (Right (mkDeclaration sa title info) { declChildren = children })   where   info = TypeClassDeclaration args implies (convertFundepsToStrings args fundeps)   children = map convertClassMember ds-  convertClassMember (P.PositionedDeclaration _ _ d) =-    convertClassMember d-  convertClassMember (P.TypeDeclaration ident' ty) =-    ChildDeclaration (P.showIdent ident') Nothing Nothing (ChildTypeClassMember ty)+  convertClassMember (P.TypeDeclaration (ss, com) ident' ty) =+    ChildDeclaration (P.showIdent ident') (convertComments com) (Just ss) (ChildTypeClassMember ty)   convertClassMember _ =     P.internalError "convertDeclaration: Invalid argument to convertClassMember."-convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title =+convertDeclaration (P.TypeInstanceDeclaration (ss, com) _ constraints className tys _) title =   Just (Left ((classNameString, AugmentClass) : map (, AugmentType) typeNameStrings, AugmentChild childDecl))   where   classNameString = unQual className@@ -151,28 +148,12 @@   extractProperNames (P.TypeConstructor n) = [unQual n]   extractProperNames _ = [] -  childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)+  childDecl = ChildDeclaration title (convertComments com) (Just ss) (ChildInstance constraints classApp)   classApp = foldl' P.TypeApp (P.TypeConstructor (fmap P.coerceProperName className)) tys-convertDeclaration (P.ValueFixityDeclaration fixity (P.Qualified mn alias) _) title =-  Just $ Right $ mkDeclaration title (AliasDeclaration fixity (P.Qualified mn (Right alias)))-convertDeclaration (P.TypeFixityDeclaration fixity (P.Qualified mn alias) _) title =-  Just $ Right $ mkDeclaration title (AliasDeclaration fixity (P.Qualified mn (Left alias)))-convertDeclaration (P.PositionedDeclaration srcSpan com d') title =-  fmap (addComments . addSourceSpan) (convertDeclaration d' title)-  where-  addComments (Right d) =-    Right (d { declComments = convertComments com })-  addComments (Left augment) =-    Left (withAugmentChild (\d -> d { cdeclComments = convertComments com })-                           augment)--  addSourceSpan (Right d) =-    Right (d { declSourceSpan = Just srcSpan })-  addSourceSpan (Left augment) =-    Left (withAugmentChild (\d -> d { cdeclSourceSpan = Just srcSpan })-                           augment)--  withAugmentChild f (t, AugmentChild d) = (t, AugmentChild (f d))+convertDeclaration (P.ValueFixityDeclaration sa fixity (P.Qualified mn alias) _) title =+  Just . Right $ mkDeclaration sa title (AliasDeclaration fixity (P.Qualified mn (Right alias)))+convertDeclaration (P.TypeFixityDeclaration sa fixity (P.Qualified mn alias) _) title =+  Just . Right $ mkDeclaration sa title (AliasDeclaration fixity (P.Qualified mn (Left alias))) convertDeclaration _ _ = Nothing  convertComments :: [P.Comment] -> Maybe Text

src/Language/PureScript/Errors.hs view

@@ -19,6 +19,7 @@ import           Data.Foldable (fold) import           Data.Functor.Identity (Identity(..)) import           Data.List (transpose, nubBy, sort, partition, dropWhileEnd)+import qualified Data.List.NonEmpty as NEL import           Data.Maybe (maybeToList, fromMaybe, mapMaybe) import qualified Data.Map as M import qualified Data.Text as T@@ -189,6 +190,10 @@ errorMessage :: SimpleErrorMessage -> MultipleErrors errorMessage err = MultipleErrors [ErrorMessage [] err] +-- | Create an error set from a single simple error message and source annotation+errorMessage' :: SourceSpan -> SimpleErrorMessage -> MultipleErrors+errorMessage' ss err = MultipleErrors [ErrorMessage [PositionedError ss] err]+ -- | Create an error set from a single error message singleError :: ErrorMessage -> MultipleErrors singleError = MultipleErrors . pure@@ -1040,7 +1045,7 @@             ]     renderHint (ErrorInBindingGroup nms) detail =       paras [ detail-            , line $ "in binding group " <> T.intercalate ", " (map showIdent nms)+            , line $ "in binding group " <> T.intercalate ", " (NEL.toList (fmap showIdent nms))             ]     renderHint (ErrorInDataBindingGroup nms) detail =       paras [ detail@@ -1190,7 +1195,7 @@  -- Pretty print and export declaration prettyPrintExport :: DeclarationRef -> Text-prettyPrintExport (TypeRef pn _) = runProperName pn+prettyPrintExport (TypeRef _ pn _) = runProperName pn prettyPrintExport ref =   fromMaybe     (internalError "prettyPrintRef returned Nothing in prettyPrintExport")@@ -1205,30 +1210,28 @@   in i <> maybe "" (\q -> " as " <> runModuleName q) qual  prettyPrintRef :: DeclarationRef -> Maybe Text-prettyPrintRef (TypeRef pn Nothing) =+prettyPrintRef (TypeRef _ pn Nothing) =   Just $ runProperName pn <> "(..)"-prettyPrintRef (TypeRef pn (Just [])) =+prettyPrintRef (TypeRef _ pn (Just [])) =   Just $ runProperName pn-prettyPrintRef (TypeRef pn (Just dctors)) =+prettyPrintRef (TypeRef _ pn (Just dctors)) =   Just $ runProperName pn <> "(" <> T.intercalate ", " (map runProperName dctors) <> ")"-prettyPrintRef (TypeOpRef op) =+prettyPrintRef (TypeOpRef _ op) =   Just $ "type " <> showOp op-prettyPrintRef (ValueRef ident) =+prettyPrintRef (ValueRef _ ident) =   Just $ showIdent ident-prettyPrintRef (ValueOpRef op) =+prettyPrintRef (ValueOpRef _ op) =   Just $ showOp op-prettyPrintRef (TypeClassRef pn) =+prettyPrintRef (TypeClassRef _ pn) =   Just $ "class " <> runProperName pn-prettyPrintRef (TypeInstanceRef ident) =+prettyPrintRef (TypeInstanceRef _ ident) =   Just $ showIdent ident-prettyPrintRef (ModuleRef name) =+prettyPrintRef (ModuleRef _ name) =   Just $ "module " <> runModuleName name-prettyPrintRef (KindRef pn) =+prettyPrintRef (KindRef _ pn) =   Just $ "kind " <> runProperName pn-prettyPrintRef (ReExportRef _ _) =+prettyPrintRef ReExportRef{} =   Nothing-prettyPrintRef (PositionedDeclarationRef _ _ ref) =-  prettyPrintRef ref  -- | Pretty print multiple errors prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String

src/Language/PureScript/Externs.hs view

@@ -178,28 +178,24 @@   efSourceSpan    = ss    fixityDecl :: Declaration -> Maybe ExternsFixity-  fixityDecl (ValueFixityDeclaration (Fixity assoc prec) name op) =-      fmap (const (ExternsFixity assoc prec op name)) (find (findOp getValueOpRef op) exps)-  fixityDecl (PositionedDeclaration _ _ d) = fixityDecl d+  fixityDecl (ValueFixityDeclaration _ (Fixity assoc prec) name op) =+    fmap (const (ExternsFixity assoc prec op name)) (find (findOp getValueOpRef op) exps)   fixityDecl _ = Nothing    typeFixityDecl :: Declaration -> Maybe ExternsTypeFixity-  typeFixityDecl (TypeFixityDeclaration (Fixity assoc prec) name op) =-      fmap (const (ExternsTypeFixity assoc prec op name)) (find (findOp getTypeOpRef op) exps)-  typeFixityDecl (PositionedDeclaration _ _ d) = typeFixityDecl d+  typeFixityDecl (TypeFixityDeclaration _ (Fixity assoc prec) name op) =+    fmap (const (ExternsTypeFixity assoc prec op name)) (find (findOp getTypeOpRef op) exps)   typeFixityDecl _ = Nothing    findOp :: (DeclarationRef -> Maybe (OpName a)) -> OpName a -> DeclarationRef -> Bool   findOp g op = maybe False (== op) . g    importDecl :: Declaration -> Maybe ExternsImport-  importDecl (ImportDeclaration m mt qmn) = Just (ExternsImport m mt qmn)-  importDecl (PositionedDeclaration _ _ d) = importDecl d+  importDecl (ImportDeclaration _ m mt qmn) = Just (ExternsImport m mt qmn)   importDecl _ = Nothing    toExternsDeclaration :: DeclarationRef -> [ExternsDeclaration]-  toExternsDeclaration (PositionedDeclarationRef _ _ r) = toExternsDeclaration r-  toExternsDeclaration (TypeRef pn dctors) =+  toExternsDeclaration (TypeRef _ pn dctors) =     case Qualified (Just mn) pn `M.lookup` types env of       Nothing -> internalError "toExternsDeclaration: no kind in toExternsDeclaration"       Just (kind, TypeSynonym)@@ -211,10 +207,10 @@                             , (dty, _, ty, args) <- maybeToList (Qualified (Just mn) dctor `M.lookup` dataConstructors env)                             ]       _ -> internalError "toExternsDeclaration: Invalid input"-  toExternsDeclaration (ValueRef ident)+  toExternsDeclaration (ValueRef _ ident)     | Just (ty, _, _) <- Qualified (Just mn) ident `M.lookup` names env     = [ EDValue ident ty ]-  toExternsDeclaration (TypeClassRef className)+  toExternsDeclaration (TypeClassRef _ className)     | Just TypeClassData{..} <- Qualified (Just mn) className `M.lookup` typeClasses env     , Just (kind, TypeSynonym) <- Qualified (Just mn) (coerceProperName className) `M.lookup` types env     , Just (_, synTy) <- Qualified (Just mn) (coerceProperName className) `M.lookup` typeSynonyms env@@ -222,13 +218,13 @@       , EDTypeSynonym (coerceProperName className) typeClassArguments synTy       , EDClass className typeClassArguments typeClassMembers typeClassSuperclasses typeClassDependencies       ]-  toExternsDeclaration (TypeInstanceRef ident)+  toExternsDeclaration (TypeInstanceRef _ ident)     = [ EDInstance tcdClassName ident tcdInstanceTypes tcdDependencies       | m1 <- maybeToList (M.lookup (Just mn) (typeClassDictionaries env))       , m2 <- M.elems m1       , TypeClassDictionaryInScope{..} <- maybeToList (M.lookup (Qualified (Just mn) ident) m2)       ]-  toExternsDeclaration (KindRef pn)+  toExternsDeclaration (KindRef _ pn)     | Qualified (Just mn) pn `S.member` kinds env     = [ EDKind pn ]   toExternsDeclaration _ = []

src/Language/PureScript/Ide.hs view

@@ -12,8 +12,7 @@ -- Interface for the psc-ide-server ----------------------------------------------------------------------------- -{-# LANGUAGE PackageImports        #-}-{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE PackageImports #-}  module Language.PureScript.Ide        ( handleCommand@@ -23,6 +22,7 @@  import           "monad-logger" Control.Monad.Logger import qualified Language.PureScript                as P+import qualified Language.PureScript.Constants      as C import qualified Language.PureScript.Ide.CaseSplit  as CS import           Language.PureScript.Ide.Command import           Language.PureScript.Ide.Completion@@ -31,6 +31,7 @@ import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Imports    hiding (Import) import           Language.PureScript.Ide.Matcher+import           Language.PureScript.Ide.Prim import           Language.PureScript.Ide.Pursuit import           Language.PureScript.Ide.Rebuild import           Language.PureScript.Ide.SourceFile@@ -43,8 +44,10 @@  -- | Accepts a Commmand and runs it against psc-ide's State. This is the main -- entry point for the server.-handleCommand :: (Ide m, MonadLogger m, MonadError IdeError m) =>-                 Command -> m Success+handleCommand+  :: (Ide m, MonadLogger m, MonadError IdeError m)+  => Command+  -> m Success handleCommand c = case c of   Load [] ->     findAvailableExterns >>= loadModulesAsync@@ -104,13 +107,15 @@   -> m Success findCompletions filters matcher currentModule complOptions = do   modules <- getAllModules currentModule-  pure (CompletionResult (getCompletions filters matcher complOptions modules))+  let insertPrim = (:) (C.Prim, idePrimDeclarations)+  pure (CompletionResult (getCompletions filters matcher complOptions (insertPrim modules)))  findType :: Ide m =>             Text -> [Filter] -> Maybe P.ModuleName -> m Success findType search filters currentModule = do   modules <- getAllModules currentModule-  pure (CompletionResult (getExactCompletions search filters modules))+  let insertPrim = (:) (C.Prim, idePrimDeclarations)+  pure (CompletionResult (getExactCompletions search filters (insertPrim modules)))  findPursuitCompletions :: MonadIO m =>                           PursuitQuery -> m Success@@ -218,7 +223,7 @@   (failures, allModules) <-     partitionEithers <$> (parseModulesFromFiles =<< findAllSourceFiles)   unless (null failures) $-    $(logWarn) ("Failed to parse: " <> show failures)+    logWarnN ("Failed to parse: " <> show failures)   traverse_ insertModule allModules    pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "

src/Language/PureScript/Ide/CaseSplit.hs view

@@ -30,7 +30,6 @@ import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types-import           Language.PureScript.Ide.Util  import           Text.Parsec                   as Parsec import qualified Text.PrettyPrint.Boxes        as Box@@ -129,8 +128,8 @@         ts <- P.lex "" (toS s)         P.runTokenParser "" (P.parseDeclaration <* Parsec.eof) ts   in-    case unwrapPositioned <$> x of-      Right (P.TypeDeclaration i t) -> pure (i, t)+    case x of+      Right (P.TypeDeclaration _ i t) -> pure (i, t)       Right _ -> throwError (GeneralError "Found a non-type-declaration")       Left err ->         throwError (GeneralError ("Parsing the type signature failed with: "

src/Language/PureScript/Ide/Completion.hs view

@@ -76,11 +76,11 @@ defaultCompletionOptions = CompletionOptions { coMaxResults = Nothing, coGroupReexports = False }  applyCompletionOptions :: CompletionOptions -> [Match IdeDeclarationAnn] -> [(Match IdeDeclarationAnn, [P.ModuleName])]-applyCompletionOptions co decls =-  maybe identity take (coMaxResults co) decls-  & if coGroupReexports co-    then groupCompletionReexports-    else map simpleExport+applyCompletionOptions co decls =  decls+  & (if coGroupReexports co+      then groupCompletionReexports+      else map simpleExport)+  & maybe identity take (coMaxResults co)  simpleExport :: Match a -> (Match a, [P.ModuleName]) simpleExport match@(Match (moduleName, _)) = (match, [moduleName])

src/Language/PureScript/Ide/Externs.hs view

@@ -28,12 +28,13 @@ import           Data.Version (showVersion) import           Language.PureScript.Ide.Error (IdeError (..)) import           Language.PureScript.Ide.Types-import           Language.PureScript.Ide.Util  import qualified Language.PureScript as P -readExternFile :: (MonadIO m, MonadError IdeError m, MonadLogger m) =>-                  FilePath -> m P.ExternsFile+readExternFile+  :: (MonadIO m, MonadError IdeError m, MonadLogger m)+  => FilePath+  -> m P.ExternsFile readExternFile fp = do    parseResult <- liftIO (decodeStrict <$> BS.readFile fp)    case parseResult of@@ -58,8 +59,8 @@   where     decls = map       (IdeDeclarationAnn emptyAnn)-      (resolvedDeclarations ++ operatorDecls ++ tyOperatorDecls)-    exportDecls = mapMaybe (convertExport . unwrapPositionedRef) (P.efExports ef)+      (resolvedDeclarations <> operatorDecls <> tyOperatorDecls)+    exportDecls = mapMaybe convertExport (P.efExports ef)     operatorDecls = convertOperator <$> P.efFixities ef     tyOperatorDecls = convertTypeOperator <$> P.efTypeFixities ef     (toResolve, declarations) =@@ -114,35 +115,45 @@   | SynonymToResolve (P.ProperName 'P.TypeName) P.Type  convertExport :: P.DeclarationRef -> Maybe (P.ModuleName, P.DeclarationRef)-convertExport (P.ReExportRef m r) = Just (m, r)+convertExport (P.ReExportRef _ m r) = Just (m, r) convertExport _ = Nothing  convertDecl :: P.ExternsDeclaration -> Either ToResolve (Maybe IdeDeclaration)-convertDecl P.EDType{..} = Right $ Just $ IdeDeclType $-  IdeType edTypeName edTypeKind-convertDecl P.EDTypeSynonym{..} = Left (SynonymToResolve edTypeSynonymName edTypeSynonymType)-convertDecl P.EDDataConstructor{..} = Right $ Just $ IdeDeclDataConstructor $-  IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType-convertDecl P.EDValue{..} = Right $ Just $ IdeDeclValue $-  IdeValue edValueName edValueType-convertDecl P.EDClass{..} = Left (TypeClassToResolve edClassName)-convertDecl P.EDKind{..} = Right (Just (IdeDeclKind edKindName))-convertDecl P.EDInstance{} = Right Nothing+convertDecl ed = case ed of+  P.EDType{..} ->+    Right (Just (IdeDeclType (IdeType edTypeName edTypeKind [])))+  P.EDTypeSynonym{..} ->+    Left (SynonymToResolve edTypeSynonymName edTypeSynonymType)+  P.EDDataConstructor{..} ->+    Right+      (Just+        (IdeDeclDataConstructor+          (IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType)))+  P.EDValue{..} ->+    Right (Just (IdeDeclValue (IdeValue edValueName edValueType)))+  P.EDClass{..} ->+    Left (TypeClassToResolve edClassName)+  P.EDKind{..} ->+    Right (Just (IdeDeclKind edKindName))+  P.EDInstance{} ->+    Right Nothing  convertOperator :: P.ExternsFixity -> IdeDeclaration convertOperator P.ExternsFixity{..} =-  IdeDeclValueOperator $ IdeValueOperator-    efOperator-    efAlias-    efPrecedence-    efAssociativity-    Nothing+  IdeDeclValueOperator+    (IdeValueOperator+      efOperator+      efAlias+      efPrecedence+      efAssociativity+      Nothing)  convertTypeOperator :: P.ExternsTypeFixity -> IdeDeclaration convertTypeOperator P.ExternsTypeFixity{..} =-  IdeDeclTypeOperator $ IdeTypeOperator-    efTypeOperator-    efTypeAlias-    efTypePrecedence-    efTypeAssociativity-    Nothing+  IdeDeclTypeOperator+    (IdeTypeOperator+      efTypeOperator+      efTypeAlias+      efTypePrecedence+      efTypeAssociativity+      Nothing)

src/Language/PureScript/Ide/Filter.hs view

@@ -16,6 +16,7 @@  module Language.PureScript.Ide.Filter        ( Filter+       , declarationTypeFilter        , namespaceFilter        , moduleFilter        , prefixFilter@@ -28,6 +29,7 @@ import           Data.Aeson import           Data.List.NonEmpty            (NonEmpty) import           Data.Text                     (isPrefixOf)+import qualified Language.PureScript.Ide.Filter.Declaration as D import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util import qualified Language.PureScript           as P@@ -77,6 +79,15 @@ declarationFilter predicate search =   filterModuleDecls (flip predicate search) +-- | Only keeps Identifiers in the given type declarations+declarationTypeFilter :: [D.IdeDeclaration] -> Filter+declarationTypeFilter [] = mkFilter identity+declarationTypeFilter decls =+    mkFilter $ filterModuleDecls filterDecls+    where+      filterDecls :: IdeDeclaration -> Bool+      filterDecls decl = D.typeDeclarationForDeclaration decl `elem` decls+ filterModuleDecls :: (IdeDeclaration -> Bool) -> [Module] -> [Module] filterModuleDecls predicate =   filter (not . null . snd) . fmap filterDecls@@ -109,4 +120,7 @@         params <- o .: "params"         namespaces <- params .: "namespaces"         return $ namespaceFilter namespaces+      "declarations" -> do+        declarations <- o.: "params"+        return $ declarationTypeFilter declarations       _ -> mzero

+ src/Language/PureScript/Ide/Filter/Declaration.hs view

@@ -0,0 +1,55 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Language.PureScript.Ide.Filter.Declaration+       ( IdeDeclaration(..)+       , DeclarationType(..)+       , typeDeclarationForDeclaration+       ) where++import           Protolude                     hiding (isPrefixOf)++import           Data.Aeson+import qualified Language.PureScript.Ide.Types as PI++data DeclarationType = Value+  | Type+  | Synonym+  | DataConstructor+  | TypeClass+  | ValueOperator+  | TypeOperator+  | Kind+  deriving (Show, Eq, Ord)++instance FromJSON DeclarationType where+  parseJSON = withText "Declaration type tag" $ \str ->+    case str of+      "value"             -> pure Value+      "type"              -> pure Type+      "synonym"           -> pure Synonym+      "dataconstructor"   -> pure DataConstructor+      "typeclass"         -> pure TypeClass+      "valueoperator"     -> pure ValueOperator+      "typeoperator"      -> pure TypeOperator+      "kind"              -> pure Kind+      _                   -> mzero++newtype IdeDeclaration = IdeDeclaration+  { declarationtype :: DeclarationType+  } deriving (Show, Eq, Ord)++instance FromJSON IdeDeclaration where+  parseJSON (Object o) =+    IdeDeclaration <$> o .: "declarationtype"+  parseJSON _ = mzero++typeDeclarationForDeclaration :: PI.IdeDeclaration -> IdeDeclaration+typeDeclarationForDeclaration decl = case decl of+  PI.IdeDeclValue _ -> IdeDeclaration Value+  PI.IdeDeclType _ -> IdeDeclaration Type+  PI.IdeDeclTypeSynonym _ -> IdeDeclaration Synonym+  PI.IdeDeclDataConstructor _ -> IdeDeclaration DataConstructor+  PI.IdeDeclTypeClass _ -> IdeDeclaration TypeClass+  PI.IdeDeclValueOperator _ -> IdeDeclaration ValueOperator+  PI.IdeDeclTypeOperator _ -> IdeDeclaration TypeOperator+  PI.IdeDeclKind _ -> IdeDeclaration Kind

src/Language/PureScript/Ide/Imports.hs view

@@ -93,7 +93,7 @@     (P.mark (Parsec.many (P.same *> P.parseImportDeclaration')))   pure (ImportParse mn ipStart ipEnd (map mkImport decls))   where-    mkImport (mn, (P.Explicit refs), qual) = Import mn (P.Explicit (unwrapPositionedRef <$> refs)) qual+    mkImport (mn, (P.Explicit refs), qual) = Import mn (P.Explicit refs) qual     mkImport (mn, it, qual) = Import mn it qual  sliceImportSection :: [Text] -> Either Text (P.ModuleName, [Text], [Import], [Text])@@ -192,19 +192,19 @@     else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports   where     refFromDeclaration (IdeDeclTypeClass tc) =-      P.TypeClassRef (tc ^. ideTCName)+      P.TypeClassRef ideSpan (tc ^. ideTCName)     refFromDeclaration (IdeDeclDataConstructor dtor) =-      P.TypeRef (dtor ^. ideDtorTypeName) Nothing+      P.TypeRef ideSpan (dtor ^. ideDtorTypeName) Nothing     refFromDeclaration (IdeDeclType t) =-      P.TypeRef (t ^. ideTypeName) (Just [])+      P.TypeRef ideSpan (t ^. ideTypeName) (Just [])     refFromDeclaration (IdeDeclValueOperator op) =-      P.ValueOpRef (op ^. ideValueOpName)+      P.ValueOpRef ideSpan (op ^. ideValueOpName)     refFromDeclaration (IdeDeclTypeOperator op) =-      P.TypeOpRef (op ^. ideTypeOpName)+      P.TypeOpRef ideSpan (op ^. ideTypeOpName)     refFromDeclaration (IdeDeclKind kn) =-      P.KindRef kn+      P.KindRef ideSpan kn     refFromDeclaration d =-      P.ValueRef (P.Ident (identifierFromIdeDeclaration d))+      P.ValueRef ideSpan (P.Ident (identifierFromIdeDeclaration d))      -- | Adds a declaration to an import:     -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)@@ -222,13 +222,16 @@         refs     insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs) -    insertDtor _ (P.TypeRef tn' _) = P.TypeRef tn' Nothing+    insertDtor _ (P.TypeRef ss tn' _) = P.TypeRef ss tn' Nothing     insertDtor _ refs = refs      matchType :: P.ProperName 'P.TypeName -> P.DeclarationRef -> Bool-    matchType tn (P.TypeRef n _) = tn == n+    matchType tn (P.TypeRef _ n _) = tn == n     matchType _ _ = False +ideSpan :: P.SourceSpan+ideSpan = P.internalModuleSourceSpan "<psc-ide>"+ updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a] updateAtFirstOrPrepend p t d l =   case findIndex p l of@@ -336,6 +339,6 @@   case P.lex "<psc-ide>" t        >>= P.runTokenParser "<psc-ide>" P.parseImportDeclaration' of     Right (mn, P.Explicit refs, mmn) ->-      Just (Import mn (P.Explicit (unwrapPositionedRef <$> refs)) mmn)+      Just (Import mn (P.Explicit refs) mmn)     Right (mn, idt, mmn) -> Just (Import mn idt mmn)     Left _ -> Nothing

+ src/Language/PureScript/Ide/Prim.hs view

@@ -0,0 +1,20 @@+module Language.PureScript.Ide.Prim (idePrimDeclarations) where++import           Protolude+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Language.PureScript as P+import qualified Language.PureScript.Environment as PEnv+import           Language.PureScript.Ide.Types++idePrimDeclarations :: [IdeDeclarationAnn]+idePrimDeclarations =+  primTypes <> primKinds <> primClasses+  where+    primTypes = foreach (Map.toList PEnv.primTypes) $ \(tn, (kind, _)) ->+      IdeDeclarationAnn emptyAnn (IdeDeclType (IdeType (P.disqualify tn) kind []))+    primKinds = foreach (Set.toList PEnv.primKinds) $ \kn ->+      IdeDeclarationAnn emptyAnn (IdeDeclKind (P.disqualify kn))+    primClasses = foreach (Map.toList PEnv.primClasses) $ \(cn, _) ->+      -- Dummy kind and instances here, but we primarily care about the name completion+      IdeDeclarationAnn emptyAnn (IdeDeclTypeClass (IdeTypeClass (P.disqualify cn) P.kindType []) )

src/Language/PureScript/Ide/Rebuild.hs view

@@ -176,7 +176,7 @@     mkShallowModule P.ExternsFile{..} =       P.Module (P.internalModuleSourceSpan "<rebuild>") [] efModuleName (map mkImport efImports) Nothing     mkImport (P.ExternsImport mn it iq) =-      P.ImportDeclaration mn it iq+      P.ImportDeclaration (P.internalModuleSourceSpan "<rebuild>", []) mn it iq     getExtern mn = M.lookup mn ex     -- Sort a list so its elements appear in the same order as in another list.     inOrderOf :: (Ord a) => [a] -> [a] -> [a]

src/Language/PureScript/Ide/Reexports.hs view

@@ -92,7 +92,7 @@   -> P.DeclarationRef   -> Either P.DeclarationRef [IdeDeclarationAnn] resolveRef decls ref = case ref of-  P.TypeRef tn mdtors ->+  P.TypeRef _ tn mdtors ->     case findRef (anyOf (_IdeDeclType . ideTypeName) (== tn))          <|> findRef (anyOf (_IdeDeclTypeSynonym . ideSynonymName) (== tn)) of       Nothing ->@@ -104,15 +104,15 @@             -- those up ourselfes             findDtors tn           Just dtors -> mapMaybe lookupDtor dtors-  P.ValueRef i ->+  P.ValueRef _ i ->     findWrapped (anyOf (_IdeDeclValue . ideValueIdent) (== i))-  P.ValueOpRef name ->+  P.ValueOpRef _ name ->     findWrapped (anyOf (_IdeDeclValueOperator . ideValueOpName) (== name))-  P.TypeOpRef name ->+  P.TypeOpRef _ name ->     findWrapped (anyOf (_IdeDeclTypeOperator . ideTypeOpName) (== name))-  P.TypeClassRef name ->+  P.TypeClassRef _ name ->     findWrapped (anyOf (_IdeDeclTypeClass . ideTCName) (== name))-  P.KindRef name ->+  P.KindRef _ name ->     findWrapped (anyOf _IdeDeclKind (== name))   _ ->     Left ref

src/Language/PureScript/Ide/SourceFile.hs view

@@ -59,8 +59,8 @@ extractAstInformation   :: P.Module   -> (DefinitionSites P.SourceSpan, TypeAnnotations)-extractAstInformation (P.Module ss _ _ decls _) =-  let definitions = Map.fromList (concatMap (extractSpans ss) decls)+extractAstInformation (P.Module _ _ _ decls _) =+  let definitions = Map.fromList (concatMap extractSpans decls)       typeAnnotations = Map.fromList (extractTypeAnnotations decls)   in (definitions, typeAnnotations) @@ -70,40 +70,35 @@   -> [(P.Ident, P.Type)] extractTypeAnnotations = mapMaybe extract   where-    extract d = case unwrapPositioned d of-      P.TypeDeclaration ident ty -> Just (ident, ty)-      _ -> Nothing+    extract (P.TypeDeclaration _ ident ty) = Just (ident, ty)+    extract _ = Nothing  -- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts -- definition sites inside that Declaration. extractSpans-  :: P.SourceSpan-  -- ^ The surrounding span-  -> P.Declaration+  :: P.Declaration   -- ^ The declaration to extract spans from   -> [(IdeNamespaced, P.SourceSpan)]   -- ^ Declarations and their source locations-extractSpans ss d = case d of-  P.PositionedDeclaration ss' _ d' ->-    extractSpans ss' d'-  P.ValueDeclaration i _ _ _ ->+extractSpans d = case d of+  P.ValueDeclaration (ss, _) i _ _ _ ->     [(IdeNamespaced IdeNSValue (P.runIdent i), ss)]-  P.TypeSynonymDeclaration name _ _ ->+  P.TypeSynonymDeclaration (ss, _) name _ _ ->     [(IdeNamespaced IdeNSType (P.runProperName name), ss)]-  P.TypeClassDeclaration name _ _ _ members ->-    (IdeNamespaced IdeNSType (P.runProperName name), ss) : concatMap (extractSpans' ss) members-  P.DataDeclaration _ name _ ctors ->+  P.TypeClassDeclaration (ss, _) name _ _ _ members ->+    (IdeNamespaced IdeNSType (P.runProperName name), ss) : concatMap extractSpans' members+  P.DataDeclaration (ss, _) _ name _ ctors ->     (IdeNamespaced IdeNSType (P.runProperName name), ss)     : map (\(cname, _) -> (IdeNamespaced IdeNSValue (P.runProperName cname), ss)) ctors-  P.FixityDeclaration (Left (P.ValueFixity _ _ opName)) ->+  P.FixityDeclaration (ss, _) (Left (P.ValueFixity _ _ opName)) ->     [(IdeNamespaced IdeNSValue (P.runOpName opName), ss)]-  P.FixityDeclaration (Right (P.TypeFixity _ _ opName)) ->+  P.FixityDeclaration (ss, _) (Right (P.TypeFixity _ _ opName)) ->     [(IdeNamespaced IdeNSType (P.runOpName opName), ss)]-  P.ExternDeclaration ident _ ->+  P.ExternDeclaration (ss, _) ident _ ->     [(IdeNamespaced IdeNSValue (P.runIdent ident), ss)]-  P.ExternDataDeclaration name _ ->+  P.ExternDataDeclaration (ss, _) name _ ->     [(IdeNamespaced IdeNSType (P.runProperName name), ss)]-  P.ExternKindDeclaration name ->+  P.ExternKindDeclaration (ss, _) name ->     [(IdeNamespaced IdeNSKind (P.runProperName name), ss)]   _ -> []   where@@ -111,9 +106,7 @@     -- typeclass member functions. Typedeclarations would clash with value     -- declarations for non-typeclass members, which is why we can't handle them     -- in extractSpans.-    extractSpans' ssP dP = case dP of-      P.PositionedDeclaration ssP' _ dP' ->-        extractSpans' ssP' dP'-      P.TypeDeclaration ident _ ->-        [(IdeNamespaced IdeNSValue (P.runIdent ident), ssP)]+    extractSpans' dP = case dP of+      P.TypeDeclaration (ss', _) ident _ ->+        [(IdeNamespaced IdeNSValue (P.runIdent ident), ss')]       _ -> []

src/Language/PureScript/Ide/State.hs view

@@ -30,6 +30,7 @@   -- for tests   , resolveOperatorsForModule   , resolveInstances+  , resolveDataConstructorsForModule   ) where  import           Protolude@@ -82,7 +83,7 @@ getFileState :: Ide m => m IdeFileState getFileState = do   st <- ideStateVar <$> ask-  fmap ideFileState . liftIO . readTVarIO $ st+  ideFileState <$> liftIO (readTVarIO st)  -- | STM version of getFileState getFileStateSTM :: TVar IdeState -> STM IdeFileState@@ -93,8 +94,12 @@ getVolatileState :: Ide m => m IdeVolatileState getVolatileState = do   st <- ideStateVar <$> ask-  fmap ideVolatileState . liftIO . readTVarIO $ st+  liftIO (atomically (getVolatileStateSTM st)) +-- | STM version of getVolatileState+getVolatileStateSTM :: TVar IdeState -> STM IdeVolatileState+getVolatileStateSTM st = ideVolatileState <$> readTVar st+ -- | Sets the VolatileState inside Ide's state setVolatileStateSTM :: TVar IdeState -> IdeVolatileState -> STM () setVolatileStateSTM ref vs = do@@ -172,14 +177,17 @@   -> STM (ModuleMap (ReexportResult [IdeDeclarationAnn])) populateVolatileStateSTM ref = do   IdeFileState{fsExterns = externs, fsModules = modules} <- getFileStateSTM ref+  rebuildCache <- vsCachedRebuild <$> getVolatileStateSTM ref   let asts = map (extractAstInformation . fst) modules   let (moduleDeclarations, reexportRefs) = (map fst &&& map snd) (Map.map convertExterns externs)       results =-        resolveLocations asts moduleDeclarations+        moduleDeclarations+        & map resolveDataConstructorsForModule+        & resolveLocations asts         & resolveInstances externs         & resolveOperators         & resolveReexports reexportRefs-  setVolatileStateSTM ref (IdeVolatileState (AstData asts) (map reResolved results) Nothing)+  setVolatileStateSTM ref (IdeVolatileState (AstData asts) (map reResolved results) rebuildCache)   pure results  resolveLocations@@ -306,3 +314,22 @@  mapIf :: Functor f => (b -> Bool) -> (b -> b) -> f b -> f b mapIf p f = map (\x -> if p x then f x else x)++resolveDataConstructorsForModule+  :: [IdeDeclarationAnn]+  -> [IdeDeclarationAnn]+resolveDataConstructorsForModule decls =+  map (idaDeclaration %~ resolveDataConstructors) decls+  where+    resolveDataConstructors :: IdeDeclaration -> IdeDeclaration+    resolveDataConstructors decl = case decl of+      IdeDeclType ty ->+        IdeDeclType (ty & ideTypeDtors .~ fromMaybe [] (Map.lookup (ty^.ideTypeName) dtors))+      _ ->+        decl++    dtors =+      decls+      & mapMaybe (preview (idaDeclaration._IdeDeclDataConstructor))+      & foldr (\(IdeDataConstructor name typeName type') ->+                  Map.insertWith (<>) typeName [(name, type')]) Map.empty

src/Language/PureScript/Ide/Types.hs view

@@ -48,6 +48,7 @@ data IdeType = IdeType  { _ideTypeName :: P.ProperName 'P.TypeName  , _ideTypeKind :: P.Kind+ , _ideTypeDtors :: [(P.ProperName 'P.ConstructorName, P.Type)]  } deriving (Show, Eq, Ord)  data IdeTypeSynonym = IdeTypeSynonym@@ -204,16 +205,16 @@            , "expandedType" .= complExpandedType            , "definedAt" .= complLocation            , "documentation" .= complDocumentation-           , "exportedFrom" .= complExportedFrom+           , "exportedFrom" .= map P.runModuleName complExportedFrom            ]  identifierFromDeclarationRef :: P.DeclarationRef -> Text-identifierFromDeclarationRef (P.TypeRef name _) = P.runProperName name-identifierFromDeclarationRef (P.ValueRef ident) = P.runIdent ident-identifierFromDeclarationRef (P.TypeClassRef name) = P.runProperName name-identifierFromDeclarationRef (P.KindRef name) = P.runProperName name-identifierFromDeclarationRef (P.ValueOpRef op) = P.showOp op-identifierFromDeclarationRef (P.TypeOpRef op) = P.showOp op+identifierFromDeclarationRef (P.TypeRef _ name _) = P.runProperName name+identifierFromDeclarationRef (P.ValueRef _ ident) = P.runIdent ident+identifierFromDeclarationRef (P.TypeClassRef _ name) = P.runProperName name+identifierFromDeclarationRef (P.KindRef _ name) = P.runProperName name+identifierFromDeclarationRef (P.ValueOpRef _ op) = P.showOp op+identifierFromDeclarationRef (P.TypeOpRef _ op) = P.showOp op identifierFromDeclarationRef _ = ""  data Success =

src/Language/PureScript/Ide/Util.hs view

@@ -15,8 +15,6 @@ module Language.PureScript.Ide.Util   ( identifierFromIdeDeclaration   , unwrapMatch-  , unwrapPositioned-  , unwrapPositionedRef   , namespaceForDeclaration   , encodeT   , decodeT@@ -91,14 +89,6 @@  decodeT :: (FromJSON a) => Text -> Maybe a decodeT = decode . TLE.encodeUtf8 . TL.fromStrict--unwrapPositioned :: P.Declaration -> P.Declaration-unwrapPositioned (P.PositionedDeclaration _ _ x) = unwrapPositioned x-unwrapPositioned x = x--unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef-unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = unwrapPositionedRef x-unwrapPositionedRef x = x  properNameT :: Iso' (P.ProperName a) Text properNameT = iso P.runProperName P.ProperName

src/Language/PureScript/Interactive.hs view

@@ -40,6 +40,7 @@  import           System.Directory (getCurrentDirectory) import           System.FilePath ((</>))+import           System.FilePath.Glob (glob)  -- | Pretty-print errors printErrors :: MonadIO m => P.MultipleErrors -> m ()@@ -118,7 +119,8 @@   -> m () handleReloadState reload = do   modify $ updateLets (const [])-  files <- asks psciLoadedFiles+  globs <- asks psciFileGlobs+  files <- liftIO $ concat <$> traverse glob globs   e <- runExceptT $ do     modules <- ExceptT . liftIO $ loadAllModules files     (externs, _) <- ExceptT . liftIO . runMake . make $ modules@@ -202,26 +204,24 @@   refsList refs = " (" <> commaList (mapMaybe showRef refs) <> ")"    showRef :: P.DeclarationRef -> Maybe Text-  showRef (P.TypeRef pn dctors) =+  showRef (P.TypeRef _ pn dctors) =     Just $ N.runProperName pn <> "(" <> maybe ".." (commaList . map N.runProperName) dctors <> ")"-  showRef (P.TypeOpRef op) =+  showRef (P.TypeOpRef _ op) =     Just $ "type " <> N.showOp op-  showRef (P.ValueRef ident) =+  showRef (P.ValueRef _ ident) =     Just $ N.runIdent ident-  showRef (P.ValueOpRef op) =+  showRef (P.ValueOpRef _ op) =     Just $ N.showOp op-  showRef (P.TypeClassRef pn) =+  showRef (P.TypeClassRef _ pn) =     Just $ "class " <> N.runProperName pn-  showRef (P.TypeInstanceRef ident) =+  showRef (P.TypeInstanceRef _ ident) =     Just $ N.runIdent ident-  showRef (P.ModuleRef name) =+  showRef (P.ModuleRef _ name) =     Just $ "module " <> N.runModuleName name-  showRef (P.KindRef pn) =+  showRef (P.KindRef _ pn) =     Just $ "kind " <> N.runProperName pn-  showRef (P.ReExportRef _ _) =+  showRef (P.ReExportRef _ _ _) =     Nothing-  showRef (P.PositionedDeclarationRef _ _ ref) =-    showRef ref    commaList :: [Text] -> Text   commaList = T.intercalate ", "

src/Language/PureScript/Interactive/Completion.hs view

@@ -197,28 +197,25 @@ typeDecls = mapMaybe getTypeName . filter P.isDataDecl . P.exportedDeclarations   where   getTypeName :: P.Declaration -> Maybe (N.ProperName 'N.TypeName, P.Declaration)-  getTypeName d@(P.TypeSynonymDeclaration name _ _) = Just (name, d)-  getTypeName d@(P.DataDeclaration _ name _ _) = Just (name, d)-  getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d+  getTypeName d@(P.TypeSynonymDeclaration _ name _ _) = Just (name, d)+  getTypeName d@(P.DataDeclaration _ _ name _ _) = Just (name, d)   getTypeName _ = Nothing  identNames :: P.Module -> [(N.Ident, P.Declaration)] identNames = nubOnFst . concatMap getDeclNames . P.exportedDeclarations   where   getDeclNames :: P.Declaration -> [(P.Ident, P.Declaration)]-  getDeclNames d@(P.ValueDeclaration ident _ _ _)  = [(ident, d)]-  getDeclNames d@(P.TypeDeclaration ident _ ) = [(ident, d)]-  getDeclNames d@(P.ExternDeclaration ident _) = [(ident, d)]-  getDeclNames d@(P.TypeClassDeclaration _ _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds-  getDeclNames (P.PositionedDeclaration _ _ d) = getDeclNames d+  getDeclNames d@(P.ValueDeclaration _ ident _ _ _)  = [(ident, d)]+  getDeclNames d@(P.TypeDeclaration _ ident _ ) = [(ident, d)]+  getDeclNames d@(P.ExternDeclaration _ ident _) = [(ident, d)]+  getDeclNames d@(P.TypeClassDeclaration _ _ _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds   getDeclNames _ = []  dctorNames :: P.Module -> [(N.ProperName 'N.ConstructorName, P.Declaration)] dctorNames = nubOnFst . concatMap go . P.exportedDeclarations   where   go :: P.Declaration -> [(N.ProperName 'N.ConstructorName, P.Declaration)]-  go decl@(P.DataDeclaration _ _ _ ctors) = map ((\n -> (n, decl)) . fst) ctors-  go (P.PositionedDeclaration _ _ d) = go d+  go decl@(P.DataDeclaration _ _ _ _ ctors) = map ((\n -> (n, decl)) . fst) ctors   go _ = []  moduleNames :: [P.Module] -> [String]

src/Language/PureScript/Interactive/Module.hs view

@@ -51,17 +51,16 @@     supportImport = (supportModuleName, P.Implicit, Just (P.ModuleName [P.ProperName "$Support"]))     eval          = P.Var (P.Qualified (Just (P.ModuleName [P.ProperName "$Support"])) (P.Ident "eval"))     mainValue     = P.App eval (P.Var (P.Qualified Nothing (P.Ident "it")))-    itDecl        = P.ValueDeclaration (P.Ident "it") P.Public [] [P.MkUnguarded val]-    typeDecl      = P.TypeDeclaration (P.Ident "$main")+    itDecl        = P.ValueDeclaration (internalSpan, []) (P.Ident "it") P.Public [] [P.MkUnguarded val]+    typeDecl      = P.TypeDeclaration (internalSpan, []) (P.Ident "$main")                       (P.TypeApp                         (P.TypeApp                           (P.TypeConstructor                             (P.Qualified (Just (P.ModuleName [P.ProperName "$Eff"])) (P.ProperName "Eff")))                               (P.TypeWildcard internalSpan))                                 (P.TypeWildcard internalSpan))-    mainDecl      = P.ValueDeclaration (P.Ident "$main") P.Public [] [P.MkUnguarded mainValue]+    mainDecl      = P.ValueDeclaration (internalSpan, []) (P.Ident "$main") P.Public [] [P.MkUnguarded mainValue]     decls         = if exec then [itDecl, typeDecl, mainDecl] else [itDecl]-    internalSpan  = P.internalModuleSourceSpan "<internal>"   in     P.Module internalSpan              [] moduleName@@ -76,9 +75,9 @@ createTemporaryModuleForKind PSCiState{psciImportedModules = imports, psciLetBindings = lets} typ =   let     moduleName = P.ModuleName [P.ProperName "$PSCI"]-    itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ+    itDecl = P.TypeSynonymDeclaration (internalSpan, []) (P.ProperName "IT") [] typ   in-    P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ [itDecl]) Nothing+    P.Module internalSpan [] moduleName ((importDecl `map` imports) ++ lets ++ [itDecl]) Nothing  -- | -- Makes a volatile module to execute the current imports.@@ -88,13 +87,16 @@   let     moduleName = P.ModuleName [P.ProperName "$PSCI"]   in-    P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName (importDecl `map` imports) Nothing+    P.Module internalSpan [] moduleName (importDecl `map` imports) Nothing  importDecl :: ImportedModule -> P.Declaration-importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ+importDecl (mn, declType, asQ) = P.ImportDeclaration (internalSpan, []) mn declType asQ  indexFile :: FilePath indexFile = ".psci_modules" ++ pathSeparator : "index.js"  modulesDir :: FilePath modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"++internalSpan :: P.SourceSpan+internalSpan = P.internalModuleSourceSpan "<internal>"

src/Language/PureScript/Interactive/Parser.hs view

@@ -88,14 +88,10 @@ -- (like import declarations). psciDeclaration :: P.TokenParser Command psciDeclaration = fmap Decls $ mark $ many1 $ same *> do-  decl <- discardPositionInfo <$> P.parseDeclaration+  decl <- P.parseDeclaration   if acceptable decl     then return decl     else fail "this kind of declaration is not supported in psci"--discardPositionInfo :: P.Declaration -> P.Declaration-discardPositionInfo (P.PositionedDeclaration _ _ d) = d-discardPositionInfo d = d  acceptable :: P.Declaration -> Bool acceptable P.DataDeclaration{} = True

src/Language/PureScript/Interactive/Types.hs view

@@ -12,7 +12,7 @@ -- These configuration values do not change during execution. -- data PSCiConfig = PSCiConfig-  { psciLoadedFiles         :: [FilePath]+  { psciFileGlobs           :: [String]   , psciEnvironment         :: P.Environment   } deriving Show

src/Language/PureScript/Linter.hs view

@@ -32,11 +32,10 @@   moduleNames = S.fromList (ordNub (mapMaybe getDeclIdent ds))    getDeclIdent :: Declaration -> Maybe Ident-  getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d-  getDeclIdent (ValueDeclaration ident _ _ _) = Just ident-  getDeclIdent (ExternDeclaration ident _) = Just ident-  getDeclIdent (TypeInstanceDeclaration ident _ _ _ _) = Just ident-  getDeclIdent (BindingGroupDeclaration _) = internalError "lint: binding groups should not be desugared yet."+  getDeclIdent (ValueDeclaration _ ident _ _ _) = Just ident+  getDeclIdent (ExternDeclaration _ ident _) = Just ident+  getDeclIdent (TypeInstanceDeclaration _ ident _ _ _ _) = Just ident+  getDeclIdent BindingGroupDeclaration{} = internalError "lint: binding groups should not be desugared yet."   getDeclIdent _ = Nothing    lintDeclaration :: Declaration -> m ()@@ -45,14 +44,12 @@     (warningsInDecl, _, _, _, _) = everythingWithScope (\_ _ -> mempty) stepE stepB (\_ _ -> mempty) stepDo      f :: Declaration -> MultipleErrors-    f (PositionedDeclaration pos _ dec) = addHint (PositionedError pos) (f dec)-    f (TypeClassDeclaration name args _ _ decs) = addHint (ErrorInTypeClassDeclaration name) (foldMap (f' (S.fromList $ fst <$> args)) decs)+    f (TypeClassDeclaration _ name args _ _ decs) = addHint (ErrorInTypeClassDeclaration name) (foldMap (f' (S.fromList $ fst <$> args)) decs)     f dec = f' S.empty dec      f' :: S.Set Text -> Declaration -> MultipleErrors-    f' s (PositionedDeclaration pos _ dec) = addHint (PositionedError pos) (f' s dec)-    f' s dec@(ValueDeclaration name _ _ _) = addHint (ErrorInValueDeclaration name) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec)-    f' s (TypeDeclaration name ty) = addHint (ErrorInTypeDeclaration name) (checkTypeVars s ty)+    f' s dec@(ValueDeclaration _ name _ _ _) = addHint (ErrorInValueDeclaration name) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec)+    f' s (TypeDeclaration _ name ty) = addHint (ErrorInTypeDeclaration name) (checkTypeVars s ty)     f' s dec = warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec      stepE :: S.Set Ident -> Expr -> MultipleErrors

src/Language/PureScript/Linter/Exhaustive.hs view

@@ -242,13 +242,14 @@ checkExhaustive   :: forall m    . (MonadWriter MultipleErrors m, MonadSupply m)-   => Environment+   => SourceSpan+   -> Environment    -> ModuleName    -> Int    -> [CaseAlternative]    -> Expr    -> m Expr-checkExhaustive env mn numArgs cas expr = makeResult . first ordNub $ foldl' step ([initialize numArgs], (pure True, [])) cas+checkExhaustive ss env mn numArgs cas expr = makeResult . first ordNub $ foldl' step ([initialize numArgs], (pure True, [])) cas   where   step :: ([[Binder]], (Either RedundancyError Bool, [[Binder]])) -> CaseAlternative -> ([[Binder]], (Either RedundancyError Bool, [[Binder]]))   step (uncovered, (nec, redundant)) ca =@@ -274,8 +275,8 @@          then return expr          else addPartialConstraint (second null (splitAt 5 bss)) expr     where-      tellRedundant = tell . errorMessage . uncurry OverlappingPattern . second null . splitAt 5 $ bss'-      tellIncomplete = tell . errorMessage $ IncompleteExhaustivityCheck+      tellRedundant = tell . errorMessage' ss . uncurry OverlappingPattern . second null . splitAt 5 $ bss'+      tellIncomplete = tell . errorMessage' ss $ IncompleteExhaustivityCheck    -- | We add a Partial constraint by adding a call to the following identity function:   --@@ -294,7 +295,7 @@     where       partial :: Text -> Text -> Declaration       partial var tyVar =-        ValueDeclaration (Ident C.__unused) Private [] $+        ValueDeclaration (ss, []) (Ident C.__unused) Private [] $         [MkUnguarded           (TypedValue            True@@ -321,41 +322,41 @@ checkExhaustiveExpr   :: forall m    . (MonadWriter MultipleErrors m, MonadSupply m)-   => Environment+   => SourceSpan+   -> Environment    -> ModuleName    -> Expr    -> m Expr-checkExhaustiveExpr env mn = onExpr+checkExhaustiveExpr initSS env mn = onExpr initSS   where   onDecl :: Declaration -> m Declaration-  onDecl (BindingGroupDeclaration bs) = BindingGroupDeclaration <$> mapM (thirdM onExpr) bs-  onDecl (ValueDeclaration name x y [MkUnguarded e]) = ValueDeclaration name x y . mkUnguardedExpr <$> censor (addHint (ErrorInValueDeclaration name)) (onExpr e)-  onDecl (PositionedDeclaration pos x dec) = PositionedDeclaration pos x <$> censor (addHint (PositionedError pos)) (onDecl dec)+  onDecl (BindingGroupDeclaration bs) = BindingGroupDeclaration <$> mapM (\(sai@((ss, _), _), nk, expr) -> (sai, nk,) <$> onExpr ss expr) bs+  onDecl (ValueDeclaration sa@(ss, _) name x y [MkUnguarded e]) = ValueDeclaration sa name x y . mkUnguardedExpr <$> censor (addHint (ErrorInValueDeclaration name)) (onExpr ss e)   onDecl decl = return decl -  onExpr :: Expr -> m Expr-  onExpr (UnaryMinus e) = UnaryMinus <$> onExpr e-  onExpr (Literal (ArrayLiteral es)) = Literal . ArrayLiteral <$> mapM onExpr es-  onExpr (Literal (ObjectLiteral es)) = Literal . ObjectLiteral <$> mapM (sndM onExpr) es-  onExpr (TypeClassDictionaryConstructorApp x e) = TypeClassDictionaryConstructorApp x <$> onExpr e-  onExpr (Accessor x e) = Accessor x <$> onExpr e-  onExpr (ObjectUpdate o es) = ObjectUpdate <$> onExpr o <*> mapM (sndM onExpr) es-  onExpr (Abs x e) = Abs x <$> onExpr e-  onExpr (App e1 e2) = App <$> onExpr e1 <*> onExpr e2-  onExpr (IfThenElse e1 e2 e3) = IfThenElse <$> onExpr e1 <*> onExpr e2 <*> onExpr e3-  onExpr (Case es cas) = do-    case' <- Case <$> mapM onExpr es <*> mapM onCaseAlternative cas-    checkExhaustive env mn (length es) cas case'-  onExpr (TypedValue x e y) = TypedValue x <$> onExpr e <*> pure y-  onExpr (Let ds e) = Let <$> mapM onDecl ds <*> onExpr e-  onExpr (PositionedValue pos x e) = PositionedValue pos x <$> censor (addHint (PositionedError pos)) (onExpr e)-  onExpr expr = return expr+  onExpr :: SourceSpan -> Expr -> m Expr+  onExpr ss (UnaryMinus e) = UnaryMinus <$> onExpr ss e+  onExpr ss (Literal (ArrayLiteral es)) = Literal . ArrayLiteral <$> mapM (onExpr ss) es+  onExpr ss (Literal (ObjectLiteral es)) = Literal . ObjectLiteral <$> mapM (sndM (onExpr ss)) es+  onExpr ss (TypeClassDictionaryConstructorApp x e) = TypeClassDictionaryConstructorApp x <$> onExpr ss e+  onExpr ss (Accessor x e) = Accessor x <$> onExpr ss e+  onExpr ss (ObjectUpdate o es) = ObjectUpdate <$> onExpr ss o <*> mapM (sndM (onExpr ss)) es+  onExpr ss (Abs x e) = Abs x <$> onExpr ss e+  onExpr ss (App e1 e2) = App <$> onExpr ss e1 <*> onExpr ss e2+  onExpr ss (IfThenElse e1 e2 e3) = IfThenElse <$> onExpr ss e1 <*> onExpr ss e2 <*> onExpr ss e3+  onExpr ss (Case es cas) = do+    case' <- Case <$> mapM (onExpr ss) es <*> mapM (onCaseAlternative ss) cas+    checkExhaustive ss env mn (length es) cas case'+  onExpr ss (TypedValue x e y) = TypedValue x <$> onExpr ss e <*> pure y+  onExpr ss (Let ds e) = Let <$> mapM onDecl ds <*> onExpr ss e+  onExpr _ (PositionedValue ss x e) = PositionedValue ss x <$> onExpr ss e+  onExpr _ expr = return expr -  onCaseAlternative :: CaseAlternative -> m CaseAlternative-  onCaseAlternative (CaseAlternative x [MkUnguarded e]) = CaseAlternative x . mkUnguardedExpr <$> onExpr e-  onCaseAlternative (CaseAlternative x es) = CaseAlternative x <$> mapM onGuardedExpr es+  onCaseAlternative :: SourceSpan -> CaseAlternative -> m CaseAlternative+  onCaseAlternative ss (CaseAlternative x [MkUnguarded e]) = CaseAlternative x . mkUnguardedExpr <$> onExpr ss e+  onCaseAlternative ss (CaseAlternative x es) = CaseAlternative x <$> mapM (onGuardedExpr ss) es -  onGuardedExpr :: GuardedExpr -> m GuardedExpr-  onGuardedExpr (GuardedExpr guard rhs) = GuardedExpr guard <$> onExpr rhs+  onGuardedExpr :: SourceSpan -> GuardedExpr -> m GuardedExpr+  onGuardedExpr ss (GuardedExpr guard rhs) = GuardedExpr guard <$> onExpr ss rhs    mkUnguardedExpr = pure . MkUnguarded

src/Language/PureScript/Linter/Imports.hs view

@@ -13,7 +13,7 @@ import Data.Function (on) import Data.Foldable (for_) import Data.List (find, intersect, groupBy, sortBy, (\\))-import Data.Maybe (mapMaybe, fromMaybe)+import Data.Maybe (mapMaybe) import Data.Monoid (Sum(..)) import Data.Traversable (forM) import qualified Data.Text as T@@ -58,33 +58,31 @@   -> m () lintImports (Module _ _ _ _ Nothing) _ _ =   internalError "lintImports needs desugared exports"-lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do+lintImports (Module _ _ mn mdecls (Just mexports)) env usedImps = do    -- TODO: this needs some work to be easier to understand -  let scope = maybe primImports (\(_, imps', _) -> imps') (M.lookup mn env)+  let scope = maybe nullImports (\(_, imps', _) -> imps') (M.lookup mn env)       usedImps' = foldr (elaborateUsed scope) usedImps exportedModules       numOpenImports = getSum $ foldMap (Sum . countOpenImports) mdecls       allowImplicit = numOpenImports == 1       imports = M.toAscList (findImports mdecls)    for_ imports $ \(mni, decls) ->-    unless (isPrim mni) $-      for_ decls $ \(ss', declType, qualifierName) ->-        maybe id warnWithPosition ss' $ do-          let names = ordNub $ M.findWithDefault [] mni usedImps'-          lintImportDecl env mni qualifierName names declType allowImplicit+    unless (isPrim mni) .+      for_ decls $ \(ss, declType, qualifierName) -> do+        let names = ordNub $ M.findWithDefault [] mni usedImps'+        lintImportDecl env mni qualifierName names ss declType allowImplicit    for_ (M.toAscList (byQual imports)) $ \(mnq, entries) -> do     let mnis = ordNub $ map (\(_, _, mni) -> mni) entries     unless (length mnis == 1) $ do       let implicits = filter (\(_, declType, _) -> not $ isExplicit declType) entries-      for_ implicits $ \(ss', _, mni) ->-        maybe id warnWithPosition ss' $ do-          let names = ordNub $ M.findWithDefault [] mni usedImps'-              usedRefs = findUsedRefs env mni (Just mnq) names-          unless (null usedRefs) $-            tell $ errorMessage $ ImplicitQualifiedImport mni mnq usedRefs+      for_ implicits $ \(ss, _, mni) -> do+        let names = ordNub $ M.findWithDefault [] mni usedImps'+            usedRefs = findUsedRefs ss env mni (Just mnq) names+        unless (null usedRefs) .+          tell . errorMessage' ss $ ImplicitQualifiedImport mni mnq usedRefs    for_ imports $ \(mnq, imps) -> do @@ -100,11 +98,10 @@           $ unwarned      for_ duplicates $ \(pos, _, _) ->-      maybe id warnWithPosition pos $-        tell $ errorMessage $ DuplicateSelectiveImport mnq+      tell . errorMessage' pos $ DuplicateSelectiveImport mnq      for_ (imps \\ (warned ++ duplicates)) $ \(pos, typ, _) ->-      warnDuplicateRefs (fromMaybe ss pos) DuplicateImportRef $ case typ of+      warnDuplicateRefs pos DuplicateImportRef $ case typ of         Explicit refs -> refs         Hiding refs -> refs         _ -> []@@ -119,10 +116,9 @@   selfCartesianSubset [] = []    countOpenImports :: Declaration -> Int-  countOpenImports (PositionedDeclaration _ _ d) = countOpenImports d-  countOpenImports (ImportDeclaration mn' Implicit Nothing)+  countOpenImports (ImportDeclaration _ mn' Implicit Nothing)     | not (isPrim mn' || mn == mn') = 1-  countOpenImports (ImportDeclaration mn' (Hiding _) Nothing)+  countOpenImports (ImportDeclaration _ mn' (Hiding _) Nothing)     | not (isPrim mn' || mn == mn') = 1   countOpenImports _ = 0 @@ -135,8 +131,8 @@   -- import to that module, with the corresponding source span, import type,   -- and module being imported   byQual-    :: [(ModuleName, [(Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)])]-    -> M.Map ModuleName [(Maybe SourceSpan, ImportDeclarationType, ModuleName)]+    :: [(ModuleName, [(SourceSpan, ImportDeclarationType, Maybe ModuleName)])]+    -> M.Map ModuleName [(SourceSpan, ImportDeclarationType, ModuleName)]   byQual = foldr goImp M.empty     where     goImp (mni, xs) acc = foldr (goDecl mni) acc xs@@ -150,8 +146,7 @@   exportedModules :: [ModuleName]   exportedModules = ordNub $ mapMaybe extractModule mexports     where-    extractModule (PositionedDeclarationRef _ _ r) = extractModule r-    extractModule (ModuleRef mne) = Just mne+    extractModule (ModuleRef _ mne) = Just mne     extractModule _ = Nothing    -- Elaborates the UsedImports to include values from modules that are being@@ -195,10 +190,11 @@   -> ModuleName   -> Maybe ModuleName   -> [Qualified Name]+  -> SourceSpan   -> ImportDeclarationType   -> Bool   -> m Bool-lintImportDecl env mni qualifierName names declType allowImplicit =+lintImportDecl env mni qualifierName names ss declType allowImplicit =   case declType of     Implicit -> case qualifierName of       Nothing ->@@ -224,8 +220,8 @@     -- used constructors explicity `T(X, Y, [...])` to `T(..)` for suggestion     -- message.     simplifyTypeRef :: DeclarationRef -> DeclarationRef-    simplifyTypeRef (TypeRef name (Just dctors))-      | not (null dctors) = TypeRef name Nothing+    simplifyTypeRef (TypeRef ss' name (Just dctors))+      | not (null dctors) = TypeRef ss' name Nothing     simplifyTypeRef other = other    checkExplicit@@ -250,7 +246,7 @@           (_, []) | c /= Just [] -> warn (UnusedDctorImport mni tn qualifierName allRefs)           (Just ctors, dctors') ->             let ddiff = ctors \\ dctors'-            in unless' (null ddiff) $ warn $ UnusedDctorExplicitImport mni tn ddiff qualifierName allRefs+            in unless' (null ddiff) . warn $ UnusedDctorExplicitImport mni tn ddiff qualifierName allRefs           _ -> return False      return (didWarn || or didWarn')@@ -259,7 +255,7 @@   unused = warn (UnusedImport mni)    warn :: SimpleErrorMessage -> m Bool-  warn err = tell (errorMessage err) >> return True+  warn err = tell (errorMessage' ss err) >> return True    -- Unless the boolean is true, run the action. Return false when the action is   -- not run, otherwise return whatever the action does.@@ -272,7 +268,7 @@   unless' True _ = return False    allRefs :: [DeclarationRef]-  allRefs = findUsedRefs env mni qualifierName names+  allRefs = findUsedRefs ss env mni qualifierName names    dtys     :: ModuleName@@ -292,24 +288,25 @@   typeForDCtor mn pn = fst <$> find (elem pn . fst . snd) (M.toList (dtys mn))  findUsedRefs-  :: Env+  :: SourceSpan+  -> Env   -> ModuleName   -> Maybe ModuleName   -> [Qualified Name]   -> [DeclarationRef]-findUsedRefs env mni qn names =+findUsedRefs ss env mni qn names =   let-    classRefs = TypeClassRef <$> mapMaybe (getClassName <=< disqualifyFor qn) names-    valueRefs = ValueRef <$> mapMaybe (getIdentName <=< disqualifyFor qn) names-    valueOpRefs = ValueOpRef <$> mapMaybe (getValOpName <=< disqualifyFor qn) names-    typeOpRefs = TypeOpRef <$> mapMaybe (getTypeOpName <=< disqualifyFor qn) names+    classRefs = TypeClassRef ss <$> mapMaybe (getClassName <=< disqualifyFor qn) names+    valueRefs = ValueRef ss <$> mapMaybe (getIdentName <=< disqualifyFor qn) names+    valueOpRefs = ValueOpRef ss <$> mapMaybe (getValOpName <=< disqualifyFor qn) names+    typeOpRefs = TypeOpRef ss <$> mapMaybe (getTypeOpName <=< disqualifyFor qn) names     types = mapMaybe (getTypeName <=< disqualifyFor qn) names     dctors = mapMaybe (getDctorName <=< disqualifyFor qn) names     typesWithDctors = reconstructTypeRefs dctors     typesWithoutDctors = filter (`M.notMember` typesWithDctors) types     typesRefs-      = map (flip TypeRef (Just [])) typesWithoutDctors-      ++ map (\(ty, ds) -> TypeRef ty (Just ds)) (M.toList typesWithDctors)+      = map (flip (TypeRef ss) (Just [])) typesWithoutDctors+      ++ map (\(ty, ds) -> TypeRef ss ty (Just ds)) (M.toList typesWithDctors)   in sortBy compDecRef $ classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs ++ valueOpRefs    where@@ -343,12 +340,11 @@ matchName _ name = Just name  runDeclRef :: DeclarationRef -> Maybe Name-runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref-runDeclRef (ValueRef ident) = Just $ IdentName ident-runDeclRef (ValueOpRef op) = Just $ ValOpName op-runDeclRef (TypeRef pn _) = Just $ TyName pn-runDeclRef (TypeOpRef op) = Just $ TyOpName op-runDeclRef (TypeClassRef pn) = Just $ TyClassName pn+runDeclRef (ValueRef _ ident) = Just $ IdentName ident+runDeclRef (ValueOpRef _ op) = Just $ ValOpName op+runDeclRef (TypeRef _ pn _) = Just $ TyName pn+runDeclRef (TypeOpRef _ op) = Just $ TyOpName op+runDeclRef (TypeClassRef _ pn) = Just $ TyClassName pn runDeclRef _ = Nothing  checkDuplicateImports@@ -360,7 +356,6 @@ checkDuplicateImports mn xs ((_, t1, q1), (pos, t2, q2)) =   if t1 == t2 && q1 == q2   then do-    maybe id warnWithPosition pos $-      tell $ errorMessage $ DuplicateImport mn t2 q2+    tell . errorMessage' pos $ DuplicateImport mn t2 q2     return $ (pos, t2, q2) : xs   else return xs

src/Language/PureScript/Make.hs view

@@ -68,7 +68,6 @@ import qualified Language.PureScript.Bundle as Bundle import qualified Language.PureScript.CodeGen.JS as J import           Language.PureScript.CodeGen.JS.Printer-import qualified Language.PureScript.Constants as C import qualified Language.PureScript.CoreFn as CF import qualified Language.PureScript.CoreFn.ToJSON as CFJ import qualified Language.PureScript.CoreImp.AST as Imp@@ -258,9 +257,6 @@     externs <- decode bs     guard $ T.unpack (efVersion externs) == showVersion Paths.version     return externs--importPrim :: Module -> Module-importPrim = addDefaultImport (ModuleName [ProperName C.prim])  -- | A monad for running make actions newtype Make a = Make

src/Language/PureScript/ModuleDependencies.hs view

@@ -4,9 +4,10 @@   , ModuleGraph   ) where -import           Protolude+import           Protolude hiding (head)  import           Data.Graph+import           Data.List (head) import qualified Data.Set as S import           Language.PureScript.AST import qualified Language.PureScript.Constants as C@@ -41,24 +42,25 @@     toGraphNode mns m@(Module _ _ mn ds _) = do       let deps = ordNub (mapMaybe usedModules ds)       void . parU deps $ \(dep, pos) ->-        when (dep /= C.Prim && S.notMember dep mns) $+        when (dep /= C.Prim && S.notMember dep mns) .           throwError             . addHint (ErrorInModule mn)-            . maybe identity (addHint . PositionedError) pos-            . errorMessage+            . errorMessage' pos             $ ModuleNotFound dep       pure (m, getModuleName m, map fst deps)  -- | Calculate a list of used modules based on explicit imports and qualified names.-usedModules :: Declaration -> Maybe (ModuleName, Maybe SourceSpan)+usedModules :: Declaration -> Maybe (ModuleName, SourceSpan) -- Regardless of whether an imported module is qualified we still need to -- take into account its import to build an accurate list of dependencies.-usedModules (ImportDeclaration mn _ _) = pure (mn, Nothing)-usedModules (PositionedDeclaration ss _ d) = fmap (second (const (Just ss))) (usedModules d)+usedModules (ImportDeclaration (ss, _) mn _ _) = pure (mn, ss) usedModules _ = Nothing  -- | Convert a strongly connected component of the module graph to a module toModule :: MonadError MultipleErrors m => SCC Module -> m Module toModule (AcyclicSCC m) = return m toModule (CyclicSCC [m]) = return m-toModule (CyclicSCC ms) = throwError . errorMessage $ CycleInModules (map getModuleName ms)+toModule (CyclicSCC ms) =+  throwError+    . errorMessage' (getModuleSourceSpan (head ms))+    $ CycleInModules (map getModuleName ms)

src/Language/PureScript/Parser/Common.hs view

@@ -133,8 +133,8 @@   -> P.Parsec [PositionedToken] u a   -> P.Parsec [PositionedToken] u b withSourceSpan f p = do-  start <- P.getPosition   comments <- readComments+  start <- P.getPosition   x <- p   end <- P.getPosition   input <- P.getInput@@ -143,3 +143,14 @@         _ -> Nothing   let sp = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos $ fromMaybe end end')   return $ f sp comments x++withSourceAnnF+  :: P.Parsec [PositionedToken] u (SourceAnn -> a)+  -> P.Parsec [PositionedToken] u a+withSourceAnnF = withSourceSpan (\ss com f -> f (ss, com))++withSourceSpan'+  :: (SourceSpan -> a -> b)+  -> P.Parsec [PositionedToken] u a+  -> P.Parsec [PositionedToken] u b+withSourceSpan' f = withSourceSpan (\ss _ -> f ss)

src/Language/PureScript/Parser/Declarations.hs view

@@ -24,6 +24,7 @@ import           Control.Parallel.Strategies (withStrategy, parList, rseq) import           Data.Functor (($>)) import           Data.Maybe (fromMaybe)+import           Data.Monoid ((<>)) import qualified Data.Set as S import           Data.Text (Text) import           Language.PureScript.AST@@ -45,25 +46,27 @@           <|> parens ((,) <$> identifier <*> (Just <$> (indented *> doubleColon *> indented *> parseKind)))  parseDataDeclaration :: TokenParser Declaration-parseDataDeclaration = do+parseDataDeclaration = withSourceAnnF $ do   dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)   name <- indented *> typeName   tyArgs <- many (indented *> kindedIdent)   ctors <- P.option [] $ do     indented *> equals     P.sepBy1 ((,) <$> dataConstructorName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe-  return $ DataDeclaration dtype name tyArgs ctors+  return $ \sa -> DataDeclaration sa dtype name tyArgs ctors  parseTypeDeclaration :: TokenParser Declaration-parseTypeDeclaration =-  TypeDeclaration <$> P.try (parseIdent <* indented <* doubleColon)-                  <*> parsePolyType+parseTypeDeclaration = withSourceAnnF $ do+  name <- P.try (parseIdent <* indented <* doubleColon)+  ty <- parsePolyType+  return $ \sa -> TypeDeclaration sa name ty  parseTypeSynonymDeclaration :: TokenParser Declaration-parseTypeSynonymDeclaration =-  TypeSynonymDeclaration <$> (reserved "type" *> indented *> typeName)-                         <*> many (indented *> kindedIdent)-                         <*> (indented *> equals *> noWildcards parsePolyType)+parseTypeSynonymDeclaration = withSourceAnnF $ do+  name <- reserved "type" *> indented *> typeName+  vars <- many (indented *> kindedIdent)+  ty <- indented *> equals *> noWildcards parsePolyType+  return $ \sa -> TypeSynonymDeclaration sa name vars ty  parseValueWithWhereClause :: TokenParser Expr parseValueWithWhereClause = do@@ -76,7 +79,7 @@     mark $ P.many1 (same *> parseLocalDeclaration)   return $ maybe value (`Let` value) whereClause -parseValueWithIdentAndBinders :: Ident -> [Binder] -> TokenParser Declaration+parseValueWithIdentAndBinders :: Ident -> [Binder] -> TokenParser (SourceAnn -> Declaration) parseValueWithIdentAndBinders ident bs = do   value <- indented *> (     (\v -> [MkUnguarded v]) <$> (equals *> withSourceSpan PositionedValue parseValueWithWhereClause) <|>@@ -84,34 +87,43 @@                            <*> (indented *> equals                                          *> withSourceSpan PositionedValue parseValueWithWhereClause))     )-  return $ ValueDeclaration ident Public bs value+  return $ \sa -> ValueDeclaration sa ident Public bs value  parseValueDeclaration :: TokenParser Declaration-parseValueDeclaration = do+parseValueDeclaration = withSourceAnnF $ do   ident <- parseIdent   binders <- P.many parseBinderNoParens   parseValueWithIdentAndBinders ident binders  parseLocalValueDeclaration :: TokenParser Declaration-parseLocalValueDeclaration = join $ go <$> parseBinder <*> (P.many parseBinderNoParens)+parseLocalValueDeclaration = withSourceAnnF .+    join $ go <$> parseBinder <*> P.many parseBinderNoParens   where-  go :: Binder -> [Binder] -> TokenParser Declaration+  go :: Binder -> [Binder] -> TokenParser (SourceAnn -> Declaration)   go (VarBinder ident) bs = parseValueWithIdentAndBinders ident bs   go (PositionedBinder _ _ b) bs = go b bs-  go binder [] = BoundValueDeclaration binder <$> (indented *> equals *> parseValueWithWhereClause)-  go _ _ = P.unexpected $ "patterns in local value declaration"+  go binder [] = do+    boot <- indented *> equals *> parseValueWithWhereClause+    return $ \sa -> BoundValueDeclaration sa binder boot+  go _ _ = P.unexpected "patterns in local value declaration"  parseExternDeclaration :: TokenParser Declaration-parseExternDeclaration = reserved "foreign" *> indented *> reserved "import" *> indented *> parseExternAlt where-  parseExternAlt = parseExternData <|> P.try parseExternKind <|> parseExternTerm--  parseExternData = ExternDataDeclaration <$> (reserved "data" *> indented *> typeName)-                                          <*> (indented *> doubleColon *> parseKind)--  parseExternKind = ExternKindDeclaration <$> (reserved "kind" *> indented *> kindName)--  parseExternTerm = ExternDeclaration <$> parseIdent-                                      <*> (indented *> doubleColon *> noWildcards parsePolyType)+parseExternDeclaration = withSourceAnnF $+  reserved "foreign" *>+  indented *> reserved "import" *>+  indented *> (parseExternData <|> P.try parseExternKind <|> parseExternTerm)+  where+  parseExternData =+    (\name kind sa -> ExternDataDeclaration sa name kind)+      <$> (reserved "data" *> indented *> typeName)+      <*> (indented *> doubleColon *> parseKind)+  parseExternKind =+    flip ExternKindDeclaration+      <$> (reserved "kind" *> indented *> kindName)+  parseExternTerm =+    (\name ty sa -> ExternDeclaration sa name ty)+      <$> parseIdent+      <*> (indented *> doubleColon *> noWildcards parsePolyType)  parseAssociativity :: TokenParser Associativity parseAssociativity =@@ -123,11 +135,11 @@ parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)  parseFixityDeclaration :: TokenParser Declaration-parseFixityDeclaration = do+parseFixityDeclaration = withSourceAnnF $ do   fixity <- parseFixity   indented-  FixityDeclaration-    <$> ((Right <$> typeFixity fixity) <|> (Left <$> valueFixity fixity))+  def <- (Right <$> typeFixity fixity) <|> (Left <$> valueFixity fixity)+  return $ \sa -> FixityDeclaration sa def   where   typeFixity fixity =     TypeFixity fixity@@ -139,9 +151,9 @@       <*> (reserved "as" *> parseOperator)  parseImportDeclaration :: TokenParser Declaration-parseImportDeclaration = withSourceSpan PositionedDeclaration $ do+parseImportDeclaration = withSourceAnnF $ do   (mn, declType, asQ) <- parseImportDeclaration'-  return $ ImportDeclaration mn declType asQ+  return $ \sa -> ImportDeclaration sa mn declType asQ  parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, Maybe ModuleName) parseImportDeclaration' = do@@ -159,22 +171,21 @@  parseDeclarationRef :: TokenParser DeclarationRef parseDeclarationRef =-  withSourceSpan PositionedDeclarationRef-    $ (KindRef <$> P.try (reserved "kind" *> kindName))-    <|> (ValueRef <$> parseIdent)-    <|> (ValueOpRef <$> parens parseOperator)-    <|> parseTypeRef-    <|> (TypeClassRef <$> (reserved "class" *> properName))-    <|> (ModuleRef <$> (indented *> reserved "module" *> moduleName))-    <|> (TypeOpRef <$> (indented *> reserved "type" *> parens parseOperator))+    withSourceSpan' KindRef (P.try (reserved "kind" *> kindName))+    <|> withSourceSpan' ValueRef parseIdent+    <|> withSourceSpan' ValueOpRef (parens parseOperator)+    <|> withSourceSpan' (\sa -> ($ TypeRef sa)) parseTypeRef+    <|> withSourceSpan' TypeClassRef (reserved "class" *> properName)+    <|> withSourceSpan' ModuleRef (indented *> reserved "module" *> moduleName)+    <|> withSourceSpan' TypeOpRef (indented *> reserved "type" *> parens parseOperator)   where   parseTypeRef = do     name <- typeName     dctors <- P.optionMaybe $ parens (symbol' ".." *> pure Nothing <|> Just <$> commaSep dataConstructorName)-    return $ TypeRef name (fromMaybe (Just []) dctors)+    return $ \f -> f name (fromMaybe (Just []) dctors)  parseTypeClassDeclaration :: TokenParser Declaration-parseTypeClassDeclaration = do+parseTypeClassDeclaration = withSourceAnnF $ do   reserved "class"   implies <- P.option [] . P.try $ do     indented@@ -190,8 +201,8 @@   dependencies <- P.option [] (indented *> pipe *> commaSep1 parseFunctionalDependency)   members <- P.option [] $ do     indented *> reserved "where"-    indented *> mark (P.many (same *> positioned parseTypeDeclaration))-  return $ TypeClassDeclaration className idents implies dependencies members+    indented *> mark (P.many (same *> parseTypeDeclaration))+  return $ \sa -> TypeClassDeclaration sa className idents implies dependencies members  parseConstraint :: TokenParser Constraint parseConstraint = Constraint <$> parseQualified properName@@ -199,24 +210,24 @@                              <*> pure Nothing  parseInstanceDeclaration :: TokenParser (TypeInstanceBody -> Declaration)-parseInstanceDeclaration = do+parseInstanceDeclaration = withSourceAnnF $ do   reserved "instance"   name <- parseIdent <* indented <* doubleColon-  deps <- P.optionMaybe $ P.try $ do+  deps <- P.optionMaybe . P.try $ do     deps <- (return <$> parseConstraint) <|> parens (commaSep1 parseConstraint)     indented     rfatArrow     return deps   className <- indented *> parseQualified properName   ty <- P.many (indented *> parseTypeAtom)-  return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty+  return $ \sa -> TypeInstanceDeclaration sa name (fromMaybe [] deps) className ty  parseTypeInstanceDeclaration :: TokenParser Declaration parseTypeInstanceDeclaration = do   instanceDecl <- parseInstanceDeclaration   members <- P.option [] $ do     indented *> reserved "where"-    mark (P.many (same *> positioned declsInInstance))+    mark (P.many (same *> declsInInstance))   return $ instanceDecl (ExplicitInstance members)   where     declsInInstance :: TokenParser Declaration@@ -232,28 +243,27 @@   instanceDecl <- parseInstanceDeclaration   return $ instanceDecl ty -positioned :: TokenParser Declaration -> TokenParser Declaration-positioned = withSourceSpan PositionedDeclaration- -- | Parse a single declaration parseDeclaration :: TokenParser Declaration-parseDeclaration = positioned (P.choice-                   [ parseDataDeclaration-                   , parseTypeDeclaration-                   , parseTypeSynonymDeclaration-                   , parseValueDeclaration-                   , parseExternDeclaration-                   , parseFixityDeclaration-                   , parseTypeClassDeclaration-                   , parseTypeInstanceDeclaration-                   , parseDerivingInstanceDeclaration-                   ]) P.<?> "declaration"+parseDeclaration =+  P.choice+    [ parseDataDeclaration+    , parseTypeDeclaration+    , parseTypeSynonymDeclaration+    , parseValueDeclaration+    , parseExternDeclaration+    , parseFixityDeclaration+    , parseTypeClassDeclaration+    , parseTypeInstanceDeclaration+    , parseDerivingInstanceDeclaration+    ] P.<?> "declaration"  parseLocalDeclaration :: TokenParser Declaration-parseLocalDeclaration = positioned (P.choice-                   [ parseTypeDeclaration-                   , parseLocalValueDeclaration-                   ] P.<?> "local declaration")+parseLocalDeclaration =+  P.choice+    [ parseTypeDeclaration+    , parseLocalValueDeclaration+    ] P.<?> "local declaration"  -- | Parse a module declaration and its export declarations parseModuleDeclaration :: TokenParser (ModuleName, Maybe [DeclarationRef])@@ -261,7 +271,7 @@   reserved "module"   indented   name <- moduleName-  exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef+  exports <- P.optionMaybe . parens $ commaSep1 parseDeclarationRef   reserved "where"   pure (name, exports) @@ -277,7 +287,7 @@     -- by only parsing as far as the module header. See PR #2054.     imports <- P.many (same *> parseImportDeclaration)     decls   <- P.many (same *> parseDeclaration)-    return (imports ++ decls)+    return (imports <> decls)   _ <- P.eof   end <- P.getPosition   let ss = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end)@@ -291,7 +301,7 @@   -> [(k, Text)]   -> m [(k, Module)] parseModulesFromFiles toFilePath input =-  flip parU wrapError . inParallel . flip map input $ parseModuleFromFile toFilePath+  flip parU wrapError . inParallel . flip fmap input $ parseModuleFromFile toFilePath   where   wrapError :: Either P.ParseError a -> m a   wrapError = either (throwError . MultipleErrors . pure . toPositionedError) return@@ -495,7 +505,7 @@   return (PathTree (AssocList (reverse tree)))   where     insertUpdate (seen, xs) (key, node)-      | S.member key seen = P.unexpected ("Duplicate key in record update: " ++ show key)+      | S.member key seen = P.unexpected ("Duplicate key in record update: " <> show key)       | otherwise = return (S.insert key seen, (key, node) : xs)  parseUpdaterBody :: Expr -> TokenParser Expr

src/Language/PureScript/Pretty/Values.hs view

@@ -11,10 +11,10 @@  import Control.Arrow (second) +import Data.Text (Text)+import qualified Data.List.NonEmpty as NEL import qualified Data.Monoid as Monoid ((<>))- import qualified Data.Text as T-import Data.Text (Text)  import Language.PureScript.AST import Language.PureScript.Crash@@ -122,15 +122,14 @@  prettyPrintDeclaration :: Int -> Declaration -> Box prettyPrintDeclaration d _ | d < 0 = ellipsis-prettyPrintDeclaration _ (TypeDeclaration ident ty) =+prettyPrintDeclaration _ (TypeDeclaration _ ident ty) =   text (T.unpack (showIdent ident) ++ " :: ") <> typeAsBox ty-prettyPrintDeclaration d (ValueDeclaration ident _ [] [GuardedExpr [] val]) =+prettyPrintDeclaration d (ValueDeclaration _ ident _ [] [GuardedExpr [] val]) =   text (T.unpack (showIdent ident) ++ " = ") <> prettyPrintValue (d - 1) val prettyPrintDeclaration d (BindingGroupDeclaration ds) =-  vsep 1 left (map (prettyPrintDeclaration (d - 1) . toDecl) ds)+  vsep 1 left (NEL.toList (fmap (prettyPrintDeclaration (d - 1) . toDecl) ds))   where-  toDecl (nm, t, e) = ValueDeclaration nm t [] [GuardedExpr [] e]-prettyPrintDeclaration d (PositionedDeclaration _ _ decl) = prettyPrintDeclaration d decl+  toDecl ((sa, nm), t, e) = ValueDeclaration sa nm t [] [GuardedExpr [] e] prettyPrintDeclaration _ _ = internalError "Invalid argument to prettyPrintDeclaration"  prettyPrintCaseAlternative :: Int -> CaseAlternative -> Box

src/Language/PureScript/Sugar/BindingGroups.hs view

@@ -18,6 +18,7 @@ import Data.Graph import Data.List (intersect) import Data.Maybe (isJust)+import qualified Data.List.NonEmpty as NEL import qualified Data.Set as S  import Language.PureScript.AST@@ -42,7 +43,7 @@ -- collapseBindingGroupsModule :: [Module] -> [Module] collapseBindingGroupsModule =-  map $ \(Module ss coms name ds exps) ->+  fmap $ \(Module ss coms name ds exps) ->     Module ss coms name (collapseBindingGroups ds) exps  createBindingGroups@@ -67,11 +68,11 @@   handleDecls ds = do     let values = filter isValueDecl ds         dataDecls = filter isDataDecl ds-        allProperNames = map declTypeName dataDecls-        dataVerts = map (\d -> (d, declTypeName d, usedTypeNames moduleName d `intersect` allProperNames)) dataDecls+        allProperNames = fmap declTypeName dataDecls+        dataVerts = fmap (\d -> (d, declTypeName d, usedTypeNames moduleName d `intersect` allProperNames)) dataDecls     dataBindingGroupDecls <- parU (stronglyConnComp dataVerts) toDataBindingGroup-    let allIdents = map declIdent values-        valueVerts = map (\d -> (d, declIdent d, usedIdents moduleName d `intersect` allIdents)) values+    let allIdents = fmap declIdent values+        valueVerts = fmap (\d -> (d, declIdent d, usedIdents moduleName d `intersect` allIdents)) values     bindingGroupDecls <- parU (stronglyConnComp valueVerts) (toBindingGroup moduleName)     return $ filter isImportDecl ds ++              filter isExternKindDecl ds ++@@ -89,14 +90,12 @@ collapseBindingGroups :: [Declaration] -> [Declaration] collapseBindingGroups =   let (f, _, _) = everywhereOnValues id collapseBindingGroupsForValue id-  in map f . concatMap go+  in fmap f . concatMap go   where-  go (DataBindingGroupDeclaration ds) = ds+  go (DataBindingGroupDeclaration ds) = NEL.toList ds   go (BindingGroupDeclaration ds) =-    map (\(ident, nameKind, val) ->-      ValueDeclaration ident nameKind [] [MkUnguarded val]) ds-  go (PositionedDeclaration pos com d) =-    map (PositionedDeclaration pos com) $ go d+    NEL.toList $ fmap (\((sa, ident), nameKind, val) ->+      ValueDeclaration sa ident nameKind [] [MkUnguarded val]) ds   go other = [other]  collapseBindingGroupsForValue :: Expr -> Expr@@ -108,9 +107,8 @@   where   def _ _ = [] -  getValue (ValueDeclaration _ _ [] [MkUnguarded val]) = val+  getValue (ValueDeclaration _ _ _ [] [MkUnguarded val]) = val   getValue ValueDeclaration{} = internalError "Binders should have been desugared"-  getValue (PositionedDeclaration _ _ d) = getValue d   getValue _ = internalError "Expected ValueDeclaration"    (_, usedIdents', _, _, _) = everythingWithScope def usedNamesE def def def@@ -152,14 +150,12 @@   usedNames _ = []  declIdent :: Declaration -> Ident-declIdent (ValueDeclaration ident _ _ _) = ident-declIdent (PositionedDeclaration _ _ d) = declIdent d+declIdent (ValueDeclaration _ ident _ _ _) = ident declIdent _ = internalError "Expected ValueDeclaration"  declTypeName :: Declaration -> ProperName 'TypeName-declTypeName (DataDeclaration _ pn _ _) = pn-declTypeName (TypeSynonymDeclaration pn _ _) = pn-declTypeName (PositionedDeclaration _ _ d) = declTypeName d+declTypeName (DataDeclaration _ _ pn _ _) = pn+declTypeName (TypeSynonymDeclaration _ pn _ _) = pn declTypeName _ = internalError "Expected DataDeclaration"  -- |@@ -173,7 +169,7 @@    -> SCC Declaration    -> m Declaration toBindingGroup _ (AcyclicSCC d) = return d-toBindingGroup moduleName (CyclicSCC ds') =+toBindingGroup moduleName (CyclicSCC ds') = do   -- Once we have a mutually-recursive group of declarations, we need to sort   -- them further by their immediate dependencies (those outside function   -- bodies). In particular, this is relevant for type instance dictionaries@@ -183,21 +179,20 @@   -- If we discover declarations that still contain mutually-recursive   -- immediate references, we're guaranteed to get an undefined reference at   -- runtime, so treat this as an error. See also github issue #365.-  BindingGroupDeclaration <$> mapM toBinding (stronglyConnComp valueVerts)+  BindingGroupDeclaration . NEL.fromList <$> mapM toBinding (stronglyConnComp valueVerts)   where   idents :: [Ident]-  idents = map (\(_, i, _) -> i) valueVerts+  idents = fmap (\(_, i, _) -> i) valueVerts    valueVerts :: [(Declaration, Ident, [Ident])]-  valueVerts = map (\d -> (d, declIdent d, usedImmediateIdents moduleName d `intersect` idents)) ds'+  valueVerts = fmap (\d -> (d, declIdent d, usedImmediateIdents moduleName d `intersect` idents)) ds' -  toBinding :: SCC Declaration -> m (Ident, NameKind, Expr)+  toBinding :: SCC Declaration -> m ((SourceAnn, Ident), NameKind, Expr)   toBinding (AcyclicSCC d) = return $ fromValueDecl d   toBinding (CyclicSCC ds) = throwError $ foldMap cycleError ds    cycleError :: Declaration -> MultipleErrors-  cycleError (PositionedDeclaration p _ d) = onErrorMessages (withPosition p) $ cycleError d-  cycleError (ValueDeclaration n _ _ [MkUnguarded _]) = errorMessage $ CycleInDeclaration n+  cycleError (ValueDeclaration (ss, _) n _ _ [MkUnguarded _]) = errorMessage' ss $ CycleInDeclaration n   cycleError _ = internalError "cycleError: Expected ValueDeclaration"  toDataBindingGroup@@ -206,19 +201,17 @@   -> m Declaration toDataBindingGroup (AcyclicSCC d) = return d toDataBindingGroup (CyclicSCC [d]) = case isTypeSynonym d of-  Just pn -> throwError . errorMessage $ CycleInTypeSynonym (Just pn)+  Just pn -> throwError . errorMessage' (declSourceSpan d) $ CycleInTypeSynonym (Just pn)   _ -> return d toDataBindingGroup (CyclicSCC ds')-  | all (isJust . isTypeSynonym) ds' = throwError . errorMessage $ CycleInTypeSynonym Nothing-  | otherwise = return $ DataBindingGroupDeclaration ds'+  | all (isJust . isTypeSynonym) ds' = throwError . errorMessage' (declSourceSpan (head ds')) $ CycleInTypeSynonym Nothing+  | otherwise = return . DataBindingGroupDeclaration $ NEL.fromList ds'  isTypeSynonym :: Declaration -> Maybe (ProperName 'TypeName)-isTypeSynonym (TypeSynonymDeclaration pn _ _) = Just pn-isTypeSynonym (PositionedDeclaration _ _ d) = isTypeSynonym d+isTypeSynonym (TypeSynonymDeclaration _ pn _ _) = Just pn isTypeSynonym _ = Nothing -fromValueDecl :: Declaration -> (Ident, NameKind, Expr)-fromValueDecl (ValueDeclaration ident nameKind [] [MkUnguarded val]) = (ident, nameKind, val)+fromValueDecl :: Declaration -> ((SourceAnn, Ident), NameKind, Expr)+fromValueDecl (ValueDeclaration sa ident nameKind [] [MkUnguarded val]) = ((sa, ident), nameKind, val) fromValueDecl ValueDeclaration{} = internalError "Binders should have been desugared"-fromValueDecl (PositionedDeclaration _ _ d) = fromValueDecl d fromValueDecl _ = internalError "Expected ValueDeclaration"

src/Language/PureScript/Sugar/CaseDeclarations.hs view

@@ -42,9 +42,11 @@   :: forall m. (MonadSupply m, MonadError MultipleErrors m)   => [Declaration]   -> m [Declaration]-desugarCaseGuards declarations = parU declarations f+desugarCaseGuards declarations = parU declarations go   where-    (f, _, _) = everywhereOnValuesM return desugarGuardedExprs return+    go d =+      let (f, _, _) = everywhereOnValuesM return (desugarGuardedExprs (declSourceSpan d)) return+      in f d  -- | -- Desugar case with pattern guards and pattern clauses to a@@ -52,9 +54,10 @@ -- desugarGuardedExprs   :: forall m. (MonadSupply m)-  => Expr+  => SourceSpan+  -> Expr   -> m Expr-desugarGuardedExprs (Case scrut alternatives)+desugarGuardedExprs ss (Case scrut alternatives)   | any (not . isTrivialExpr) scrut = do     -- in case the scrutinee is non trivial (e.g. not a Var or Literal)     -- we may evaluate the scrutinee more than once when a guard occurrs.@@ -62,10 +65,10 @@     (scrut', scrut_decls) <- unzip <$> forM scrut (\e -> do       scrut_id <- freshIdent'       pure ( Var (Qualified Nothing scrut_id)-           , ValueDeclaration scrut_id Private [] [MkUnguarded e]+           , ValueDeclaration (ss, []) scrut_id Private [] [MkUnguarded e]            )       )-    Let scrut_decls <$> desugarGuardedExprs (Case scrut' alternatives)+    Let scrut_decls <$> desugarGuardedExprs ss (Case scrut' alternatives)   where     isTrivialExpr (Var _) = True     isTrivialExpr (Literal _) = True@@ -75,7 +78,7 @@     isTrivialExpr (TypedValue _ e _) = isTrivialExpr e     isTrivialExpr _ = False -desugarGuardedExprs (Case scrut alternatives) =+desugarGuardedExprs ss (Case scrut alternatives) =   let     -- Alternatives which do not have guards are     -- left as-is. Alternatives which@@ -217,7 +220,7 @@     desugarAltOutOfLine alt_binder rem_guarded rem_alts mk_body       | Just rem_case <- mkCaseOfRemainingGuardsAndAlts = do -        desugared     <- desugarGuardedExprs rem_case+        desugared     <- desugarGuardedExprs ss rem_case         rem_case_id   <- freshIdent'         unused_binder <- freshIdent' @@ -228,7 +231,7 @@           alt_fail = [CaseAlternative [NullBinder] [MkUnguarded goto_rem_case]]          pure $ Let [-          ValueDeclaration rem_case_id Private []+          ValueDeclaration (ss, []) rem_case_id Private []             [MkUnguarded (Abs (VarBinder unused_binder) desugared)]           ] (mk_body alt_fail) @@ -263,13 +266,13 @@     alts' <- desugarAlternatives alternatives     return $ optimize (Case scrut alts') -desugarGuardedExprs (TypedValue infered e ty) =-  TypedValue infered <$> desugarGuardedExprs e <*> pure ty+desugarGuardedExprs ss (TypedValue infered e ty) =+  TypedValue infered <$> desugarGuardedExprs ss e <*> pure ty -desugarGuardedExprs (PositionedValue ss comms e) =-  PositionedValue ss comms <$> desugarGuardedExprs e+desugarGuardedExprs _ (PositionedValue ss comms e) =+  PositionedValue ss comms <$> desugarGuardedExprs ss e -desugarGuardedExprs v = pure v+desugarGuardedExprs _ v = pure v  -- | -- Validates that case head and binder lengths match.@@ -323,33 +326,28 @@ desugarCases = desugarRest <=< fmap join . flip parU toDecls . groupBy inSameGroup   where     desugarRest :: [Declaration] -> m [Declaration]-    desugarRest (TypeInstanceDeclaration name constraints className tys ds : rest) =-      (:) <$> (TypeInstanceDeclaration name constraints className tys <$> traverseTypeInstanceBody desugarCases ds) <*> desugarRest rest-    desugarRest (ValueDeclaration name nameKind bs result : rest) =+    desugarRest (TypeInstanceDeclaration sa name constraints className tys ds : rest) =+      (:) <$> (TypeInstanceDeclaration sa name constraints className tys <$> traverseTypeInstanceBody desugarCases ds) <*> desugarRest rest+    desugarRest (ValueDeclaration sa name nameKind bs result : rest) =       let (_, f, _) = everywhereOnValuesTopDownM return go return           f' = mapM (\(GuardedExpr gs e) -> GuardedExpr gs <$> f e)-      in (:) <$> (ValueDeclaration name nameKind bs <$> f' result) <*> desugarRest rest+      in (:) <$> (ValueDeclaration sa name nameKind bs <$> f' result) <*> desugarRest rest       where       go (Let ds val') = Let <$> desugarCases ds <*> pure val'       go other = return other-    desugarRest (PositionedDeclaration pos com d : ds) = do-      (d' : ds') <- desugarRest (d : ds)-      return (PositionedDeclaration pos com d' : ds')     desugarRest (d : ds) = (:) d <$> desugarRest ds     desugarRest [] = pure []  inSameGroup :: Declaration -> Declaration -> Bool-inSameGroup (ValueDeclaration ident1 _ _ _) (ValueDeclaration ident2 _ _ _) = ident1 == ident2-inSameGroup (PositionedDeclaration _ _ d1) d2 = inSameGroup d1 d2-inSameGroup d1 (PositionedDeclaration _ _ d2) = inSameGroup d1 d2+inSameGroup (ValueDeclaration _ ident1 _ _ _) (ValueDeclaration _ ident2 _ _ _) = ident1 == ident2 inSameGroup _ _ = False  toDecls :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]-toDecls [ValueDeclaration ident nameKind bs [MkUnguarded val]] | all isIrrefutable bs = do+toDecls [ValueDeclaration sa@(ss, _) ident nameKind bs [MkUnguarded val]] | all isIrrefutable bs = do   args <- mapM fromVarBinder bs   let body = foldr (Abs . VarBinder) val args-  guardWith (errorMessage (OverlappingArgNames (Just ident))) $ length (ordNub args) == length args-  return [ValueDeclaration ident nameKind [] [MkUnguarded body]]+  guardWith (errorMessage' ss (OverlappingArgNames (Just ident))) $ length (ordNub args) == length args+  return [ValueDeclaration sa ident nameKind [] [MkUnguarded body]]   where   fromVarBinder :: Binder -> m Ident   fromVarBinder NullBinder = freshIdent'@@ -357,30 +355,26 @@   fromVarBinder (PositionedBinder _ _ b) = fromVarBinder b   fromVarBinder (TypedBinder _ b) = fromVarBinder b   fromVarBinder _ = internalError "fromVarBinder: Invalid argument"-toDecls ds@(ValueDeclaration ident _ bs (result : _) : _) = do+toDecls ds@(ValueDeclaration (ss, _) ident _ bs (result : _) : _) = do   let tuples = map toTuple ds        isGuarded (MkUnguarded _) = False       isGuarded _               = True -  unless (all ((== length bs) . length . fst) tuples) $-      throwError . errorMessage $ ArgListLengthsDiffer ident-  unless (not (null bs) || isGuarded result) $-      throwError . errorMessage $ DuplicateValueDeclaration ident-  caseDecl <- makeCaseDeclaration ident tuples+  unless (all ((== length bs) . length . fst) tuples) .+    throwError . errorMessage' ss $ ArgListLengthsDiffer ident+  unless (not (null bs) || isGuarded result) .+    throwError . errorMessage' ss $ DuplicateValueDeclaration ident+  caseDecl <- makeCaseDeclaration ss ident tuples   return [caseDecl]-toDecls (PositionedDeclaration pos com d : ds) = do-  (d' : ds') <- rethrowWithPosition pos $ toDecls (d : ds)-  return (PositionedDeclaration pos com d' : ds') toDecls ds = return ds  toTuple :: Declaration -> ([Binder], [GuardedExpr])-toTuple (ValueDeclaration _ _ bs result) = (bs, result)-toTuple (PositionedDeclaration _ _ d) = toTuple d+toTuple (ValueDeclaration _ _ _ bs result) = (bs, result) toTuple _ = internalError "Not a value declaration" -makeCaseDeclaration :: forall m. (MonadSupply m) => Ident -> [([Binder], [GuardedExpr])] -> m Declaration-makeCaseDeclaration ident alternatives = do+makeCaseDeclaration :: forall m. (MonadSupply m) => SourceSpan -> Ident -> [([Binder], [GuardedExpr])] -> m Declaration+makeCaseDeclaration ss ident alternatives = do   let namedArgs = map findName . fst <$> alternatives       argNames = foldl1 resolveNames namedArgs   args <- if allUnique (catMaybes argNames)@@ -390,7 +384,7 @@       binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]   let value = foldr (Abs . VarBinder) (Case vars binders) args -  return $ ValueDeclaration ident Public [] [MkUnguarded value]+  return $ ValueDeclaration (ss, []) ident Public [] [MkUnguarded value]   where   -- We will construct a table of potential names.   -- VarBinders will become Just _ which is a potential name.

src/Language/PureScript/Sugar/DoNotation.hs view

@@ -24,10 +24,9 @@  -- | Desugar a single do statement desugarDo :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration-desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> rethrowWithPosition pos (desugarDo d) desugarDo d =   let (f, _, _) = everywhereOnValuesM return replace return-  in f d+  in rethrowWithPosition (declSourceSpan d) $ f d   where   bind :: Expr   bind = Var (Qualified Nothing (Ident C.bind))@@ -62,9 +61,8 @@   go [DoNotationLet _] = throwError . errorMessage $ InvalidDoLet   go (DoNotationLet ds : rest) = do     let checkBind :: Declaration -> m ()-        checkBind (ValueDeclaration i@(Ident name) _ _ _)-          | name `elem` [ C.bind, C.discard ] = throwError . errorMessage $ CannotUseBindWithDo i-        checkBind (PositionedDeclaration pos _ decl) = rethrowWithPosition pos (checkBind decl)+        checkBind (ValueDeclaration (ss, _) i@(Ident name) _ _ _)+          | name `elem` [ C.bind, C.discard ] = throwError . errorMessage' ss $ CannotUseBindWithDo i         checkBind _ = pure ()     mapM_ checkBind ds     rest' <- go rest

src/Language/PureScript/Sugar/LetPattern.hs view

@@ -19,7 +19,6 @@ -- Desugar a single let expression -- desugarLetPattern :: Declaration -> Declaration-desugarLetPattern (PositionedDeclaration pos com d) = PositionedDeclaration pos com $ desugarLetPattern d desugarLetPattern decl =   let (f, _, _) = everywhereOnValues id replace id   in f decl@@ -34,12 +33,8 @@      -- ^ The original let-in result expression      -> Expr   go [] e = e-  go (pd@(PositionedDeclaration pos com d) : ds) e =-    case d of-      BoundValueDeclaration {} -> PositionedValue pos com $ go (d:ds) e-      _ -> append pd $ go ds e-  go (BoundValueDeclaration binder boundE : ds) e =-    Case [boundE] [CaseAlternative [binder] [MkUnguarded $ go ds e]]+  go (BoundValueDeclaration (pos, com) binder boundE : ds) e =+    PositionedValue pos com $ Case [boundE] [CaseAlternative [binder] [MkUnguarded $ go ds e]]   go (d:ds) e = append d $ go ds e    append :: Declaration -> Expr -> Expr

src/Language/PureScript/Sugar/Names.hs view

@@ -65,9 +65,9 @@   externsEnv :: Env -> ExternsFile -> m Env   externsEnv env ExternsFile{..} = do     let members = Exports{..}-        env' = M.insert efModuleName (efSourceSpan, primImports, members) env-        fromEFImport (ExternsImport mn mt qmn) = (mn, [(Nothing, Just mt, qmn)])-    imps <- foldM (resolveModuleImport env') primImports (map fromEFImport efImports)+        env' = M.insert efModuleName (efSourceSpan, nullImports, members) env+        fromEFImport (ExternsImport mn mt qmn) = (mn, [(efSourceSpan, Just mt, qmn)])+    imps <- foldM (resolveModuleImport env') nullImports (map fromEFImport efImports)     exps <- resolveExports env' efSourceSpan efModuleName imps members efExports     return $ M.insert efModuleName (efSourceSpan, imps, exps) env     where@@ -75,12 +75,11 @@     exportedTypes :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)     exportedTypes = M.fromList $ mapMaybe toExportedType efExports       where-      toExportedType (TypeRef tyCon dctors) = Just (tyCon, (fromMaybe (mapMaybe forTyCon efDeclarations) dctors, efModuleName))+      toExportedType (TypeRef _ tyCon dctors) = Just (tyCon, (fromMaybe (mapMaybe forTyCon efDeclarations) dctors, efModuleName))         where         forTyCon :: ExternsDeclaration -> Maybe (ProperName 'ConstructorName)         forTyCon (EDDataConstructor pn _ tNm _ _) | tNm == tyCon = Just pn         forTyCon _ = Nothing-      toExportedType (PositionedDeclarationRef _ _ r) = toExportedType r       toExportedType _ = Nothing      exportedTypeOps :: M.Map (OpName 'TypeOpName) ModuleName@@ -104,7 +103,7 @@   updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)   updateEnv (ms, env) m@(Module ss _ mn _ refs) = do     members <- findExportable m-    let env' = M.insert mn (ss, primImports, members) env+    let env' = M.insert mn (ss, nullImports, members) env     (m', imps) <- resolveImports env' m     exps <- maybe (return members) (resolveExports env' ss mn imps members) refs     return (m' : ms, M.insert mn (ss, imps, exps) env)@@ -127,24 +126,24 @@ elaborateExports exps (Module ss coms mn decls refs) =   Module ss coms mn decls $ Just     $ elaboratedTypeRefs-    ++ go TypeOpRef exportedTypeOps-    ++ go TypeClassRef exportedTypeClasses-    ++ go ValueRef exportedValues-    ++ go ValueOpRef exportedValueOps-    ++ go KindRef exportedKinds+    ++ go (TypeOpRef ss) exportedTypeOps+    ++ go (TypeClassRef ss) exportedTypeClasses+    ++ go (ValueRef ss) exportedValues+    ++ go (ValueOpRef ss) exportedValueOps+    ++ go (KindRef ss) exportedKinds     ++ maybe [] (filter isModuleRef) refs   where    elaboratedTypeRefs :: [DeclarationRef]   elaboratedTypeRefs =     flip map (M.toList (exportedTypes exps)) $ \(tctor, (dctors, mn')) ->-      let ref = TypeRef tctor (Just dctors)-      in if mn == mn' then ref else ReExportRef mn' ref+      let ref = TypeRef ss tctor (Just dctors)+      in if mn == mn' then ref else ReExportRef ss mn' ref    go :: (a -> DeclarationRef) -> (Exports -> M.Map a ModuleName) -> [DeclarationRef]   go toRef select =     flip map (M.toList (select exps)) $ \(export, mn') ->-      if mn == mn' then toRef export else ReExportRef mn' (toRef export)+      if mn == mn' then toRef export else ReExportRef ss mn' (toRef export)  -- | -- Replaces all local names with qualified names within a module and checks that all existing@@ -156,58 +155,89 @@   => Imports   -> Module   -> m Module-renameInModule imports (Module ss coms mn decls exps) =-  Module ss coms mn <$> parU decls go <*> pure exps+renameInModule imports (Module modSS coms mn decls exps) =+  Module modSS coms mn <$> parU decls go <*> pure exps   where -  (go, _, _, _, _) = everywhereWithContextOnValuesM (Nothing, []) updateDecl updateValue updateBinder updateCase defS+  (go, _, _, _, _) =+    everywhereWithContextOnValuesM+      (modSS, [])+      (\(_, bound) d -> (\(bound', d') -> ((declSourceSpan d', bound'), d')) <$> updateDecl bound d)+      updateValue+      updateBinder+      updateCase+      defS    updateDecl-    :: (Maybe SourceSpan, [Ident])+    :: [Ident]     -> Declaration-    -> m ((Maybe SourceSpan, [Ident]), Declaration)-  updateDecl (_, bound) d@(PositionedDeclaration pos _ _) =-    return ((Just pos, bound), d)-  updateDecl (pos, bound) (DataDeclaration dtype name args dctors) =-    (,) (pos, bound) <$> (DataDeclaration dtype name <$> updateTypeArguments pos args-                                                     <*> traverse (sndM (traverse (updateTypesEverywhere pos))) dctors)-  updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =-    (,) (pos, bound) <$> (TypeSynonymDeclaration name <$> updateTypeArguments pos ps-                                                      <*> updateTypesEverywhere pos ty)-  updateDecl (pos, bound) (TypeClassDeclaration className args implies deps ds) =-    (,) (pos, bound) <$> (TypeClassDeclaration className <$> updateTypeArguments pos args-                                                         <*> updateConstraints pos implies-                                                         <*> pure deps-                                                         <*> pure ds)-  updateDecl (pos, bound) (TypeInstanceDeclaration name cs cn ts ds) =-    (,) (pos, bound) <$> (TypeInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn pos <*> traverse (updateTypesEverywhere pos) ts <*> pure ds)-  updateDecl (pos, bound) (TypeDeclaration name ty) =-    (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)-  updateDecl (pos, bound) (ExternDeclaration name ty) =-    (,) (pos, name : bound) <$> (ExternDeclaration name <$> updateTypesEverywhere pos ty)-  updateDecl (pos, bound) (ExternDataDeclaration name ki) =-    (,) (pos, bound) <$> (ExternDataDeclaration name <$> updateKindsEverywhere pos ki)-  updateDecl (pos, bound) (TypeFixityDeclaration fixity alias op) =-    (,) (pos, bound) <$> (TypeFixityDeclaration fixity <$> updateTypeName alias pos <*> pure op)-  updateDecl (pos, bound) (ValueFixityDeclaration fixity (Qualified mn' (Left alias)) op) =-    (,) (pos, bound) <$> (ValueFixityDeclaration fixity . fmap Left <$> updateValueName (Qualified mn' alias) pos <*> pure op)-  updateDecl (pos, bound) (ValueFixityDeclaration fixity (Qualified mn' (Right alias)) op) =-    (,) (pos, bound) <$> (ValueFixityDeclaration fixity . fmap Right <$> updateDataConstructorName (Qualified mn' alias) pos  <*> pure op)-  updateDecl s d = return (s, d)+    -> m ([Ident], Declaration)+  updateDecl bound (DataDeclaration sa@(ss, _) dtype name args dctors) =+    fmap (bound,) $+      DataDeclaration sa dtype name+        <$> updateTypeArguments ss args+        <*> traverse (sndM (traverse (updateTypesEverywhere ss))) dctors+  updateDecl bound (TypeSynonymDeclaration sa@(ss, _) name ps ty) =+    fmap (bound,) $+      TypeSynonymDeclaration sa name+        <$> updateTypeArguments ss ps+        <*> updateTypesEverywhere ss ty+  updateDecl bound (TypeClassDeclaration sa@(ss, _) className args implies deps ds) =+    fmap (bound,) $+      TypeClassDeclaration sa className+        <$> updateTypeArguments ss args+        <*> updateConstraints ss implies+        <*> pure deps+        <*> pure ds+  updateDecl bound (TypeInstanceDeclaration sa@(ss, _) name cs cn ts ds) =+    fmap (bound,) $+      TypeInstanceDeclaration sa name+        <$> updateConstraints ss cs+        <*> updateClassName cn ss+        <*> traverse (updateTypesEverywhere ss) ts+        <*> pure ds+  updateDecl bound (TypeDeclaration sa@(ss, _) name ty) =+    fmap (bound,) $+      TypeDeclaration sa name+        <$> updateTypesEverywhere ss ty+  updateDecl bound (ExternDeclaration sa@(ss, _) name ty) =+    fmap (name : bound,) $+      ExternDeclaration sa name+        <$> updateTypesEverywhere ss ty+  updateDecl bound (ExternDataDeclaration sa@(ss, _) name ki) =+    fmap (bound,) $+      ExternDataDeclaration sa name+        <$> updateKindsEverywhere ss ki+  updateDecl bound (TypeFixityDeclaration sa@(ss, _) fixity alias op) =+    fmap (bound,) $+      TypeFixityDeclaration sa fixity+        <$> updateTypeName alias ss+        <*> pure op+  updateDecl bound (ValueFixityDeclaration sa@(ss, _) fixity (Qualified mn' (Left alias)) op) =+    fmap (bound,) $+      ValueFixityDeclaration sa fixity . fmap Left+        <$> updateValueName (Qualified mn' alias) ss+        <*> pure op+  updateDecl bound (ValueFixityDeclaration sa@(ss, _) fixity (Qualified mn' (Right alias)) op) =+    fmap (bound,) $+      ValueFixityDeclaration sa fixity . fmap Right+        <$> updateDataConstructorName (Qualified mn' alias) ss+        <*> pure op+  updateDecl b d =+    return (b, d)    updateValue-    :: (Maybe SourceSpan, [Ident])+    :: (SourceSpan, [Ident])     -> Expr-    -> m ((Maybe SourceSpan, [Ident]), Expr)+    -> m ((SourceSpan, [Ident]), Expr)   updateValue (_, bound) v@(PositionedValue pos' _ _) =-    return ((Just pos', bound), v)+    return ((pos', bound), v)   updateValue (pos, bound) (Abs (VarBinder arg) val') =     return ((pos, arg : bound), Abs (VarBinder arg) val')   updateValue (pos, bound) (Let ds val') = do     let args = mapMaybe letBoundVariable ds-    unless (length (ordNub args) == length args) $-      maybe id rethrowWithPosition pos $-        throwError . errorMessage $ OverlappingNamesInLet+    unless (length (ordNub args) == length args) .+      throwError . errorMessage' pos $ OverlappingNamesInLet     return ((pos, args ++ bound), Let ds val')   updateValue (pos, bound) (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =     (,) (pos, bound) <$> (Var <$> updateValueName name' pos)@@ -222,11 +252,11 @@   updateValue s v = return (s, v)    updateBinder-    :: (Maybe SourceSpan, [Ident])+    :: (SourceSpan, [Ident])     -> Binder-    -> m ((Maybe SourceSpan, [Ident]), Binder)+    -> m ((SourceSpan, [Ident]), Binder)   updateBinder (_, bound) v@(PositionedBinder pos _ _) =-    return ((Just pos, bound), v)+    return ((pos, bound), v)   updateBinder s@(pos, _) (ConstructorBinder name b) =     (,) s <$> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)   updateBinder s@(pos, _) (OpBinder op) =@@ -238,9 +268,9 @@     return (s, v)    updateCase-    :: (Maybe SourceSpan, [Ident])+    :: (SourceSpan, [Ident])     -> CaseAlternative-    -> m ((Maybe SourceSpan, [Ident]), CaseAlternative)+    -> m ((SourceSpan, [Ident]), CaseAlternative)   updateCase (pos, bound) c@(CaseAlternative bs gs) =     return ((pos, concatMap binderNames bs ++ updateGuard gs ++ bound), c)     where@@ -253,11 +283,10 @@         updatePatGuard _                  = []    letBoundVariable :: Declaration -> Maybe Ident-  letBoundVariable (ValueDeclaration ident _ _ _) = Just ident-  letBoundVariable (PositionedDeclaration _ _ d) = letBoundVariable d+  letBoundVariable (ValueDeclaration _ ident _ _ _) = Just ident   letBoundVariable _ = Nothing -  updateKindsEverywhere :: Maybe SourceSpan -> Kind -> m Kind+  updateKindsEverywhere :: SourceSpan -> Kind -> m Kind   updateKindsEverywhere pos = everywhereOnKindsM updateKind     where     updateKind :: Kind -> m Kind@@ -266,11 +295,11 @@    updateTypeArguments     :: (Traversable f, Traversable g)-    => Maybe SourceSpan+    => SourceSpan     -> f (a, g Kind) -> m (f (a, g Kind))   updateTypeArguments pos = traverse (sndM (traverse (updateKindsEverywhere pos))) -  updateTypesEverywhere :: Maybe SourceSpan -> Type -> m Type+  updateTypesEverywhere :: SourceSpan -> Type -> m Type   updateTypesEverywhere pos = everywhereOnTypesM updateType     where     updateType :: Type -> m Type@@ -283,7 +312,7 @@     updateInConstraint (Constraint name ts info) =       Constraint <$> updateClassName name pos <*> pure ts <*> pure info -  updateConstraints :: Maybe SourceSpan -> [Constraint] -> m [Constraint]+  updateConstraints :: SourceSpan -> [Constraint] -> m [Constraint]   updateConstraints pos = traverse $ \(Constraint name ts info) ->     Constraint       <$> updateClassName name pos@@ -292,40 +321,40 @@    updateTypeName     :: Qualified (ProperName 'TypeName)-    -> Maybe SourceSpan+    -> SourceSpan     -> m (Qualified (ProperName 'TypeName))   updateTypeName = update (importedTypes imports) TyName    updateTypeOpName     :: Qualified (OpName 'TypeOpName)-    -> Maybe SourceSpan+    -> SourceSpan     -> m (Qualified (OpName 'TypeOpName))   updateTypeOpName = update (importedTypeOps imports) TyOpName    updateDataConstructorName     :: Qualified (ProperName 'ConstructorName)-    -> Maybe SourceSpan+    -> SourceSpan     -> m (Qualified (ProperName 'ConstructorName))   updateDataConstructorName = update (importedDataConstructors imports) DctorName    updateClassName     :: Qualified (ProperName 'ClassName)-    -> Maybe SourceSpan+    -> SourceSpan     -> m (Qualified (ProperName 'ClassName))   updateClassName = update (importedTypeClasses imports) TyClassName -  updateValueName :: Qualified Ident -> Maybe SourceSpan -> m (Qualified Ident)+  updateValueName :: Qualified Ident -> SourceSpan -> m (Qualified Ident)   updateValueName = update (importedValues imports) IdentName    updateValueOpName     :: Qualified (OpName 'ValueOpName)-    -> Maybe SourceSpan+    -> SourceSpan     -> m (Qualified (OpName 'ValueOpName))   updateValueOpName = update (importedValueOps imports) ValOpName    updateKindName     :: Qualified (ProperName 'KindName)-    -> Maybe SourceSpan+    -> SourceSpan     -> m (Qualified (ProperName 'KindName))   updateKindName = update (importedKinds imports) KiName @@ -337,9 +366,9 @@     => M.Map (Qualified a) [ImportRecord a]     -> (a -> Name)     -> Qualified a-    -> Maybe SourceSpan+    -> SourceSpan     -> m (Qualified a)-  update imps toName qname@(Qualified mn' name) pos = positioned $+  update imps toName qname@(Qualified mn' name) pos = warnAndRethrowWithPosition pos $     case (M.lookup qname imps, mn') of        -- We found the name in our imports, so we return the name for it,@@ -367,5 +396,4 @@       _ -> throwUnknown      where-    positioned err = maybe err (`warnAndRethrowWithPosition` err) pos     throwUnknown = throwError . errorMessage . UnknownName . fmap toName $ qname

src/Language/PureScript/Sugar/Names/Common.hs view

@@ -6,8 +6,7 @@ import Control.Monad.Writer (MonadWriter(..))  import Data.Foldable (for_)-import Data.Function (on)-import Data.List (nubBy, (\\))+import Data.List (nub, (\\)) import Data.Maybe (mapMaybe)  import Language.PureScript.AST@@ -25,7 +24,7 @@   -> m () warnDuplicateRefs pos toError refs = do   let withoutCtors = deleteCtors `map` refs-      dupeRefs = mapMaybe (refToName pos) $ withoutCtors \\ nubBy ((==) `on` withoutPosInfo) withoutCtors+      dupeRefs = mapMaybe (refToName pos) $ withoutCtors \\ nub withoutCtors       dupeCtors = concat $ mapMaybe (extractCtors pos) refs    for_ (dupeRefs ++ dupeCtors) $ \(pos', name) ->@@ -33,37 +32,26 @@    where -  -- Returns a DeclarationRef unwrapped from any PositionedDeclarationRef-  -- constructor(s) it may be wrapped within. Used so position info is ignored-  -- when making the comparison for duplicates.-  withoutPosInfo :: DeclarationRef -> DeclarationRef-  withoutPosInfo (PositionedDeclarationRef _ _ ref) = withoutPosInfo ref-  withoutPosInfo other = other-   -- Deletes the constructor information from TypeRefs so that only the   -- referenced type is used in the duplicate check - constructors are handled   -- separately   deleteCtors :: DeclarationRef -> DeclarationRef-  deleteCtors (PositionedDeclarationRef ss com ref) =-    PositionedDeclarationRef ss com (deleteCtors ref)-  deleteCtors (TypeRef pn _) = TypeRef pn Nothing+  deleteCtors (TypeRef sa pn _) = TypeRef sa pn Nothing   deleteCtors other = other    -- Extracts the names of duplicate constructor references from TypeRefs.   extractCtors :: SourceSpan -> DeclarationRef -> Maybe [(SourceSpan, Name)]-  extractCtors _ (PositionedDeclarationRef pos' _ ref) = extractCtors pos' ref-  extractCtors pos' (TypeRef _ (Just dctors)) =+  extractCtors pos' (TypeRef _ _ (Just dctors)) =     let dupes = dctors \\ ordNub dctors     in if null dupes then Nothing else Just $ ((pos',) . DctorName) <$> dupes   extractCtors _ _ = Nothing    -- Converts a DeclarationRef into a name for an error message.   refToName :: SourceSpan -> DeclarationRef -> Maybe (SourceSpan, Name)-  refToName pos' (TypeRef name _) = Just (pos', TyName name)-  refToName pos' (TypeOpRef op) = Just (pos', TyOpName op)-  refToName pos' (ValueRef name) = Just (pos', IdentName name)-  refToName pos' (ValueOpRef op) = Just (pos', ValOpName op)-  refToName pos' (TypeClassRef name) = Just (pos', TyClassName name)-  refToName pos' (ModuleRef name) = Just (pos', ModName name)-  refToName _ (PositionedDeclarationRef pos' _ ref) = refToName pos' ref+  refToName pos' (TypeRef _ name _) = Just (pos', TyName name)+  refToName pos' (TypeOpRef _ op) = Just (pos', TyOpName op)+  refToName pos' (ValueRef _ name) = Just (pos', IdentName name)+  refToName pos' (ValueOpRef _ op) = Just (pos', ValOpName op)+  refToName pos' (TypeClassRef _ name) = Just (pos', TyClassName name)+  refToName pos' (ModuleRef _ name) = Just (pos', ModName name)   refToName _ _ = Nothing

src/Language/PureScript/Sugar/Names/Env.hs view

@@ -2,7 +2,7 @@   ( ImportRecord(..)   , ImportProvenance(..)   , Imports(..)-  , primImports+  , nullImports   , Exports(..)   , nullExports   , Env@@ -115,26 +115,6 @@ nullImports = Imports M.empty M.empty M.empty M.empty M.empty M.empty S.empty S.empty M.empty  -- |--- An 'Imports' value with imports for the `Prim` module.----primImports :: Imports-primImports =-  nullImports-    { importedTypes = M.fromList $ mkEntries `concatMap` M.keys primTypes-    , importedTypeClasses = M.fromList $ mkEntries `concatMap` M.keys primClasses-    , importedKinds = M.fromList $ mkEntries `concatMap` S.toList primKinds-    }-  where-  mkEntries :: Qualified a -> [(Qualified a, [ImportRecord a])]-  mkEntries fullName@(Qualified _ name) =-    [ (fullName, [ImportRecord fullName primModuleName Prim])-    , (Qualified Nothing name, [ImportRecord fullName primModuleName Prim])-    ]--primModuleName :: ModuleName-primModuleName = ModuleName [ProperName "Prim"]---- | -- The exported declarations from a module. -- data Exports = Exports@@ -216,7 +196,7 @@ -- | Environment which only contains the Prim module. primEnv :: Env primEnv = M.singleton-  primModuleName+  (ModuleName [ProperName "Prim"])   (internalModuleSourceSpan "<Prim>", nullImports, primExports)  -- |

src/Language/PureScript/Sugar/Names/Exports.hs view

@@ -27,34 +27,34 @@ -- findExportable :: forall m. (MonadError MultipleErrors m) => Module -> m Exports findExportable (Module _ _ mn ds _) =-  rethrow (addHint (ErrorInModule mn)) $ foldM updateExports nullExports ds+  rethrow (addHint (ErrorInModule mn)) $ foldM updateExports' nullExports ds   where+  updateExports' :: Exports -> Declaration -> m Exports+  updateExports' exps decl = rethrowWithPosition (declSourceSpan decl) $ updateExports exps decl+   updateExports :: Exports -> Declaration -> m Exports-  updateExports exps (TypeClassDeclaration tcn _ _ _ ds') = do-    exps' <- exportTypeClass Internal exps tcn mn+  updateExports exps (TypeClassDeclaration (ss, _) tcn _ _ _ ds') = do+    exps' <- rethrowWithPosition ss $ exportTypeClass Internal exps tcn mn     foldM go exps' ds'     where-    go exps'' (TypeDeclaration name _) = exportValue exps'' name mn-    go exps'' (PositionedDeclaration pos _ d) = rethrowWithPosition pos $ go exps'' d+    go exps'' (TypeDeclaration (ss', _) name _) = rethrowWithPosition ss' $ exportValue exps'' name mn     go _ _ = internalError "Invalid declaration in TypeClassDeclaration"-  updateExports exps (DataDeclaration _ tn _ dcs) =+  updateExports exps (DataDeclaration _ _ tn _ dcs) =     exportType Internal exps tn (map fst dcs) mn-  updateExports exps (TypeSynonymDeclaration tn _ _) =+  updateExports exps (TypeSynonymDeclaration _ tn _ _) =     exportType Internal exps tn [] mn-  updateExports exps (ExternDataDeclaration tn _) =+  updateExports exps (ExternDataDeclaration _ tn _) =     exportType Internal exps tn [] mn-  updateExports exps (ValueDeclaration name _ _ _) =+  updateExports exps (ValueDeclaration _ name _ _ _) =     exportValue exps name mn-  updateExports exps (ValueFixityDeclaration _ _ op) =+  updateExports exps (ValueFixityDeclaration _ _ _ op) =     exportValueOp exps op mn-  updateExports exps (TypeFixityDeclaration _ _ op) =+  updateExports exps (TypeFixityDeclaration _ _ _ op) =     exportTypeOp exps op mn-  updateExports exps (ExternDeclaration name _) =+  updateExports exps (ExternDeclaration _ name _) =     exportValue exps name mn-  updateExports exps (ExternKindDeclaration pn) =+  updateExports exps (ExternKindDeclaration _ pn) =     exportKind exps pn mn-  updateExports exps (PositionedDeclaration pos _ d) =-    rethrowWithPosition pos $ updateExports exps d   updateExports exps _ = return exps  -- |@@ -84,9 +84,7 @@   -- `DeclarationRef` for an explicit export. When the ref refers to another   -- module, export anything from the imports that matches for that module.   elaborateModuleExports :: Exports -> DeclarationRef -> m Exports-  elaborateModuleExports result (PositionedDeclarationRef pos _ r) =-    warnAndRethrowWithPosition pos $ elaborateModuleExports result r-  elaborateModuleExports result (ModuleRef name) | name == mn = do+  elaborateModuleExports result (ModuleRef _ name) | name == mn = do     let types' = exportedTypes result `M.union` exportedTypes exps     let typeOps' = exportedTypeOps result `M.union` exportedTypeOps exps     let classes' = exportedTypeClasses result `M.union` exportedTypeClasses exps@@ -101,10 +99,10 @@       , exportedValueOps = valueOps'       , exportedKinds = kinds'       }-  elaborateModuleExports result (ModuleRef name) = do+  elaborateModuleExports result (ModuleRef ss' name) = do     let isPseudo = isPseudoModule name     when (not isPseudo && not (isImportedModule name))-      . throwError . errorMessage . UnknownExport $ ModName name+      . throwError . errorMessage' ss' . UnknownExport $ ModName name     reTypes <- extract isPseudo name TyName (importedTypes imps)     reTypeOps <- extract isPseudo name TyOpName (importedTypeOps imps)     reDctors <- extract isPseudo name DctorName (importedDataConstructors imps)@@ -270,21 +268,19 @@   -- listing for the last ref would be used.   combineTypeRefs :: [DeclarationRef] -> [DeclarationRef]   combineTypeRefs-    = fmap (uncurry TypeRef)-    . map (foldr1 $ \(tc, dcs1) (_, dcs2) -> (tc, liftM2 (++) dcs1 dcs2))-    . groupBy ((==) `on` fst)-    . sortBy (compare `on` fst)-    . mapMaybe getTypeRef+    = fmap (\(ss', (tc, dcs)) -> TypeRef ss' tc dcs)+    . fmap (foldr1 $ \(ss, (tc, dcs1)) (_, (_, dcs2)) -> (ss, (tc, liftM2 (++) dcs1 dcs2)))+    . groupBy ((==) `on` (fst . snd))+    . sortBy (compare `on` (fst . snd))+    . mapMaybe (\ref -> (declRefSourceSpan ref,) <$> getTypeRef ref)    filterTypes     :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)     -> DeclarationRef     -> m (M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName))-  filterTypes result (PositionedDeclarationRef pos _ r) =-    rethrowWithPosition pos $ filterTypes result r-  filterTypes result (TypeRef name expDcons) =+  filterTypes result (TypeRef ss name expDcons) =     case name `M.lookup` exportedTypes exps of-      Nothing -> throwError . errorMessage . UnknownExport $ TyName name+      Nothing -> throwError . errorMessage' ss . UnknownExport $ TyName name       Just (dcons, _) -> do         let expDcons' = fromMaybe dcons expDcons         traverse_ (checkDcon name dcons) expDcons'@@ -299,8 +295,8 @@       -> ProperName 'ConstructorName       -> m ()     checkDcon tcon dcons dcon =-      unless (dcon `elem` dcons) $-        throwError . errorMessage $ UnknownExportDataConstructor tcon dcon+      unless (dcon `elem` dcons) .+        throwError . errorMessage' ss $ UnknownExportDataConstructor tcon dcon   filterTypes result _ = return result    filterExport@@ -311,12 +307,10 @@     -> M.Map a ModuleName     -> DeclarationRef     -> m (M.Map a ModuleName)-  filterExport toName get fromExps result (PositionedDeclarationRef pos _ r) =-    rethrowWithPosition pos $ filterExport toName get fromExps result r   filterExport toName get fromExps result ref     | Just name <- get ref =         case name `M.lookup` fromExps exps of           -- TODO: I'm not sure if we actually need to check mn == mn' here -gb           Just mn' | mn == mn' -> return $ M.insert name mn result-          _ -> throwError . errorMessage . UnknownExport $ toName name+          _ -> throwError . errorMessage' (declRefSourceSpan ref) . UnknownExport $ toName name   filterExport _ _ _ result _ = return result

src/Language/PureScript/Sugar/Names/Imports.hs view

@@ -21,7 +21,7 @@ import Language.PureScript.Names import Language.PureScript.Sugar.Names.Env -type ImportDef = (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)+type ImportDef = (SourceSpan, ImportDeclarationType, Maybe ModuleName)  -- | -- Finds the imports within a module, mapping the imported module name to an optional set of@@ -30,13 +30,12 @@ findImports   :: [Declaration]   -> M.Map ModuleName [ImportDef]-findImports = foldl (go Nothing) M.empty+findImports = foldr go M.empty   where-  go pos result (ImportDeclaration mn typ qual) =+  go (ImportDeclaration (pos, _) mn typ qual) result =     let imp = (pos, typ, qual)     in M.insert mn (maybe [imp] (imp :) (mn `M.lookup` result)) result-  go _ result (PositionedDeclaration pos _ d) = go (Just pos) result d-  go _ result _ = result+  go _ result = result  -- | -- Constructs a set of imports for a module.@@ -51,9 +50,9 @@   rethrow (addHint (ErrorInModule currentModule)) $ do     let imports = findImports decls         imports' = M.map (map (\(ss', dt, mmn) -> (ss', Just dt, mmn))) imports-        scope = M.insert currentModule [(Nothing, Nothing, Nothing)] imports'+        scope = M.insert currentModule [(internalModuleSourceSpan "<module>", Nothing, Nothing)] imports'     (Module ss coms currentModule decls exps,) <$>-      foldM (resolveModuleImport env) primImports (M.toList scope)+      foldM (resolveModuleImport env) nullImports (M.toList scope)  -- | Constructs a set of imports for a single module import. resolveModuleImport@@ -61,17 +60,17 @@    . MonadError MultipleErrors m   => Env   -> Imports-  -> (ModuleName, [(Maybe SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])+  -> (ModuleName, [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])   -> m Imports resolveModuleImport env ie (mn, imps) = foldM go ie imps   where   go :: Imports-     -> (Maybe SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)+     -> (SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)      -> m Imports-  go ie' (pos, typ, impQual) = do+  go ie' (ss, typ, impQual) = do     modExports <--      positioned $ maybe-        (throwError . errorMessage . UnknownName . Qualified Nothing $ ModName mn)+      maybe+        (throwError . errorMessage' ss . UnknownName . Qualified Nothing $ ModName mn)         (return . envModuleExports)         (mn `M.lookup` env)     let impModules = importedModules ie'@@ -79,11 +78,7 @@         ie'' = ie' { importedModules = maybe (S.insert mn impModules) (const impModules) impQual                    , importedQualModules = maybe qualModules (`S.insert` qualModules) impQual                    }-    positioned $ resolveImport mn modExports ie'' impQual typ-    where-    positioned err = case pos of-      Nothing -> err-      Just pos' -> rethrowWithPosition pos' err+    resolveImport mn modExports ie'' impQual ss typ  -- | -- Extends the local environment for a module by resolving an import of another module.@@ -95,67 +90,68 @@   -> Exports   -> Imports   -> Maybe ModuleName+  -> SourceSpan   -> Maybe ImportDeclarationType   -> m Imports resolveImport importModule exps imps impQual = resolveByType   where -  resolveByType :: Maybe ImportDeclarationType -> m Imports-  resolveByType Nothing =-    importAll (importRef Local)-  resolveByType (Just Implicit) =-    importAll (importRef FromImplicit)-  resolveByType (Just (Explicit refs)) =+  resolveByType :: SourceSpan -> Maybe ImportDeclarationType -> m Imports+  resolveByType ss Nothing =+    importAll ss (importRef Local)+  resolveByType ss (Just Implicit) =+    importAll ss (importRef FromImplicit)+  resolveByType _ (Just (Explicit refs)) =     checkRefs False refs >> foldM (importRef FromExplicit) imps refs-  resolveByType (Just (Hiding refs)) =-    checkRefs True refs >> importAll (importNonHidden refs)+  resolveByType ss (Just (Hiding refs)) =+    checkRefs True refs >> importAll ss (importNonHidden refs)    -- Check that a 'DeclarationRef' refers to an importable symbol   checkRefs :: Bool -> [DeclarationRef] -> m ()   checkRefs isHiding = traverse_ check     where-    check (PositionedDeclarationRef pos _ r) =-      rethrowWithPosition pos $ check r-    check (ValueRef name) =-      checkImportExists IdentName (exportedValues exps) name-    check (ValueOpRef op) =-      checkImportExists ValOpName (exportedValueOps exps) op-    check (TypeRef name dctors) = do-      checkImportExists TyName (exportedTypes exps) name+    check (ValueRef ss name) =+      checkImportExists ss IdentName (exportedValues exps) name+    check (ValueOpRef ss op) =+      checkImportExists ss ValOpName (exportedValueOps exps) op+    check (TypeRef ss name dctors) = do+      checkImportExists ss TyName (exportedTypes exps) name       let (allDctors, _) = allExportedDataConstructors name-      for_ dctors $ traverse_ (checkDctorExists name allDctors)-    check (TypeOpRef name) =-      checkImportExists TyOpName (exportedTypeOps exps) name-    check (TypeClassRef name) =-      checkImportExists TyClassName (exportedTypeClasses exps) name-    check (ModuleRef name) | isHiding =-      throwError . errorMessage $ ImportHidingModule name-    check (KindRef name) = do-      checkImportExists KiName (exportedKinds exps) name+      for_ dctors $ traverse_ (checkDctorExists ss name allDctors)+    check (TypeOpRef ss name) =+      checkImportExists ss TyOpName (exportedTypeOps exps) name+    check (TypeClassRef ss name) =+      checkImportExists ss TyClassName (exportedTypeClasses exps) name+    check (ModuleRef ss name) | isHiding =+      throwError . errorMessage' ss $ ImportHidingModule name+    check (KindRef ss name) =+      checkImportExists ss KiName (exportedKinds exps) name     check r = internalError $ "Invalid argument to checkRefs: " ++ show r    -- Check that an explicitly imported item exists in the module it is being imported from   checkImportExists     :: Ord a-    => (a -> Name)+    => SourceSpan+    -> (a -> Name)     -> M.Map a b     -> a     -> m ()-  checkImportExists toName exports item+  checkImportExists ss toName exports item     = when (item `M.notMember` exports)-    . throwError . errorMessage+    . throwError . errorMessage' ss     $ UnknownImport importModule (toName item)    -- Ensure that an explicitly imported data constructor exists for the type it is being imported   -- from   checkDctorExists-    :: ProperName 'TypeName+    :: SourceSpan+    -> ProperName 'TypeName     -> [ProperName 'ConstructorName]     -> ProperName 'ConstructorName     -> m ()-  checkDctorExists tcon exports dctor+  checkDctorExists ss tcon exports dctor     = when (dctor `notElem` exports)-    . throwError . errorMessage+    . throwError . errorMessage' ss     $ UnknownImportDataConstructor importModule tcon dctor    importNonHidden :: [DeclarationRef] -> Imports -> DeclarationRef -> m Imports@@ -164,51 +160,47 @@     where     -- TODO: rework this to be not confusing     isHidden :: DeclarationRef -> Bool-    isHidden ref'@(TypeRef _ _) = foldl (checkTypeRef ref') False hidden+    isHidden ref'@TypeRef{} = foldl (checkTypeRef ref') False hidden     isHidden ref' = ref' `elem` hidden     checkTypeRef :: DeclarationRef -> Bool -> DeclarationRef -> Bool     checkTypeRef _ True _ = True-    checkTypeRef r acc (PositionedDeclarationRef _ _ h) = checkTypeRef r acc h-    checkTypeRef (TypeRef _ Nothing) acc (TypeRef _ (Just _)) = acc-    checkTypeRef (TypeRef name (Just dctor)) _ (TypeRef name' (Just dctor')) = name == name' && dctor == dctor'-    checkTypeRef (TypeRef name _) _ (TypeRef name' Nothing) = name == name'-    checkTypeRef (PositionedDeclarationRef _ _ r) acc hiddenRef = checkTypeRef r acc hiddenRef+    checkTypeRef (TypeRef _ _ Nothing) acc (TypeRef _ _ (Just _)) = acc+    checkTypeRef (TypeRef _ name (Just dctor)) _ (TypeRef _ name' (Just dctor')) = name == name' && dctor == dctor'+    checkTypeRef (TypeRef _ name _) _ (TypeRef _ name' Nothing) = name == name'     checkTypeRef _ acc _ = acc    -- Import all symbols-  importAll :: (Imports -> DeclarationRef -> m Imports) -> m Imports-  importAll importer =-    foldM (\m (name, (dctors, _)) -> importer m (TypeRef name (Just dctors))) imps (M.toList (exportedTypes exps))-      >>= flip (foldM (\m (name, _) -> importer m (TypeOpRef name))) (M.toList (exportedTypeOps exps))-      >>= flip (foldM (\m (name, _) -> importer m (ValueRef name))) (M.toList (exportedValues exps))-      >>= flip (foldM (\m (name, _) -> importer m (ValueOpRef name))) (M.toList (exportedValueOps exps))-      >>= flip (foldM (\m (name, _) -> importer m (TypeClassRef name))) (M.toList (exportedTypeClasses exps))-      >>= flip (foldM (\m (name, _) -> importer m (KindRef name))) (M.toList (exportedKinds exps))+  importAll :: SourceSpan -> (Imports -> DeclarationRef -> m Imports) -> m Imports+  importAll ss importer =+    foldM (\m (name, (dctors, _)) -> importer m (TypeRef ss name (Just dctors))) imps (M.toList (exportedTypes exps))+      >>= flip (foldM (\m (name, _) -> importer m (TypeOpRef ss name))) (M.toList (exportedTypeOps exps))+      >>= flip (foldM (\m (name, _) -> importer m (ValueRef ss name))) (M.toList (exportedValues exps))+      >>= flip (foldM (\m (name, _) -> importer m (ValueOpRef ss name))) (M.toList (exportedValueOps exps))+      >>= flip (foldM (\m (name, _) -> importer m (TypeClassRef ss name))) (M.toList (exportedTypeClasses exps))+      >>= flip (foldM (\m (name, _) -> importer m (KindRef ss name))) (M.toList (exportedKinds exps))    importRef :: ImportProvenance -> Imports -> DeclarationRef -> m Imports-  importRef prov imp (PositionedDeclarationRef pos _ r) =-    rethrowWithPosition pos $ importRef prov imp r-  importRef prov imp (ValueRef name) = do+  importRef prov imp (ValueRef _ name) = do     let values' = updateImports (importedValues imp) (exportedValues exps) id name prov     return $ imp { importedValues = values' }-  importRef prov imp (ValueOpRef name) = do+  importRef prov imp (ValueOpRef _ name) = do     let valueOps' = updateImports (importedValueOps imp) (exportedValueOps exps) id name prov     return $ imp { importedValueOps = valueOps' }-  importRef prov imp (TypeRef name dctors) = do+  importRef prov imp (TypeRef ss name dctors) = do     let types' = updateImports (importedTypes imp) (exportedTypes exps) snd name prov     let (dctorNames, mn) = allExportedDataConstructors name         dctorLookup :: M.Map (ProperName 'ConstructorName) ModuleName         dctorLookup = M.fromList $ map (, mn) dctorNames-    traverse_ (traverse_ $ checkDctorExists name dctorNames) dctors+    traverse_ (traverse_ $ checkDctorExists ss name dctorNames) dctors     let dctors' = foldl (\m d -> updateImports m dctorLookup id d prov) (importedDataConstructors imp) (fromMaybe dctorNames dctors)     return $ imp { importedTypes = types', importedDataConstructors = dctors' }-  importRef prov imp (TypeOpRef name) = do+  importRef prov imp (TypeOpRef _ name) = do     let ops' = updateImports (importedTypeOps imp) (exportedTypeOps exps) id name prov     return $ imp { importedTypeOps = ops' }-  importRef prov imp (TypeClassRef name) = do+  importRef prov imp (TypeClassRef _ name) = do     let typeClasses' = updateImports (importedTypeClasses imp) (exportedTypeClasses exps) id name prov     return $ imp { importedTypeClasses = typeClasses' }-  importRef prov imp (KindRef name) = do+  importRef prov imp (KindRef _ name) = do     let kinds' = updateImports (importedKinds imp) (exportedKinds exps) id name prov     return $ imp { importedKinds = kinds' }   importRef _ _ TypeInstanceRef{} = internalError "TypeInstanceRef in importRef"

src/Language/PureScript/Sugar/ObjectWildcards.hs view

@@ -26,8 +26,7 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> mapM desugarDecl ds <*> pure exts  desugarDecl :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration-desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d-desugarDecl other = fn other+desugarDecl d = rethrowWithPosition (declSourceSpan d) $ fn d   where   (fn, _, _) = everywhereOnValuesTopDownM return desugarExpr return @@ -70,7 +69,7 @@       then Abs (VarBinder val) <$> wrapLambda (buildUpdates valExpr) ps       else wrapLambda (buildLet val . buildUpdates valExpr) ps     where-      buildLet val = Let [ValueDeclaration val Public [] [MkUnguarded obj]]+      buildLet val = Let [ValueDeclaration (declSourceSpan d, []) val Public [] [MkUnguarded obj]]        -- recursively build up the nested `ObjectUpdate` expressions       buildUpdates :: Expr -> PathTree Expr -> Expr

src/Language/PureScript/Sugar/Operators.hs view

@@ -116,16 +116,12 @@     (f', _, _, _, _) =       everywhereWithContextOnValuesM         Nothing-        (\pos -> uncurry goDecl <=< goDecl' pos)+        (\_ d -> (Just (declSourceSpan d),) <$> goDecl' d)         (\pos -> uncurry goExpr <=< goExpr' pos)         (\pos -> uncurry goBinder <=< goBinder' pos)         defS         defS -    goDecl :: Maybe SourceSpan -> Declaration -> m (Maybe SourceSpan, Declaration)-    goDecl _ d@(PositionedDeclaration pos _ _) = return (Just pos, d)-    goDecl pos other = return (pos, other)-     goExpr :: Maybe SourceSpan -> Expr -> m (Maybe SourceSpan, Expr)     goExpr _ e@(PositionedValue pos _ _) = return (Just pos, e)     goExpr pos (Op op) =@@ -180,7 +176,7 @@   where   (f, _, _) =       everywhereOnValuesTopDownM-        (decontextify goDecl)+        goDecl         (goExpr <=< decontextify goExpr')         (goBinder <=< decontextify goBinder') @@ -203,7 +199,7 @@   where   (f, _, _) =       everywhereOnValues-        (decontextify goDecl)+        (runIdentity . goDecl)         (goExpr . decontextify goExpr')         (goBinder . decontextify goBinder') @@ -258,11 +254,10 @@ collectFixities (Module _ _ moduleName ds _) = concatMap collect ds   where   collect :: Declaration -> [Either ValueFixityRecord TypeFixityRecord]-  collect (PositionedDeclaration pos _ (ValueFixityDeclaration fixity name op)) =-    [Left (Qualified (Just moduleName) op, pos, fixity, name)]-  collect (PositionedDeclaration pos _ (TypeFixityDeclaration fixity name op)) =-    [Right (Qualified (Just moduleName) op, pos, fixity, name)]-  collect FixityDeclaration{} = internalError "Fixity without srcpos info"+  collect (ValueFixityDeclaration (ss, _) fixity name op) =+    [Left (Qualified (Just moduleName) op, ss, fixity, name)]+  collect (TypeFixityDeclaration (ss, _) fixity name op) =+    [Right (Qualified (Just moduleName) op, ss, fixity, name)]   collect _ = []  ensureNoDuplicates@@ -294,9 +289,9 @@   :: forall m    . Monad m   => (Maybe SourceSpan -> Type -> m Type)-  -> ( Maybe SourceSpan -> Declaration  -> m (Maybe SourceSpan, Declaration)-     , Maybe SourceSpan -> Expr         -> m (Maybe SourceSpan, Expr)-     , Maybe SourceSpan -> Binder       -> m (Maybe SourceSpan, Binder)+  -> ( Declaration -> m Declaration+     , Maybe SourceSpan -> Expr -> m (Maybe SourceSpan, Expr)+     , Maybe SourceSpan -> Binder -> m (Maybe SourceSpan, Binder)      ) updateTypes goType = (goDecl, goExpr, goBinder)   where@@ -304,29 +299,28 @@   goType' :: Maybe SourceSpan -> Type -> m Type   goType' = everywhereOnTypesM . goType -  goDecl :: Maybe SourceSpan -> Declaration -> m (Maybe SourceSpan, Declaration)-  goDecl _ d@(PositionedDeclaration pos _ _) = return (Just pos, d)-  goDecl pos (DataDeclaration ddt name args dctors) = do-    dctors' <- traverse (sndM (traverse (goType' pos))) dctors-    return (pos, DataDeclaration ddt name args dctors')-  goDecl pos (ExternDeclaration name ty) = do-    ty' <- goType' pos ty-    return (pos, ExternDeclaration name ty')-  goDecl pos (TypeClassDeclaration name args implies deps decls) = do-    implies' <- traverse (overConstraintArgs (traverse (goType' pos))) implies-    return (pos, TypeClassDeclaration name args implies' deps decls)-  goDecl pos (TypeInstanceDeclaration name cs className tys impls) = do-    cs' <- traverse (overConstraintArgs (traverse (goType' pos))) cs-    tys' <- traverse (goType' pos) tys-    return (pos, TypeInstanceDeclaration name cs' className tys' impls)-  goDecl pos (TypeSynonymDeclaration name args ty) = do-    ty' <- goType' pos ty-    return (pos, TypeSynonymDeclaration name args ty')-  goDecl pos (TypeDeclaration expr ty) = do-    ty' <- goType' pos ty-    return (pos, TypeDeclaration expr ty')-  goDecl pos other = return (pos, other)+  goType'' :: SourceSpan -> Type -> m Type+  goType'' = goType' . Just +  goDecl :: Declaration -> m Declaration+  goDecl (DataDeclaration sa@(ss, _) ddt name args dctors) =+    DataDeclaration sa ddt name args <$> traverse (sndM (traverse (goType'' ss))) dctors+  goDecl (ExternDeclaration sa@(ss, _) name ty) =+    ExternDeclaration sa name <$> goType'' ss ty+  goDecl (TypeClassDeclaration sa@(ss, _) name args implies deps decls) = do+    implies' <- traverse (overConstraintArgs (traverse (goType'' ss))) implies+    return $ TypeClassDeclaration sa name args implies' deps decls+  goDecl (TypeInstanceDeclaration sa@(ss, _) name cs className tys impls) = do+    cs' <- traverse (overConstraintArgs (traverse (goType'' ss))) cs+    tys' <- traverse (goType'' ss) tys+    return $ TypeInstanceDeclaration sa name cs' className tys' impls+  goDecl (TypeSynonymDeclaration sa@(ss, _) name args ty) =+    TypeSynonymDeclaration sa name args <$> goType'' ss ty+  goDecl (TypeDeclaration sa@(ss, _) expr ty) =+    TypeDeclaration sa expr <$> goType'' ss ty+  goDecl other =+    return other+   goExpr :: Maybe SourceSpan -> Expr -> m (Maybe SourceSpan, Expr)   goExpr _ e@(PositionedValue pos _ _) = return (Just pos, e)   goExpr pos (TypeClassDictionary (Constraint name tys info) dicts hints) = do@@ -367,23 +361,21 @@   where    checkRef :: DeclarationRef -> m ()-  checkRef (PositionedDeclarationRef pos _ d) =-    rethrowWithPosition pos $ checkRef d-  checkRef dr@(ValueOpRef op) =+  checkRef dr@(ValueOpRef ss' op) =     for_ (getValueOpAlias op) $ \case       Left ident ->-        unless (ValueRef ident `elem` exps)-          . throwError . errorMessage-          $ TransitiveExportError dr [ValueRef ident]+        unless (ValueRef ss' ident `elem` exps)+          . throwError . errorMessage' ss'+          $ TransitiveExportError dr [ValueRef ss' ident]       Right ctor ->         unless (anyTypeRef (maybe False (elem ctor) . snd))-          . throwError . errorMessage+          . throwError . errorMessage' ss           $ TransitiveDctorExportError dr ctor-  checkRef dr@(TypeOpRef op) =+  checkRef dr@(TypeOpRef ss' op) =     for_ (getTypeOpAlias op) $ \ty ->       unless (anyTypeRef ((== ty) . fst))-        . throwError . errorMessage-        $ TransitiveExportError dr [TypeRef ty Nothing]+        . throwError . errorMessage' ss'+        $ TransitiveExportError dr [TypeRef ss' ty Nothing]   checkRef _ = return ()    -- Finds the name associated with a type operator when that type is also

src/Language/PureScript/Sugar/TypeClasses.hs view

@@ -176,30 +176,27 @@   -> Desugar m (Maybe DeclarationRef, [Declaration]) desugarDecl mn exps = go   where-  go d@(TypeClassDeclaration name args implies deps members) = do+  go d@(TypeClassDeclaration sa name args implies deps members) = do     modify (M.insert (mn, name) (makeTypeClassData args (map memberToNameAndType members) implies deps))-    return (Nothing, d : typeClassDictionaryDeclaration name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)-  go (TypeInstanceDeclaration _ _ _ _ DerivedInstance) = internalError "Derived instanced should have been desugared"-  go d@(TypeInstanceDeclaration name deps className tys (ExplicitInstance members)) = do+    return (Nothing, d : typeClassDictionaryDeclaration sa name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)+  go (TypeInstanceDeclaration _ _ _ _ _ DerivedInstance) = internalError "Derived instanced should have been desugared"+  go d@(TypeInstanceDeclaration sa name deps className tys (ExplicitInstance members)) = do     desugared <- desugarCases members-    dictDecl <- typeInstanceDictionaryDeclaration name mn deps className tys desugared+    dictDecl <- typeInstanceDictionaryDeclaration sa name mn deps className tys desugared     return (expRef name className tys, [d, dictDecl])-  go d@(TypeInstanceDeclaration name deps className tys (NewtypeInstanceWithDictionary dict)) = do+  go d@(TypeInstanceDeclaration sa name deps className tys (NewtypeInstanceWithDictionary dict)) = do     let dictTy = foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys         constrainedTy = quantify (foldr ConstrainedType dictTy deps)-    return (expRef name className tys, [d, ValueDeclaration name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]])-  go (PositionedDeclaration pos com d) = do-    (dr, ds) <- rethrowWithPosition pos $ desugarDecl mn exps d-    return (dr, map (PositionedDeclaration pos com) ds)+    return (expRef name className tys, [d, ValueDeclaration sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]])   go other = return (Nothing, [other])    expRef :: Ident -> Qualified (ProperName 'ClassName) -> [Type] -> Maybe DeclarationRef   expRef name className tys-    | isExportedClass className && all isExportedType (getConstructors `concatMap` tys) = Just $ TypeInstanceRef name+    | isExportedClass className && all isExportedType (getConstructors `concatMap` tys) = Just $ TypeInstanceRef genSpan name     | otherwise = Nothing    isExportedClass :: Qualified (ProperName 'ClassName) -> Bool-  isExportedClass = isExported (elem . TypeClassRef)+  isExportedClass = isExported (elem . TypeClassRef genSpan)    isExportedType :: Qualified (ProperName 'TypeName) -> Bool   isExportedType = isExported $ \pn -> isJust . find (matchesTypeRef pn)@@ -212,7 +209,7 @@   isExported _ _ = internalError "Names should have been qualified in name desugaring"    matchesTypeRef :: ProperName 'TypeName -> DeclarationRef -> Bool-  matchesTypeRef pn (TypeRef pn' _) = pn == pn'+  matchesTypeRef pn (TypeRef _ pn' _) = pn == pn'   matchesTypeRef _ _ = False    getConstructors :: Type -> [Qualified (ProperName 'TypeName)]@@ -221,25 +218,28 @@     getConstructor (TypeConstructor tcname) = [tcname]     getConstructor _ = [] +  genSpan :: SourceSpan+  genSpan = internalModuleSourceSpan "<generated>"+ memberToNameAndType :: Declaration -> (Ident, Type)-memberToNameAndType (TypeDeclaration ident ty) = (ident, ty)-memberToNameAndType (PositionedDeclaration _ _ d) = memberToNameAndType d+memberToNameAndType (TypeDeclaration _ ident ty) = (ident, ty) memberToNameAndType _ = internalError "Invalid declaration in type class definition"  typeClassDictionaryDeclaration-  :: ProperName 'ClassName+  :: SourceAnn+  -> ProperName 'ClassName   -> [(Text, Maybe Kind)]   -> [Constraint]   -> [Declaration]   -> Declaration-typeClassDictionaryDeclaration name args implies members =+typeClassDictionaryDeclaration sa name args implies members =   let superclassTypes = superClassDictionaryNames implies `zip`         [ function unit (foldl TypeApp (TypeConstructor (fmap coerceProperName superclass)) tyArgs)         | (Constraint superclass tyArgs _) <- implies         ]       members' = map (first runIdent . memberToNameAndType) members       mtys = members' ++ superclassTypes-  in TypeSynonymDeclaration (coerceProperName name) args (TypeApp tyRecord $ rowFromList (map (first (Label . mkString)) mtys, REmpty))+  in TypeSynonymDeclaration sa (coerceProperName name) args (TypeApp tyRecord $ rowFromList (map (first (Label . mkString)) mtys, REmpty))  typeClassMemberToDictionaryAccessor   :: ModuleName@@ -247,15 +247,13 @@   -> [(Text, Maybe Kind)]   -> Declaration   -> Declaration-typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =+typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration sa ident ty) =   let className = Qualified (Just mn) name-  in ValueDeclaration ident Private [] $+  in ValueDeclaration sa ident Private [] $     [MkUnguarded (      TypedValue False (TypeClassDictionaryAccessor className ident) $        moveQuantifiersToFront (quantify (ConstrainedType (Constraint className (map (TypeVar . fst) args) Nothing) ty))     )]-typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos com d) =-  PositionedDeclaration pos com $ typeClassMemberToDictionaryAccessor mn name args d typeClassMemberToDictionaryAccessor _ _ _ _ = internalError "Invalid declaration in type class definition"  unit :: Type@@ -264,14 +262,15 @@ typeInstanceDictionaryDeclaration   :: forall m    . (MonadSupply m, MonadError MultipleErrors m)-  => Ident+  => SourceAnn+  -> Ident   -> ModuleName   -> [Constraint]   -> Qualified (ProperName 'ClassName)   -> [Type]   -> [Declaration]   -> Desugar m Declaration-typeInstanceDictionaryDeclaration name mn deps className tys decls =+typeInstanceDictionaryDeclaration sa name mn deps className tys decls =   rethrow (addHint (ErrorInInstance className tys)) $ do   m <- get @@ -302,30 +301,25 @@           dictTy = foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys           constrainedTy = quantify (foldr ConstrainedType dictTy deps)           dict = TypeClassDictionaryConstructorApp className props-          result = ValueDeclaration name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]+          result = ValueDeclaration sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]       return result    where    declName :: Declaration -> Maybe Ident-  declName (PositionedDeclaration _ _ d) = declName d-  declName (ValueDeclaration ident _ _ _) = Just ident-  declName (TypeDeclaration ident _) = Just ident+  declName (ValueDeclaration _ ident _ _ _) = Just ident+  declName (TypeDeclaration _ ident _) = Just ident   declName _ = Nothing    memberToValue :: [(Ident, Type)] -> Declaration -> Desugar m Expr-  memberToValue tys' (ValueDeclaration ident _ [] [MkUnguarded val]) = do+  memberToValue tys' (ValueDeclaration _ ident _ [] [MkUnguarded val]) = do     _ <- maybe (throwError . errorMessage $ ExtraneousClassMember ident className) return $ lookup ident tys'     return val-  memberToValue tys' (PositionedDeclaration pos com d) = rethrowWithPosition pos $ do-    val <- memberToValue tys' d-    return (PositionedValue pos com val)   memberToValue _ _ = internalError "Invalid declaration in type instance definition"  typeClassMemberName :: Declaration -> Text-typeClassMemberName (TypeDeclaration ident _) = runIdent ident-typeClassMemberName (ValueDeclaration ident _ _ _) = runIdent ident-typeClassMemberName (PositionedDeclaration _ _ d) = typeClassMemberName d+typeClassMemberName (TypeDeclaration _ ident _) = runIdent ident+typeClassMemberName (ValueDeclaration _ ident _ _ _) = runIdent ident typeClassMemberName _ = internalError "typeClassMemberName: Invalid declaration in type class definition"  superClassDictionaryNames :: [Constraint] -> [Text]

src/Language/PureScript/Sugar/TypeClasses/Deriving.hs view

@@ -84,9 +84,8 @@         fromExternsDecl mn' (EDTypeSynonym name args ty) = Just (Qualified (Just mn') name, (args, ty))         fromExternsDecl _ _ = Nothing -        fromLocalDecl (TypeSynonymDeclaration name args ty) = do+        fromLocalDecl (TypeSynonymDeclaration _ name args ty) =           Just (Qualified (Just mn) name, (args, ty))-        fromLocalDecl (PositionedDeclaration _ _ d) = fromLocalDecl d         fromLocalDecl _ = Nothing      instanceData :: NewtypeDerivedInstances@@ -99,11 +98,10 @@           foldMap (\nm -> NewtypeDerivedInstances mempty (S.singleton (qualify mn' edInstanceClassName, nm))) (extractNewtypeName mn' edInstanceTypes)         fromExternsDecl _ _ = mempty -        fromLocalDecl (TypeClassDeclaration cl args cons deps _) =+        fromLocalDecl (TypeClassDeclaration _ cl args cons deps _) =           NewtypeDerivedInstances (M.singleton (mn, cl) (map fst args, cons, deps)) mempty-        fromLocalDecl (TypeInstanceDeclaration _ _ cl tys _) =+        fromLocalDecl (TypeInstanceDeclaration _ _ _ cl tys _) =           foldMap (\nm -> NewtypeDerivedInstances mempty (S.singleton (qualify mn cl, nm))) (extractNewtypeName mn tys)-        fromLocalDecl (PositionedDeclaration _ _ d) = fromLocalDecl d         fromLocalDecl _ = mempty  -- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,@@ -116,62 +114,61 @@   -> [Declaration]   -> Declaration   -> m Declaration-deriveInstance mn syns _ ds (TypeInstanceDeclaration nm deps className tys DerivedInstance)+deriveInstance mn syns _ ds (TypeInstanceDeclaration sa@(ss, _) nm deps className tys DerivedInstance)   | className == Qualified (Just dataGeneric) (ProperName C.generic)   = case tys of       [ty] | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor ty            , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveGeneric mn syns ds tyCon args-           | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 1+           -> TypeInstanceDeclaration sa nm deps className tys . ExplicitInstance <$> deriveGeneric ss mn syns ds tyCon args+           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty+      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1   | className == Qualified (Just dataEq) (ProperName "Eq")   = case tys of       [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty            , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveEq mn syns ds tyCon-           | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 1+           -> TypeInstanceDeclaration sa nm deps className tys . ExplicitInstance <$> deriveEq ss mn syns ds tyCon+           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty+      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1   | className == Qualified (Just dataOrd) (ProperName "Ord")   = case tys of       [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty            , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveOrd mn syns ds tyCon-           | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 1+           -> TypeInstanceDeclaration sa nm deps className tys . ExplicitInstance <$> deriveOrd ss mn syns ds tyCon+           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty+      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1   | className == Qualified (Just dataFunctor) (ProperName "Functor")   = case tys of       [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty            , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveFunctor mn syns ds tyCon-           | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 1+           -> TypeInstanceDeclaration sa nm deps className tys . ExplicitInstance <$> deriveFunctor ss mn syns ds tyCon+           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty+      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1   | className == Qualified (Just dataNewtype) (ProperName "Newtype")   = case tys of       [wrappedTy, unwrappedTy]         | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy         , mn == fromMaybe mn mn'         -> do (inst, actualUnwrappedTy) <- deriveNewtype mn syns ds tyCon args unwrappedTy-              return $ TypeInstanceDeclaration nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst)-        | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys wrappedTy-      _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 2+              return $ TypeInstanceDeclaration sa nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst)+        | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys wrappedTy+      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2   | className == Qualified (Just dataGenericRep) (ProperName C.generic)   = case tys of       [actualTy, repTy]         | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor actualTy         , mn == fromMaybe mn mn'         -> do (inst, inferredRepTy) <- deriveGenericRep mn syns ds tyCon args repTy-              return $ TypeInstanceDeclaration nm deps className [actualTy, inferredRepTy] (ExplicitInstance inst)-        | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys actualTy-      _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 2-  | otherwise = throwError . errorMessage $ CannotDerive className tys-deriveInstance mn syns ndis ds (TypeInstanceDeclaration nm deps className tys NewtypeInstance) =+              return $ TypeInstanceDeclaration sa nm deps className [actualTy, inferredRepTy] (ExplicitInstance inst)+        | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys actualTy+      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2+  | otherwise = throwError . errorMessage' ss $ CannotDerive className tys+deriveInstance mn syns ndis ds (TypeInstanceDeclaration sa@(ss, _) nm deps className tys NewtypeInstance) =   case tys of     _ : _ | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor (last tys)           , mn == fromMaybe mn mn'-          -> TypeInstanceDeclaration nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance mn syns ndis className ds tys tyCon args-          | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys (last tys)-    _ -> throwError . errorMessage $ InvalidNewtypeInstance className tys-deriveInstance mn syns ndis ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn syns ndis ds d+          -> TypeInstanceDeclaration sa nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance ss mn syns ndis className ds tys tyCon args+          | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys (last tys)+    _ -> throwError . errorMessage' ss $ InvalidNewtypeInstance className tys deriveInstance _ _ _ _ e = return e  unwrapTypeConstructor :: Type -> Maybe (Qualified (ProperName 'TypeName), [Type])@@ -186,7 +183,8 @@ deriveNewtypeInstance   :: forall m    . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => ModuleName+  => SourceSpan+  -> ModuleName   -> SynonymMap   -> NewtypeDerivedInstances   -> Qualified (ProperName 'ClassName)@@ -195,12 +193,12 @@   -> ProperName 'TypeName   -> [Type]   -> m Expr-deriveNewtypeInstance mn syns ndis className ds tys tyConNm dargs = do+deriveNewtypeInstance ss mn syns ndis className ds tys tyConNm dargs = do     verifySuperclasses     tyCon <- findTypeDecl tyConNm ds     go tyCon   where-    go (DataDeclaration Newtype _ tyArgNames [(_, [wrapped])])+    go (DataDeclaration _ Newtype _ tyArgNames [(_, [wrapped])])       -- The newtype might not be applied to all type arguments.       -- This is okay as long as the newtype wraps something which ends with       -- sufficiently many type applications to variables.@@ -214,8 +212,7 @@           do let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs              wrapped'' <- replaceAllTypeSynonymsM syns wrapped'              return (DeferredDictionary className (init tys ++ [replaceAllTypeVars subst wrapped'']))-    go (PositionedDeclaration _ _ d) = go d-    go _ = throwError . errorMessage $ InvalidNewtypeInstance className tys+    go _ = throwError . errorMessage' ss $ InvalidNewtypeInstance className tys      takeReverse :: Int -> [a] -> [a]     takeReverse n = take n . reverse@@ -248,8 +245,8 @@                   -- be possible, so we warn again.                   for_ (extractNewtypeName mn tys) $ \nm ->                     unless ((constraintClass', nm) `S.member` ndiDerivedInstances ndis) $-                      tell . errorMessage $ MissingNewtypeSuperclassInstance constraintClass className tys-                else tell . errorMessage $ UnverifiableSuperclassInstance constraintClass className tys+                      tell . errorMessage' ss $ MissingNewtypeSuperclassInstance constraintClass className tys+                else tell . errorMessage' ss $ UnverifiableSuperclassInstance constraintClass className tys  dataGeneric :: ModuleName dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]@@ -280,24 +277,25 @@  deriveGeneric   :: forall m. (MonadError MultipleErrors m, MonadSupply m)-  => ModuleName+  => SourceSpan+  -> ModuleName   -> SynonymMap   -> [Declaration]   -> ProperName 'TypeName   -> [Type]   -> m [Declaration]-deriveGeneric mn syns ds tyConNm dargs = do+deriveGeneric ss mn syns ds tyConNm dargs = do   tyCon <- findTypeDecl tyConNm ds   toSpine <- mkSpineFunction tyCon   fromSpine <- mkFromSpineFunction tyCon   toSignature <- mkSignatureFunction tyCon dargs-  return [ ValueDeclaration (Ident C.toSpine) Public [] (unguarded toSpine)-         , ValueDeclaration (Ident C.fromSpine) Public [] (unguarded fromSpine)-         , ValueDeclaration (Ident C.toSignature) Public [] (unguarded toSignature)+  return [ ValueDeclaration (ss, []) (Ident C.toSpine) Public [] (unguarded toSpine)+         , ValueDeclaration (ss, []) (Ident C.fromSpine) Public [] (unguarded fromSpine)+         , ValueDeclaration (ss, []) (Ident C.toSignature) Public [] (unguarded toSignature)          ]   where     mkSpineFunction :: Declaration -> m Expr-    mkSpineFunction (DataDeclaration _ _ _ args) = do+    mkSpineFunction (DataDeclaration _ _ _ _ args) = do       x <- freshIdent'       lamCase x <$> mapM mkCtorClause args       where@@ -330,11 +328,10 @@             )           $ fields       toSpineFun i _ = lamNull $ App (mkGenVar (Ident C.toSpine)) i-    mkSpineFunction (PositionedDeclaration _ _ d) = mkSpineFunction d     mkSpineFunction _ = internalError "mkSpineFunction: expected DataDeclaration"      mkSignatureFunction :: Declaration -> [Type] -> m Expr-    mkSignatureFunction (DataDeclaration _ name tyArgs args) classArgs = lamNull . mkSigProd <$> mapM mkProdClause args+    mkSignatureFunction (DataDeclaration _ _ name tyArgs args) classArgs = lamNull . mkSigProd <$> mapM mkProdClause args       where       mkSigProd :: [Expr] -> Expr       mkSigProd =@@ -373,11 +370,10 @@       mkProductSignature typ = lamNull $ App (mkGenVar (Ident C.toSignature))                                (TypedValue False (mkGenVar (Ident "anyProxy")) (proxy typ))       instantiate = replaceAllTypeVars (zipWith (\(arg, _) ty -> (arg, ty)) tyArgs classArgs)-    mkSignatureFunction (PositionedDeclaration _ _ d) classArgs = mkSignatureFunction d classArgs     mkSignatureFunction _ _ = internalError "mkSignatureFunction: expected DataDeclaration"      mkFromSpineFunction :: Declaration -> m Expr-    mkFromSpineFunction (DataDeclaration _ _ _ args) = do+    mkFromSpineFunction (DataDeclaration _ _ _ _ args) = do       x <- freshIdent'       lamCase x <$> (addCatch <$> mapM mkAlternative args)       where@@ -434,7 +430,6 @@       mkRecFun :: [(Label, Type)] -> Expr       mkRecFun xs = mkJust $ foldr (lam . labelToIdent . fst) recLiteral xs         where recLiteral = Literal . ObjectLiteral $ map (\(l@(Label s), _) -> (s, mkVar $ labelToIdent l)) xs-    mkFromSpineFunction (PositionedDeclaration _ _ d) = mkFromSpineFunction d     mkFromSpineFunction _ = internalError "mkFromSpineFunction: expected DataDeclaration"      -- Helpers@@ -466,31 +461,30 @@     go =<< findTypeDecl tyConNm ds   where     go :: Declaration -> m ([Declaration], Type)-    go (DataDeclaration _ _ args dctors) = do+    go (DataDeclaration (ss, _) _ _ args dctors) = do       x <- freshIdent "x"       (reps, to, from) <- unzip3 <$> traverse makeInst dctors       let rep = toRepTy reps           inst | null reps =                    -- If there are no cases, spin-                   [ ValueDeclaration (Ident "to") Public [] $ unguarded $+                   [ ValueDeclaration (ss, []) (Ident "to") Public [] $ unguarded $                        lamCase x [ CaseAlternative [NullBinder]                                                    (unguarded (App toName (Var (Qualified Nothing x))))                                  ]-                   , ValueDeclaration (Ident "from") Public [] $ unguarded $+                   , ValueDeclaration (ss, []) (Ident "from") Public [] $ unguarded $                        lamCase x [ CaseAlternative [NullBinder]                                                    (unguarded (App fromName (Var (Qualified Nothing x))))                                  ]                    ]                | otherwise =-                   [ ValueDeclaration (Ident "to") Public [] $ unguarded $+                   [ ValueDeclaration (ss, []) (Ident "to") Public [] $ unguarded $                        lamCase x (zipWith ($) (map underBinder (sumBinders (length dctors))) to)-                   , ValueDeclaration (Ident "from") Public [] $ unguarded $+                   , ValueDeclaration (ss, []) (Ident "from") Public [] $ unguarded $                        lamCase x (zipWith ($) (map underExpr (sumExprs (length dctors))) from)                    ]            subst = zipWith ((,) . fst) args tyConArgs       return (inst, replaceAllTypeVars subst rep)-    go (PositionedDeclaration _ _ d) = go d     go _ = internalError "deriveGenericRep go: expected DataDeclaration"      select :: (a -> a) -> (a -> a) -> Int -> [a -> a]@@ -643,24 +637,25 @@ checkIsWildcard tyConNm _ =   throwError . errorMessage $ ExpectedWildcard tyConNm -deriveEq ::-  forall m. (MonadError MultipleErrors m, MonadSupply m)-  => ModuleName+deriveEq+  :: forall m+   . (MonadError MultipleErrors m, MonadSupply m)+  => SourceSpan+  -> ModuleName   -> SynonymMap   -> [Declaration]   -> ProperName 'TypeName   -> m [Declaration]-deriveEq mn syns ds tyConNm = do+deriveEq ss mn syns ds tyConNm = do   tyCon <- findTypeDecl tyConNm ds   eqFun <- mkEqFunction tyCon-  return [ ValueDeclaration (Ident C.eq) Public [] (unguarded eqFun) ]+  return [ ValueDeclaration (ss, []) (Ident C.eq) Public [] (unguarded eqFun) ]   where     mkEqFunction :: Declaration -> m Expr-    mkEqFunction (DataDeclaration _ _ _ args) = do+    mkEqFunction (DataDeclaration _ _ _ _ args) = do       x <- freshIdent "x"       y <- freshIdent "y"       lamCase2 x y <$> (addCatch <$> mapM mkCtorClause args)-    mkEqFunction (PositionedDeclaration _ _ d) = mkEqFunction d     mkEqFunction _ = internalError "mkEqFunction: expected DataDeclaration"      preludeConj :: Expr -> Expr -> Expr@@ -698,24 +693,25 @@       $ fields     toEqTest l r _ = preludeEq l r -deriveOrd ::-  forall m. (MonadError MultipleErrors m, MonadSupply m)-  => ModuleName+deriveOrd+  :: forall m+   . (MonadError MultipleErrors m, MonadSupply m)+  => SourceSpan+  -> ModuleName   -> SynonymMap   -> [Declaration]   -> ProperName 'TypeName   -> m [Declaration]-deriveOrd mn syns ds tyConNm = do+deriveOrd ss mn syns ds tyConNm = do   tyCon <- findTypeDecl tyConNm ds   compareFun <- mkCompareFunction tyCon-  return [ ValueDeclaration (Ident C.compare) Public [] (unguarded compareFun) ]+  return [ ValueDeclaration (ss, []) (Ident C.compare) Public [] (unguarded compareFun) ]   where     mkCompareFunction :: Declaration -> m Expr-    mkCompareFunction (DataDeclaration _ _ _ args) = do+    mkCompareFunction (DataDeclaration _ _ _ _ args) = do       x <- freshIdent "x"       y <- freshIdent "y"       lamCase2 x y <$> (addCatch . concat <$> mapM mkCtorClauses (splitLast args))-    mkCompareFunction (PositionedDeclaration _ _ d) = mkCompareFunction d     mkCompareFunction _ = internalError "mkCompareFunction: expected DataDeclaration"      splitLast :: [a] -> [(a, Bool)]@@ -801,18 +797,18 @@     go =<< findTypeDecl tyConNm ds   where     go :: Declaration -> m ([Declaration], Type)-    go (DataDeclaration Data name _ _) =-      throwError . errorMessage $ CannotDeriveNewtypeForData name-    go (DataDeclaration Newtype name args dctors) = do+    go (DataDeclaration (ss, _) Data name _ _) =+      throwError . errorMessage' ss $ CannotDeriveNewtypeForData name+    go (DataDeclaration (ss, _) Newtype name args dctors) = do       checkNewtype name dctors       wrappedIdent <- freshIdent "n"       unwrappedIdent <- freshIdent "a"       let (ctorName, [ty]) = head dctors       ty' <- replaceAllTypeSynonymsM syns ty       let inst =-            [ ValueDeclaration (Ident "wrap") Public [] $ unguarded $+            [ ValueDeclaration (ss, []) (Ident "wrap") Public [] $ unguarded $                 Constructor (Qualified (Just mn) ctorName)-            , ValueDeclaration (Ident "unwrap") Public [] $ unguarded $+            , ValueDeclaration (ss, []) (Ident "unwrap") Public [] $ unguarded $                 lamCase wrappedIdent                   [ CaseAlternative                       [ConstructorBinder (Qualified (Just mn) ctorName) [VarBinder unwrappedIdent]]@@ -821,7 +817,6 @@             ]           subst = zipWith ((,) . fst) args tyConArgs       return (inst, replaceAllTypeVars subst ty')-    go (PositionedDeclaration _ _ d) = go d     go _ = internalError "deriveNewtype go: expected DataDeclaration"  findTypeDecl@@ -832,8 +827,7 @@ findTypeDecl tyConNm = maybe (throwError . errorMessage $ CannotFindDerivingType tyConNm) return . find isTypeDecl   where   isTypeDecl :: Declaration -> Bool-  isTypeDecl (DataDeclaration _ nm _ _) | nm == tyConNm = True-  isTypeDecl (PositionedDeclaration _ _ d) = isTypeDecl d+  isTypeDecl (DataDeclaration _ _ nm _ _) | nm == tyConNm = True   isTypeDecl _ = False  lam :: Ident -> Expr -> Expr@@ -883,24 +877,24 @@ deriveFunctor   :: forall m    . (MonadError MultipleErrors m, MonadSupply m)-  => ModuleName+  => SourceSpan+  -> ModuleName   -> SynonymMap   -> [Declaration]   -> ProperName 'TypeName   -> m [Declaration]-deriveFunctor mn syns ds tyConNm = do+deriveFunctor ss mn syns ds tyConNm = do   tyCon <- findTypeDecl tyConNm ds   mapFun <- mkMapFunction tyCon-  return [ ValueDeclaration (Ident C.map) Public [] (unguarded mapFun) ]+  return [ ValueDeclaration (ss, []) (Ident C.map) Public [] (unguarded mapFun) ]   where     mkMapFunction :: Declaration -> m Expr-    mkMapFunction (DataDeclaration _ _ tys ctors) = case reverse tys of-      [] -> throwError . errorMessage $ KindsDoNotUnify (FunKind kindType kindType) kindType+    mkMapFunction (DataDeclaration (ss', _) _ _ tys ctors) = case reverse tys of+      [] -> throwError . errorMessage' ss' $ KindsDoNotUnify (FunKind kindType kindType) kindType       ((iTy, _) : _) -> do         f <- freshIdent "f"         m <- freshIdent "m"         lam f . lamCase m <$> mapM (mkCtorClause iTy f) ctors-    mkMapFunction (PositionedDeclaration _ _ d) = mkMapFunction d     mkMapFunction _ = internalError "mkMapFunction: expected DataDeclaration"      mkCtorClause :: Text -> Ident -> (ProperName 'ConstructorName, [Type]) -> m CaseAlternative

src/Language/PureScript/Sugar/TypeDeclarations.hs view

@@ -23,39 +23,33 @@    . MonadError MultipleErrors m   => Module   -> m Module-desugarTypeDeclarationsModule (Module ss coms name ds exps) =+desugarTypeDeclarationsModule (Module modSS coms name ds exps) =   rethrow (addHint (ErrorInModule name)) $-    Module ss coms name <$> desugarTypeDeclarations ds <*> pure exps+    Module modSS coms name <$> desugarTypeDeclarations ds <*> pure exps   where    desugarTypeDeclarations :: [Declaration] -> m [Declaration]-  desugarTypeDeclarations (PositionedDeclaration pos com d : rest) = do-    (d' : rest') <- rethrowWithPosition pos $ desugarTypeDeclarations (d : rest)-    return (PositionedDeclaration pos com d' : rest')-  desugarTypeDeclarations (TypeDeclaration name' ty : d : rest) = do+  desugarTypeDeclarations (TypeDeclaration sa name' ty : d : rest) = do     (_, nameKind, val) <- fromValueDeclaration d-    desugarTypeDeclarations (ValueDeclaration name' nameKind [] [MkUnguarded (TypedValue True val ty)] : rest)+    desugarTypeDeclarations (ValueDeclaration sa name' nameKind [] [MkUnguarded (TypedValue True val ty)] : rest)     where     fromValueDeclaration :: Declaration -> m (Ident, NameKind, Expr)-    fromValueDeclaration (ValueDeclaration name'' nameKind [] [MkUnguarded val])+    fromValueDeclaration (ValueDeclaration _ name'' nameKind [] [MkUnguarded val])       | name' == name'' = return (name'', nameKind, val)-    fromValueDeclaration (PositionedDeclaration pos com d') = do-      (ident, nameKind, val) <- rethrowWithPosition pos $ fromValueDeclaration d'-      return (ident, nameKind, PositionedValue pos com val)-    fromValueDeclaration _ =-      throwError . errorMessage $ OrphanTypeDeclaration name'-  desugarTypeDeclarations [TypeDeclaration name' _] =-    throwError . errorMessage $ OrphanTypeDeclaration name'-  desugarTypeDeclarations (ValueDeclaration name' nameKind bs val : rest) = do+    fromValueDeclaration d' =+      throwError . errorMessage' (declSourceSpan d') $ OrphanTypeDeclaration name'+  desugarTypeDeclarations [TypeDeclaration (ss, _) name' _] =+    throwError . errorMessage' ss $ OrphanTypeDeclaration name'+  desugarTypeDeclarations (ValueDeclaration sa name' nameKind bs val : rest) = do     let (_, f, _) = everywhereOnValuesTopDownM return go return         f' = mapM (\(GuardedExpr g e) -> GuardedExpr g <$> f e)-    (:) <$> (ValueDeclaration name' nameKind bs <$> f' val)+    (:) <$> (ValueDeclaration sa name' nameKind bs <$> f' val)         <*> desugarTypeDeclarations rest     where     go (Let ds' val') = Let <$> desugarTypeDeclarations ds' <*> pure val'     go other = return other-  desugarTypeDeclarations (TypeInstanceDeclaration nm deps cls args (ExplicitInstance ds') : rest) =-    (:) <$> (TypeInstanceDeclaration nm deps cls args . ExplicitInstance <$> desugarTypeDeclarations ds')+  desugarTypeDeclarations (TypeInstanceDeclaration sa nm deps cls args (ExplicitInstance ds') : rest) =+    (:) <$> (TypeInstanceDeclaration sa nm deps cls args . ExplicitInstance <$> desugarTypeDeclarations ds')         <*> desugarTypeDeclarations rest   desugarTypeDeclarations (d:rest) = (:) d <$> desugarTypeDeclarations rest   desugarTypeDeclarations [] = return []

src/Language/PureScript/TypeChecker.hs view

@@ -22,11 +22,12 @@ import Data.Foldable (for_, traverse_, toList) import Data.List (nubBy, (\\), sort, group) import Data.Maybe+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.List.NonEmpty as NEL import qualified Data.Map as M import qualified Data.Set as S-import Data.Monoid ((<>)) import qualified Data.Text as T-import Data.Text (Text)  import Language.PureScript.AST import Language.PureScript.Crash@@ -35,7 +36,6 @@ import Language.PureScript.Kinds import Language.PureScript.Linter import Language.PureScript.Names-import Language.PureScript.Traversals import Language.PureScript.TypeChecker.Kinds as T import Language.PureScript.TypeChecker.Monad as T import Language.PureScript.TypeChecker.Synonyms as T@@ -140,8 +140,7 @@     argToIndex :: Text -> Maybe Int     argToIndex = flip M.lookup $ M.fromList (zipWith ((,) . fst) args [0..]) -    toPair (TypeDeclaration ident ty) = (ident, ty)-    toPair (PositionedDeclaration _ _ d) = toPair d+    toPair (TypeDeclaration _ ident ty) = (ident, ty)     toPair _ = internalError "Invalid declaration in TypeClassDeclaration"      -- Currently we are only checking usability based on the type class currently@@ -229,17 +228,18 @@ typeCheckAll moduleName _ = traverse go   where   go :: Declaration -> m Declaration-  go (DataDeclaration dtype name args dctors) = do-    warnAndRethrow (addHint (ErrorInTypeConstructor name)) $ do+  go (DataDeclaration sa@(ss, _) dtype name args dctors) = do+    warnAndRethrow (addHint (ErrorInTypeConstructor name) . addHint (PositionedError ss)) $ do       when (dtype == Newtype) $ checkNewtype name dctors       checkDuplicateTypeArguments $ map fst args       ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)       let args' = args `withKinds` ctorKind       addDataType moduleName dtype name args' dctors ctorKind-    return $ DataDeclaration dtype name args dctors+    return $ DataDeclaration sa dtype name args dctors   go (d@(DataBindingGroupDeclaration tys)) = do-    let syns = mapMaybe toTypeSynonym tys-        dataDecls = mapMaybe toDataDecl tys+    let tysList = NEL.toList tys+        syns = mapMaybe toTypeSynonym tysList+        dataDecls = mapMaybe toDataDecl tysList         bindingGroupNames = ordNub ((syns^..traverse._1) ++ (dataDecls^..traverse._2))     warnAndRethrow (addHint (ErrorInDataBindingGroup bindingGroupNames)) $ do       (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(_, name, args, dctors) -> (name, args, concatMap snd dctors)) dataDecls)@@ -254,56 +254,53 @@         addTypeSynonym moduleName name args' ty kind     return d     where-    toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)-    toTypeSynonym (PositionedDeclaration _ _ d') = toTypeSynonym d'+    toTypeSynonym (TypeSynonymDeclaration _ nm args ty) = Just (nm, args, ty)     toTypeSynonym _ = Nothing-    toDataDecl (DataDeclaration dtype nm args dctors) = Just (dtype, nm, args, dctors)-    toDataDecl (PositionedDeclaration _ _ d') = toDataDecl d'+    toDataDecl (DataDeclaration _ dtype nm args dctors) = Just (dtype, nm, args, dctors)     toDataDecl _ = Nothing-  go (TypeSynonymDeclaration name args ty) = do-    warnAndRethrow (addHint (ErrorInTypeSynonym name)) $ do+  go (TypeSynonymDeclaration sa@(ss, _) name args ty) = do+    warnAndRethrow (addHint (ErrorInTypeSynonym name) . addHint (PositionedError ss) ) $ do       checkDuplicateTypeArguments $ map fst args       kind <- kindsOf False moduleName name args [ty]       let args' = args `withKinds` kind       addTypeSynonym moduleName name args' ty kind-    return $ TypeSynonymDeclaration name args ty+    return $ TypeSynonymDeclaration sa name args ty   go TypeDeclaration{} =     internalError "Type declarations should have been removed before typeCheckAlld"-  go (ValueDeclaration name nameKind [] [MkUnguarded val]) = do+  go (ValueDeclaration sa@(ss, _) name nameKind [] [MkUnguarded val]) = do     env <- getEnv-    warnAndRethrow (addHint (ErrorInValueDeclaration name)) $ do-      val' <- checkExhaustiveExpr env moduleName val+    warnAndRethrow (addHint (ErrorInValueDeclaration name) . addHint (PositionedError ss)) $ do+      val' <- checkExhaustiveExpr ss env moduleName val       valueIsNotDefined moduleName name-      [(_, (val'', ty))] <- typesOf NonRecursiveBindingGroup moduleName [(name, val')]+      [(_, (val'', ty))] <- typesOf NonRecursiveBindingGroup moduleName [((sa, name), val')]       addValue moduleName name ty nameKind-      return $ ValueDeclaration name nameKind [] [MkUnguarded val'']+      return $ ValueDeclaration sa name nameKind [] [MkUnguarded val'']   go ValueDeclaration{} = internalError "Binders were not desugared"   go BoundValueDeclaration{} = internalError "BoundValueDeclaration should be desugared"   go (BindingGroupDeclaration vals) = do     env <- getEnv-    warnAndRethrow (addHint (ErrorInBindingGroup (map (\(ident, _, _) -> ident) vals))) $ do-      for_ vals $ \(ident, _, _) ->-        valueIsNotDefined moduleName ident-      vals' <- mapM (thirdM (checkExhaustiveExpr env moduleName)) vals-      tys <- typesOf RecursiveBindingGroup moduleName $ map (\(ident, _, ty) -> (ident, ty)) vals'-      vals'' <- forM [ (name, val, nameKind, ty)-                     | (name, nameKind, _) <- vals'-                     , (name', (val, ty)) <- tys+    warnAndRethrow (addHint (ErrorInBindingGroup (fmap (\((_, ident), _, _) -> ident) vals))) $ do+      for_ vals $ \((_, ident), _, _) -> valueIsNotDefined moduleName ident+      vals' <- NEL.toList <$> traverse (\(sai@((ss, _), _), nk, expr) -> (sai, nk,) <$> checkExhaustiveExpr ss env moduleName expr) vals+      tys <- typesOf RecursiveBindingGroup moduleName $ fmap (\(sai, _, ty) -> (sai, ty)) vals'+      vals'' <- forM [ (sai, val, nameKind, ty)+                     | (sai@(_, name), nameKind, _) <- vals'+                     , ((_, name'), (val, ty)) <- tys                      , name == name'-                     ] $ \(name, val, nameKind, ty) -> do+                     ] $ \(sai@(_, name), val, nameKind, ty) -> do         addValue moduleName name ty nameKind-        return (name, nameKind, val)-      return $ BindingGroupDeclaration vals''-  go (d@(ExternDataDeclaration name kind)) = do+        return (sai, nameKind, val)+      return . BindingGroupDeclaration $ NEL.fromList vals''+  go (d@(ExternDataDeclaration _ name kind)) = do     env <- getEnv     putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }     return d-  go (d@(ExternKindDeclaration name)) = do+  go (d@(ExternKindDeclaration _ name)) = do     env <- getEnv     putEnv $ env { kinds = S.insert (Qualified (Just moduleName) name) (kinds env) }     return d-  go (d@(ExternDeclaration name ty)) = do-    warnAndRethrow (addHint (ErrorInForeignImport name)) $ do+  go (d@(ExternDeclaration (ss, _) name ty)) = do+    warnAndRethrow (addHint (ErrorInForeignImport name) . addHint (PositionedError ss)) $ do       env <- getEnv       kind <- kindOf ty       guardWith (errorMessage (ExpectedType ty kind)) $ kind == kindType@@ -313,23 +310,23 @@     return d   go d@FixityDeclaration{} = return d   go d@ImportDeclaration{} = return d-  go d@(TypeClassDeclaration pn args implies deps tys) = do+  go d@(TypeClassDeclaration _ pn args implies deps tys) = do     addTypeClass moduleName pn args implies deps tys     return d-  go (d@(TypeInstanceDeclaration dictName deps className tys body)) = rethrow (addHint (ErrorInInstance className tys)) $ do-    env <- getEnv-    case M.lookup className (typeClasses env) of-      Nothing -> internalError "typeCheckAll: Encountered unknown type class in instance declaration"-      Just typeClass -> do-        checkInstanceArity dictName className typeClass tys-        sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys)-        checkOrphanInstance dictName className typeClass tys-        _ <- traverseTypeInstanceBody checkInstanceMembers body-        let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) [] className tys (Just deps)-        addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (tcdValue dict) dict-        return d-  go (PositionedDeclaration pos com d) =-    warnAndRethrowWithPosition pos $ PositionedDeclaration pos com <$> go d+  go (d@(TypeInstanceDeclaration (ss, _) dictName deps className tys body)) =+    rethrow (addHint (ErrorInInstance className tys) . addHint (PositionedError ss)) $ do+      env <- getEnv+      case M.lookup className (typeClasses env) of+        Nothing -> internalError "typeCheckAll: Encountered unknown type class in instance declaration"+        Just typeClass -> do+          checkInstanceArity dictName className typeClass tys+          sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys)+          checkOrphanInstance dictName className typeClass tys+          _ <- traverseTypeInstanceBody checkInstanceMembers body+          deps' <- (traverse . overConstraintArgs . traverse) replaceAllTypeSynonyms deps+          let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) [] className tys (Just deps')+          addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (tcdValue dict) dict+          return d    checkInstanceArity :: Ident -> Qualified (ProperName 'ClassName) -> TypeClassData -> [Type] -> m ()   checkInstanceArity dictName className typeClass tys = do@@ -346,8 +343,7 @@     return instDecls     where     memberName :: Declaration -> Ident-    memberName (ValueDeclaration ident _ _ _) = ident-    memberName (PositionedDeclaration _ _ d) = memberName d+    memberName (ValueDeclaration _ ident _ _ _) = ident     memberName _ = internalError "checkInstanceMembers: Invalid declaration in type instance definition"      firstDuplicate :: (Eq a) => [a] -> Maybe a@@ -428,7 +424,7 @@   where    checkMemberExport :: (Type -> [DeclarationRef]) -> DeclarationRef -> m ()-  checkMemberExport extract dr@(TypeRef name dctors) = do+  checkMemberExport extract dr@(TypeRef _ name dctors) = do     env <- getEnv     case M.lookup (Qualified (Just mn) name) (typeSynonyms env) of       Nothing -> return ()@@ -440,7 +436,7 @@           Nothing -> return ()           Just (_, _, ty, _) -> checkExport dr extract ty     return ()-  checkMemberExport extract dr@(ValueRef name) = do+  checkMemberExport extract dr@(ValueRef _ name) = do     ty <- lookupVariable (Qualified (Just mn) name)     checkExport dr extract ty   checkMemberExport _ _ = return ()@@ -448,58 +444,55 @@   checkExport :: DeclarationRef -> (Type -> [DeclarationRef]) -> Type -> m ()   checkExport dr extract ty = case filter (not . exported) (extract ty) of     [] -> return ()-    hidden -> throwError . errorMessage $ TransitiveExportError dr (nubBy nubEq hidden)+    hidden -> throwError . errorMessage' (declRefSourceSpan dr) $ TransitiveExportError dr (nubBy nubEq hidden)     where     exported e = any (exports e) exps-    exports (TypeRef pn1 _) (TypeRef pn2 _) = pn1 == pn2-    exports (ValueRef id1) (ValueRef id2) = id1 == id2-    exports (TypeClassRef pn1) (TypeClassRef pn2) = pn1 == pn2-    exports (PositionedDeclarationRef _ _ r1) r2 = exports r1 r2-    exports r1 (PositionedDeclarationRef _ _ r2) = exports r1 r2+    exports (TypeRef _ pn1 _) (TypeRef _ pn2 _) = pn1 == pn2+    exports (ValueRef _ id1) (ValueRef _ id2) = id1 == id2+    exports (TypeClassRef _ pn1) (TypeClassRef _ pn2) = pn1 == pn2     exports _ _ = False     -- We avoid Eq for `nub`bing as the dctor part of `TypeRef` evaluates to     -- `error` for the values generated here (we don't need them anyway)-    nubEq (TypeRef pn1 _) (TypeRef pn2 _) = pn1 == pn2+    nubEq (TypeRef _ pn1 _) (TypeRef _ pn2 _) = pn1 == pn2     nubEq r1 r2 = r1 == r2     -- Check that all the type constructors defined in the current module that appear in member types   -- have also been exported from the module   checkTypesAreExported :: DeclarationRef -> m ()-  checkTypesAreExported = checkMemberExport findTcons+  checkTypesAreExported ref = checkMemberExport findTcons ref     where     findTcons :: Type -> [DeclarationRef]     findTcons = everythingOnTypes (++) go       where-      go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [TypeRef name (internalError "Data constructors unused in checkTypesAreExported")]+      go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn =+        [TypeRef (declRefSourceSpan ref) name (internalError "Data constructors unused in checkTypesAreExported")]       go _ = []    -- Check that all the classes defined in the current module that appear in member types have also   -- been exported from the module   checkClassesAreExported :: DeclarationRef -> m ()-  checkClassesAreExported = checkMemberExport findClasses+  checkClassesAreExported ref = checkMemberExport findClasses ref     where     findClasses :: Type -> [DeclarationRef]     findClasses = everythingOnTypes (++) go       where-      go (ConstrainedType c _) = (fmap TypeClassRef . extractCurrentModuleClass . constraintClass) c+      go (ConstrainedType c _) = (fmap (TypeClassRef (declRefSourceSpan ref)) . extractCurrentModuleClass . constraintClass) c       go _ = []     extractCurrentModuleClass :: Qualified (ProperName 'ClassName) -> [ProperName 'ClassName]     extractCurrentModuleClass (Qualified (Just mn') name) | mn == mn' = [name]     extractCurrentModuleClass _ = []    checkClassMembersAreExported :: DeclarationRef -> m ()-  checkClassMembersAreExported dr@(TypeClassRef name) = do-    let members = ValueRef `map` head (mapMaybe findClassMembers decls)+  checkClassMembersAreExported dr@(TypeClassRef ss' name) = do+    let members = ValueRef ss' `map` head (mapMaybe findClassMembers decls)     let missingMembers = members \\ exps-    unless (null missingMembers) $ throwError . errorMessage $ TransitiveExportError dr members+    unless (null missingMembers) . throwError . errorMessage' ss' $ TransitiveExportError dr members     where     findClassMembers :: Declaration -> Maybe [Ident]-    findClassMembers (TypeClassDeclaration name' _ _ _ ds) | name == name' = Just $ map extractMemberName ds-    findClassMembers (PositionedDeclaration _ _ d) = findClassMembers d+    findClassMembers (TypeClassDeclaration _ name' _ _ _ ds) | name == name' = Just $ map extractMemberName ds     findClassMembers _ = Nothing     extractMemberName :: Declaration -> Ident-    extractMemberName (PositionedDeclaration _ _ d) = extractMemberName d-    extractMemberName (TypeDeclaration memberName _) = memberName+    extractMemberName (TypeDeclaration _ memberName _) = memberName     extractMemberName _ = internalError "Unexpected declaration in typeclass member list"   checkClassMembersAreExported _ = return ()

src/Language/PureScript/TypeChecker/Entailment.hs view

@@ -44,20 +44,17 @@  -- | Describes what sort of dictionary to generate for type class instances data Evidence+  -- | An existing named instance   = NamedInstance (Qualified Ident)-  -- ^ An existing named instance-  | WarnInstance Type-  -- ^ Computed instance of the Warn type class with a user-defined warning message-  | IsSymbolInstance PSString-  -- ^ Computed instance of the IsSymbol type class for a given Symbol literal++  -- | Computed instances+  | WarnInstance Type         -- ^ Warn type class with a user-defined warning message+  | IsSymbolInstance PSString -- ^ The IsSymbol type class for a given Symbol literal   | CompareSymbolInstance-  -- ^ Computed instance of CompareSymbol   | AppendSymbolInstance-  -- ^ Computed instance of AppendSymbol   | UnionInstance-  -- ^ Computed instance of Union   | ConsInstance-  -- ^ Computed instance of RowCons+  | RowToListInstance   deriving (Show, Eq)  -- | Extract the identifier of a named instance@@ -173,6 +170,9 @@       = [ TypeClassDictionaryInScope UnionInstance [] C.Union [lOut, rOut, uOut] cst ]     forClassName _ C.RowCons [TypeLevelString sym, ty, r, _]       = [ TypeClassDictionaryInScope ConsInstance [] C.RowCons [TypeLevelString sym, ty, r, RCons (Label sym) ty r] Nothing ]+    forClassName _ C.RowToList [r, _]+      | Just entries <- solveRowToList r+      = [ TypeClassDictionaryInScope RowToListInstance [] C.RowToList [r, entries] Nothing ]     forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (ordNub (Nothing : Just mn : map Just (mapMaybe ctorModules tys)))     forClassName _ _ _ = internalError "forClassName: expected qualified class name" @@ -333,6 +333,7 @@               return $ App (Abs (VarBinder (Ident C.__unused)) valUndefined) e             mkDictionary UnionInstance _ = return valUndefined             mkDictionary ConsInstance _ = return valUndefined+            mkDictionary RowToListInstance _ = return valUndefined             mkDictionary (WarnInstance msg) _ = do               tell . errorMessage $ UserDefinedWarning msg               -- We cannot call the type class constructor here because Warn is declared in Prim.@@ -373,6 +374,18 @@             -- the right hand side, and we can't be certain we won't reorder the             -- types for such labels.             _ -> (not (null fixed), (fixed, rowVar), Just [ Constraint C.Union [rest, r, rowVar] Nothing ])++    -- | Convert a closed row to a sorted list of entries+    solveRowToList :: Type -> Maybe Type+    solveRowToList r =+        guard (REmpty == rest) $>+        foldr rowListCons (TypeConstructor C.RowListNil) fixed+      where+        (fixed, rest) = rowToSortedList r+        rowListCons (lbl, ty) tl = foldl TypeApp (TypeConstructor C.RowListCons)+                                     [ TypeLevelString (runLabel lbl)+                                     , ty+                                     , tl ]  -- Check if an instance matches our list of types, allowing for types -- to be solved via functional dependencies. If the types match, we return a

src/Language/PureScript/TypeChecker/Types.hs view

@@ -40,9 +40,10 @@ import Data.List (transpose, (\\), partition, delete) import Data.Maybe (fromMaybe) import Data.Monoid ((<>))+import Data.Traversable (for)+import qualified Data.List.NonEmpty as NEL import qualified Data.Map as M import qualified Data.Set as S-import Data.Traversable (for)  import Language.PureScript.AST import Language.PureScript.Crash@@ -74,8 +75,8 @@   :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => BindingGroupType   -> ModuleName-  -> [(Ident, Expr)]-  -> m [(Ident, (Expr, Type))]+  -> [((SourceAnn, Ident), Expr)]+  -> m [((SourceAnn, Ident), (Expr, Type))] typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do     (tys, wInfer) <- capturingSubstitution tidyUp $ do       (SplitBindingGroup untyped typed dict, w) <- withoutWarnings $ typeDictionaryForBindingGroup (Just moduleName) vals@@ -83,7 +84,7 @@       ds2 <- forM untyped $ \e -> withoutWarnings $ typeForBindingGroupElement e dict       return (map (False, ) ds1 ++ map (True, ) ds2, w) -    inferred <- forM tys $ \(shouldGeneralize, ((ident, (val, ty)), _)) -> do+    inferred <- forM tys $ \(shouldGeneralize, ((sai@((ss, _), ident), (val, ty)), _)) -> do       -- Replace type class dictionary placeholders with actual dictionaries       (val', unsolved) <- replaceTypeClassDictionaries shouldGeneralize val       -- Generalize and constrain the type@@ -94,12 +95,14 @@        when shouldGeneralize $ do         -- Show the inferred type in a warning-        tell . errorMessage $ MissingTypeDeclaration ident generalized+        tell+          . errorMessage' ss+          $ MissingTypeDeclaration ident generalized         -- For non-recursive binding groups, can generalize over constraints.         -- For recursive binding groups, we throw an error here for now.         when (bindingGroupType == RecursiveBindingGroup && not (null unsolved))           . throwError-          . errorMessage+          . errorMessage' ss           $ CannotGeneralizeRecursiveFunction ident generalized         -- Make sure any unsolved type constraints only use type variables which appear         -- unknown in the inferred type.@@ -111,22 +114,25 @@           TypeClassData{ typeClassDependencies } <- gets (findClass . typeClasses . checkEnv)           let solved = foldMap (S.fromList . fdDetermined) typeClassDependencies           let constraintTypeVars = ordNub . foldMap (unknownsInType . fst) . filter ((`notElem` solved) . snd) $ zip (constraintArgs con) [0..]-          when (any (`notElem` unsolvedTypeVars) constraintTypeVars) $ do-            throwError . onErrorMessages (replaceTypes currentSubst) . errorMessage $ AmbiguousTypeVariables generalized con+          when (any (`notElem` unsolvedTypeVars) constraintTypeVars) .+            throwError+              . onErrorMessages (replaceTypes currentSubst)+              . errorMessage' ss+              $ AmbiguousTypeVariables generalized con        -- Check skolem variables did not escape their scope       skolemEscapeCheck val'-      return ((ident, (foldr (Abs . VarBinder . (\(x, _, _) -> x)) val' unsolved, generalized)), unsolved)+      return ((sai, (foldr (Abs . VarBinder . (\(x, _, _) -> x)) val' unsolved, generalized)), unsolved)      -- Show warnings here, since types in wildcards might have been solved during     -- instance resolution (by functional dependencies).     finalState <- get     let replaceTypes' = replaceTypes (checkSubstitution finalState)         runTypeSearch' gen = runTypeSearch (guard gen $> foldMap snd inferred) finalState-        raisePreviousWarnings gen w = (escalateWarningWhen isHoleError . tell . onErrorMessages (runTypeSearch' gen . replaceTypes')) w+        raisePreviousWarnings gen = (escalateWarningWhen isHoleError . tell . onErrorMessages (runTypeSearch' gen . replaceTypes'))      raisePreviousWarnings False wInfer-    forM_ tys $ \(shouldGeneralize, ((_, (_, _)), w)) -> do+    forM_ tys $ \(shouldGeneralize, ((_, (_, _)), w)) ->       raisePreviousWarnings shouldGeneralize w      return (map fst inferred)@@ -172,9 +178,9 @@ -- -- This structure breaks down a binding group into typed and untyped parts. data SplitBindingGroup = SplitBindingGroup-  { _splitBindingGroupUntyped :: [(Ident, (Expr, Type))]+  { _splitBindingGroupUntyped :: [((SourceAnn, Ident), (Expr, Type))]   -- ^ The untyped expressions-  , _splitBindingGroupTyped :: [(Ident, (Expr, Type, Bool))]+  , _splitBindingGroupTyped :: [((SourceAnn, Ident), (Expr, Type, Bool))]   -- ^ The typed expressions, along with their type annotations   , _splitBindingGroupNames :: M.Map (Qualified Ident) (Type, NameKind, NameVisibility)   -- ^ A map containing all expressions and their assigned types (which might be@@ -190,46 +196,46 @@ typeDictionaryForBindingGroup   :: (MonadState CheckState m, MonadWriter MultipleErrors m)   => Maybe ModuleName-  -> [(Ident, Expr)]+  -> [((SourceAnn, Ident), Expr)]   -> m SplitBindingGroup typeDictionaryForBindingGroup moduleName vals = do     -- Filter the typed and untyped declarations and make a map of names to typed declarations.     -- Replace type wildcards here so that the resulting dictionary of types contains the     -- fully expanded types.     let (untyped, typed) = partitionEithers (map splitTypeAnnotation vals)-    (typedDict, typed') <- fmap unzip . for typed $ \(ident, (expr, ty, checkType)) -> do+    (typedDict, typed') <- fmap unzip . for typed $ \(sai, (expr, ty, checkType)) -> do       ty' <- replaceTypeWildcards ty-      return ((ident, ty'), (ident, (expr, ty', checkType)))+      return ((sai, ty'), (sai, (expr, ty', checkType)))     -- Create fresh unification variables for the types of untyped declarations-    (untypedDict, untyped') <- fmap unzip . for untyped $ \(ident, expr) -> do+    (untypedDict, untyped') <- fmap unzip . for untyped $ \(sai, expr) -> do       ty <- freshType-      return ((ident, ty), (ident, (expr, ty)))+      return ((sai, ty), (sai, (expr, ty)))     -- Create the dictionary of all name/type pairs, which will be added to the     -- environment during type checking     let dict = M.fromList [ (Qualified moduleName ident, (ty, Private, Undefined))-                          | (ident, ty) <- typedDict <> untypedDict+                          | ((_, ident), ty) <- typedDict <> untypedDict                           ]     return (SplitBindingGroup untyped' typed' dict)   where     -- | Check if a value contains a type annotation, and if so, separate it     -- from the value itself.-    splitTypeAnnotation :: (Ident, Expr) -> Either (Ident, Expr) (Ident, (Expr, Type, Bool))-    splitTypeAnnotation (name, TypedValue checkType value ty) = Right (name, (value, ty, checkType))-    splitTypeAnnotation (name, PositionedValue pos c value) =+    splitTypeAnnotation :: (a, Expr) -> Either (a, Expr) (a, (Expr, Type, Bool))+    splitTypeAnnotation (a, TypedValue checkType value ty) = Right (a, (value, ty, checkType))+    splitTypeAnnotation (a, PositionedValue pos c value) =       bimap (second (PositionedValue pos c))             (second (\(e, t, b) -> (PositionedValue pos c e, t, b)))-            (splitTypeAnnotation (name, value))-    splitTypeAnnotation (name, value) = Left (name, value)+            (splitTypeAnnotation (a, value))+    splitTypeAnnotation (a, value) = Left (a, value)  -- | Check the type annotation of a typed value in a binding group. checkTypedBindingGroupElement   :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => ModuleName-  -> (Ident, (Expr, Type, Bool))+  -> ((SourceAnn, Ident), (Expr, Type, Bool))   -- ^ The identifier we are trying to define, along with the expression and its type annotation   -> M.Map (Qualified Ident) (Type, NameKind, NameVisibility)   -- ^ Names brought into scope in this binding group-  -> m (Ident, (Expr, Type))+  -> m ((SourceAnn, Ident), (Expr, Type)) checkTypedBindingGroupElement mn (ident, (val, ty, checkType)) dict = do   -- Kind check   (kind, args) <- kindOfWithScopedVars ty@@ -246,12 +252,12 @@ -- | Infer a type for a value in a binding group which lacks an annotation. typeForBindingGroupElement   :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => (Ident, (Expr, Type))+  => ((SourceAnn, Ident), (Expr, Type))   -- ^ The identifier we are trying to define, along with the expression and its assigned type   -- (at this point, this should be a unification variable)   -> M.Map (Qualified Ident) (Type, NameKind, NameVisibility)   -- ^ Names brought into scope in this binding group-  -> m (Ident, (Expr, Type))+  -> m ((SourceAnn, Ident), (Expr, Type)) typeForBindingGroupElement (ident, (val, ty)) dict = do   -- Infer the type with the new names in scope   TypedValue _ val' ty' <- bindNames dict $ infer val@@ -420,32 +426,31 @@   -> (Expr -> m Expr)   -> m ([Declaration], Expr) inferLetBinding seen [] ret j = (,) seen <$> withBindingGroupVisible (j ret)-inferLetBinding seen (ValueDeclaration ident nameKind [] [MkUnguarded tv@(TypedValue checkType val ty)] : rest) ret j = do-  Just moduleName <- checkCurrentModule <$> get-  (kind, args) <- kindOfWithScopedVars ty-  checkTypeKind ty kind-  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 (Qualified Nothing ident) (ty'', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] [MkUnguarded (TypedValue checkType val' ty'')]]) rest ret j-inferLetBinding seen (ValueDeclaration ident nameKind [] [MkUnguarded val] : rest) ret j = do-  valTy <- freshType-  let dict = M.singleton (Qualified Nothing ident) (valTy, nameKind, Undefined)-  TypedValue _ val' valTy' <- bindNames dict $ infer val-  unifyTypes valTy valTy'-  bindNames (M.singleton (Qualified Nothing ident) (valTy', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] [MkUnguarded val']]) rest ret j+inferLetBinding seen (ValueDeclaration sa@(ss, _) ident nameKind [] [MkUnguarded tv@(TypedValue checkType val ty)] : rest) ret j =+  warnAndRethrowWithPositionTC ss $ do+    Just moduleName <- checkCurrentModule <$> get+    (kind, args) <- kindOfWithScopedVars ty+    checkTypeKind ty kind+    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 (Qualified Nothing ident) (ty'', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration sa ident nameKind [] [MkUnguarded (TypedValue checkType val' ty'')]]) rest ret j+inferLetBinding seen (ValueDeclaration sa@(ss, _) ident nameKind [] [MkUnguarded val] : rest) ret j =+  warnAndRethrowWithPositionTC ss $ do+    valTy <- freshType+    let dict = M.singleton (Qualified Nothing ident) (valTy, nameKind, Undefined)+    TypedValue _ val' valTy' <- bindNames dict $ infer val+    unifyTypes valTy valTy'+    bindNames (M.singleton (Qualified Nothing ident) (valTy', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration sa ident nameKind [] [MkUnguarded val']]) rest ret j inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do   Just moduleName <- checkCurrentModule <$> get-  SplitBindingGroup untyped typed dict <- typeDictionaryForBindingGroup Nothing (map (\(i, _, v) -> (i, v)) ds)+  SplitBindingGroup untyped typed dict <- typeDictionaryForBindingGroup Nothing . NEL.toList $ fmap (\(i, _, v) -> (i, v)) ds   ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict   ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict-  let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']+  let ds' = NEL.fromList [(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 = 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"  -- | Infer the types of variables brought into scope by a binder

tests/Language/PureScript/Ide/CompletionSpec.hs view

@@ -19,7 +19,7 @@     moduleB = [ideKind "Kind" `annExp` "A"]  matches :: [(Match IdeDeclarationAnn, [P.ModuleName])]-matches = map (\d -> (Match (mn "Main", d), [mn "Main"])) [ ideKind "Kind", ideType "Type" Nothing ]+matches = map (\d -> (Match (mn "Main", d), [mn "Main"])) [ ideKind "Kind", ideType "Type" Nothing [] ]  spec :: Spec spec = describe "Applying completion options" $ do

tests/Language/PureScript/Ide/FilterSpec.hs view

@@ -5,6 +5,7 @@ import           Protolude import           Data.List.NonEmpty import           Language.PureScript.Ide.Filter+import           Language.PureScript.Ide.Filter.Declaration as D import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Test as T import qualified Language.PureScript as P@@ -12,11 +13,16 @@  type Module = (P.ModuleName, [IdeDeclarationAnn]) -moduleA, moduleB, moduleC, moduleD :: Module+moduleA, moduleB, moduleC, moduleD, moduleE, moduleF, moduleG, moduleH, moduleI :: Module moduleA = (P.moduleNameFromString "Module.A", [T.ideValue "function1" Nothing]) moduleB = (P.moduleNameFromString "Module.B", [T.ideValue "data1" Nothing])-moduleC = (P.moduleNameFromString "Module.C", [T.ideType "List" Nothing])+moduleC = (P.moduleNameFromString "Module.C", [T.ideType "List" Nothing []]) moduleD = (P.moduleNameFromString "Module.D", [T.ideKind "kind1"])+moduleE = (P.moduleNameFromString "Module.E", [T.ideSynonym "SFType" Nothing Nothing `annLoc` synonymSS])+moduleF = (P.moduleNameFromString "Module.F", [T.ideDtor "DtorA" "TypeA" Nothing])+moduleG = (P.moduleNameFromString "Module.G", [T.ideTypeClass "MyClass" P.kindType []])+moduleH = (P.moduleNameFromString "Module.H", [T.ideValueOp "<$>" (P.Qualified Nothing (Left "")) 0 Nothing Nothing])+moduleI = (P.moduleNameFromString "Module.I", [T.ideTypeOp "~>" (P.Qualified Nothing "") 0 Nothing Nothing])  modules :: [Module] modules = [moduleA, moduleB]@@ -33,6 +39,9 @@ runNamespace :: NonEmpty IdeNamespace -> [Module] -> [Module] runNamespace namespaces = applyFilters [namespaceFilter namespaces] +runDeclaration :: [D.IdeDeclaration] -> [Module] -> [Module]+runDeclaration decls = applyFilters [declarationTypeFilter decls]+ spec :: Spec spec = do   describe "equality Filter" $ do@@ -91,3 +100,69 @@       runNamespace (fromList [ IdeNSValue, IdeNSType, IdeNSKind])         [moduleA, moduleB, moduleC, moduleD]         `shouldBe` [moduleA, moduleB, moduleC, moduleD]+  describe "declarationTypeFilter" $ do+    let moduleADecl = D.IdeDeclaration D.Value+        moduleCDecl = D.IdeDeclaration D.Type+        moduleDDecl = D.IdeDeclaration D.Kind+        moduleEDecl = D.IdeDeclaration D.Synonym+        moduleFDecl = D.IdeDeclaration D.DataConstructor+        moduleGDecl = D.IdeDeclaration D.TypeClass+        moduleHDecl = D.IdeDeclaration D.ValueOperator+        moduleIDecl = D.IdeDeclaration D.TypeOperator+    it "keeps everything on empty list of declarations" $+      runDeclaration []+        [moduleA, moduleB, moduleD] `shouldBe` [moduleA, moduleB, moduleD]+    it "extracts modules by filtering `value` declarations" $+      runDeclaration [moduleADecl]+        [moduleA, moduleB, moduleD] `shouldBe` [moduleA, moduleB]+    it "removes everything if no `value` declarations has been found" $+      runDeclaration [moduleADecl]+        [moduleD, moduleG, moduleE, moduleH] `shouldBe` []+    it "extracts module by filtering `type` declarations" $+      runDeclaration [moduleCDecl]+        [moduleA, moduleB, moduleC, moduleD, moduleE] `shouldBe` [moduleC]+    it "removes everything if a `type` declaration have not been found" $+      runDeclaration [moduleCDecl]+        [moduleA, moduleG, moduleE, moduleH] `shouldBe` []+    it "extracts module by filtering `synonym` declarations" $+      runDeclaration [moduleEDecl]+        [moduleA, moduleB, moduleD, moduleE] `shouldBe` [moduleE]+    it "removes everything if a `synonym` declaration have not been found" $+      runDeclaration [moduleEDecl]+        [moduleA, moduleB, moduleC, moduleH] `shouldBe` []+    it "extracts module by filtering `constructor` declarations" $+      runDeclaration [moduleFDecl]+        [moduleA, moduleB, moduleC, moduleF] `shouldBe` [moduleF]+    it "removes everything if a `constructor` declaration have not been found" $+      runDeclaration [moduleFDecl]+        [moduleA, moduleB, moduleC, moduleH] `shouldBe` []+    it "extracts module by filtering `typeclass` declarations" $+      runDeclaration [moduleGDecl]+        [moduleA, moduleC, moduleG] `shouldBe` [moduleG]+    it "removes everything if a `typeclass` declaration have not been found" $+      runDeclaration [moduleGDecl]+        [moduleA, moduleB, moduleC, moduleH] `shouldBe` []+    it "extracts modules by filtering `valueoperator` declarations" $+      runDeclaration [moduleHDecl]+        [moduleA, moduleC, moduleG, moduleH, moduleF] `shouldBe` [moduleH]+    it "removes everything if a `valueoperator` declaration have not been found" $+      runDeclaration [moduleHDecl]+        [moduleA, moduleB, moduleC, moduleD] `shouldBe` []+    it "extracts modules by filtering `typeoperator` declarations" $+      runDeclaration [moduleIDecl]+        [moduleA, moduleC, moduleG, moduleI, moduleF] `shouldBe` [moduleI]+    it "removes everything if a `typeoperator` declaration have not been found" $+      runDeclaration [moduleIDecl]+        [moduleA, moduleD] `shouldBe` []+    it "extracts module by filtering `kind` declarations" $+      runDeclaration [moduleCDecl]+        [moduleA, moduleC, moduleG, moduleI, moduleF] `shouldBe` [moduleC]+    it "removes everything if a `kind` declaration have not been found" $+      runDeclaration [moduleCDecl]+        [moduleA, moduleD] `shouldBe` []+    it "extracts modules by filtering `value` and `synonym` declarations" $+      runDeclaration [moduleADecl, moduleEDecl]+        [moduleA, moduleB, moduleD, moduleE] `shouldBe` [moduleA, moduleB, moduleE]+    it "extracts modules by filtering `kind`, `synonym` and `valueoperator` declarations" $+      runDeclaration [moduleADecl, moduleDDecl, moduleHDecl]+        [moduleA, moduleB, moduleD, moduleG, moduleE, moduleH] `shouldBe` [moduleA, moduleB, moduleD, moduleH]

tests/Language/PureScript/Ide/ImportsSpec.hs view

@@ -107,7 +107,7 @@         addDtorImport i t mn is =           prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideDtor i t Nothing)) mn is)         addTypeImport i mn is =-          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideType i Nothing)) mn is)+          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideType i Nothing [])) mn is)         addKindImport i mn is =           prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideKind i)) mn is)     it "adds an implicit unqualified import to a file without any imports" $@@ -208,7 +208,7 @@         moduleName = (P.moduleNameFromString "Control.Monad")         addImport imports import' = addExplicitImport' import' moduleName imports         valueImport ident = _idaDeclaration (Test.ideValue ident Nothing)-        typeImport name = _idaDeclaration (Test.ideType name Nothing)+        typeImport name = _idaDeclaration (Test.ideType name Nothing [])         classImport name = _idaDeclaration (Test.ideTypeClass name P.kindType [])         dtorImport name typeName = _idaDeclaration (Test.ideDtor name typeName Nothing)         -- expect any list of provided identifiers, when imported, to come out as specified

tests/Language/PureScript/Ide/ReexportsSpec.hs view

@@ -13,7 +13,7 @@  valueA, typeA, synonymA, classA, dtorA1, dtorA2, kindA :: IdeDeclarationAnn valueA = ideValue "valueA" Nothing-typeA = ideType "TypeA" Nothing+typeA = ideType "TypeA" Nothing [] synonymA = ideSynonym "SynonymA" Nothing Nothing classA = ideTypeClass "ClassA" P.kindType [] dtorA1 = ideDtor "DtorA1" "TypeA" Nothing@@ -27,24 +27,27 @@  type Refs = [(P.ModuleName, P.DeclarationRef)] +testSpan :: P.SourceSpan+testSpan = P.internalModuleSourceSpan "<test>"+ succTestCases :: [(Text, Refs, [IdeDeclarationAnn])] succTestCases =-  [ ("resolves a value reexport", [(mn "A", P.ValueRef (P.Ident "valueA"))], [valueA `annExp` "A"])+  [ ("resolves a value reexport", [(mn "A", P.ValueRef testSpan (P.Ident "valueA"))], [valueA `annExp` "A"])   , ("resolves a type reexport with explicit data constructors"-    , [(mn "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], [typeA `annExp` "A", dtorA1 `annExp` "A"])+    , [(mn "A", P.TypeRef testSpan (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], [typeA `annExp` "A", dtorA1 `annExp` "A"])   , ("resolves a type reexport with implicit data constructors"-    , [(mn "A", P.TypeRef (P.ProperName "TypeA") Nothing)], map (`annExp` "A") [typeA, dtorA1, dtorA2])+    , [(mn "A", P.TypeRef testSpan (P.ProperName "TypeA") Nothing)], map (`annExp` "A") [typeA, dtorA1, dtorA2])   , ("resolves a synonym reexport"-    , [(mn "A", P.TypeRef (P.ProperName "SynonymA") Nothing)], [synonymA `annExp` "A"])-  , ("resolves a class reexport", [(mn "A", P.TypeClassRef (P.ProperName "ClassA"))], [classA `annExp` "A"])-  , ("resolves a kind reexport", [(mn "A", P.KindRef (P.ProperName "KindA"))], [kindA `annExp` "A"])+    , [(mn "A", P.TypeRef testSpan (P.ProperName "SynonymA") Nothing)], [synonymA `annExp` "A"])+  , ("resolves a class reexport", [(mn "A", P.TypeClassRef testSpan (P.ProperName "ClassA"))], [classA `annExp` "A"])+  , ("resolves a kind reexport", [(mn "A", P.KindRef testSpan (P.ProperName "KindA"))], [kindA `annExp` "A"])   ]  failTestCases :: [(Text, Refs)] failTestCases =-  [ ("fails to resolve a non existing value", [(mn "A", P.ValueRef (P.Ident "valueB"))])-  , ("fails to resolve a non existing type reexport" , [(mn "A", P.TypeRef (P.ProperName "TypeB") Nothing)])-  , ("fails to resolve a non existing class reexport", [(mn "A", P.TypeClassRef (P.ProperName "ClassB"))])+  [ ("fails to resolve a non existing value", [(mn "A", P.ValueRef testSpan (P.Ident "valueB"))])+  , ("fails to resolve a non existing type reexport" , [(mn "A", P.TypeRef testSpan (P.ProperName "TypeB") Nothing)])+  , ("fails to resolve a non existing class reexport", [(mn "A", P.TypeClassRef testSpan (P.ProperName "ClassB"))])   ]  spec :: Spec

tests/Language/PureScript/Ide/SourceFileSpec.hs view

@@ -16,55 +16,61 @@ span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2) span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3) +ann0, ann1, ann2 :: P.SourceAnn+ann0 = (span0, [])+ann1 = (span1, [])+ann2 = (span2, [])+ typeAnnotation1, value1, synonym1, class1, class2, data1, data2, valueFixity, typeFixity, foreign1, foreign2, foreign3, member1 :: P.Declaration-typeAnnotation1 = P.TypeDeclaration (P.Ident "value1") P.REmpty-value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] []-synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty-class1 = P.TypeClassDeclaration (P.ProperName "Class1") [] [] [] []-class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] [] []-  [P.PositionedDeclaration span2 [] member1]-data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] []-data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]+typeAnnotation1 = P.TypeDeclaration ann1 (P.Ident "value1") P.REmpty+value1 = P.ValueDeclaration ann1 (P.Ident "value1") P.Public [] []+synonym1 = P.TypeSynonymDeclaration ann1 (P.ProperName "Synonym1") [] P.REmpty+class1 = P.TypeClassDeclaration ann1 (P.ProperName "Class1") [] [] [] []+class2 = P.TypeClassDeclaration ann1 (P.ProperName "Class2") [] [] [] [member1]+data1 = P.DataDeclaration ann1 P.Newtype (P.ProperName "Data1") [] []+data2 = P.DataDeclaration ann1 P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])] valueFixity =   P.ValueFixityDeclaration+    ann1     (P.Fixity P.Infix 0)     (P.Qualified Nothing (Left (P.Ident "")))     (P.OpName "<$>") typeFixity =   P.TypeFixityDeclaration+    ann1     (P.Fixity P.Infix 0)     (P.Qualified Nothing (P.ProperName ""))     (P.OpName "~>")-foreign1 = P.ExternDeclaration (P.Ident "foreign1") P.REmpty-foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.kindType-foreign3 = P.ExternKindDeclaration (P.ProperName "Foreign3")-member1 = P.TypeDeclaration (P.Ident "member1") P.REmpty+foreign1 = P.ExternDeclaration ann1 (P.Ident "foreign1") P.REmpty+foreign2 = P.ExternDataDeclaration ann1 (P.ProperName "Foreign2") P.kindType+foreign3 = P.ExternKindDeclaration ann1 (P.ProperName "Foreign3")+member1 = P.TypeDeclaration ann2 (P.Ident "member1") P.REmpty  spec :: Spec spec = do   describe "Extracting Spans" $ do     it "extracts a span for a value declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(IdeNamespaced IdeNSValue "value1", span1)]+      extractSpans value1 `shouldBe` [(IdeNamespaced IdeNSValue "value1", span1)]     it "extracts a span for a type synonym declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(IdeNamespaced IdeNSType "Synonym1", span1)]+      extractSpans synonym1 `shouldBe` [(IdeNamespaced IdeNSType "Synonym1", span1)]     it "extracts a span for a typeclass declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(IdeNamespaced IdeNSType "Class1", span1)]+      extractSpans class1 `shouldBe` [(IdeNamespaced IdeNSType "Class1", span1)]     it "extracts spans for a typeclass declaration and its members" $-      extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(IdeNamespaced IdeNSType "Class2", span1), (IdeNamespaced IdeNSValue "member1", span2)]+      extractSpans class2 `shouldBe` [(IdeNamespaced IdeNSType "Class2", span1), (IdeNamespaced IdeNSValue "member1", span2)]     it "extracts a span for a data declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(IdeNamespaced IdeNSType "Data1", span1)]+      extractSpans data1 `shouldBe` [(IdeNamespaced IdeNSType "Data1", span1)]     it "extracts spans for a data declaration and its constructors" $-      extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(IdeNamespaced IdeNSType "Data2", span1), (IdeNamespaced IdeNSValue "Cons1", span1)]+      extractSpans data2 `shouldBe` [(IdeNamespaced IdeNSType "Data2", span1), (IdeNamespaced IdeNSValue "Cons1", span1)]     it "extracts a span for a value operator fixity declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] valueFixity) `shouldBe` [(IdeNamespaced IdeNSValue "<$>", span1)]+      extractSpans valueFixity `shouldBe` [(IdeNamespaced IdeNSValue "<$>", span1)]     it "extracts a span for a type operator fixity declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] typeFixity) `shouldBe` [(IdeNamespaced IdeNSType "~>", span1)]+      extractSpans typeFixity `shouldBe` [(IdeNamespaced IdeNSType "~>", span1)]     it "extracts a span for a foreign declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(IdeNamespaced IdeNSValue "foreign1", span1)]+      extractSpans foreign1 `shouldBe` [(IdeNamespaced IdeNSValue "foreign1", span1)]     it "extracts a span for a data foreign declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(IdeNamespaced IdeNSType "Foreign2", span1)]+      extractSpans foreign2 `shouldBe` [(IdeNamespaced IdeNSType "Foreign2", span1)]     it "extracts a span for a foreign kind declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] foreign3) `shouldBe` [(IdeNamespaced IdeNSKind "Foreign3", span1)]+      extractSpans foreign3 `shouldBe` [(IdeNamespaced IdeNSKind "Foreign3", span1)]   describe "Type annotations" $ do     it "extracts a type annotation" $       extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]@@ -98,7 +104,7 @@       [ ("Test",          [ ideValue "sfValue" Nothing `annLoc` valueSS          , ideSynonym "SFType" Nothing Nothing `annLoc` synonymSS-         , ideType "SFData" Nothing `annLoc` typeSS+         , ideType "SFData" Nothing [] `annLoc` typeSS          , ideDtor "SFOne" "SFData" Nothing `annLoc` typeSS          , ideDtor "SFTwo" "SFData" Nothing `annLoc` typeSS          , ideDtor "SFThree" "SFData" Nothing `annLoc` typeSS@@ -109,14 +115,3 @@            `annLoc` typeOpSS          ])       ]--valueSS, synonymSS, typeSS, classSS, valueOpSS, typeOpSS :: P.SourceSpan-valueSS = ss 3 1-synonymSS = ss 5 1-typeSS = ss 7 1-classSS = ss 8 1-valueOpSS = ss 12 1-typeOpSS = ss 13 1--ss :: Int -> Int -> P.SourceSpan-ss x y = P.SourceSpan "Test.purs" (P.SourcePos x y) (P.SourcePos x y)

tests/Language/PureScript/Ide/StateSpec.hs view

@@ -13,27 +13,26 @@  valueOperator :: Maybe P.Type -> IdeDeclarationAnn valueOperator =-  d . IdeDeclValueOperator . IdeValueOperator (P.OpName "<$>") (P.Qualified (Just (mn "Test")) (Left (P.Ident "function"))) 2 P.Infix+  ideValueOp "<$>" (P.Qualified (Just (mn "Test")) (Left "function")) 2 Nothing  ctorOperator :: Maybe P.Type -> IdeDeclarationAnn ctorOperator =-  d . IdeDeclValueOperator . IdeValueOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (Right (P.ProperName "Cons"))) 2 P.Infix+  ideValueOp ":" (P.Qualified (Just (mn "Test")) (Right "Cons")) 2 Nothing  typeOperator :: Maybe P.Kind -> IdeDeclarationAnn typeOperator =-  d . IdeDeclTypeOperator . IdeTypeOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (P.ProperName "List")) 2 P.Infix+  ideTypeOp ":" (P.Qualified (Just (mn "Test")) "List") 2 Nothing  testModule :: (P.ModuleName, [IdeDeclarationAnn])-testModule = (mn "Test", [ d (IdeDeclValue (IdeValue (P.Ident "function") P.REmpty))-                         , d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "Cons") (P.ProperName "List") (P.REmpty)))-                         , d (IdeDeclType (IdeType (P.ProperName "List") P.kindType))-                         , valueOperator Nothing-                         , ctorOperator Nothing-                         , typeOperator Nothing-                         ])--d :: IdeDeclaration -> IdeDeclarationAnn-d = IdeDeclarationAnn emptyAnn+testModule =+  (mn "Test",+    [ ideValue "function" (Just P.REmpty)+    , ideDtor "Cons" "List" (Just P.tyString)+    , ideType "List" Nothing []+    , valueOperator Nothing+    , ctorOperator Nothing+    , typeOperator Nothing+    ])  testState :: ModuleMap [IdeDeclarationAnn] testState = Map.fromList [testModule]@@ -81,7 +80,7 @@     it "resolves the type for a value operator" $       resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))     it "resolves the type for a constructor operator" $-      resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))+      resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.tyString))     it "resolves the kind for a type operator" $       resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))   describe "resolving instances for type classes" $ do@@ -89,3 +88,8 @@       resolveInstances (Map.singleton (mn "InstanceModule") ef) moduleMap         `shouldSatisfy`         elemOf (ix (mn "ClassModule") . ix 0 . idaDeclaration . _IdeDeclTypeClass . ideTCInstances . folded) ideInstance+  describe "resolving data constructors" $ do+    it "resolves a constructor" $ do+      resolveDataConstructorsForModule (snd testModule)+        `shouldSatisfy`+        elem (ideType "List" Nothing [(P.ProperName "Cons", P.tyString)])

tests/Language/PureScript/Ide/Test.hs view

@@ -1,6 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports    #-}+{-# LANGUAGE DataKinds         #-} module Language.PureScript.Ide.Test where  import           Control.Concurrent.STM@@ -63,8 +64,8 @@ ideValue :: Text -> Maybe P.Type -> IdeDeclarationAnn ideValue i ty = ida (IdeDeclValue (IdeValue (P.Ident i) (fromMaybe P.tyString ty))) -ideType :: Text -> Maybe P.Kind -> IdeDeclarationAnn-ideType pn ki = ida (IdeDeclType (IdeType (P.ProperName pn) (fromMaybe P.kindType ki)))+ideType :: Text -> Maybe P.Kind -> [(P.ProperName 'P.ConstructorName, P.Type)] -> IdeDeclarationAnn+ideType pn ki dtors = ida (IdeDeclType (IdeType (P.ProperName pn) (fromMaybe P.kindType ki) dtors))  ideSynonym :: Text -> Maybe P.Type -> Maybe P.Kind -> IdeDeclarationAnn ideSynonym pn ty kind = ida (IdeDeclTypeSynonym (IdeTypeSynonym (P.ProperName pn) (fromMaybe P.tyString ty) (fromMaybe P.kindType kind)))@@ -97,6 +98,17 @@  ideKind :: Text -> IdeDeclarationAnn ideKind pn = ida (IdeDeclKind (P.ProperName pn))++valueSS, synonymSS, typeSS, classSS, valueOpSS, typeOpSS :: P.SourceSpan+valueSS = ss 3 1+synonymSS = ss 5 1+typeSS = ss 7 1+classSS = ss 8 1+valueOpSS = ss 12 1+typeOpSS = ss 13 1++ss :: Int -> Int -> P.SourceSpan+ss x y = P.SourceSpan "Test.purs" (P.SourcePos x y) (P.SourcePos x y)  mn :: Text -> P.ModuleName mn = P.moduleNameFromString

tests/TestDocs.hs view

@@ -13,7 +13,6 @@ import Control.Monad.IO.Class (liftIO)  import Data.Foldable-import Data.List ((\\)) import Data.Maybe (fromMaybe) import Data.Monoid import Data.Text (Text)@@ -99,7 +98,7 @@ data AssertionFailure   -- | A declaration was not documented, but should have been   = NotDocumented P.ModuleName Text-  -- | A child declaration was not documented, but should have been+  -- | The expected list of child declarations did not match the actual list   | ChildrenNotDocumented P.ModuleName Text [Text]   -- | A declaration was documented, but should not have been   | Documented P.ModuleName Text@@ -152,9 +151,9 @@         Nothing ->           Fail (NotDocumented mn decl)         Just actualChildren ->-          case children \\ actualChildren of-            [] -> Pass-            cs -> Fail (ChildrenNotDocumented mn decl cs)+          if children == actualChildren+            then Pass+            else Fail (ChildrenNotDocumented mn decl actualChildren)      ShouldNotBeDocumented mn decl ->       case findChildren decl (declarationsFor mn) of@@ -405,6 +404,11 @@    , ("Desugar",       [ ValueShouldHaveTypeSignature (n "Desugar") "test" (renderedType "forall a b. X (a -> b) a -> b")+      ])++  , ("ChildDeclOrder",+      [ ShouldBeDocumented (n "ChildDeclOrder") "Two" ["First", "Second", "showTwo", "fooTwo"]+      , ShouldBeDocumented (n "ChildDeclOrder") "Foo" ["foo1", "foo2", "fooTwo", "fooInt"]       ])   ]

tests/support/bower.json view

@@ -8,13 +8,14 @@     "purescript-functions": "3.0.0",     "purescript-generics": "4.0.0",     "purescript-generics-rep": "5.0.0",+    "purescript-lists": "4.6.0",     "purescript-newtype": "2.0.0",     "purescript-partial": "1.2.0",     "purescript-prelude": "3.0.0",     "purescript-psci-support": "3.0.0",     "purescript-st": "3.0.0",     "purescript-symbols": "3.0.0",-    "purescript-tailrec": "3.0.0",+    "purescript-tailrec": "3.3.0",     "purescript-typelevel-prelude": "2.0.0",     "purescript-unsafe-coerce": "3.0.0"   }