purescript 0.11.4 → 0.11.5

raw patch · 60 files changed

+1037/−547 lines, 60 filesdep +stringsearchdep ~directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: stringsearch

Dependency ranges changed: directory

API changes (from Hackage documentation)

Files

• CONTRIBUTING.md +1/−1
• CONTRIBUTORS.md +4/−0
• app/Command/Compile.hs +3/−4
• app/Command/Ide.hs +10/−9
• app/Command/REPL.hs +9/−6
• examples/docs/src/Desugar.purs +8/−0
• examples/failing/2874-forall.purs +8/−0
• examples/failing/2874-forall2.purs +10/−0
• examples/failing/2874-wildcard.purs +11/−0
• examples/failing/InstanceSigsBodyIncorrect.purs +10/−0
• examples/failing/InstanceSigsDifferentTypes.purs +10/−0
• examples/failing/InstanceSigsIncorrectType.purs +10/−0
• examples/failing/InstanceSigsOrphanTypeDeclaration.purs +10/−0
• examples/passing/InstanceSigs.purs +12/−0
• examples/passing/InstanceSigsGeneral.purs +12/−0
• examples/passing/NewtypeInstance.purs +17/−3
• examples/warning/NewtypeInstance.purs +8/−0
• examples/warning/NewtypeInstance2.purs +16/−0
• examples/warning/NewtypeInstance3.purs +22/−0
• examples/warning/NewtypeInstance4.purs +24/−0
• purescript.cabal +25/−7
• src/Language/PureScript/AST/Declarations.hs +2/−0
• src/Language/PureScript/AST/SourcePos.hs +4/−3
• src/Language/PureScript/CoreImp/Optimizer/TCO.hs +5/−5
• src/Language/PureScript/Docs/Convert.hs +3/−2
• src/Language/PureScript/Environment.hs +3/−3
• src/Language/PureScript/Errors.hs +34/−12
• src/Language/PureScript/Errors/JSON.hs +1/−1
• src/Language/PureScript/Ide.hs +21/−13
• src/Language/PureScript/Ide/Command.hs +8/−0
• src/Language/PureScript/Ide/Completion.hs +115/−7
• src/Language/PureScript/Ide/Error.hs +2/−2
• src/Language/PureScript/Ide/Filter.hs +29/−10
• src/Language/PureScript/Ide/Imports.hs +51/−34
• src/Language/PureScript/Ide/Rebuild.hs +2/−5
• src/Language/PureScript/Ide/Reexports.hs +6/−2
• src/Language/PureScript/Ide/SourceFile.hs +32/−18
• src/Language/PureScript/Ide/State.hs +51/−85
• src/Language/PureScript/Ide/Types.hs +50/−35
• src/Language/PureScript/Ide/Util.hs +16/−46
• src/Language/PureScript/Ide/Watcher.hs +1/−1
• src/Language/PureScript/Interactive.hs +4/−1
• src/Language/PureScript/Interactive/Module.hs +2/−2
• src/Language/PureScript/Parser/Declarations.hs +8/−2
• src/Language/PureScript/Parser/Types.hs +11/−0
• src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +95/−15
• src/Language/PureScript/Types.hs +7/−0
• src/System/IO/UTF8.hs +9/−2
• tests/Language/PureScript/Ide/CompletionSpec.hs +34/−0
• tests/Language/PureScript/Ide/FilterSpec.hs +45/−6
• tests/Language/PureScript/Ide/ImportsSpec.hs +31/−7
• tests/Language/PureScript/Ide/RebuildSpec.hs +2/−1
• tests/Language/PureScript/Ide/ReexportsSpec.hs +7/−2
• tests/Language/PureScript/Ide/SourceFileSpec.hs +13/−13
• tests/Language/PureScript/Ide/Test.hs +9/−9
• tests/TestCompiler.hs +39/−42
• tests/TestDocs.hs +4/−0
• tests/TestPsci/CompletionTest.hs +14/−12
• tests/TestUtils.hs +26/−118
• tests/support/bower.json +1/−1

@@ -23,7 +23,7 @@  ``` bash # Build-stack exec psc -- 'tests/support/bower_components/purescript-*/src/**/*.purs' examples/blah/Blah.purs+stack exec purs -- compile 'tests/support/bower_components/purescript-*/src/**/*.purs' examples/blah/Blah.purs  # Run node -e "require('./output/Main/').main()"

@@ -36,6 +36,7 @@ | [@davidchambers](https://github.com/davidchambers) | David Chambers | [MIT license](http://opensource.org/licenses/MIT) | | [@DavidLindbom](https://github.com/DavidLindbom) | David Lindbom | [MIT license](http://opensource.org/licenses/MIT) | | [@dckc](https://github.com/dckc) | Dan Connolly | [MIT license](http://opensource.org/licenses/MIT) |+| [@kleeneplus](https://github.com/dgendill) | Dominick Gendill | [MIT license](http://opensource.org/licenses/MIT) | | [@eamelink](https://github.com/eamelink) | Erik Bakker | MIT license | | [@epost](https://github.com/epost) | Erik Post | MIT license | | [@erdeszt](https://github.com/erdeszt) | Tibor Erdesz | [MIT license](http://opensource.org/licenses/MIT) |@@ -45,6 +46,7 @@ | [@FrigoEU](https://github.com/FrigoEU) | Simon Van Casteren | [MIT license](http://opensource.org/licenses/MIT) | | [@garyb](https://github.com/garyb) | Gary Burgess | [MIT license](http://opensource.org/licenses/MIT) | | [@hdgarrood](https://github.com/hdgarrood) | Harry Garrood | [MIT license](http://opensource.org/licenses/MIT) |+| [@houli](https://github.com/houli) | Eoin Houlihan | [MIT license](http://opensource.org/licenses/MIT) | | [@ianbollinger](https://github.com/ianbollinger) | Ian D. Bollinger | [MIT license](http://opensource.org/licenses/MIT) | | [@ilovezfs](https://github.com/ilovezfs) | ilovezfs | MIT license | | [@izgzhen](https://github.com/izgzhen) | Zhen Zhang | [MIT license](http://opensource.org/licenses/MIT) |@@ -86,11 +88,13 @@ | [@rvion](https://github.com/rvion) | Rémi Vion | [MIT license](http://opensource.org/licenses/MIT) | | [@RyanGlScott](https://github.com/RyanGlScott) | Ryan Scott | [MIT license](http://opensource.org/licenses/MIT) | | [@sebastiaanvisser](https://github.com/sebastiaanvisser) | Sebastiaan Visser | MIT license |+| [@sectore](https://github.com/sectore) | Jens Krause | [MIT license](http://opensource.org/licenses/MIT) | | [@senju](https://github.com/senju) | senju | [MIT license](http://opensource.org/licenses/MIT) | | [@seungha-kim](https://github.com/seungha-kim) | Seungha Kim | [MIT license](http://opensource.org/licenses/MIT) | | [@simonyangme](https://github.com/simonyangme) | Simon Yang | [MIT license](http://opensource.org/licenses/MIT) | | [@sharkdp](https://github.com/sharkdp) | David Peter | [MIT license](http://opensource.org/licenses/MIT) | | [@soupi](https://github.com/soupi) | Gil Mizrahi | [MIT license](http://opensource.org/licenses/MIT) |+| [@stefanholzmueller](https://github.com/stefanholzmueller) | Stefan Holzmüller | [MIT license](http://opensource.org/licenses/MIT) | | [@sztupi](https://github.com/sztupi) | Attila Sztupak | [MIT license](http://opensource.org/licenses/MIT) | | [@taktoa](https://github.com/taktoa) | Remy Goldschmidt | [MIT license](http://opensource.org/licenses/MIT) | | [@taku0](https://github.com/taku0) | taku0 | [MIT license](http://opensource.org/licenses/MIT) |

@@ -22,7 +22,6 @@ import qualified System.Console.ANSI as ANSI import           System.Exit (exitSuccess, exitFailure) import           System.Directory (getCurrentDirectory)-import           System.FilePath (makeRelative) import           System.FilePath.Glob (glob) import           System.IO (hPutStr, hPutStrLn, stderr) import           System.IO.UTF8 (readUTF8FileT)@@ -38,8 +37,9 @@ -- | Argumnets: verbose, use JSON, warnings, errors printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO () printWarningsAndErrors verbose False warnings errors = do+  pwd <- getCurrentDirectory   cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stderr-  let ppeOpts = P.defaultPPEOptions { P.ppeCodeColor = cc, P.ppeFull = verbose }+  let ppeOpts = P.defaultPPEOptions { P.ppeCodeColor = cc, P.ppeFull = verbose, P.ppeRelativeDirectory = pwd }   when (P.nonEmpty warnings) $     hPutStrLn stderr (P.prettyPrintMultipleWarnings ppeOpts warnings)   case errors of@@ -55,7 +55,6 @@  compile :: PSCMakeOptions -> IO () compile PSCMakeOptions{..} = do-  pwd <- getCurrentDirectory   input <- globWarningOnMisses (unless pscmJSONErrors . warnFileTypeNotFound) pscmInput   when (null input && not pscmJSONErrors) $ do     hPutStr stderr $ unlines [ "purs compile: No input files."@@ -64,7 +63,7 @@     exitFailure   moduleFiles <- readInput input   (makeErrors, makeWarnings) <- runMake pscmOpts $ do-    ms <- P.parseModulesFromFiles (makeRelative pwd) moduleFiles+    ms <- P.parseModulesFromFiles id moduleFiles     let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, Right fp)) ms     foreigns <- inferForeignModules filePathMap     let makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix

@@ -120,7 +120,7 @@      unless noWatch $       void (forkFinally (watcher polling logLevel ideState fullOutputPath) print)-    let conf = Configuration {confLogLevel = logLevel, confOutputPath = outputPath, confGlobs = globs}+    let conf = IdeConfiguration {confLogLevel = logLevel, confOutputPath = outputPath, confGlobs = globs}         env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}     startServer port env @@ -164,15 +164,16 @@           case decodeT cmd of             Just cmd' -> do               let message duration =-                    "Command " <> commandName cmd'-                    <> " took "-                    <> displayTimeSpec duration-              result <- logPerf message (runExceptT (handleCommand cmd'))-              -- $(logDebug) ("Answer was: " <> T.pack (show result))+                    "Command "+                      <> commandName cmd'+                      <> " took "+                      <> displayTimeSpec duration+              logPerf message $ do+                result <- runExceptT (handleCommand cmd')+                liftIO $ catchGoneHandle $ BSL8.hPutStrLn h $ case result of+                  Right r  -> Aeson.encode r+                  Left err -> Aeson.encode err               liftIO (hFlush stdout)-              case result of-                Right r  -> liftIO $ catchGoneHandle (BSL8.hPutStrLn h (Aeson.encode r))-                Left err -> liftIO $ catchGoneHandle (BSL8.hPutStrLn h (Aeson.encode err))             Nothing -> do               $(logError) ("Parsing the command failed. Command: " <> cmd)               liftIO $ do

@@ -53,6 +53,7 @@ import           System.FilePath ((</>)) import           System.FilePath.Glob (glob) import           System.Process (readProcessWithExitCode)+import qualified Data.ByteString.Lazy.UTF8 as U  -- | Command line options data PSCiOptions = PSCiOptions@@ -206,12 +207,12 @@           case Wai.pathInfo req of             [] ->               respond $ Wai.responseLBS status200-                                        [(hContentType, "text/html")]-                                        indexPage+                                        [(hContentType, "text/html; charset=UTF-8")]+                                        (U.fromString indexPage)             ["js", "index.js"] ->               respond $ Wai.responseLBS status200                                         [(hContentType, "application/javascript")]-                                        indexJS+                                        (U.fromString indexJS)             ["js", "latest.js"] -> do               may <- readTVarIO indexJs               case may of@@ -224,7 +225,7 @@                                             , (hPragma, "no-cache")                                             , (hExpires, "0")                                             ]-                                            (fromString js)+                                            (U.fromString js)             ["js", "bundle.js"] -> do               may <- readTVarIO bundleJs               case may of@@ -233,7 +234,7 @@                 Just js ->                   respond $ Wai.responseLBS status200                                             [ (hContentType, "application/javascript")]-                                            (fromString js)+                                            (U.fromString js)             _ -> respond $ Wai.responseLBS status404 [] "Not found"        let browserState = BrowserState cmdChan shutdownVar indexJs bundleJs@@ -323,7 +324,9 @@         case psciBackend of           Backend setup eval reload (shutdown :: state -> IO ()) ->             case e of-              Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure+              Left errs -> do+                pwd <- getCurrentDirectory+                putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions {P.ppeRelativeDirectory = pwd} errs) >> exitFailure               Right (modules, externs, env) -> do                 historyFilename <- getHistoryFilename                 let settings = defaultSettings { historyFile = Just historyFilename }

@@ -0,0 +1,8 @@+module Desugar where++data X a b = X a b++test :: forall a b. X (a -> b) a -> b+test x =+  let X a b = x+  in a b

@@ -0,0 +1,8 @@+-- @shouldFailWith ErrorParsingModule+module Main where++class T a b | a -> b+instance tT :: (T Int (forall a. a)) => T Int String++ddd :: Int+ddd = 0 :: forall t. T Int t => Int

@@ -0,0 +1,10 @@+-- @shouldFailWith ErrorParsingModule+module Main where++class X a b | a -> b+class X a (forall t. t) <= Y a b | a -> b+instance tX :: X Int String+instance tY :: Y Int Boolean++ggg :: Int+ggg = 0 :: forall t. Y Int t => Int

@@ -0,0 +1,11 @@+-- @shouldFailWith ErrorParsingModule+module Main where++class Foo a where+  foo :: a++class Baz b where+  baz :: b++instance bazFoo :: (Baz _) => Foo b where+  foo = baz

@@ -0,0 +1,10 @@+-- @shouldFailWith TypesDoNotUnify++module Main where++class Foo a where+  foo :: a++instance fooNumber :: Foo Number where+  foo :: Number+  foo = true

@@ -0,0 +1,10 @@+-- @shouldFailWith TypesDoNotUnify++module Main where++class Foo a where+  foo :: a++instance fooNumber :: Foo Number where+  foo :: Int+  foo = 0.0

@@ -0,0 +1,10 @@+-- @shouldFailWith TypesDoNotUnify++module Main where++class Foo a where+  foo :: a++instance fooNumber :: Foo Number where+  foo :: Boolean+  foo = true

@@ -0,0 +1,10 @@+-- @shouldFailWith OrphanTypeDeclaration++module Main where++class Foo a where+  foo :: a++instance fooNumber :: Foo Number where+  bar :: Int+  foo = 0.0

@@ -0,0 +1,12 @@+module Main where++import Control.Monad.Eff.Console (log)++class Foo a where+  foo :: a++instance fooNumber :: Foo Number where+  foo :: Number+  foo = 0.0++main = log "Done"

@@ -0,0 +1,12 @@+module Main where++import Control.Monad.Eff.Console (log)++class Eq a where+  eq :: a -> a -> Boolean++instance eqNumber :: Eq Number where+  eq :: forall x y. x -> y -> Boolean+  eq _ _ = true++main = log "Done"

@@ -3,15 +3,15 @@ import Prelude import Control.Monad.Eff import Control.Monad.Eff.Console+import Data.Monoid+import Data.Tuple  type MyString = String   newtype X = X MyString  derive newtype instance showX :: Show X- derive newtype instance eqX :: Eq X- derive newtype instance ordX :: Ord X  newtype Y a = Y (Array a)@@ -29,12 +29,26 @@ newtype MyArray a = MyArray (Array a)  derive newtype instance showMyArray :: Show a => Show (MyArray a)- derive newtype instance functorMyArray :: Functor MyArray  newtype ProxyArray x a = ProxyArray (Array a)  derive newtype instance functorProxyArray :: Functor (ProxyArray x)++class (Monad m, Monoid w) <= MonadWriter w m | m -> w where+  tell :: w -> m Unit++instance monadWriterTuple :: Monoid w => MonadWriter w (Tuple w) where+  tell w = Tuple w unit++newtype MyWriter w a = MyWriter (Tuple w a)++derive newtype instance functorMyWriter :: Functor (MyWriter w)+derive newtype instance applyMyWriter :: Semigroup w => Apply (MyWriter w)+derive newtype instance applicativeMyWriter :: Monoid w => Applicative (MyWriter w)+derive newtype instance bindMyWriter :: Semigroup w => Bind (MyWriter w)+derive newtype instance monadMyWriter :: Monoid w => Monad (MyWriter w)+derive newtype instance monadWriterMyWriter :: Monoid w => MonadWriter w (MyWriter w)  main = do   logShow (X "test")

@@ -0,0 +1,8 @@+-- @shouldWarnWith MissingNewtypeSuperclassInstance+module Main where++import Prelude++newtype X = X String++derive newtype instance ordX :: Ord X

@@ -0,0 +1,16 @@+-- @shouldWarnWith MissingNewtypeSuperclassInstance+module Main where++import Prelude+import Data.Monoid (class Monoid)+import Data.Tuple (Tuple(..))++class (Monad m, Monoid w) <= MonadWriter w m | m -> w where+  tell :: w -> m Unit++instance monadWriterTuple :: Monoid w => MonadWriter w (Tuple w) where+  tell w = Tuple w unit++newtype MyWriter w a = MyWriter (Tuple w a)++derive newtype instance monadWriterMyWriter :: Monoid w => MonadWriter w (MyWriter w)

@@ -0,0 +1,22 @@+-- @shouldWarnWith MissingNewtypeSuperclassInstance+module Main where++import Prelude+import Data.Monoid (class Monoid)+import Data.Tuple (Tuple(..))++class (Monad m, Monoid w) <= MonadTell w m | m -> w where+  tell :: w -> m Unit++class (MonadTell w m) <= MonadWriter w m | m -> w where+  listen :: forall a. m a -> m (Tuple w a)++instance monadTellTuple :: Monoid w => MonadTell w (Tuple w) where+  tell w = Tuple w unit++instance monadWriterTuple :: Monoid w => MonadWriter w (Tuple w) where+  listen (Tuple w a) = Tuple w (Tuple w a)++newtype MyWriter w a = MyWriter (Tuple w a)++derive newtype instance monadWriterMyWriter :: Monoid w => MonadWriter w (MyWriter w)

@@ -0,0 +1,24 @@+-- @shouldWarnWith UnverifiableSuperclassInstance+module Main where++import Prelude+import Data.Monoid (class Monoid)+import Data.Tuple (Tuple(..))++class Monoid w <= MonadTell w m where+  tell :: w -> m Unit++class (MonadTell w m) <= MonadWriter w m where+  listen :: forall a. m a -> m (Tuple w a)++instance monadTellTuple :: Monoid w => MonadTell w (Tuple w) where+  tell w = Tuple w unit++instance monadWriterTuple :: Monoid w => MonadWriter w (Tuple w) where+  listen (Tuple w a) = Tuple w (Tuple w a)++newtype MyWriter w a = MyWriter (Tuple w a)++-- No fundep means this is unverifiable+derive newtype instance monadTellMyWriter :: Monoid w => MonadTell w (MyWriter w)+derive newtype instance monadWriterMyWriter :: Monoid w => MonadWriter w (MyWriter w)

@@ -3,16 +3,16 @@ -- see: https://github.com/sol/hpack  name:           purescript-version:        0.11.4+version:        0.11.5 cabal-version:  >= 1.10 build-type:     Simple license:        BSD3 license-file:   LICENSE-copyright:      (c) 2013-16 Phil Freeman, (c) 2014-16 Gary Burgess+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.git/issues+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@@ -35,6 +35,7 @@       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@@ -85,6 +86,9 @@       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@@ -184,6 +188,10 @@       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@@ -398,6 +406,8 @@       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@@ -596,6 +606,10 @@       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@@ -638,7 +652,7 @@  source-repository head     type: git-    location: https://github.com/purescript/purescript.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)@@ -662,7 +676,7 @@         , containers         , data-ordlist >=0.4.7.0         , deepseq-        , directory >=1.2+        , directory >=1.2.3         , dlist         , edit-distance         , filepath@@ -692,6 +706,7 @@         , spdx ==0.2.*         , split         , stm >=0.2.4.0+        , stringsearch         , syb         , text         , time@@ -870,7 +885,7 @@         , containers         , data-ordlist >=0.4.7.0         , deepseq-        , directory >=1.2+        , directory >=1.2.3         , dlist         , edit-distance         , filepath@@ -900,6 +915,7 @@         , spdx ==0.2.*         , split         , stm >=0.2.4.0+        , stringsearch         , syb         , text         , time@@ -958,7 +974,7 @@         , containers         , data-ordlist >=0.4.7.0         , deepseq-        , directory >=1.2+        , directory >=1.2.3         , dlist         , edit-distance         , filepath@@ -988,6 +1004,7 @@         , spdx ==0.2.*         , split         , stm >=0.2.4.0+        , stringsearch         , syb         , text         , time@@ -1006,6 +1023,7 @@     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

@@ -109,6 +109,8 @@   | InvalidDerivedInstance (Qualified (ProperName 'ClassName)) [Type] Int   | ExpectedTypeConstructor (Qualified (ProperName 'ClassName)) [Type] Type   | InvalidNewtypeInstance (Qualified (ProperName 'ClassName)) [Type]+  | MissingNewtypeSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [Type]+  | UnverifiableSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [Type]   | CannotFindDerivingType (ProperName 'TypeName)   | DuplicateLabel Label (Maybe Expr)   | DuplicateValueDeclaration Ident

@@ -13,6 +13,7 @@ import Data.Monoid import qualified Data.Text as T import Data.Text (Text)+import System.FilePath (makeRelative)  -- | -- Source position information@@ -65,9 +66,9 @@   displaySourcePos (spanStart sp) <> " - " <>   displaySourcePos (spanEnd sp) -displaySourceSpan :: SourceSpan -> Text-displaySourceSpan sp =-  T.pack (spanName sp) <> " " <>+displaySourceSpan :: FilePath -> SourceSpan -> Text+displaySourceSpan relPath sp =+  T.pack (makeRelative relPath (spanName sp)) <> " " <>     displayStartEndPos sp  instance A.ToJSON SourceSpan where

@@ -13,19 +13,19 @@ tco :: AST -> AST tco = everywhere convert where   tcoVar :: Text -> Text-  tcoVar arg = "__tco_" <> arg+  tcoVar arg = "$tco_var_" <> arg    copyVar :: Text -> Text-  copyVar arg = "__copy_" <> arg+  copyVar arg = "$copy_" <> arg    tcoDone :: Text-  tcoDone = tcoVar "done"+  tcoDone = "$tco_done"    tcoLoop :: Text-  tcoLoop = tcoVar "loop"+  tcoLoop = "$tco_loop"    tcoResult :: Text-  tcoResult = tcoVar "result"+  tcoResult = "$tco_result"    convert :: AST -> AST   convert (VariableIntroduction ss name (Just fn@Function {}))

@@ -58,7 +58,7 @@       Nothing -> Local mn    isLocal :: P.ModuleName -> Bool-  isLocal = not . flip Map.member modulesDeps +  isLocal = not . flip Map.member modulesDeps  -- | -- Convert a group of modules to the intermediate format, designed for@@ -208,7 +208,8 @@   where   desugar' =     traverse P.desugarDoModule-      >=> traverse P.desugarCasesModule+      >=> map P.desugarLetPatternModule+      >>> traverse P.desugarCasesModule       >=> traverse P.desugarTypeDeclarationsModule       >=> ignoreWarnings . P.desugarImportsWithEnv [] 

@@ -377,9 +377,9 @@     -- class RowCons (l :: Symbol) (a :: Type) (i :: # Type) (o :: # Type) | l i a -> o, l o -> a i     , (primName "RowCons", (makeTypeClassData                              [ ("l", Just kindSymbol)-                             , ("a", Just (Row kindType))-                             , ("i", Just kindType)-                             , ("o", Just kindType)+                             , ("a", Just kindType)+                             , ("i", Just (Row kindType))+                             , ("o", Just (Row kindType))                              ] [] []                              [ FunctionalDependency [0, 1, 2] [3]                              , FunctionalDependency [0, 3] [1, 2]

@@ -121,6 +121,8 @@   PossiblyInfiniteInstance{} -> "PossiblyInfiniteInstance"   CannotDerive{} -> "CannotDerive"   InvalidNewtypeInstance{} -> "InvalidNewtypeInstance"+  MissingNewtypeSuperclassInstance{} -> "MissingNewtypeSuperclassInstance"+  UnverifiableSuperclassInstance{} -> "UnverifiableSuperclassInstance"   InvalidDerivedInstance{} -> "InvalidDerivedInstance"   ExpectedTypeConstructor{} -> "ExpectedTypeConstructor"   CannotFindDerivingType{} -> "CannotFindDerivingType"@@ -262,6 +264,8 @@   gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts   gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts   gSimple (InvalidNewtypeInstance cl ts) = InvalidNewtypeInstance cl <$> traverse f ts+  gSimple (MissingNewtypeSuperclassInstance cl1 cl2 ts) = MissingNewtypeSuperclassInstance cl1 cl2 <$> traverse f ts+  gSimple (UnverifiableSuperclassInstance cl1 cl2 ts) = UnverifiableSuperclassInstance cl1 cl2 <$> traverse f ts   gSimple (InvalidDerivedInstance cl ts n) = InvalidDerivedInstance cl <$> traverse f ts <*> pure n   gSimple (ExpectedTypeConstructor cl ts ty) = ExpectedTypeConstructor cl <$> traverse f ts <*> f ty   gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k@@ -362,24 +366,26 @@  -- | `prettyPrintSingleError` Options data PPEOptions = PPEOptions-  { ppeCodeColor :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not-  , ppeFull      :: Bool -- ^ Should write a full error message?-  , ppeLevel     :: Level -- ^ Should this report an error or a warning?-  , ppeShowDocs  :: Bool -- ^ Should show a link to error message's doc page?+  { ppeCodeColor         :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not+  , ppeFull              :: Bool -- ^ Should write a full error message?+  , ppeLevel             :: Level -- ^ Should this report an error or a warning?+  , ppeShowDocs          :: Bool -- ^ Should show a link to error message's doc page?+  , ppeRelativeDirectory :: FilePath -- ^ FilePath to which the errors are relative   }  -- | Default options for PPEOptions defaultPPEOptions :: PPEOptions defaultPPEOptions = PPEOptions-  { ppeCodeColor = Just defaultCodeColor-  , ppeFull      = False-  , ppeLevel     = Error-  , ppeShowDocs  = True+  { ppeCodeColor         = Just defaultCodeColor+  , ppeFull              = False+  , ppeLevel             = Error+  , ppeShowDocs          = True+  , ppeRelativeDirectory = mempty   }  -- | Pretty print a single error, simplifying if necessary prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box-prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalState defaultUnknownMap $ do+prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = flip evalState defaultUnknownMap $ do   em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)   um <- get   return (prettyPrintErrorMessage um em)@@ -522,7 +528,7 @@       line $ "Export for " <> printName new <> " conflicts with " <> runName existing     renderSimpleErrorMessage (DuplicateModule mn ss) =       paras [ line ("Module " <> markCode (runModuleName mn) <> " has been defined multiple times:")-            , indent . paras $ map (line . displaySourceSpan) ss+            , indent . paras $ map (line . displaySourceSpan relPath) ss             ]     renderSimpleErrorMessage (CycleInDeclaration nm) =       line $ "The value of " <> markCode (showIdent nm) <> " is undefined here, so this reference is not allowed."@@ -551,7 +557,7 @@             ]     renderSimpleErrorMessage (EscapedSkolem name (Just srcSpan) ty) =       paras [ line $ "The type variable " <> markCode name <> ", bound at"-            , indent $ line $ displaySourceSpan srcSpan+            , indent $ line $ displaySourceSpan relPath srcSpan             , line "has escaped its scope, appearing in the type"             , markCodeBox $ indent $ typeAsBox ty             ]@@ -671,6 +677,22 @@                 ]             , line "Make sure this is a newtype."             ]+    renderSimpleErrorMessage (MissingNewtypeSuperclassInstance su cl ts) =+      paras [ line "The derived newtype instance for"+            , markCodeBox $ indent $ Box.hsep 1 Box.left+                [ line (showQualified runProperName cl)+                , Box.vcat Box.left (map typeAtomAsBox ts)+                ]+            , line $ "does not include a derived superclass instance for " <> markCode (showQualified runProperName su) <> "."+            ]+    renderSimpleErrorMessage (UnverifiableSuperclassInstance su cl ts) =+      paras [ line "The derived newtype instance for"+            , markCodeBox $ indent $ Box.hsep 1 Box.left+                [ line (showQualified runProperName cl)+                , Box.vcat Box.left (map typeAtomAsBox ts)+                ]+            , line $ "implies an superclass instance for " <> markCode (showQualified runProperName su) <> " which could not be verified."+            ]     renderSimpleErrorMessage (InvalidDerivedInstance nm ts argCount) =       paras [ line "Cannot derive the type class instance"             , markCodeBox $ indent $ Box.hsep 1 Box.left@@ -1053,7 +1075,7 @@                 ]             ]     renderHint (PositionedError srcSpan) detail =-      paras [ line $ "at " <> displaySourceSpan srcSpan+      paras [ line $ "at " <> displaySourceSpan relPath srcSpan             , detail             ] 

@@ -50,7 +50,7 @@ toJSONError :: Bool -> P.Level -> P.ErrorMessage -> JSONError toJSONError verbose level e =   JSONError (toErrorPosition <$> sspan)-            (P.renderBox (P.prettyPrintSingleError (P.PPEOptions Nothing verbose level False) (P.stripModuleAndSpan e)))+            (P.renderBox (P.prettyPrintSingleError (P.PPEOptions Nothing verbose level False mempty) (P.stripModuleAndSpan e)))             (P.errorCode e)             (P.errorDocUri e)             (P.spanName <$> sspan)

@@ -56,8 +56,8 @@     loadModulesSync modules   Type search filters currentModule ->     findType search filters currentModule-  Complete filters matcher currentModule ->-    findCompletions filters matcher currentModule+  Complete filters matcher currentModule complOptions ->+    findCompletions filters matcher currentModule complOptions   Pursuit query Package ->     findPursuitPackages query   Pursuit query Identifier ->@@ -75,12 +75,15 @@   Import fp outfp _ (AddImplicitImport mn) -> do     rs <- addImplicitImport fp mn     answerRequest outfp rs+  Import fp outfp _ (AddQualifiedImport mn qual) -> do+    rs <- addQualifiedImport fp mn qual+    answerRequest outfp rs   Import fp outfp filters (AddImportForIdentifier ident) -> do     rs <- addImportForIdentifier fp ident filters     case rs of       Right rs' -> answerRequest outfp rs'       Left question ->-        pure (CompletionResult (map (completionFromMatch . map withEmptyAnn) question))+        pure (CompletionResult (map (completionFromMatch . simpleExport . map withEmptyAnn) question))   Rebuild file ->     rebuildFileAsync file   RebuildSync file ->@@ -92,17 +95,22 @@   Quit ->     liftIO exitSuccess -findCompletions :: Ide m =>-                   [Filter] -> Matcher IdeDeclarationAnn -> Maybe P.ModuleName -> m Success-findCompletions filters matcher currentModule = do+findCompletions+  :: Ide m+  => [Filter]+  -> Matcher IdeDeclarationAnn+  -> Maybe P.ModuleName+  -> CompletionOptions+  -> m Success+findCompletions filters matcher currentModule complOptions = do   modules <- getAllModules currentModule-  pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules+  pure (CompletionResult (getCompletions filters matcher complOptions modules))  findType :: Ide m =>             Text -> [Filter] -> Maybe P.ModuleName -> m Success findType search filters currentModule = do   modules <- getAllModules currentModule-  pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules+  pure (CompletionResult (getExactCompletions search filters modules))  findPursuitCompletions :: MonadIO m =>                           PursuitQuery -> m Success@@ -167,7 +175,7 @@ -- | Looks up the ExternsFiles for the given Modulenames and loads them into the -- server state. Then proceeds to parse all the specified sourcefiles and -- inserts their ASTs into the state. Finally kicks off an async worker, which--- populates Stage 2 and 3 of the state.+-- populates the VolatileState. loadModulesAsync   :: (Ide m, MonadError IdeError m, MonadLogger m)   => [P.ModuleName]@@ -179,9 +187,9 @@   -- successfully parsed modules.   env <- ask   let ll = confLogLevel (ideConfiguration env)-  -- populateStage2 and 3 return Unit for now, so it's fine to discard this+  -- populateVolatileState return Unit for now, so it's fine to discard this   -- result. We might want to block on this in a benchmarking situation.-  _ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))+  _ <- liftIO (async (runLogger ll (runReaderT populateVolatileState env)))   pure tr  loadModulesSync@@ -190,7 +198,7 @@   -> m Success loadModulesSync moduleNames = do   tr <- loadModules moduleNames-  populateStage2 *> populateStage3+  populateVolatileState   pure tr  loadModules@@ -208,7 +216,7 @@   -- We parse all source files, log eventual parse failures and insert the   -- successful parses into the state.   (failures, allModules) <--    partitionEithers <$> (traverse parseModule =<< findAllSourceFiles)+    partitionEithers <$> (parseModulesFromFiles =<< findAllSourceFiles)   unless (null failures) $     $(logWarn) ("Failed to parse: " <> show failures)   traverse_ insertModule allModules

@@ -19,6 +19,7 @@ import           Data.Aeson import qualified Language.PureScript               as P import           Language.PureScript.Ide.CaseSplit+import           Language.PureScript.Ide.Completion import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types@@ -35,6 +36,7 @@       { completeFilters       :: [Filter]       , completeMatcher       :: Matcher IdeDeclarationAnn       , completeCurrentModule :: Maybe P.ModuleName+      , completeOptions       :: CompletionOptions       }     | Pursuit       { pursuitQuery      :: PursuitQuery@@ -79,6 +81,7 @@  data ImportCommand   = AddImplicitImport P.ModuleName+  | AddQualifiedImport P.ModuleName P.ModuleName   | AddImportForIdentifier Text   deriving (Show, Eq) @@ -88,6 +91,10 @@     case command of       "addImplicitImport" ->         AddImplicitImport <$> (P.moduleNameFromString <$> o .: "module")+      "addQualifiedImport" ->+        AddQualifiedImport+          <$> (P.moduleNameFromString <$> o .: "module")+          <*> (P.moduleNameFromString <$> o .: "qualifier")       "addImport" ->         AddImportForIdentifier <$> o .: "identifier"       _ -> mzero@@ -129,6 +136,7 @@           <$> params .:? "filters" .!= []           <*> params .:? "matcher" .!= mempty           <*> (fmap P.moduleNameFromString <$> params .:? "currentModule")+          <*> params .:? "options" .!= defaultCompletionOptions       "pursuit" -> do         params <- o .: "params"         Pursuit

@@ -1,14 +1,26 @@ module Language.PureScript.Ide.Completion        ( getCompletions        , getExactMatches+       , getExactCompletions+       , simpleExport+       , completionFromMatch+       , CompletionOptions(..)+       , defaultCompletionOptions+       , applyCompletionOptions        ) where  import           Protolude +import           Control.Lens hiding ((&), op)+import           Data.Aeson+import qualified Data.Map as Map+import qualified Data.Text as T+import qualified Language.PureScript as P+import           Language.PureScript.Ide.Error (prettyPrintTypeSingleLine) import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types-import qualified Language.PureScript as P+import           Language.PureScript.Ide.Util  type Module = (P.ModuleName, [IdeDeclarationAnn]) @@ -17,17 +29,113 @@ getCompletions   :: [Filter]   -> Matcher IdeDeclarationAnn+  -> CompletionOptions   -> [Module]-  -> [Match IdeDeclarationAnn]-getCompletions filters matcher modules =-  runMatcher matcher (completionsFromModules (applyFilters filters modules))+  -> [Completion]+getCompletions filters matcher options modules =+  modules+  & applyFilters filters+  & matchesFromModules+  & runMatcher matcher+  & applyCompletionOptions options+  <&> completionFromMatch  getExactMatches :: Text -> [Filter] -> [Module] -> [Match IdeDeclarationAnn] getExactMatches search filters modules =-  completionsFromModules (applyFilters (equalityFilter search : filters) modules)+  modules+  & applyFilters (equalityFilter search : filters)+  & matchesFromModules -completionsFromModules :: [Module] -> [Match IdeDeclarationAnn]-completionsFromModules = foldMap completionFromModule+getExactCompletions :: Text -> [Filter] -> [Module] -> [Completion]+getExactCompletions search filters modules =+  modules+  & getExactMatches search filters+  <&> simpleExport+  <&> completionFromMatch++matchesFromModules :: [Module] -> [Match IdeDeclarationAnn]+matchesFromModules = foldMap completionFromModule   where     completionFromModule (moduleName, decls) =       map (\x -> Match (moduleName, x)) decls++data CompletionOptions = CompletionOptions+  { coMaxResults :: Maybe Int+  , coGroupReexports :: Bool+  }++instance FromJSON CompletionOptions where+  parseJSON = withObject "CompletionOptions" $ \o -> do+    maxResults <- o .:? "maxResults"+    groupReexports <- o .:? "groupReexports" .!= False+    pure (CompletionOptions { coMaxResults = maxResults+                            , coGroupReexports = groupReexports+                            })++defaultCompletionOptions :: CompletionOptions+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++simpleExport :: Match a -> (Match a, [P.ModuleName])+simpleExport match@(Match (moduleName, _)) = (match, [moduleName])++groupCompletionReexports :: [Match IdeDeclarationAnn] -> [(Match IdeDeclarationAnn, [P.ModuleName])]+groupCompletionReexports initial =+  Map.elems (foldr go Map.empty initial)+  where+    go (Match (moduleName, d@(IdeDeclarationAnn ann decl))) =+      let+        origin = fromMaybe moduleName (ann^.annExportedFrom)+      in+        Map.alter+        (insertDeclaration moduleName origin d)+        (Namespaced (namespaceForDeclaration decl)+         (P.runModuleName origin <> "." <> identifierFromIdeDeclaration decl))+    insertDeclaration moduleName origin d old = case old of+      Nothing -> Just ( Match (origin, d & idaAnnotation.annExportedFrom .~ Nothing)+                      , [moduleName]+                      )+      Just x -> Just (second (moduleName :) x)++data Namespaced a = Namespaced IdeNamespace a+  deriving (Show, Eq, Ord)++completionFromMatch :: (Match IdeDeclarationAnn, [P.ModuleName]) -> Completion+completionFromMatch (Match (m, IdeDeclarationAnn ann decl), mns) =+  Completion {..}+  where+    (complIdentifier, complExpandedType) = case decl of+      IdeDeclValue v -> (v ^. ideValueIdent . identT, v ^. ideValueType & prettyPrintTypeSingleLine)+      IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & P.prettyPrintKind)+      IdeDeclTypeSynonym s -> (s ^. ideSynonymName . properNameT, s ^. ideSynonymType & prettyPrintTypeSingleLine)+      IdeDeclDataConstructor d -> (d ^. ideDtorName . properNameT, d ^. ideDtorType & prettyPrintTypeSingleLine)+      IdeDeclTypeClass d -> (d ^. ideTCName . properNameT, d ^. ideTCKind & P.prettyPrintKind)+      IdeDeclValueOperator (IdeValueOperator op ref precedence associativity typeP) ->+        (P.runOpName op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyPrintTypeSingleLine typeP)+      IdeDeclTypeOperator (IdeTypeOperator op ref precedence associativity kind) ->+        (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) P.prettyPrintKind kind)+      IdeDeclKind k -> (P.runProperName k, "kind")++    complExportedFrom = mns++    complModule = P.runModuleName m++    complType = maybe complExpandedType prettyPrintTypeSingleLine (_annTypeAnnotation ann)++    complLocation = _annLocation ann++    complDocumentation = Nothing++    showFixity p a r o =+      let asso = case a of+            P.Infix -> "infix"+            P.Infixl -> "infixl"+            P.Infixr -> "infixr"+      in T.unwords [asso, show p, r, "as", P.runOpName o]+

@@ -66,9 +66,9 @@     insertTSCompletions _ _ _ v = v      identCompletion (P.Qualified mn i, ty) =-      Completion (maybe "" P.runModuleName mn) i (prettyPrintTypeSingleLine ty) (prettyPrintTypeSingleLine ty) Nothing Nothing+      Completion (maybe "" P.runModuleName mn) i (prettyPrintTypeSingleLine ty) (prettyPrintTypeSingleLine ty) Nothing Nothing (maybe [] (\x -> [x]) mn)     fieldCompletion (label, ty) =-      Completion "" ("_." <> P.prettyPrintLabel label) (prettyPrintTypeSingleLine ty) (prettyPrintTypeSingleLine ty) Nothing Nothing+      Completion "" ("_." <> P.prettyPrintLabel label) (prettyPrintTypeSingleLine ty) (prettyPrintTypeSingleLine ty) Nothing Nothing []  textError :: IdeError -> Text textError (GeneralError msg)          = msg

@@ -16,6 +16,7 @@  module Language.PureScript.Ide.Filter        ( Filter+       , namespaceFilter        , moduleFilter        , prefixFilter        , equalityFilter@@ -25,18 +26,28 @@ import           Protolude                     hiding (isPrefixOf)  import           Data.Aeson+import           Data.List.NonEmpty            (NonEmpty) import           Data.Text                     (isPrefixOf)-import qualified Language.PureScript           as P import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util+import qualified Language.PureScript           as P -newtype Filter = Filter (Endo [Module]) deriving(Monoid)+newtype Filter = Filter (Endo [Module])+  deriving (Monoid)  type Module = (P.ModuleName, [IdeDeclarationAnn])  mkFilter :: ([Module] -> [Module]) -> Filter mkFilter = Filter . Endo +-- | Only keeps Identifiers in the given Namespaces+namespaceFilter :: NonEmpty IdeNamespace -> Filter+namespaceFilter namespaces =+  mkFilter (filterModuleDecls filterNamespaces)+  where+    filterNamespaces :: IdeDeclaration -> Bool+    filterNamespaces decl = elem (namespaceForDeclaration decl) namespaces+ -- | Only keeps the given Modules moduleFilter :: [P.ModuleName] -> Filter moduleFilter =@@ -48,25 +59,29 @@ -- | Only keeps Identifiers that start with the given prefix prefixFilter :: Text -> Filter prefixFilter "" = mkFilter identity-prefixFilter t = mkFilter $ identFilter prefix t+prefixFilter t =+  mkFilter $ declarationFilter prefix t   where     prefix :: IdeDeclaration -> Text -> Bool     prefix ed search = search `isPrefixOf` identifierFromIdeDeclaration ed  -- | Only keeps Identifiers that are equal to the search string equalityFilter :: Text -> Filter-equalityFilter = mkFilter . identFilter equality+equalityFilter =+  mkFilter . declarationFilter equality   where     equality :: IdeDeclaration -> Text -> Bool     equality ed search = identifierFromIdeDeclaration ed == search -identFilter :: (IdeDeclaration -> Text -> Bool) -> Text -> [Module] -> [Module]-identFilter predicate search =-    filter (not . null . snd) . fmap filterModuleDecls+declarationFilter :: (IdeDeclaration -> Text -> Bool) -> Text -> [Module] -> [Module]+declarationFilter predicate search =+  filterModuleDecls (flip predicate search)++filterModuleDecls :: (IdeDeclaration -> Bool) -> [Module] -> [Module]+filterModuleDecls predicate =+  filter (not . null . snd) . fmap filterDecls   where-    filterModuleDecls :: Module -> Module-    filterModuleDecls (moduleIdent, decls) =-        (moduleIdent, filter (flip predicate search . discardAnn) decls)+    filterDecls (moduleIdent, decls) = (moduleIdent, filter (predicate . discardAnn) decls)  runFilter :: Filter -> [Module] -> [Module] runFilter (Filter f) = appEndo f@@ -90,4 +105,8 @@         params <- o .: "params"         modules <- map P.moduleNameFromString <$> params .: "modules"         return $ moduleFilter modules+      "namespace" -> do+        params <- o .: "params"+        namespaces <- params .: "namespaces"+        return $ namespaceFilter namespaces       _ -> mzero

@@ -14,6 +14,7 @@  module Language.PureScript.Ide.Imports        ( addImplicitImport+       , addQualifiedImport        , addImportForIdentifier        , answerRequest        , parseImportsFromFile@@ -21,6 +22,7 @@        , parseImport        , prettyPrintImportSection        , addImplicitImport'+       , addQualifiedImport'        , addExplicitImport'        , sliceImportSection        , prettyPrintImport'@@ -31,7 +33,7 @@ import           Protolude  import           Control.Lens                       ((^.), (%~), ix)-import           Data.List                          (findIndex, nubBy)+import           Data.List                          (findIndex, nubBy, partition) import qualified Data.Text                          as T import qualified Language.PureScript                as P import           Language.PureScript.Ide.Completion@@ -46,27 +48,6 @@ data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)               deriving (Eq, Show) -instance Ord Import where-  compare = compImport--compImportType :: P.ImportDeclarationType -> P.ImportDeclarationType -> Ordering-compImportType P.Implicit P.Implicit = EQ-compImportType P.Implicit _ = LT-compImportType (P.Explicit _) (P.Hiding _) = LT-compImportType (P.Explicit _) (P.Explicit _) = EQ-compImportType (P.Explicit _) P.Implicit = GT-compImportType (P.Hiding _) (P.Hiding _) = EQ-compImportType (P.Hiding _) _ = GT--compImport :: Import -> Import -> Ordering-compImport (Import n i q) (Import n' i' q')-  | compImportType i i' /= EQ = compImportType i i'-    -- This means that for a stable sort, the first implicit import will stay-    -- the first implicit import-  | not (P.isExplicit i) && isNothing q = LT-  | not (P.isExplicit i) && isNothing q' = GT-  | otherwise = compare n n'- -- | Reads a file and returns the parsed modulename as well as the parsed -- imports, while ignoring eventual parse errors that aren't relevant to the -- import section@@ -85,7 +66,7 @@ parseImportsFromFile' :: (MonadIO m, MonadError IdeError m) =>                         FilePath -> m (P.ModuleName, [Text], [Import], [Text]) parseImportsFromFile' fp = do-  file <- ideReadTextFile fp+  file <- ideReadFile fp   case sliceImportSection (T.lines file) of     Right res -> pure res     Left err -> throwError (GeneralError err)@@ -143,10 +124,11 @@       & ix (l2 - l1) %~ T.take c2  -- | Adds an implicit import like @import Prelude@ to a Sourcefile.-addImplicitImport :: (MonadIO m, MonadError IdeError m)-                     => FilePath     -- ^ The Sourcefile read from-                     -> P.ModuleName -- ^ The module to import-                     -> m [Text]+addImplicitImport+  :: (MonadIO m, MonadError IdeError m)+  => FilePath     -- ^ The source file read from+  -> P.ModuleName -- ^ The module to import+  -> m [Text] addImplicitImport fp mn = do   (_, pre, imports, post) <- parseImportsFromFile' fp   let newImportSection = addImplicitImport' imports mn@@ -154,11 +136,27 @@  addImplicitImport' :: [Import] -> P.ModuleName -> [Text] addImplicitImport' imports mn =-  -- We need to append the new import, because there could already be implicit-  -- imports and we need to preserve the order on these, as the first implicit-  -- import is the one that doesn't generate warnings.-  prettyPrintImportSection ( imports ++ [Import mn P.Implicit Nothing])+  prettyPrintImportSection (Import mn P.Implicit Nothing : imports) +-- | Adds a qualified import like @import Data.Map as Map@ to a source file.+addQualifiedImport+  :: (MonadIO m, MonadError IdeError m)+  => FilePath+  -- ^ The sourcefile read from+  -> P.ModuleName+  -- ^ The module to import+  -> P.ModuleName+  -- ^ The qualifier under which to import+  -> m [Text]+addQualifiedImport fp mn qualifier = do+  (_, pre, imports, post) <- parseImportsFromFile' fp+  let newImportSection = addQualifiedImport' imports mn qualifier+  pure (pre ++ newImportSection ++ post)++addQualifiedImport' :: [Import] -> P.ModuleName -> P.ModuleName -> [Text]+addQualifiedImport' imports mn qualifier =+  prettyPrintImportSection (Import mn P.Implicit (Just qualifier) : imports)+ -- | Adds an explicit import like @import Prelude (unit)@ to a Sourcefile. If an -- explicit import already exists for the given module, it adds the identifier -- to that imports list.@@ -203,6 +201,8 @@       P.ValueOpRef (op ^. ideValueOpName)     refFromDeclaration (IdeDeclTypeOperator op) =       P.TypeOpRef (op ^. ideTypeOpName)+    refFromDeclaration (IdeDeclKind kn) =+      P.KindRef kn     refFromDeclaration d =       P.ValueRef (P.Ident (identifierFromIdeDeclaration d)) @@ -272,7 +272,7 @@       if m1 /= m2          -- If the modules don't line up we just ask the user to specify the          -- module-      then pure $ Left ms+      then pure (Left ms)       else case decideRedundantCase d1 d2 <|> decideRedundantCase d2 d1 of         -- If dataconstructor and type line up we just import the         -- dataconstructor as that will give us an unnecessary import warning at@@ -281,13 +281,16 @@           Right <$> addExplicitImport fp decl m1         -- Here we need the user to specify whether he wanted a dataconstructor         -- or a type++        -- TODO: With the new namespace filter, this can actually be a+        -- request for the user to specify which of the two was wanted.         Nothing ->           throwError (GeneralError "Undecidable between type and dataconstructor")      -- Multiple matches were found so we need to ask the user to clarify which     -- module he meant     xs ->-      pure $ Left xs+      pure (Left xs)     where       decideRedundantCase d@(IdeDeclDataConstructor dtor) (IdeDeclType t) =         if dtor ^. ideDtorTypeName == t ^. ideTypeName then Just d else Nothing@@ -300,7 +303,21 @@   "import " <> P.prettyPrintImport mn idt qual  prettyPrintImportSection :: [Import] -> [Text]-prettyPrintImportSection imports = map prettyPrintImport' (sort imports)+prettyPrintImportSection imports =+  let+    (implicitImports, explicitImports) = partition isImplicitImport imports+  in+    sort (map prettyPrintImport' implicitImports)+      -- Only add the extra spacing if both implicit as well as+      -- explicit/qualified imports exist+      <> (guard (not (null explicitImports || null implicitImports)) $> "")+      <> sort (map prettyPrintImport' explicitImports)+  where+    isImplicitImport :: Import -> Bool+    isImplicitImport i = case i of+      Import _ P.Implicit Nothing -> True+      _ -> False+  -- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@, -- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the

@@ -20,8 +20,6 @@ import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           System.Directory (getCurrentDirectory)-import           System.FilePath (makeRelative)  -- | Given a filepath performs the following steps: --@@ -48,15 +46,14 @@ rebuildFile path runOpenBuild = do    input <- ideReadFile path-  pwd <- liftIO getCurrentDirectory -  m <- case snd <$> P.parseModuleFromFile (makeRelative pwd) (path, input) of+  m <- case snd <$> P.parseModuleFromFile identity (path, input) of     Left parseError ->       throwError (RebuildError (P.MultipleErrors [P.toPositionedError parseError]))     Right m -> pure m    -- Externs files must be sorted ahead of time, so that they get applied-  -- correctly to the 'Environment'.+  -- in the right order (bottom up) to the 'Environment'.   externs <- logPerf (labelTimespec "Sorting externs") (sortExterns m =<< getExternFiles)    outputDirectory <- confOutputPath . ideConfiguration <$> ask

@@ -93,8 +93,10 @@   -> Either P.DeclarationRef [IdeDeclarationAnn] resolveRef decls ref = case ref of   P.TypeRef tn mdtors ->-    case findRef (anyOf (_IdeDeclType . ideTypeName) (== tn)) of-      Nothing -> Left ref+    case findRef (anyOf (_IdeDeclType . ideTypeName) (== tn))+         <|> findRef (anyOf (_IdeDeclTypeSynonym . ideSynonymName) (== tn)) of+      Nothing ->+        Left ref       Just d -> Right $ d : case mdtors of           Nothing ->             -- If the dataconstructor field inside the TypeRef is Nothing, that@@ -110,6 +112,8 @@     findWrapped (anyOf (_IdeDeclTypeOperator . ideTypeOpName) (== name))   P.TypeClassRef name ->     findWrapped (anyOf (_IdeDeclTypeClass . ideTCName) (== name))+  P.KindRef name ->+    findWrapped (anyOf _IdeDeclKind (== name))   _ ->     Left ref   where

@@ -14,6 +14,7 @@  module Language.PureScript.Ide.SourceFile   ( parseModule+  , parseModulesFromFiles   , extractAstInformation   -- for tests   , extractSpans@@ -22,25 +23,38 @@  import           Protolude +import           Control.Parallel.Strategies (withStrategy, parList, rseq) import qualified Data.Map                      as Map import qualified Language.PureScript           as P import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           System.Directory (getCurrentDirectory)-import           System.FilePath (makeRelative)  parseModule   :: (MonadIO m, MonadError IdeError m)   => FilePath   -> m (Either FilePath (FilePath, P.Module)) parseModule path = do-  pwd <- liftIO getCurrentDirectory   contents <- ideReadFile path-  case P.parseModuleFromFile (makeRelative pwd) (path, contents) of-    Left _ -> pure (Left path)-    Right m -> pure (Right m)+  pure (parseModule' path contents) +parseModule' :: FilePath -> Text -> Either FilePath (FilePath, P.Module)+parseModule' path file =+  case P.parseModuleFromFile identity (path, file) of+    Left _ -> Left path+    Right m -> Right m++parseModulesFromFiles+  :: (MonadIO m, MonadError IdeError m)+  => [FilePath]+  -> m [Either FilePath (FilePath, P.Module)]+parseModulesFromFiles paths = do+  files <- traverse (\p -> (p,) <$> ideReadFile p) paths+  pure (inParallel (map (uncurry parseModule') files))+  where+    inParallel :: [Either e (k, a)] -> [Either e (k, a)]+    inParallel = withStrategy (parList rseq)+ -- | Extracts AST information from a parsed module extractAstInformation   :: P.Module@@ -67,30 +81,30 @@   -- ^ The surrounding span   -> P.Declaration   -- ^ The declaration to extract spans from-  -> [(IdeDeclNamespace, P.SourceSpan)]+  -> [(IdeNamespaced, P.SourceSpan)]   -- ^ Declarations and their source locations extractSpans ss d = case d of   P.PositionedDeclaration ss' _ d' ->     extractSpans ss' d'   P.ValueDeclaration i _ _ _ ->-    [(IdeNSValue (P.runIdent i), ss)]+    [(IdeNamespaced IdeNSValue (P.runIdent i), ss)]   P.TypeSynonymDeclaration name _ _ ->-    [(IdeNSType (P.runProperName name), ss)]+    [(IdeNamespaced IdeNSType (P.runProperName name), ss)]   P.TypeClassDeclaration name _ _ _ members ->-    (IdeNSType (P.runProperName name), ss) : concatMap (extractSpans' ss) members+    (IdeNamespaced IdeNSType (P.runProperName name), ss) : concatMap (extractSpans' ss) members   P.DataDeclaration _ name _ ctors ->-    (IdeNSType (P.runProperName name), ss)-    : map (\(cname, _) -> (IdeNSValue (P.runProperName cname), ss)) ctors+    (IdeNamespaced IdeNSType (P.runProperName name), ss)+    : map (\(cname, _) -> (IdeNamespaced IdeNSValue (P.runProperName cname), ss)) ctors   P.FixityDeclaration (Left (P.ValueFixity _ _ opName)) ->-    [(IdeNSValue (P.runOpName opName), ss)]+    [(IdeNamespaced IdeNSValue (P.runOpName opName), ss)]   P.FixityDeclaration (Right (P.TypeFixity _ _ opName)) ->-    [(IdeNSType (P.runOpName opName), ss)]+    [(IdeNamespaced IdeNSType (P.runOpName opName), ss)]   P.ExternDeclaration ident _ ->-    [(IdeNSValue (P.runIdent ident), ss)]+    [(IdeNamespaced IdeNSValue (P.runIdent ident), ss)]   P.ExternDataDeclaration name _ ->-    [(IdeNSType (P.runProperName name), ss)]+    [(IdeNamespaced IdeNSType (P.runProperName name), ss)]   P.ExternKindDeclaration name ->-    [(IdeNSKind (P.runProperName name), ss)]+    [(IdeNamespaced IdeNSKind (P.runProperName name), ss)]   _ -> []   where     -- We need this special case to be able to also get the position info for@@ -101,5 +115,5 @@       P.PositionedDeclaration ssP' _ dP' ->         extractSpans' ssP' dP'       P.TypeDeclaration ident _ ->-        [(IdeNSValue (P.runIdent ident), ssP)]+        [(IdeNamespaced IdeNSValue (P.runIdent ident), ssP)]       _ -> []

@@ -25,9 +25,8 @@   , insertModule   , insertExternsSTM   , getAllModules-  , populateStage2-  , populateStage3-  , populateStage3STM+  , populateVolatileState+  , populateVolatileStateSTM   -- for tests   , resolveOperatorsForModule   , resolveInstances@@ -52,9 +51,7 @@ resetIdeState :: Ide m => m () resetIdeState = do   ideVar <- ideStateVar <$> ask-  liftIO . atomically $ do-    writeTVar ideVar emptyIdeState-    setStage3STM ideVar emptyStage3+  liftIO (atomically (writeTVar ideVar emptyIdeState))  -- | Gets the loaded Modulenames getLoadedModulenames :: Ide m => m [P.ModuleName]@@ -62,7 +59,7 @@  -- | Gets all loaded ExternFiles getExternFiles :: Ide m => m (ModuleMap ExternsFile)-getExternFiles = s1Externs <$> getStage1+getExternFiles = fsExterns <$> getFileState  -- | Insert a Module into Stage1 of the State insertModule :: Ide m => (FilePath, P.Module) -> m ()@@ -74,51 +71,35 @@ insertModuleSTM :: TVar IdeState -> (FilePath, P.Module) -> STM () insertModuleSTM ref (fp, module') =   modifyTVar ref $ \x ->-    x { ideStage1 = (ideStage1 x) {-          s1Modules = Map.insert+    x { ideFileState = (ideFileState x) {+          fsModules = Map.insert             (P.getModuleName module')             (module', fp)-            (s1Modules (ideStage1 x))}}---- | Retrieves Stage1 from the State.---  This includes loaded Externfiles-getStage1 :: Ide m => m Stage1-getStage1 = do-  st <- ideStateVar <$> ask-  fmap ideStage1 . liftIO . readTVarIO $ st---- | STM version of getStage1-getStage1STM :: TVar IdeState -> STM Stage1-getStage1STM ref = ideStage1 <$> readTVar ref+            (fsModules (ideFileState x))}} --- | Retrieves Stage2 from the State.-getStage2 :: Ide m => m Stage2-getStage2 = do+-- | Retrieves the FileState from the State. This includes loaded Externfiles+-- and parsed Modules+getFileState :: Ide m => m IdeFileState+getFileState = do   st <- ideStateVar <$> ask-  liftIO (atomically (getStage2STM st))--getStage2STM ::  TVar IdeState -> STM Stage2-getStage2STM ref = ideStage2 <$> readTVar ref+  fmap ideFileState . liftIO . readTVarIO $ st --- | STM version of setStage2-setStage2STM :: TVar IdeState -> Stage2 -> STM ()-setStage2STM ref s2 = do-  modifyTVar ref $ \x ->-    x {ideStage2 = s2}-  pure ()+-- | STM version of getFileState+getFileStateSTM :: TVar IdeState -> STM IdeFileState+getFileStateSTM ref = ideFileState <$> readTVar ref --- | Retrieves Stage3 from the State.+-- | Retrieves VolatileState from the State. -- This includes the denormalized Declarations and cached rebuilds-getStage3 :: Ide m => m Stage3-getStage3 = do+getVolatileState :: Ide m => m IdeVolatileState+getVolatileState = do   st <- ideStateVar <$> ask-  fmap ideStage3 . liftIO . readTVarIO $ st+  fmap ideVolatileState . liftIO . readTVarIO $ st --- | Sets Stage3 inside the compiler-setStage3STM :: TVar IdeState -> Stage3 -> STM ()-setStage3STM ref s3 = do+-- | Sets the VolatileState inside Ide's state+setVolatileStateSTM :: TVar IdeState -> IdeVolatileState -> STM ()+setVolatileStateSTM ref vs = do   modifyTVar ref $ \x ->-    x {ideStage3 = s3}+    x {ideVolatileState = vs}   pure ()  -- | Checks if the given ModuleName matches the last rebuild cache and if it@@ -126,7 +107,7 @@ -- cache getAllModules :: Ide m => Maybe P.ModuleName -> m [(P.ModuleName, [IdeDeclarationAnn])] getAllModules mmoduleName = do-  declarations <- s3Declarations <$> getStage3+  declarations <- vsDeclarations <$> getVolatileState   rebuild <- cachedRebuild   case mmoduleName of     Nothing -> pure (Map.toList declarations)@@ -134,7 +115,7 @@       case rebuild of         Just (cachedModulename, ef)           | cachedModulename == moduleName -> do-              (AstData asts) <- s2AstData <$> getStage2+              AstData asts <- vsAstData <$> getVolatileState               let                 ast =                   fromMaybe (Map.empty, Map.empty) (Map.lookup moduleName asts)@@ -148,9 +129,9 @@               pure (Map.toList resolved)         _ -> pure (Map.toList declarations) --- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the--- following Stages, which needs to be done after all the necessary Exterms have--- been loaded.+-- | Adds an ExternsFile into psc-ide's FileState. This does not populate the+-- VolatileState, which needs to be done after all the necessary Externs and+-- SourceFiles have been loaded. insertExterns :: Ide m => ExternsFile -> m () insertExterns ef = do   st <- ideStateVar <$> ask@@ -160,62 +141,47 @@ insertExternsSTM :: TVar IdeState -> ExternsFile -> STM () insertExternsSTM ref ef =   modifyTVar ref $ \x ->-    x { ideStage1 = (ideStage1 x) {-          s1Externs = Map.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}+    x { ideFileState = (ideFileState x) {+          fsExterns = Map.insert (efModuleName ef) ef (fsExterns (ideFileState x))}}  -- | Sets rebuild cache to the given ExternsFile cacheRebuild :: Ide m => ExternsFile -> m () cacheRebuild ef = do   st <- ideStateVar <$> ask   liftIO . atomically . modifyTVar st $ \x ->-    x { ideStage3 = (ideStage3 x) {-          s3CachedRebuild = Just (efModuleName ef, ef)}}+    x { ideVolatileState = (ideVolatileState x) {+          vsCachedRebuild = Just (efModuleName ef, ef)}}  -- | Retrieves the rebuild cache cachedRebuild :: Ide m => m (Maybe (P.ModuleName, ExternsFile))-cachedRebuild = s3CachedRebuild <$> getStage3---- | Extracts source spans from the parsed ASTs-populateStage2 :: (Ide m, MonadLogger m) => m ()-populateStage2 = do-  st <- ideStateVar <$> ask-  let message duration = "Finished populating Stage2 in " <> displayTimeSpec duration-  logPerf message (liftIO (atomically (populateStage2STM st)))---- | STM version of populateStage2-populateStage2STM :: TVar IdeState -> STM ()-populateStage2STM ref = do-  modules <- s1Modules <$> getStage1STM ref-  let astData = map (extractAstInformation . fst) modules-  setStage2STM ref (Stage2 (AstData astData))+cachedRebuild = vsCachedRebuild <$> getVolatileState --- | Resolves reexports and populates Stage3 with data to be used in queries.-populateStage3 :: (Ide m, MonadLogger m) => m ()-populateStage3 = do+-- | Resolves reexports and populates VolatileState with data to be used in queries.+populateVolatileState :: (Ide m, MonadLogger m) => m ()+populateVolatileState = do   st <- ideStateVar <$> ask   let message duration = "Finished populating Stage3 in " <> displayTimeSpec duration-  results <- logPerf message (liftIO (atomically (populateStage3STM st)))+  results <- logPerf message (liftIO (atomically (populateVolatileStateSTM st)))   void $ Map.traverseWithKey     (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn)))     (Map.filter reexportHasFailures results) --- | STM version of populateStage3-populateStage3STM+-- | STM version of populateVolatileState+populateVolatileStateSTM   :: TVar IdeState   -> STM (ModuleMap (ReexportResult [IdeDeclarationAnn]))-populateStage3STM ref = do-  externs <- s1Externs <$> getStage1STM ref-  (AstData asts) <- s2AstData <$> getStage2STM ref-  let (modules, reexportRefs) = (map fst &&& map snd) (Map.map convertExterns externs)+populateVolatileStateSTM ref = do+  IdeFileState{fsExterns = externs, fsModules = modules} <- getFileStateSTM ref+  let asts = map (extractAstInformation . fst) modules+  let (moduleDeclarations, reexportRefs) = (map fst &&& map snd) (Map.map convertExterns externs)       results =-        resolveLocations asts modules+        resolveLocations asts moduleDeclarations         & resolveInstances externs         & resolveOperators         & resolveReexports reexportRefs-  setStage3STM ref (Stage3 (map reResolved results) Nothing)+  setVolatileStateSTM ref (IdeVolatileState (AstData asts) (map reResolved results) Nothing)   pure results - resolveLocations   :: ModuleMap (DefinitionSites P.SourceSpan, TypeAnnotations)   -> ModuleMap [IdeDeclarationAnn]@@ -250,12 +216,12 @@       IdeDeclKind i ->         annotateKind (i ^. properNameT) (IdeDeclKind i)       where-        annotateFunction x = IdeDeclarationAnn (ann { _annLocation = Map.lookup (IdeNSValue (P.runIdent x)) defs+        annotateFunction x = IdeDeclarationAnn (ann { _annLocation = Map.lookup (IdeNamespaced IdeNSValue (P.runIdent x)) defs                                                     , _annTypeAnnotation = Map.lookup x types                                                     })-        annotateValue x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNSValue x) defs})-        annotateType x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNSType x) defs})-        annotateKind x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNSKind x) defs})+        annotateValue x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSValue x) defs})+        annotateType x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSType x) defs})+        annotateKind x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSKind x) defs})  resolveInstances   :: ModuleMap P.ExternsFile@@ -276,8 +242,8 @@           _ -> Nothing     extractInstances _ _ = Nothing -    go ::-      (IdeInstance, P.ModuleName, P.ProperName 'P.ClassName)+    go+      :: (IdeInstance, P.ModuleName, P.ProperName 'P.ClassName)       -> ModuleMap [IdeDeclarationAnn]       -> ModuleMap [IdeDeclarationAnn]     go (ideInstance, classModule, className) acc' =

@@ -22,9 +22,9 @@ import           Control.Concurrent.STM import           Control.Lens.TH import           Data.Aeson-import qualified Data.Map.Lazy                       as M-import qualified Language.PureScript                 as P-import qualified Language.PureScript.Errors.JSON     as P+import qualified Data.Map.Lazy as M+import qualified Language.PureScript as P+import qualified Language.PureScript.Errors.JSON as P  type ModuleIdent = Text type ModuleMap a = Map P.ModuleName a@@ -119,18 +119,18 @@ emptyAnn :: Annotation emptyAnn = Annotation Nothing Nothing Nothing -type DefinitionSites a = Map IdeDeclNamespace a+type DefinitionSites a = Map IdeNamespaced a type TypeAnnotations = Map P.Ident P.Type newtype AstData a = AstData (ModuleMap (DefinitionSites a, TypeAnnotations))-  -- ^ SourceSpans for the definition sites of Values and Types aswell as type+  -- ^ SourceSpans for the definition sites of values and types as well as type   -- annotations found in a module   deriving (Show, Eq, Ord, Functor, Foldable)  data IdeLogLevel = LogDebug | LogPerf | LogAll | LogDefault | LogNone   deriving (Show, Eq) -data Configuration =-  Configuration+data IdeConfiguration =+  IdeConfiguration   { confOutputPath :: FilePath   , confLogLevel   :: IdeLogLevel   , confGlobs      :: [FilePath]@@ -139,41 +139,47 @@ data IdeEnvironment =   IdeEnvironment   { ideStateVar      :: TVar IdeState-  , ideConfiguration :: Configuration+  , ideConfiguration :: IdeConfiguration   }  type Ide m = (MonadIO m, MonadReader IdeEnvironment m)  data IdeState = IdeState-  { ideStage1 :: Stage1-  , ideStage2 :: Stage2-  , ideStage3 :: Stage3+  { ideFileState     :: IdeFileState+  , ideVolatileState :: IdeVolatileState   } deriving (Show)  emptyIdeState :: IdeState-emptyIdeState = IdeState emptyStage1 emptyStage2 emptyStage3+emptyIdeState = IdeState emptyFileState emptyVolatileState -emptyStage1 :: Stage1-emptyStage1 = Stage1 M.empty M.empty+emptyFileState :: IdeFileState+emptyFileState = IdeFileState M.empty M.empty -emptyStage2 :: Stage2-emptyStage2 = Stage2 (AstData M.empty)+emptyVolatileState :: IdeVolatileState+emptyVolatileState = IdeVolatileState (AstData M.empty) M.empty Nothing -emptyStage3 :: Stage3-emptyStage3 = Stage3 M.empty Nothing -data Stage1 = Stage1-  { s1Externs :: ModuleMap P.ExternsFile-  , s1Modules :: ModuleMap (P.Module, FilePath)+-- | @IdeFileState@ holds data that corresponds 1-to-1 to an entity on the+-- filesystem. Externs correspond to the ExternsFiles the compiler emits into+-- the output folder, and modules are parsed ASTs from source files. This means,+-- that we can update single modules or ExternsFiles inside this state whenever+-- the corresponding entity changes on the file system.+data IdeFileState = IdeFileState+  { fsExterns :: ModuleMap P.ExternsFile+  , fsModules :: ModuleMap (P.Module, FilePath)   } deriving (Show) -data Stage2 = Stage2-  { s2AstData :: AstData P.SourceSpan-  } deriving (Show, Eq)--data Stage3 = Stage3-  { s3Declarations  :: ModuleMap [IdeDeclarationAnn]-  , s3CachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)+-- | @IdeVolatileState@ is derived from the @IdeFileState@ and needs to be+-- invalidated and refreshed carefully. It holds @AstData@, which is the data we+-- extract from the parsed ASTs, as well as the IdeDeclarations, which contain+-- lots of denormalized data, so they need to fully rebuilt whenever+-- @IdeFileState@ changes. The vsCachedRebuild field can hold a rebuild result+-- with open imports which is used to provide completions for module private+-- declarations+data IdeVolatileState = IdeVolatileState+  { vsAstData       :: AstData P.SourceSpan+  , vsDeclarations  :: ModuleMap [IdeDeclarationAnn]+  , vsCachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)   } deriving (Show)  newtype Match a = Match (P.ModuleName, a)@@ -187,6 +193,7 @@   , complExpandedType  :: Text   , complLocation      :: Maybe P.SourceSpan   , complDocumentation :: Maybe Text+  , complExportedFrom  :: [P.ModuleName]   } deriving (Show, Eq, Ord)  instance ToJSON Completion where@@ -197,6 +204,7 @@            , "expandedType" .= complExpandedType            , "definedAt" .= complLocation            , "documentation" .= complDocumentation+           , "exportedFrom" .= complExportedFrom            ]  identifierFromDeclarationRef :: P.DeclarationRef -> Text@@ -305,11 +313,18 @@       , "text"    .= text       ] -data IdeDeclNamespace =-  -- | An identifier in the value namespace-  IdeNSValue Text-  -- | An identifier in the type namespace-  | IdeNSType Text-  -- | An identifier in the kind namespace-  | IdeNSKind Text+-- | Denotes the different namespaces a name in PureScript can reside in.+data IdeNamespace = IdeNSValue | IdeNSType | IdeNSKind+  deriving (Show, Eq, Ord)++instance FromJSON IdeNamespace where+  parseJSON (String s) = case s of+    "value" -> pure IdeNSValue+    "type"  -> pure IdeNSType+    "kind"  -> pure IdeNSKind+    _       -> mzero+  parseJSON _ = mzero++-- | A name tagged with a namespace+data IdeNamespaced = IdeNamespaced IdeNamespace Text   deriving (Show, Eq, Ord)

@@ -17,7 +17,7 @@   , unwrapMatch   , unwrapPositioned   , unwrapPositionedRef-  , completionFromMatch+  , namespaceForDeclaration   , encodeT   , decodeT   , discardAnn@@ -28,7 +28,6 @@   , identT   , opNameT   , ideReadFile-  , ideReadTextFile   , module Language.PureScript.Ide.Logging   ) where @@ -38,11 +37,10 @@ import           Control.Lens                        hiding ((&), op) import           Data.Aeson import qualified Data.Text                           as T-import qualified Data.Text.IO                        as TIO import qualified Data.Text.Lazy                      as TL-import           Data.Text.Lazy.Encoding             (decodeUtf8, encodeUtf8)+import           Data.Text.Lazy.Encoding             as TLE import qualified Language.PureScript                 as P-import           Language.PureScript.Ide.Error       (prettyPrintTypeSingleLine, IdeError(..))+import           Language.PureScript.Ide.Error       (IdeError(..)) import           Language.PureScript.Ide.Logging import           Language.PureScript.Ide.Types import           System.IO.UTF8                      (readUTF8FileT)@@ -58,6 +56,17 @@   IdeDeclTypeOperator op -> op ^. ideTypeOpName & P.runOpName   IdeDeclKind name -> P.runProperName name +namespaceForDeclaration :: IdeDeclaration -> IdeNamespace+namespaceForDeclaration d = case d of+  IdeDeclValue _ -> IdeNSValue+  IdeDeclType _ -> IdeNSType+  IdeDeclTypeSynonym _ -> IdeNSType+  IdeDeclDataConstructor _ -> IdeNSValue+  IdeDeclTypeClass _ -> IdeNSType+  IdeDeclValueOperator _ -> IdeNSValue+  IdeDeclTypeOperator _ -> IdeNSType+  IdeDeclKind _ -> IdeNSKind+ discardAnn :: IdeDeclarationAnn -> IdeDeclaration discardAnn (IdeDeclarationAnn _ d) = d @@ -67,37 +76,6 @@ unwrapMatch :: Match a -> a unwrapMatch (Match (_, ed)) = ed -completionFromMatch :: Match IdeDeclarationAnn -> Completion-completionFromMatch (Match (m, IdeDeclarationAnn ann decl)) =-  Completion {..}-  where-    (complIdentifier, complExpandedType) = case decl of-      IdeDeclValue v -> (v ^. ideValueIdent . identT, v ^. ideValueType & prettyPrintTypeSingleLine)-      IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & P.prettyPrintKind)-      IdeDeclTypeSynonym s -> (s ^. ideSynonymName . properNameT, s ^. ideSynonymType & prettyPrintTypeSingleLine)-      IdeDeclDataConstructor d -> (d ^. ideDtorName . properNameT, d ^. ideDtorType & prettyPrintTypeSingleLine)-      IdeDeclTypeClass d -> (d ^. ideTCName . properNameT, d ^. ideTCKind & P.prettyPrintKind)-      IdeDeclValueOperator (IdeValueOperator op ref precedence associativity typeP) ->-        (P.runOpName op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyPrintTypeSingleLine typeP)-      IdeDeclTypeOperator (IdeTypeOperator op ref precedence associativity kind) ->-        (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) P.prettyPrintKind kind)-      IdeDeclKind k -> (P.runProperName k, "kind")--    complModule = P.runModuleName m--    complType = maybe complExpandedType prettyPrintTypeSingleLine (_annTypeAnnotation ann)--    complLocation = _annLocation ann--    complDocumentation = Nothing--    showFixity p a r o =-      let asso = case a of-            P.Infix -> "infix"-            P.Infixl -> "infixl"-            P.Infixr -> "infixr"-      in T.unwords [asso, show p, r, "as", P.runOpName o]- valueOperatorAliasT   :: P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName)) -> Text valueOperatorAliasT i =@@ -109,10 +87,10 @@   P.showQualified P.runProperName i  encodeT :: (ToJSON a) => a -> Text-encodeT = TL.toStrict . decodeUtf8 . encode+encodeT = TL.toStrict . TLE.decodeUtf8 . encode  decodeT :: (FromJSON a) => Text -> Maybe a-decodeT = decode . encodeUtf8 . TL.fromStrict+decodeT = decode . TLE.encodeUtf8 . TL.fromStrict  unwrapPositioned :: P.Declaration -> P.Declaration unwrapPositioned (P.PositionedDeclaration _ _ x) = unwrapPositioned x@@ -145,11 +123,3 @@  ideReadFile :: (MonadIO m, MonadError IdeError m) => FilePath -> m Text ideReadFile = ideReadFile' readUTF8FileT---- | This function is to be used over @ideReadFile@ when the result is not just--- passed on to the PureScript parser, but also needs to be treated as lines of--- text. Because @ideReadFile@ reads the file as ByteString in @BinaryMode@--- rather than @TextMode@ line endings get mangled on Windows otherwise. This is--- irrelevant for parsing, because the Lexer strips these additional @\r@'s.-ideReadTextFile :: (MonadIO m, MonadError IdeError m) => FilePath -> m Text-ideReadTextFile = ideReadFile' TIO.readFile

@@ -39,7 +39,7 @@     Left err ->       logErrorN ("Failed to reload file at: " <> toS fp <> " with error: " <> show err)     Right ef -> do-      lift $ void $ atomically (insertExternsSTM ref ef *> populateStage3STM ref)+      lift $ void $ atomically (insertExternsSTM ref ef *> populateVolatileStateSTM ref)       logDebugN ("Reloaded File at: " <> toS fp)  -- | Installs filewatchers for the given directory and reloads ExternsFiles when

@@ -38,11 +38,14 @@ import           Language.PureScript.Interactive.Printer      as Interactive import           Language.PureScript.Interactive.Types        as Interactive +import           System.Directory (getCurrentDirectory) import           System.FilePath ((</>))  -- | Pretty-print errors printErrors :: MonadIO m => P.MultipleErrors -> m ()-printErrors = liftIO . putStrLn . P.prettyPrintMultipleErrors P.defaultPPEOptions+printErrors errs = liftIO $ do+  pwd <- getCurrentDirectory+  putStrLn $ P.prettyPrintMultipleErrors P.defaultPPEOptions {P.ppeRelativeDirectory = pwd} errs  -- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the -- options and ignores the warning messages.

@@ -27,8 +27,8 @@   pwd <- getCurrentDirectory   content <- readUTF8FileT filename   return $-    either (Left . P.prettyPrintMultipleErrors P.defaultPPEOptions) (Right . map snd) $-      P.parseModulesFromFiles (makeRelative pwd) [(filename, content)]+    either (Left . P.prettyPrintMultipleErrors P.defaultPPEOptions {P.ppeRelativeDirectory = pwd}) (Right . map snd) $+      P.parseModulesFromFiles id [(filename, content)]  -- | Load all modules. loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])

@@ -195,7 +195,7 @@  parseConstraint :: TokenParser Constraint parseConstraint = Constraint <$> parseQualified properName-                             <*> P.many (noWildcards parseTypeAtom)+                             <*> P.many (noWildcards $ noForAll parseTypeAtom)                              <*> pure Nothing  parseInstanceDeclaration :: TokenParser (TypeInstanceBody -> Declaration)@@ -216,8 +216,14 @@   instanceDecl <- parseInstanceDeclaration   members <- P.option [] $ do     indented *> reserved "where"-    mark (P.many (same *> positioned parseValueDeclaration))+    mark (P.many (same *> positioned declsInInstance))   return $ instanceDecl (ExplicitInstance members)+  where+    declsInInstance :: TokenParser Declaration+    declsInInstance = P.choice+      [ parseTypeDeclaration+      , parseValueDeclaration+      ] P.<?> "type declaration or value declaration in instance"  parseDerivingInstanceDeclaration :: TokenParser Declaration parseDerivingInstanceDeclaration = do

@@ -1,6 +1,7 @@ module Language.PureScript.Parser.Types   ( parseType   , parsePolyType+  , noForAll   , noWildcards   , parseTypeAtom   ) where@@ -51,6 +52,16 @@ parseForAll :: TokenParser Type parseForAll = mkForAll <$> ((reserved "forall" <|> reserved "∀") *> P.many1 (indented *> identifier) <* indented <* dot)                        <*> parseType+++-- |+-- Parse an atomic type with no `forall`+--+noForAll :: TokenParser Type -> TokenParser Type+noForAll p = do+ ty <- p+ when (containsForAll ty) $ P.unexpected "forall"+ return ty  -- | -- Parse a type as it appears in e.g. a data constructor

@@ -1,19 +1,21 @@--- |--- This module implements the generic deriving elaboration that takes place during desugaring.---+-- | This module implements the generic deriving elaboration that takes place during desugaring. module Language.PureScript.Sugar.TypeClasses.Deriving (deriveInstances) where  import           Prelude.Compat+import           Protolude (ordNub)  import           Control.Arrow (second)-import           Control.Monad (replicateM, zipWithM)+import           Control.Monad (replicateM, zipWithM, unless, when) import           Control.Monad.Error.Class (MonadError(..))+import           Control.Monad.Writer.Class (MonadWriter(..)) import           Control.Monad.Supply.Class (MonadSupply)+import           Data.Foldable (for_) import           Data.List (foldl', find, sortBy, unzip5) import qualified Data.Map as M import           Data.Monoid ((<>)) import           Data.Maybe (fromMaybe, mapMaybe) import           Data.Ord (comparing)+import qualified Data.Set as S import           Data.Text (Text) import qualified Data.Text as T import           Language.PureScript.AST@@ -30,15 +32,47 @@ import           Language.PureScript.TypeChecker (checkNewtype) import           Language.PureScript.TypeChecker.Synonyms (SynonymMap, replaceAllTypeSynonymsM) +-- | When deriving an instance for a newtype, we must ensure that all superclass+-- instances were derived in the same way. This data structure is used to ensure+-- this property.+data NewtypeDerivedInstances = NewtypeDerivedInstances+  { ndiClasses :: M.Map (ModuleName, ProperName 'ClassName) ([Text], [Constraint], [FunctionalDependency])+  -- ^ A list of superclass constraints for each type class. Since type classes+  -- have not been desugared here, we need to track this.+  , ndiDerivedInstances :: S.Set ((ModuleName, ProperName 'ClassName), (ModuleName, ProperName 'TypeName))+  -- ^ A list of newtype instances which were derived in this module.+  } deriving Show++instance Monoid NewtypeDerivedInstances where+  mempty = NewtypeDerivedInstances mempty mempty+  mappend x y =+    NewtypeDerivedInstances { ndiClasses          = ndiClasses          x <> ndiClasses          y+                            , ndiDerivedInstances = ndiDerivedInstances x <> ndiDerivedInstances y+                            }++-- | Extract the name of the newtype appearing in the last type argument of+-- a derived newtype instance.+--+-- Note: since newtypes in newtype instances can only be applied to type arguments+-- (no flexible instances allowed), we don't need to bother with unification when+-- looking for matching superclass instances, which saves us a lot of work. Instead,+-- we just match the newtype name.+extractNewtypeName :: ModuleName -> [Type] -> Maybe (ModuleName, ProperName 'TypeName)+extractNewtypeName _ [] = Nothing+extractNewtypeName mn xs = go (last xs) where+  go (TypeApp ty (TypeVar _)) = go ty+  go (TypeConstructor name) = Just (qualify mn name)+  go _ = Nothing+ -- | Elaborates deriving instance declarations by code generation. deriveInstances   :: forall m-   . (MonadError MultipleErrors m, MonadSupply m)+   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)   => [ExternsFile]   -> Module   -> m Module deriveInstances externs (Module ss coms mn ds exts) =-    Module ss coms mn <$> mapM (deriveInstance mn synonyms ds) ds <*> pure exts+    Module ss coms mn <$> mapM (deriveInstance mn synonyms instanceData ds) ds <*> pure exts   where     -- We need to collect type synonym information, since synonyms will not be     -- removed until later, during type checking.@@ -55,16 +89,34 @@         fromLocalDecl (PositionedDeclaration _ _ d) = fromLocalDecl d         fromLocalDecl _ = Nothing +    instanceData :: NewtypeDerivedInstances+    instanceData =+        foldMap (\ExternsFile{..} -> foldMap (fromExternsDecl efModuleName) efDeclarations) externs <> foldMap fromLocalDecl ds+      where+        fromExternsDecl mn' EDClass{..} =+          NewtypeDerivedInstances (M.singleton (mn', edClassName) (map fst edClassTypeArguments, edClassConstraints, edFunctionalDependencies)) mempty+        fromExternsDecl mn' EDInstance{..} =+          foldMap (\nm -> NewtypeDerivedInstances mempty (S.singleton (qualify mn' edInstanceClassName, nm))) (extractNewtypeName mn' edInstanceTypes)+        fromExternsDecl _ _ = mempty++        fromLocalDecl (TypeClassDeclaration cl args cons deps _) =+          NewtypeDerivedInstances (M.singleton (mn, cl) (map fst args, cons, deps)) mempty+        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, -- elaborates that into an instance declaration via code generation. deriveInstance-  :: (MonadError MultipleErrors m, MonadSupply m)+  :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)   => ModuleName   -> SynonymMap+  -> NewtypeDerivedInstances   -> [Declaration]   -> Declaration   -> m Declaration-deriveInstance mn syns ds (TypeInstanceDeclaration nm deps className tys DerivedInstance)+deriveInstance mn syns _ ds (TypeInstanceDeclaration nm deps className tys DerivedInstance)   | className == Qualified (Just dataGeneric) (ProperName C.generic)   = case tys of       [ty] | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor ty@@ -112,15 +164,15 @@         | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys actualTy       _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 2   | otherwise = throwError . errorMessage $ CannotDerive className tys-deriveInstance mn syns ds (TypeInstanceDeclaration nm deps className tys NewtypeInstance) =+deriveInstance mn syns ndis ds (TypeInstanceDeclaration 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 syns className ds tys tyCon args+          -> 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 ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn syns ds d-deriveInstance _ _ _ e = return e+deriveInstance mn syns ndis ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn syns ndis ds d+deriveInstance _ _ _ _ e = return e  unwrapTypeConstructor :: Type -> Maybe (Qualified (ProperName 'TypeName), [Type]) unwrapTypeConstructor = fmap (second reverse) . go@@ -133,15 +185,18 @@  deriveNewtypeInstance   :: forall m-   . MonadError MultipleErrors m-  => SynonymMap+   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => ModuleName+  -> SynonymMap+  -> NewtypeDerivedInstances   -> Qualified (ProperName 'ClassName)   -> [Declaration]   -> [Type]   -> ProperName 'TypeName   -> [Type]   -> m Expr-deriveNewtypeInstance syns className ds tys tyConNm dargs = do+deriveNewtypeInstance mn syns ndis className ds tys tyConNm dargs = do+    verifySuperclasses     tyCon <- findTypeDecl tyConNm ds     go tyCon   where@@ -170,6 +225,31 @@     stripRight ((arg, _) : args) (TypeApp t (TypeVar arg'))       | arg == arg' = stripRight args t     stripRight _ _ = Nothing++    verifySuperclasses :: m ()+    verifySuperclasses =+      for_ (M.lookup (qualify mn className) (ndiClasses ndis)) $ \(args, superclasses, _) ->+        for_ superclasses $ \Constraint{..} -> do+          let constraintClass' = qualify (error "verifySuperclasses: unknown class module") constraintClass+          for_ (M.lookup constraintClass' (ndiClasses ndis)) $ \(_, _, deps) ->+            -- We need to check whether the newtype is mentioned, because of classes like MonadWriter+            -- with its Monoid superclass constraint.+            when (not (null args) && any ((last args `elem`) . usedTypeVariables) constraintArgs) $ do+              -- For now, we only verify superclasses where the newtype is the only argument,+              -- or for which all other arguments are determined by functional dependencies.+              -- Everything else raises a UnverifiableSuperclassInstance warning.+              -- This covers pretty much all cases we're interested in, but later we might want to do+              -- more work to extend this to other superclass relationships.+              let determined = map (TypeVar . (args !!)) . ordNub . concatMap fdDetermined . filter ((== [length args - 1]) . fdDeterminers) $ deps+              if last constraintArgs == TypeVar (last args) && all (`elem` determined) (init constraintArgs)+                then do+                  -- Now make sure that a superclass instance was derived. Again, this is not a complete+                  -- check, since the superclass might have multiple type arguments, so overlaps might still+                  -- 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  dataGeneric :: ModuleName dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]

@@ -216,6 +216,13 @@   go TypeWildcard{} = True   go _ = False +-- | Check if a type contains `forall`+containsForAll :: Type -> Bool+containsForAll = everythingOnTypes (||) go where+  go :: Type -> Bool+  go ForAll{} = True+  go _ = False+ everywhereOnTypes :: (Type -> Type) -> Type -> Type everywhereOnTypes f = go where   go (TypeApp t1 t2) = f (TypeApp (go t1) (go t2))

@@ -3,13 +3,20 @@ import Prelude.Compat  import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Search as BSS import qualified Data.ByteString.UTF8 as UTF8 import           Data.Text (Text) import qualified Data.Text.Encoding as TE +-- | Unfortunately ByteString's readFile does not convert line endings on+-- Windows, so we have to do it ourselves+fixCRLF :: BS.ByteString -> BS.ByteString+fixCRLF = BSL.toStrict . BSS.replace "\r\n" ("\n" :: BS.ByteString)+ readUTF8FileT :: FilePath -> IO Text readUTF8FileT inFile =-  fmap TE.decodeUtf8 (BS.readFile inFile)+  fmap (TE.decodeUtf8 . fixCRLF) (BS.readFile inFile)  writeUTF8FileT :: FilePath -> Text -> IO () writeUTF8FileT inFile text =@@ -17,7 +24,7 @@  readUTF8File :: FilePath -> IO String readUTF8File inFile =-  fmap UTF8.toString (BS.readFile inFile)+  fmap (UTF8.toString . fixCRLF) (BS.readFile inFile)  writeUTF8File :: FilePath -> String -> IO () writeUTF8File inFile text =

@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}+module Language.PureScript.Ide.CompletionSpec where++import Protolude++import Language.PureScript as P+import Language.PureScript.Ide.Completion+import Language.PureScript.Ide.Test+import Language.PureScript.Ide.Types+import Test.Hspec++reexportMatches :: [Match IdeDeclarationAnn]+reexportMatches =+  map (\d -> Match (mn "A", d)) moduleA+  ++ map (\d -> Match (mn "B", d)) moduleB+  where+    moduleA = [ideKind "Kind"]+    moduleB = [ideKind "Kind" `annExp` "A"]++matches :: [(Match IdeDeclarationAnn, [P.ModuleName])]+matches = map (\d -> (Match (mn "Main", d), [mn "Main"])) [ ideKind "Kind", ideType "Type" Nothing ]++spec :: Spec+spec = describe "Applying completion options" $ do+  it "keeps all matches if maxResults is not specified" $ do+    applyCompletionOptions (defaultCompletionOptions { coMaxResults = Nothing })+      (map fst matches) `shouldMatchList` matches+  it "keeps only the specified amount of maxResults" $ do+    applyCompletionOptions (defaultCompletionOptions { coMaxResults = Just 1 })+      (map fst matches) `shouldMatchList` take 1 matches+  it "groups reexports for a single identifier" $ do+    applyCompletionOptions (defaultCompletionOptions { coGroupReexports = True })+      reexportMatches `shouldBe` [(Match (mn "A", ideKind "Kind"), [mn "A", mn "B"])]

@@ -3,19 +3,20 @@ module Language.PureScript.Ide.FilterSpec where  import           Protolude+import           Data.List.NonEmpty import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Types+import           Language.PureScript.Ide.Test as T import qualified Language.PureScript as P import           Test.Hspec  type Module = (P.ModuleName, [IdeDeclarationAnn]) -value :: Text -> IdeDeclarationAnn-value s = IdeDeclarationAnn emptyAnn (IdeDeclValue (IdeValue (P.Ident (toS s)) P.REmpty))--moduleA, moduleB :: Module-moduleA = (P.moduleNameFromString "Module.A", [value "function1"])-moduleB = (P.moduleNameFromString "Module.B", [value "data1"])+moduleA, moduleB, moduleC, moduleD :: 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])+moduleD = (P.moduleNameFromString "Module.D", [T.ideKind "kind1"])  modules :: [Module] modules = [moduleA, moduleB]@@ -29,6 +30,9 @@ runModule :: [P.ModuleName] -> [Module] runModule ms = applyFilters [moduleFilter ms] modules +runNamespace :: NonEmpty IdeNamespace -> [Module] -> [Module]+runNamespace namespaces = applyFilters [namespaceFilter namespaces]+ spec :: Spec spec = do   describe "equality Filter" $ do@@ -52,3 +56,38 @@       runModule [P.moduleNameFromString "Module.A"] `shouldBe` [moduleA]     it "ignores modules that are not in scope" $       runModule (P.moduleNameFromString <$> ["Module.A", "Unknown"]) `shouldBe` [moduleA]+  describe "namespaceFilter" $ do+    it "extracts modules by filtering `value` namespaces" $+      runNamespace (fromList [IdeNSValue])+        [moduleA, moduleB, moduleD] `shouldBe` [moduleA, moduleB]+    it "extracts no modules by filtering `value` namespaces" $+      runNamespace (fromList [IdeNSValue])+        [moduleD] `shouldBe` []+    it "extracts modules by filtering `type` namespaces" $+      runNamespace (fromList [IdeNSType])+        [moduleA, moduleB, moduleC] `shouldBe` [moduleC]+    it "extracts no modules by filtering `type` namespaces" $+      runNamespace (fromList [IdeNSType])+        [moduleA, moduleB] `shouldBe` []+    it "extracts modules by filtering `kind` namespaces" $+      runNamespace (fromList [IdeNSKind])+        [moduleA, moduleB, moduleD] `shouldBe` [moduleD]+    it "extracts no modules by filtering `kind` namespaces" $+      runNamespace (fromList [IdeNSKind])+        [moduleA, moduleB] `shouldBe` []+    it "extracts modules by filtering `value` and `type` namespaces" $+      runNamespace (fromList [ IdeNSValue, IdeNSType])+        [moduleA, moduleB, moduleC, moduleD]+        `shouldBe` [moduleA, moduleB, moduleC]+    it "extracts modules by filtering `value` and `kind` namespaces" $+      runNamespace (fromList [ IdeNSValue, IdeNSKind])+        [moduleA, moduleB, moduleC, moduleD]+        `shouldBe` [moduleA, moduleB, moduleD]+    it "extracts modules by filtering `type` and `kind` namespaces" $+      runNamespace (fromList [ IdeNSType, IdeNSKind])+        [moduleA, moduleB, moduleC, moduleD]+        `shouldBe` [moduleC, moduleD]+    it "extracts modules by filtering `value`, `type` and `kind` namespaces" $+      runNamespace (fromList [ IdeNSValue, IdeNSType, IdeNSKind])+        [moduleA, moduleB, moduleC, moduleD]+        `shouldBe` [moduleA, moduleB, moduleC, moduleD]

@@ -44,7 +44,7 @@  withImports :: [Text] -> [Text] withImports is =-  take 2 simpleFile ++ is ++ drop 2 simpleFile+  take 2 simpleFile ++ [""] ++ is ++ drop 2 simpleFile  testParseImport :: Text -> Import testParseImport = fromJust . parseImport@@ -108,6 +108,8 @@           prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideDtor i t Nothing)) mn is)         addTypeImport i 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" $       shouldBe         (addImplicitImport' [] (P.moduleNameFromString "Data.Map"))@@ -115,8 +117,15 @@     it "adds an implicit unqualified import" $       shouldBe         (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))+        [ "import Data.Map"+        , "import Prelude"+        ]+    it "adds a qualified import" $+      shouldBe+        (addQualifiedImport' simpleFileImports (Test.mn "Data.Map") (Test.mn "Map"))         [ "import Prelude"-        , "import Data.Map"+        , ""+        , "import Data.Map as Map"         ]     it "adds an explicit unqualified import to a file without any imports" $       shouldBe@@ -126,6 +135,7 @@       shouldBe         (addValueImport "head" (P.moduleNameFromString "Data.Array") simpleFileImports)         [ "import Prelude"+        , ""         , "import Data.Array (head)"         ]     it "doesn't add an import if the containing module is imported implicitly" $@@ -137,24 +147,35 @@       shouldBe         (addValueImport "head" (P.moduleNameFromString "Data.Array") explicitImports)         [ "import Prelude"+        , ""         , "import Data.Array (head, tail)"         ]+    it "adds a kind to an explicit import list" $+      shouldBe+        (addKindImport "Effect" (P.moduleNameFromString "Control.Monad.Eff") simpleFileImports)+        [ "import Prelude"+        , ""+        , "import Control.Monad.Eff (kind Effect)"+        ]     it "adds an operator to an explicit import list" $       shouldBe         (addOpImport "<~>" (P.moduleNameFromString "Data.Array") explicitImports)         [ "import Prelude"+        , ""         , "import Data.Array (tail, (<~>))"         ]     it "adds a type with constructors without automatically adding an open import of said constructors " $         shouldBe           (addTypeImport "Maybe" (P.moduleNameFromString "Data.Maybe") simpleFileImports)           [ "import Prelude"+          , ""           , "import Data.Maybe (Maybe)"           ]     it "adds the type for a given DataConstructor" $         shouldBe           (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") simpleFileImports)           [ "import Prelude"+          , ""           , "import Data.Maybe (Maybe(..))"           ]     it "adds a dataconstructor to an existing type import" $ do@@ -162,6 +183,7 @@       shouldBe         (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") typeImports)         [ "import Prelude"+        , ""         , "import Data.Maybe (Maybe(..))"         ]     it "doesn't add a dataconstructor to an existing type import with open dtors" $ do@@ -169,12 +191,14 @@       shouldBe         (addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") typeImports)         [ "import Prelude"+        , ""         , "import Data.Maybe (Maybe(..))"         ]     it "doesn't add an identifier to an explicit import list if it's already imported" $       shouldBe       (addValueImport "tail" (P.moduleNameFromString "Data.Array") explicitImports)       [ "import Prelude"+      , ""       , "import Data.Array (tail)"       ] @@ -195,23 +219,23 @@           [expected]     it "sorts class" $       expectSorted (map classImport ["Applicative", "Bind"])-        ["import Prelude", "import Control.Monad (class Applicative, class Bind, ap)"]+        ["import Prelude", "", "import Control.Monad (class Applicative, class Bind, ap)"]     it "sorts value" $       expectSorted (map valueImport ["unless", "where"])-        ["import Prelude", "import Control.Monad (ap, unless, where)"]+        ["import Prelude", "", "import Control.Monad (ap, unless, where)"]     it "sorts type, value" $       expectSorted         ((map valueImport ["unless", "where"]) ++ (map typeImport ["Foo", "Bar"]))-        ["import Prelude", "import Control.Monad (Bar, Foo, ap, unless, where)"]+        ["import Prelude", "", "import Control.Monad (Bar, Foo, ap, unless, where)"]     it "sorts class, type, value" $       expectSorted         ((map valueImport ["unless", "where"]) ++ (map typeImport ["Foo", "Bar"]) ++ (map classImport ["Applicative", "Bind"]))-        ["import Prelude", "import Control.Monad (class Applicative, class Bind, Bar, Foo, ap, unless, where)"]+        ["import Prelude", "", "import Control.Monad (class Applicative, class Bind, Bar, Foo, ap, unless, where)"]     it "sorts types with constructors, using open imports for the constructors" $       expectSorted         -- the imported names don't actually have to exist!         (map (uncurry dtorImport) [("Just", "Maybe"), ("Nothing", "Maybe"), ("SomeOtherConstructor", "SomeDataType")])-        ["import Prelude", "import Control.Monad (Maybe(..), SomeDataType(..), ap)"]+        ["import Prelude", "", "import Control.Monad (Maybe(..), SomeDataType(..), ap)"]   describe "importing from a loaded IdeState" importFromIdeState  implImport :: Text -> Command

@@ -5,6 +5,7 @@ import           Protolude  import           Language.PureScript.Ide.Command+import           Language.PureScript.Ide.Completion import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types import qualified Language.PureScript.Ide.Test as Test@@ -57,5 +58,5 @@     it "completes a hidden identifier after rebuilding" $ do       ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $         Test.runIde [ rebuildSync "RebuildSpecWithHiddenIdent.purs"-                    , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent"))]+                    , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent")) defaultCompletionOptions]       complIdentifier result `shouldBe` "hidden"

@@ -11,16 +11,18 @@ import qualified Language.PureScript as P import           Test.Hspec -valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn+valueA, typeA, synonymA, classA, dtorA1, dtorA2, kindA :: IdeDeclarationAnn valueA = ideValue "valueA" Nothing typeA = ideType "TypeA" Nothing+synonymA = ideSynonym "SynonymA" Nothing Nothing classA = ideTypeClass "ClassA" P.kindType [] dtorA1 = ideDtor "DtorA1" "TypeA" Nothing dtorA2 = ideDtor "DtorA2" "TypeA" Nothing+kindA = ideKind "KindA"  env :: ModuleMap [IdeDeclarationAnn] env = Map.fromList-  [ (mn "A", [valueA, typeA, classA, dtorA1, dtorA2])+  [ (mn "A", [valueA, typeA, synonymA, classA, dtorA1, dtorA2, kindA])   ]  type Refs = [(P.ModuleName, P.DeclarationRef)]@@ -32,7 +34,10 @@     , [(mn "A", P.TypeRef (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])+  , ("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"])   ]  failTestCases :: [(Text, Refs)]

@@ -44,27 +44,27 @@ spec = do   describe "Extracting Spans" $ do     it "extracts a span for a value declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(IdeNSValue "value1", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(IdeNamespaced IdeNSValue "value1", span1)]     it "extracts a span for a type synonym declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(IdeNSType "Synonym1", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(IdeNamespaced IdeNSType "Synonym1", span1)]     it "extracts a span for a typeclass declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(IdeNSType "Class1", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(IdeNamespaced IdeNSType "Class1", span1)]     it "extracts spans for a typeclass declaration and its members" $-      extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(IdeNSType "Class2", span1), (IdeNSValue "member1", span2)]+      extractSpans span0 (P.PositionedDeclaration span1 [] 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` [(IdeNSType "Data1", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(IdeNamespaced IdeNSType "Data1", span1)]     it "extracts spans for a data declaration and its constructors" $-      extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(IdeNSType "Data2", span1), (IdeNSValue "Cons1", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] 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` [(IdeNSValue "<$>", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] valueFixity) `shouldBe` [(IdeNamespaced IdeNSValue "<$>", span1)]     it "extracts a span for a type operator fixity declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] typeFixity) `shouldBe` [(IdeNSType "~>", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] typeFixity) `shouldBe` [(IdeNamespaced IdeNSType "~>", span1)]     it "extracts a span for a foreign declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(IdeNSValue "foreign1", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(IdeNamespaced IdeNSValue "foreign1", span1)]     it "extracts a span for a data foreign declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(IdeNSType "Foreign2", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(IdeNamespaced IdeNSType "Foreign2", span1)]     it "extracts a span for a foreign kind declaration" $-      extractSpans span0 (P.PositionedDeclaration span1 [] foreign3) `shouldBe` [(IdeNSKind "Foreign3", span1)]+      extractSpans span0 (P.PositionedDeclaration span1 [] foreign3) `shouldBe` [(IdeNamespaced IdeNSKind "Foreign3", span1)]   describe "Type annotations" $ do     it "extracts a type annotation" $       extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]@@ -94,10 +94,10 @@     runIde' defConfig ideState [Type s [] Nothing]   pure (complLocation c)   where-    ideState = emptyIdeState `s3`+    ideState = emptyIdeState `volatileState`       [ ("Test",          [ ideValue "sfValue" Nothing `annLoc` valueSS-         , ideSynonym "SFType" P.tyString P.kindType `annLoc` synonymSS+         , ideSynonym "SFType" Nothing Nothing `annLoc` synonymSS          , ideType "SFData" Nothing `annLoc` typeSS          , ideDtor "SFOne" "SFData" Nothing `annLoc` typeSS          , ideDtor "SFTwo" "SFData" Nothing `annLoc` typeSS

@@ -17,14 +17,14 @@  import qualified Language.PureScript             as P -defConfig :: Configuration+defConfig :: IdeConfiguration defConfig =-  Configuration { confLogLevel = LogNone+  IdeConfiguration { confLogLevel = LogNone                 , confOutputPath = "output/"                 , confGlobs = ["src/*.purs"]                 } -runIde' :: Configuration -> IdeState -> [Command] -> IO ([Either IdeError Success], IdeState)+runIde' :: IdeConfiguration -> IdeState -> [Command] -> IO ([Either IdeError Success], IdeState) runIde' conf s cs = do   stateVar <- newTVarIO s   let env' = IdeEnvironment {ideStateVar = stateVar, ideConfiguration = conf}@@ -35,11 +35,11 @@ runIde :: [Command] -> IO ([Either IdeError Success], IdeState) runIde = runIde' defConfig emptyIdeState -s3 :: IdeState -> [(Text, [IdeDeclarationAnn])] -> IdeState-s3 s ds =-  s {ideStage3 = stage3}+volatileState :: IdeState -> [(Text, [IdeDeclarationAnn])] -> IdeState+volatileState s ds =+  s {ideVolatileState = vs}   where-    stage3 = Stage3 (Map.fromList decls) Nothing+    vs = IdeVolatileState (AstData Map.empty) (Map.fromList decls) Nothing     decls = map (first P.moduleNameFromString) ds  -- | Adding Annotations to IdeDeclarations@@ -66,8 +66,8 @@ ideType :: Text -> Maybe P.Kind -> IdeDeclarationAnn ideType pn ki = ida (IdeDeclType (IdeType (P.ProperName pn) (fromMaybe P.kindType ki))) -ideSynonym :: Text -> P.Type -> P.Kind -> IdeDeclarationAnn-ideSynonym pn ty kind = ida (IdeDeclTypeSynonym (IdeTypeSynonym (P.ProperName pn) ty kind))+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)))  ideTypeClass :: Text -> P.Kind -> [IdeInstance] -> IdeDeclarationAnn ideTypeClass pn kind instances = ida (IdeDeclTypeClass (IdeTypeClass (P.ProperName pn) kind instances))

@@ -61,26 +61,23 @@ spec :: Spec spec = do -  (supportExterns, supportForeigns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do+  (supportModules, supportExterns, supportForeigns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do     cwd <- getCurrentDirectory     let passing = cwd </> "examples" </> "passing"     let warning = cwd </> "examples" </> "warning"     let failing = cwd </> "examples" </> "failing"-    let supportDir = cwd </> "tests" </> "support" </> "bower_components"-    let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/src/**/*." ++ ext)) supportDir     passingFiles <- getTestFiles passing <$> testGlob passing     warningFiles <- getTestFiles warning <$> testGlob warning     failingFiles <- getTestFiles failing <$> testGlob failing-    supportPurs <- supportFiles "purs"-    supportPursFiles <- readInput supportPurs+    ms <- getSupportModuleTuples+    let modules = map snd ms     supportExterns <- runExceptT $ do-      modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles-      foreigns <- inferForeignModules modules-      externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)-      return (zip (map snd modules) externs, foreigns)+      foreigns <- inferForeignModules ms+      externs <- ExceptT . fmap fst . runTest $ P.make (makeActions modules foreigns) modules+      return (externs, foreigns)     case supportExterns of       Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)-      Right (externs, foreigns) -> return (externs, foreigns, passingFiles, warningFiles, failingFiles)+      Right (externs, foreigns) -> return (modules, externs, foreigns, passingFiles, warningFiles, failingFiles)    outputFile <- runIO $ do     tmp <- getTemporaryDirectory@@ -90,21 +87,21 @@   context "Passing examples" $     forM_ passingTestCases $ \testPurs ->       it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $-        assertCompiles supportExterns supportForeigns testPurs outputFile+        assertCompiles supportModules supportExterns supportForeigns testPurs outputFile    context "Warning examples" $     forM_ warningTestCases $ \testPurs -> do       let mainPath = getTestMain testPurs       expectedWarnings <- runIO $ getShouldWarnWith mainPath       it ("'" <> takeFileName mainPath <> "' should compile with warning(s) '" <> intercalate "', '" expectedWarnings <> "'") $-        assertCompilesWithWarnings supportExterns supportForeigns testPurs expectedWarnings+        assertCompilesWithWarnings supportModules supportExterns supportForeigns testPurs expectedWarnings    context "Failing examples" $     forM_ failingTestCases $ \testPurs -> do       let mainPath = getTestMain testPurs       expectedFailures <- runIO $ getShouldFailWith mainPath       it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $-        assertDoesNotCompile supportExterns supportForeigns testPurs expectedFailures+        assertDoesNotCompile supportModules supportExterns supportForeigns testPurs expectedFailures    where @@ -168,18 +165,18 @@ modulesDir :: FilePath modulesDir = ".test_modules" </> "node_modules" -makeActions :: M.Map P.ModuleName FilePath -> P.MakeActions P.Make-makeActions foreigns = (P.buildMakeActions modulesDir (P.internalError "makeActions: input file map was read.") foreigns False)-                         { P.getInputTimestamp = getInputTimestamp-                         , P.getOutputTimestamp = getOutputTimestamp-                         }+makeActions :: [P.Module] -> M.Map P.ModuleName FilePath -> P.MakeActions P.Make+makeActions modules foreigns = (P.buildMakeActions modulesDir (P.internalError "makeActions: input file map was read.") foreigns False)+                               { P.getInputTimestamp = getInputTimestamp+                               , P.getOutputTimestamp = getOutputTimestamp+                               }   where   getInputTimestamp :: P.ModuleName -> P.Make (Either P.RebuildPolicy (Maybe UTCTime))   getInputTimestamp mn-    | isSupportModule (T.unpack (P.runModuleName mn)) = return (Left P.RebuildNever)+    | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)     | otherwise = return (Left P.RebuildAlways)     where-    isSupportModule = flip elem supportModules+    isSupportModule = flip elem (map (P.runModuleName . P.getModuleName) modules)    getOutputTimestamp :: P.ModuleName -> P.Make (Maybe UTCTime)   getOutputTimestamp mn = do@@ -187,39 +184,36 @@     exists <- liftIO $ doesDirectoryExist filePath     return (if exists then Just (P.internalError "getOutputTimestamp: read timestamp") else Nothing) -readInput :: [FilePath] -> IO [(FilePath, T.Text)]-readInput inputFiles = forM inputFiles $ \inputFile -> do-  text <- readUTF8FileT inputFile-  return (inputFile, text)- runTest :: P.Make a -> IO (Either P.MultipleErrors a, P.MultipleErrors) runTest = P.runMake P.defaultOptions  compile-  :: [(P.Module, P.ExternsFile)]+  :: [P.Module]+  -> [P.ExternsFile]   -> M.Map P.ModuleName FilePath   -> [FilePath]   -> ([P.Module] -> IO ())   -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)-compile supportExterns supportForeigns inputFiles check = silence $ runTest $ do+compile supportModules supportExterns supportForeigns inputFiles check = silence $ runTest $ do   fs <- liftIO $ readInput inputFiles   ms <- P.parseModulesFromFiles id fs   foreigns <- inferForeignModules ms   liftIO (check (map snd ms))-  let actions = makeActions (foreigns `M.union` supportForeigns)+  let actions = makeActions supportModules (foreigns `M.union` supportForeigns)   case ms of-    [singleModule] -> pure <$> P.rebuildModule actions (map snd supportExterns) (snd singleModule)-    _ -> P.make actions (map fst supportExterns ++ map snd ms)+    [singleModule] -> pure <$> P.rebuildModule actions supportExterns (snd singleModule)+    _ -> P.make actions (supportModules ++ map snd ms)  assert-  :: [(P.Module, P.ExternsFile)]+  :: [P.Module]+  -> [P.ExternsFile]   -> M.Map P.ModuleName FilePath   -> [FilePath]   -> ([P.Module] -> IO ())   -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))   -> Expectation-assert supportExterns supportForeigns inputFiles check f = do-  (e, w) <- compile supportExterns supportForeigns inputFiles check+assert supportModules supportExterns supportForeigns inputFiles check f = do+  (e, w) <- compile supportModules supportExterns supportForeigns inputFiles check   maybeErr <- f (const w <$> e)   maybe (return ()) expectationFailure maybeErr @@ -236,13 +230,14 @@     else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual  assertCompiles-  :: [(P.Module, P.ExternsFile)]+  :: [P.Module]+  -> [P.ExternsFile]   -> M.Map P.ModuleName FilePath   -> [FilePath]   -> Handle   -> Expectation-assertCompiles supportExterns supportForeigns inputFiles outputFile =-  assert supportExterns supportForeigns inputFiles checkMain $ \e ->+assertCompiles supportModules supportExterns supportForeigns inputFiles outputFile =+  assert supportModules supportExterns supportForeigns inputFiles checkMain $ \e ->     case e of       Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs       Right _ -> do@@ -262,13 +257,14 @@           Nothing -> return $ Just "Couldn't find node.js executable"  assertCompilesWithWarnings-  :: [(P.Module, P.ExternsFile)]+  :: [P.Module]+  -> [P.ExternsFile]   -> M.Map P.ModuleName FilePath   -> [FilePath]   -> [String]   -> Expectation-assertCompilesWithWarnings supportExterns supportForeigns inputFiles shouldWarnWith =-  assert supportExterns supportForeigns inputFiles checkMain $ \e ->+assertCompilesWithWarnings supportModules supportExterns supportForeigns inputFiles shouldWarnWith =+  assert supportModules supportExterns supportForeigns inputFiles checkMain $ \e ->     case e of       Left errs ->         return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs@@ -282,13 +278,14 @@     (<> "\n\n" <> P.prettyPrintMultipleErrors P.defaultPPEOptions warnings)  assertDoesNotCompile-  :: [(P.Module, P.ExternsFile)]+  :: [P.Module]+  -> [P.ExternsFile]   -> M.Map P.ModuleName FilePath   -> [FilePath]   -> [String]   -> Expectation-assertDoesNotCompile supportExterns supportForeigns inputFiles shouldFailWith =-  assert supportExterns supportForeigns inputFiles noPreCheck $ \e ->+assertDoesNotCompile supportModules supportExterns supportForeigns inputFiles shouldFailWith =+  assert supportModules supportExterns supportForeigns inputFiles noPreCheck $ \e ->     case e of       Left errs ->         return $ if null shouldFailWith

@@ -402,6 +402,10 @@   , ("TypeLevelString",       [ ShouldBeDocumented (n "TypeLevelString") "Foo" ["fooBar"]       ])++  , ("Desugar",+      [ ValueShouldHaveTypeSignature (n "Desugar") "test" (renderedType "forall a b. X (a -> b) a -> b")+      ])   ]    where

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module TestPsci.CompletionTest where  import Prelude ()@@ -13,17 +14,18 @@ import           Language.PureScript.Interactive import           System.Console.Haskeline import           TestPsci.TestEnv (initTestPSCiEnv)-import           TestUtils (supportModules)+import           TestUtils (getSupportModuleNames)  completionTests :: Spec-completionTests = context "completionTests" $-  mapM_ assertCompletedOk completionTestData+completionTests = context "completionTests" $ do+  mns <- runIO $ getSupportModuleNames+  mapM_ assertCompletedOk (completionTestData mns)  -- If the cursor is at the right end of the line, with the 1st element of the -- pair as the text in the line, then pressing tab should offer all the -- elements of the list (which is the 2nd element) as completions.-completionTestData :: [(String, [String])]-completionTestData =+completionTestData :: [T.Text] -> [(String, [String])]+completionTestData supportModuleNames =   -- basic directives   [ (":h",  [":help"])   , (":r",  [":reload"])@@ -32,12 +34,12 @@   , (":b",  [":browse"])    -- :browse should complete module names-  , (":b Control.Monad.E",    map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])-  , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])+  , (":b Control.Monad.E",    map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console", ".Uncurried"])+  , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console", ".Uncurried"])    -- import should complete module names-  , ("import Control.Monad.E",    map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])-  , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])+  , ("import Control.Monad.E",    map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console", ".Uncurried"])+  , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console", ".Uncurried"])    -- :quit, :help, :reload, :clear should not complete   , (":help ", [])@@ -65,7 +67,7 @@    -- a few other import tests   , ("impor", ["import"])-  , ("import ", map ("import " ++) supportModules)+  , ("import ", map (T.unpack . mappend "import ") supportModuleNames)   , ("import Prelude ", [])    -- String and number literals should not be completed@@ -99,10 +101,10 @@ getPSCiStateForCompletion :: IO PSCiState getPSCiStateForCompletion = do   (PSCiState _ bs es, _) <- initTestPSCiEnv-  let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName (T.pack "Prelude")], P.Implicit, Nothing)]+  let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]   return $ PSCiState imports bs es  controlMonadSTasST :: ImportedModule controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))   where-  s = P.moduleNameFromString . T.pack+  s = P.moduleNameFromString

@@ -5,14 +5,21 @@ import Prelude () import Prelude.Compat +import qualified Language.PureScript as P+ import Control.Monad+import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Control.Exception-+import Data.List (sort)+import qualified Data.Text as T import System.Process import System.Directory import System.Info+import System.IO.UTF8 (readUTF8FileT) import System.Exit (exitFailure)+import System.FilePath ((</>))+import qualified System.FilePath.Glob as Glob import System.IO (stderr, hPutStrLn)  findNodeProcess :: IO (Maybe String)@@ -47,127 +54,28 @@     hPutStrLn stderr "Cannot find node (or nodejs) executable"     exitFailure +readInput :: [FilePath] -> IO [(FilePath, T.Text)]+readInput inputFiles = forM inputFiles $ \inputFile -> do+  text <- readUTF8FileT inputFile+  return (inputFile, text)+ -- | -- The support modules that should be cached between test cases, to avoid -- excessive rebuilding. ---supportModules :: [String]-supportModules =-  [ "Control.Alt"-  , "Control.Alternative"-  , "Control.Applicative"-  , "Control.Apply"-  , "Control.Biapplicative"-  , "Control.Biapply"-  , "Control.Bind"-  , "Control.Category"-  , "Control.Comonad"-  , "Control.Extend"-  , "Control.Lazy"-  , "Control.Monad"-  , "Control.Monad.Eff"-  , "Control.Monad.Eff.Class"-  , "Control.Monad.Eff.Console"-  , "Control.Monad.Eff.Unsafe"-  , "Control.Monad.Rec.Class"-  , "Control.Monad.ST"-  , "Control.MonadPlus"-  , "Control.MonadZero"-  , "Control.Plus"-  , "Control.Semigroupoid"-  , "Data.Array"-  , "Data.Array.Partial"-  , "Data.Array.ST"-  , "Data.Array.ST.Iterator"-  , "Data.Bifoldable"-  , "Data.Bifunctor"-  , "Data.Bifunctor.Clown"-  , "Data.Bifunctor.Flip"-  , "Data.Bifunctor.Join"-  , "Data.Bifunctor.Joker"-  , "Data.Bifunctor.Product"-  , "Data.Bifunctor.Wrap"-  , "Data.Bitraversable"-  , "Data.Boolean"-  , "Data.BooleanAlgebra"-  , "Data.Bounded"-  , "Data.Char"-  , "Data.CommutativeRing"-  , "Data.Either"-  , "Data.Either.Nested"-  , "Data.Eq"-  , "Data.EuclideanRing"-  , "Data.Field"-  , "Data.Foldable"-  , "Data.Function"-  , "Data.Function.Uncurried"-  , "Data.Functor"-  , "Data.Functor.Invariant"-  , "Data.Generic"-  , "Data.Generic.Rep"-  , "Data.Generic.Rep.Bounded"-  , "Data.Generic.Rep.Eq"-  , "Data.Generic.Rep.Monoid"-  , "Data.Generic.Rep.Ord"-  , "Data.Generic.Rep.Semigroup"-  , "Data.Generic.Rep.Show"-  , "Data.HeytingAlgebra"-  , "Data.Identity"-  , "Data.Lazy"-  , "Data.List"-  , "Data.List.Lazy"-  , "Data.List.Lazy.NonEmpty"-  , "Data.List.Lazy.Types"-  , "Data.List.NonEmpty"-  , "Data.List.Partial"-  , "Data.List.Types"-  , "Data.List.ZipList"-  , "Data.Maybe"-  , "Data.Maybe.First"-  , "Data.Maybe.Last"-  , "Data.Monoid"-  , "Data.Monoid.Additive"-  , "Data.Monoid.Alternate"-  , "Data.Monoid.Conj"-  , "Data.Monoid.Disj"-  , "Data.Monoid.Dual"-  , "Data.Monoid.Endo"-  , "Data.Monoid.Multiplicative"-  , "Data.NaturalTransformation"-  , "Data.Newtype"-  , "Data.NonEmpty"-  , "Data.Ord"-  , "Data.Ord.Unsafe"-  , "Data.Ordering"-  , "Data.Ring"-  , "Data.Semigroup"-  , "Data.Semiring"-  , "Data.Show"-  , "Data.String"-  , "Data.String.CaseInsensitive"-  , "Data.String.Regex"-  , "Data.String.Regex.Flags"-  , "Data.String.Regex.Unsafe"-  , "Data.String.Unsafe"-  , "Data.Symbol"-  , "Data.Traversable"-  , "Data.Tuple"-  , "Data.Tuple.Nested"-  , "Data.Unfoldable"-  , "Data.Unit"-  , "Data.Void"-  , "PSCI.Support"-  , "Partial"-  , "Partial.Unsafe"-  , "Prelude"-  , "Test.Assert"-  , "Type.Data.Ordering"-  , "Type.Data.Symbol"-  , "Type.Equality"-  , "Type.Prelude"-  , "Type.Proxy"-  , "Unsafe.Coerce"-  ]+getSupportModuleTuples :: IO [(FilePath, P.Module)]+getSupportModuleTuples = do+  cd <- getCurrentDirectory+  let supportDir = cd </> "tests" </> "support" </> "bower_components"+  supportPurs <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") supportDir+  supportPursFiles <- readInput supportPurs+  modules <- runExceptT $ ExceptT . return $ P.parseModulesFromFiles id supportPursFiles+  case modules of+    Right ms -> return ms+    Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)++getSupportModuleNames :: IO [T.Text]+getSupportModuleNames = sort . map (P.runModuleName . P.getModuleName . snd) <$> getSupportModuleTuples  pushd :: forall a. FilePath -> IO a -> IO a pushd dir act = do

@@ -4,7 +4,7 @@     "purescript-arrays": "4.0.0",     "purescript-assert": "3.0.0",     "purescript-console": "3.0.0",-    "purescript-eff": "3.0.0",+    "purescript-eff": "3.1.0",     "purescript-functions": "3.0.0",     "purescript-generics": "4.0.0",     "purescript-generics-rep": "5.0.0",