purescript 0.12.3 → 0.12.4

raw patch · 59 files changed

+1875/−888 lines, 59 filesdep +arraydep ~aesondep ~base

Dependencies added: array

Dependency ranges changed: aeson, base

Files

CONTRIBUTORS.md +3/−0
app/Command/Ide.hs +25/−24
purescript.cabal +104/−95
src/Language/PureScript/AST/Declarations.hs +2/−1
src/Language/PureScript/AST/Traversals.hs +2/−2
src/Language/PureScript/Bundle.hs +70/−27
src/Language/PureScript/CodeGen/JS.hs +15/−2
src/Language/PureScript/Docs/Convert/Single.hs +3/−2
src/Language/PureScript/Docs/RenderedCode/RenderType.hs +11/−18
src/Language/PureScript/Errors.hs +60/−52
src/Language/PureScript/Ide.hs +7/−5
src/Language/PureScript/Ide/CaseSplit.hs +19/−12
src/Language/PureScript/Ide/Completion.hs +8/−9
src/Language/PureScript/Ide/Error.hs +1/−1
src/Language/PureScript/Ide/Externs.hs +2/−1
src/Language/PureScript/Ide/Filter.hs +82/−64
src/Language/PureScript/Ide/Filter/Declaration.hs +17/−23
src/Language/PureScript/Ide/Imports.hs +6/−4
src/Language/PureScript/Ide/Prim.hs +2/−2
src/Language/PureScript/Ide/SourceFile.hs +5/−2
src/Language/PureScript/Ide/State.hs +20/−9
src/Language/PureScript/Ide/Types.hs +9/−3
src/Language/PureScript/Ide/Usage.hs +3/−0
src/Language/PureScript/Ide/Util.hs +2/−0
src/Language/PureScript/Interactive.hs +1/−1
src/Language/PureScript/Interactive/Printer.hs +5/−5
src/Language/PureScript/Parser/Declarations.hs +8/−2
src/Language/PureScript/Pretty/Types.hs +68/−60
src/Language/PureScript/Pretty/Values.hs +3/−3
src/Language/PureScript/Publish.hs +121/−106
src/Language/PureScript/Publish/ErrorsWarnings.hs +44/−65
src/Language/PureScript/Sugar/Names.hs +1/−1
src/Language/PureScript/Sugar/Operators.hs +1/−1
src/Language/PureScript/Sugar/TypeClasses.hs +26/−8
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +10/−10
src/Language/PureScript/TypeChecker.hs +11/−10
stack.yaml +5/−1
tests/Language/PureScript/Ide/CompletionSpec.hs +7/−0
tests/Language/PureScript/Ide/FilterSpec.hs +43/−53
tests/Language/PureScript/Ide/ImportsSpec.hs +6/−5
tests/Language/PureScript/Ide/SourceFileSpec.hs +5/−1
tests/Language/PureScript/Ide/Test.hs +5/−1
tests/Main.hs +5/−2
tests/TestBundle.hs +95/−0
tests/TestCompiler.hs +11/−133
tests/TestDocs.hs +7/−7
tests/TestPrimDocs.hs +28/−26
tests/TestPscPublish.hs +18/−7
tests/TestUtils.hs +154/−4
tests/purs/bundle/PSasConstructor.purs +11/−0
tests/purs/failing/Superclasses2.purs +1/−2
tests/purs/publish/basic-example/bower.json +13/−0
tests/purs/publish/basic-example/resolutions-legacy.json +640/−0
tests/purs/publish/basic-example/resolutions.json +17/−0
tests/purs/publish/basic-example/src/Main.purs +16/−0
tests/support/package-lock.json +8/−8
tests/support/package.json +1/−1
tests/support/prelude-resolutions.json +1/−7
tests/support/pscide/src/CompletionSpecDocs.purs +1/−0

CONTRIBUTORS.md view

@@ -68,6 +68,7 @@ | [@lukerandall](https://github.com/lukerandall) | Luke Randall | [MIT license](http://opensource.org/licenses/MIT) | | [@matthewleon](https://github.com/matthewleon) | Matthew Leon | [MIT license](http://opensource.org/licenses/MIT) | | [@mcoffin](https://github.com/mcoffin) | Matt Coffin | [MIT license](http://opensource.org/licenses/MIT) |+| [@mhcurylo](https://github.com/mhcurylo) | Mateusz Curylo | [MIT license](http://opensource.org/licenses/MIT) | | [@MiracleBlue](https://github.com/MiracleBlue) | Nicholas Kircher | [MIT license](http://opensource.org/licenses/MIT) | | [@mrkgnao](https://github.com/mrkgnao) | Soham Chowdhury | [MIT license](http://opensource.org/licenses/MIT) | | [@mgmeier](https://github.com/mgmeier) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) |@@ -92,6 +93,7 @@ | [@philopon](https://github.com/philopon) | Hirotomo Moriwaki | [MIT license](http://opensource.org/licenses/MIT) | | [@pseudonom](https://github.com/pseudonom) | Eric Easley | [MIT license](http://opensource.org/licenses/MIT) | | [@quesebifurcan](https://github.com/quesebifurcan) | Fredrik Wallberg | [MIT license](http://opensource.org/licenses/MIT) |+| [@rhendric](https://github.com/rhendric) | Ryan Hendrickson | [MIT license](http://opensource.org/licenses/MIT) | | [@rightfold](https://github.com/rightfold) | rightfold | [MIT license](https://opensource.org/licenses/MIT) | | [@rndnoise](https://www.github.com/rndnoise) | rndnoise | [MIT license](http://opensource.org/licenses/MIT) | | [@robdaemon](https://github.com/robdaemon) | Robert Roland | [MIT license](http://opensource.org/licenses/MIT) |@@ -128,6 +130,7 @@ | [@gabejohnson](https://github.com/gabejohnson) | Gabe Johnson | [MIT license](http://opensource.org/licenses/MIT) | | [@dariooddenino](https://github.com/dariooddenino) | Dario Oddenino | [MIT license](http://opensource.org/licenses/MIT) | | [@jordanmartinez](https://github.com/jordanmartinez) | Jordan Martinez | [MIT license](http://opensource.org/licenses/MIT) |+| [@Saulukass](https://github.com/Saulukass) | Saulius Skliutas | [MIT license](http://opensource.org/licenses/MIT) |  ### Contributors using Modified Terms

app/Command/Ide.hs view

@@ -37,10 +37,7 @@ import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Watcher-import           Network                           hiding (socketPort, accept)-import           Network.BSD                       (getProtocolNumber)-import           Network.Socket                    hiding (PortNumber, Type,-                                                    sClose)+import qualified Network.Socket                    as Network import qualified Options.Applicative               as Opts import           System.Directory import           System.Info                       as SysInfo@@ -48,24 +45,23 @@ import           System.IO                         hiding (putStrLn, print) import           System.IO.Error                   (isEOFError) -listenOnLocalhost :: PortNumber -> IO Socket+listenOnLocalhost :: Network.PortNumber -> IO Network.Socket listenOnLocalhost port = do-  proto <- getProtocolNumber "tcp"-  localhost <- inet_addr "127.0.0.1"+  addr:_ <- Network.getAddrInfo Nothing (Just "127.0.0.1") (Just (show port))   bracketOnError-    (socket AF_INET Stream proto)-    sClose+    (Network.socket (Network.addrFamily addr) (Network.addrSocketType addr) (Network.addrProtocol addr))+    Network.close     (\sock -> do-      setSocketOption sock ReuseAddr 1-      bind sock (SockAddrInet port localhost)-      listen sock maxListenQueue+      Network.setSocketOption sock Network.ReuseAddr 1+      Network.bind sock (Network.addrAddress addr)+      Network.listen sock Network.maxListenQueue       pure sock)  data ServerOptions = ServerOptions   { _serverDirectory  :: Maybe FilePath   , _serverGlobs      :: [FilePath]   , _serverOutputPath :: FilePath-  , _serverPort       :: PortNumber+  , _serverPort       :: Network.PortNumber   , _serverNoWatch    :: Bool   , _serverPolling    :: Bool   , _serverLoglevel   :: IdeLogLevel@@ -73,7 +69,7 @@   } deriving (Show)  data ClientOptions = ClientOptions-  { clientPort :: PortID+  { clientPort :: Network.PortNumber   }  command :: Opts.Parser (IO ())@@ -96,15 +92,18 @@           T.putStrLn ("Couldn't connect to purs ide server on port " <> show clientPort <> ":")           print e           exitFailure-    h <- connectTo "127.0.0.1" clientPort `catch` handler+    addr:_ <- Network.getAddrInfo Nothing (Just "127.0.0.1") (Just (show clientPort))+    sock <- Network.socket (Network.addrFamily addr) (Network.addrSocketType addr) (Network.addrProtocol addr)+    Network.connect sock (Network.addrAddress addr) `catch` handler+    h <- Network.socketToHandle sock ReadWriteMode     T.hPutStrLn h =<< T.getLine     BS8.putStrLn =<< BS8.hGetLine h     hFlush stdout     hClose h    clientOptions :: Opts.Parser ClientOptions-  clientOptions = ClientOptions . PortNumber . fromIntegral <$>-    Opts.option Opts.auto (Opts.long "port" <> Opts.short 'p' <> Opts.value (4242 :: Integer))+  clientOptions = ClientOptions . fromIntegral <$>+    Opts.option Opts.auto (Opts.long "port" `mappend` Opts.short 'p' `mappend` Opts.value (4242 :: Integer))    server :: ServerOptions -> IO ()   server opts'@(ServerOptions dir globs outputPath port noWatch polling logLevel editorMode) = do@@ -159,12 +158,12 @@   -- #2209 and #2414 for explanations   flipIfWindows = map (if SysInfo.os == "mingw32" then not else identity) -startServer :: PortNumber -> IdeEnvironment -> IO ()-startServer port env = withSocketsDo $ do+startServer :: Network.PortNumber -> IdeEnvironment -> IO ()+startServer port env = Network.withSocketsDo $ do   sock <- listenOnLocalhost port   runLogger (confLogLevel (ideConfiguration env)) (runReaderT (forever (loop sock)) env)   where-    loop :: (Ide m, MonadLogger m) => Socket -> m ()+    loop :: (Ide m, MonadLogger m) => Network.Socket -> m ()     loop sock = do       accepted <- runExceptT (acceptCommand sock)       case accepted of@@ -197,8 +196,10 @@       putText ("[Error] psc-ide-server tried interact with the handle, but the connection was already gone.")     _ -> throwIO e) -acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)-                 => Socket -> m (Text, Handle)+acceptCommand+  :: (MonadIO m, MonadLogger m, MonadError Text m)+  => Network.Socket+  -> m (Text, Handle) acceptCommand sock = do   h <- acceptConnection   $(logDebug) "Accepted a connection"@@ -216,8 +217,8 @@   where    acceptConnection = liftIO $ do      -- Use low level accept to prevent accidental reverse name resolution-     (s,_) <- accept sock-     h     <- socketToHandle s ReadWriteMode+     (s,_) <- Network.accept sock+     h     <- Network.socketToHandle s ReadWriteMode      hSetEncoding h utf8      hSetBuffering h LineBuffering      pure h

purescript.cabal view

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5d1735c5c26a07ecb7e0a4d8033e3083d74c2f22263e67ada418c4e61cae4d3e+-- hash: d36dcc914da2b1127258e1605150e6d890890d1e0b28f747c62284638526d74d  name:           purescript-version:        0.12.3+version:        0.12.4 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 @@     tests/purs/passing/RowUnion.js     tests/purs/warning/UnnecessaryFFIModule.js     tests/purs/warning/UnusedFFIImplementations.js+    tests/purs/bundle/PSasConstructor.purs     tests/purs/docs/bower_components/purescript-prelude/src/Prelude.purs     tests/purs/docs/src/Ado.purs     tests/purs/docs/src/ChildDeclOrder.purs@@ -658,6 +659,7 @@     tests/purs/passing/WildcardType.purs     tests/purs/psci/BasicEval.purs     tests/purs/psci/Multiline.purs+    tests/purs/publish/basic-example/src/Main.purs     tests/purs/warning/2140.purs     tests/purs/warning/2383.purs     tests/purs/warning/2411.purs@@ -700,6 +702,9 @@     tests/purs/warning/WildcardInferredType2.purs     tests/purs/docs/bower.json     tests/purs/docs/resolutions.json+    tests/purs/publish/basic-example/bower.json+    tests/purs/publish/basic-example/resolutions-legacy.json+    tests/purs/publish/basic-example/resolutions.json     tests/json-compat/v0.11.3/generics-4.0.0.json     tests/json-compat/v0.11.3/symbols-3.0.0.json     tests/json-compat/v0.12.1/typelevel-prelude-3.0.0.json@@ -745,62 +750,6 @@   default: False  library-  hs-source-dirs:-      src-  default-extensions: ConstraintKinds DataKinds DeriveFunctor EmptyDataDecls FlexibleContexts KindSignatures LambdaCase MultiParamTypeClasses NoImplicitPrelude PatternGuards PatternSynonyms RankNTypes RecordWildCards OverloadedStrings ScopedTypeVariables TupleSections ViewPatterns-  ghc-options: -Wall -O2-  build-depends:-      Cabal >=2.2-    , Glob >=0.9 && <0.10-    , aeson >=1.0 && <1.4-    , aeson-better-errors >=0.8-    , ansi-terminal >=0.7.1 && <0.9-    , base >=4.8 && <4.12-    , base-compat >=0.6.0-    , blaze-html >=0.8.1 && <0.10-    , bower-json >=1.0.0.1 && <1.1-    , boxes >=0.1.4 && <0.2.0-    , bytestring-    , cheapskate >=0.1 && <0.2-    , clock-    , containers-    , data-ordlist >=0.4.7.0-    , deepseq-    , directory >=1.2.3-    , dlist-    , edit-distance-    , file-embed-    , filepath-    , fsnotify >=0.2.1-    , haskeline >=0.7.0.0-    , language-javascript >=0.6.0.9 && <0.7-    , lifted-base >=0.2.3 && <0.2.4-    , microlens-platform >=0.3.9.0 && <0.4-    , monad-control >=1.0.0.0 && <1.1-    , monad-logger >=0.3 && <0.4-    , mtl >=2.1.0 && <2.3.0-    , parallel >=3.2 && <3.3-    , parsec >=3.1.10-    , pattern-arrows >=0.0.2 && <0.1-    , process >=1.2.0 && <1.7-    , protolude >=0.1.6-    , regex-tdfa-    , safe >=0.3.9 && <0.4-    , scientific >=0.3.4.9 && <0.4-    , semigroups >=0.16.2 && <0.19-    , sourcemap >=0.1.6-    , split-    , stm >=0.2.4.0-    , stringsearch-    , syb-    , text-    , time-    , transformers >=0.3.0 && <0.6-    , transformers-base >=0.4.0 && <0.5-    , transformers-compat >=0.3.0-    , unordered-containers-    , utf8-string >=1 && <2-    , vector   exposed-modules:       Control.Monad.Logger       Control.Monad.Supply@@ -959,21 +908,18 @@       System.IO.UTF8   other-modules:       Paths_purescript-  default-language: Haskell2010--executable purs-  main-is: Main.hs   hs-source-dirs:-      app-  ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N+      src+  default-extensions: ConstraintKinds DataKinds DeriveFunctor EmptyDataDecls FlexibleContexts KindSignatures LambdaCase MultiParamTypeClasses NoImplicitPrelude PatternGuards PatternSynonyms RankNTypes RecordWildCards OverloadedStrings ScopedTypeVariables TupleSections ViewPatterns NoMonadFailDesugaring+  ghc-options: -Wall -O2   build-depends:       Cabal >=2.2     , Glob >=0.9 && <0.10-    , aeson >=1.0 && <1.4+    , aeson >=1.0 && <1.5     , aeson-better-errors >=0.8     , ansi-terminal >=0.7.1 && <0.9-    , ansi-wl-pprint-    , base >=4.8 && <4.12+    , array+    , base >=4.8 && <4.13     , base-compat >=0.6.0     , blaze-html >=0.8.1 && <0.10     , bower-json >=1.0.0.1 && <1.1@@ -991,21 +937,17 @@     , filepath     , fsnotify >=0.2.1     , haskeline >=0.7.0.0-    , http-types     , language-javascript >=0.6.0.9 && <0.7     , lifted-base >=0.2.3 && <0.2.4     , microlens-platform >=0.3.9.0 && <0.4     , monad-control >=1.0.0.0 && <1.1     , monad-logger >=0.3 && <0.4     , mtl >=2.1.0 && <2.3.0-    , network-    , optparse-applicative >=0.13.0     , parallel >=3.2 && <3.3     , parsec >=3.1.10     , pattern-arrows >=0.0.2 && <0.1     , process >=1.2.0 && <1.7     , protolude >=0.1.6-    , purescript     , regex-tdfa     , safe >=0.3.9 && <0.4     , scientific >=0.3.4.9 && <0.4@@ -1023,15 +965,10 @@     , unordered-containers     , utf8-string >=1 && <2     , vector-    , wai ==3.*-    , wai-websockets ==3.*-    , warp ==3.*-    , websockets >=0.9 && <0.13-  if flag(release)-    cpp-options: -DRELEASE-  else-    build-depends:-        gitrev >=1.2.0 && <1.4+  default-language: Haskell2010++executable purs+  main-is: Main.hs   other-modules:       Command.Bundle       Command.Compile@@ -1043,23 +980,18 @@       Command.REPL       Paths_purescript       Version-  default-language: Haskell2010--test-suite tests-  type: exitcode-stdio-1.0-  main-is: Main.hs   hs-source-dirs:-      tests-  default-extensions: NoImplicitPrelude-  ghc-options: -Wall+      app+  ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N   build-depends:       Cabal >=2.2     , Glob >=0.9 && <0.10-    , HUnit-    , aeson >=1.0 && <1.4+    , aeson >=1.0 && <1.5     , aeson-better-errors >=0.8     , ansi-terminal >=0.7.1 && <0.9-    , base >=4.8 && <4.12+    , ansi-wl-pprint+    , array+    , base >=4.8 && <4.13     , base-compat >=0.6.0     , blaze-html >=0.8.1 && <0.10     , bower-json >=1.0.0.1 && <1.1@@ -1077,14 +1009,15 @@     , filepath     , fsnotify >=0.2.1     , haskeline >=0.7.0.0-    , hspec-    , hspec-discover+    , http-types     , language-javascript >=0.6.0.9 && <0.7     , lifted-base >=0.2.3 && <0.2.4     , microlens-platform >=0.3.9.0 && <0.4     , monad-control >=1.0.0.0 && <1.1     , monad-logger >=0.3 && <0.4     , mtl >=2.1.0 && <2.3.0+    , network+    , optparse-applicative >=0.13.0     , parallel >=3.2 && <3.3     , parsec >=3.1.10     , pattern-arrows >=0.0.2 && <0.1@@ -1100,8 +1033,6 @@     , stm >=0.2.4.0     , stringsearch     , syb-    , tasty-    , tasty-hspec     , text     , time     , transformers >=0.3.0 && <0.6@@ -1110,6 +1041,20 @@     , unordered-containers     , utf8-string >=1 && <2     , vector+    , wai ==3.*+    , wai-websockets ==3.*+    , warp ==3.*+    , websockets >=0.9 && <0.13+  if flag(release)+    cpp-options: -DRELEASE+  else+    build-depends:+        gitrev >=1.2.0 && <1.4+  default-language: Haskell2010++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Main.hs   other-modules:       Language.PureScript.Ide.CompletionSpec       Language.PureScript.Ide.FilterSpec@@ -1122,6 +1067,7 @@       Language.PureScript.Ide.Test       Language.PureScript.Ide.UsageSpec       PscIdeSpec+      TestBundle       TestCompiler       TestCoreFn       TestDocs@@ -1136,4 +1082,67 @@       TestPscPublish       TestUtils       Paths_purescript+  hs-source-dirs:+      tests+  default-extensions: NoImplicitPrelude+  ghc-options: -Wall+  build-depends:+      Cabal >=2.2+    , Glob >=0.9 && <0.10+    , HUnit+    , aeson >=1.0 && <1.5+    , aeson-better-errors >=0.8+    , ansi-terminal >=0.7.1 && <0.9+    , array+    , base >=4.8 && <4.13+    , base-compat >=0.6.0+    , blaze-html >=0.8.1 && <0.10+    , bower-json >=1.0.0.1 && <1.1+    , boxes >=0.1.4 && <0.2.0+    , bytestring+    , cheapskate >=0.1 && <0.2+    , clock+    , containers+    , data-ordlist >=0.4.7.0+    , deepseq+    , directory >=1.2.3+    , dlist+    , edit-distance+    , file-embed+    , filepath+    , fsnotify >=0.2.1+    , haskeline >=0.7.0.0+    , hspec+    , hspec-discover+    , language-javascript >=0.6.0.9 && <0.7+    , lifted-base >=0.2.3 && <0.2.4+    , microlens-platform >=0.3.9.0 && <0.4+    , monad-control >=1.0.0.0 && <1.1+    , monad-logger >=0.3 && <0.4+    , mtl >=2.1.0 && <2.3.0+    , parallel >=3.2 && <3.3+    , parsec >=3.1.10+    , pattern-arrows >=0.0.2 && <0.1+    , process >=1.2.0 && <1.7+    , protolude >=0.1.6+    , purescript+    , regex-tdfa+    , safe >=0.3.9 && <0.4+    , scientific >=0.3.4.9 && <0.4+    , semigroups >=0.16.2 && <0.19+    , sourcemap >=0.1.6+    , split+    , stm >=0.2.4.0+    , stringsearch+    , syb+    , tasty+    , tasty-hspec+    , text+    , time+    , transformers >=0.3.0 && <0.6+    , transformers-base >=0.4.0 && <0.5+    , transformers-compat >=0.3.0+    , unordered-containers+    , utf8-string >=1 && <2+    , vector   default-language: Haskell2010

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

@@ -100,6 +100,7 @@   | InvalidDoLet   | CycleInDeclaration Ident   | CycleInTypeSynonym (Maybe (ProperName 'TypeName))+  | CycleInTypeClassDeclaration [(ProperName 'ClassName)]   | CycleInModules [ModuleName]   | NameIsUndefined Ident   | UndefinedTypeVariable (ProperName 'TypeName)@@ -485,7 +486,7 @@   -- |   -- A data type declaration (data or newtype, name, arguments, data constructors)   ---  = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, Maybe SourceKind)] [(ProperName 'ConstructorName, [SourceType])]+  = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, Maybe SourceKind)] [(ProperName 'ConstructorName, [(Ident, SourceType)])]   -- |   -- A minimal mutually recursive set of data type declarations   --

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

@@ -629,7 +629,7 @@      ) accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)   where-  forDecls (DataDeclaration _ _ _ _ dctors) = mconcat (concatMap (fmap f . snd) dctors)+  forDecls (DataDeclaration _ _ _ _ dctors) = mconcat (concatMap (fmap (f . snd) . snd) dctors)   forDecls (ExternDeclaration _ _ ty) = f ty   forDecls (TypeClassDeclaration _ _ _ implies _ _) = mconcat (concatMap (fmap f . constraintArgs) implies)   forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) = mconcat (concatMap (fmap f . constraintArgs) cs) <> mconcat (fmap f tys)@@ -655,7 +655,7 @@   where   forDecls (DataDeclaration _ _ _ args dctors) =     foldMap (foldMap f . snd) args <>-    foldMap (foldMap forTypes . snd) dctors+    foldMap (foldMap (forTypes . snd) . snd) dctors   forDecls (TypeClassDeclaration _ _ args implies _ _) =     foldMap (foldMap f . snd) args <>     foldMap (foldMap forTypes . constraintArgs) implies

src/Language/PureScript/Bundle.hs view

@@ -23,12 +23,15 @@ import Control.Monad.Error.Class import Control.Arrow ((&&&)) +import Data.Array ((!)) import Data.Char (chr, digitToInt)-import Data.Generics (everything, everywhere, mkQ, mkT)+import Data.Foldable (fold)+import Data.Generics (GenericM, everything, everywhere, gmapMo, mkMp, mkQ, mkT) import Data.Graph import Data.List (stripPrefix)-import Data.Maybe (mapMaybe, catMaybes)+import Data.Maybe (catMaybes, fromMaybe, mapMaybe) import Data.Version (showVersion)+import qualified Data.Map as M import qualified Data.Set as S  import Language.JavaScript.Parser@@ -398,7 +401,7 @@ compile modules [] = modules compile modules entryPoints = filteredModules   where-  (graph, _, vertexFor) = graphFromEdges verts+  (graph, vertexToNode, vertexFor) = graphFromEdges verts    -- | The vertex set   verts :: [(ModuleElement, Key, [Key])]@@ -435,6 +438,13 @@   reachableSet :: S.Set Vertex   reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices) +  -- | A map from modules to the modules that are used by its reachable members.+  moduleReferenceMap :: M.Map ModuleIdentifier (S.Set ModuleIdentifier)+  moduleReferenceMap = M.fromAscListWith mappend $ map (vertToModule &&& vertToModuleRefs) $ S.toList reachableSet+    where+    vertToModuleRefs v = foldMap (S.singleton . vertToModule) $ graph ! v+    vertToModule v = m where (_, (m, _), _) = vertexToNode v+   filteredModules :: [Module]   filteredModules = map filterUsed modules     where@@ -461,6 +471,7 @@        isDeclUsed :: ModuleElement -> Bool       isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)+      isDeclUsed (Require _ _ (Right midRef)) = midRef `S.member` modulesReferenced       isDeclUsed _ = True        isKeyUsed :: Key -> Bool@@ -468,6 +479,9 @@         | Just me <- vertexFor k = me `S.member` reachableSet         | otherwise = False +      modulesReferenced :: S.Set ModuleIdentifier+      modulesReferenced = fold $ M.lookup mid moduleReferenceMap+ -- | Topologically sort the module dependency graph, so that when we generate code, modules can be -- defined in the right order. sortModules :: [Module] -> [Module]@@ -556,7 +570,7 @@   modulesJS = map moduleToJS ms    moduleToJS :: Module -> ([JSStatement], [Either Int Int])-  moduleToJS (Module mn _ ds) = (wrap (moduleName mn) (indent (concat jsDecls)), lengths)+  moduleToJS (Module mid _ ds) = (wrap mid (indent (concat jsDecls)), lengths)     where     (jsDecls, lengths) = unzip $ map declToJS ds @@ -572,7 +586,7 @@         JSVariable lfsp           (cList [             JSVarInitExpression (JSIdentifier sp nm)-              (JSVarInit sp $ either require (moduleReference sp . moduleName) req )+              (JSVarInit sp $ either require (innerModuleReference sp . moduleName) req )           ]) (JSSemi JSNoAnnot)       ]     declToJS (ExportsList exps) = withLength $ map toExport exps@@ -628,6 +642,12 @@     JSMemberSquare (JSIdentifier a optionsNamespace) JSNoAnnot       (str mn) JSNoAnnot +  innerModuleReference :: JSAnnot -> String -> JSExpression+  innerModuleReference a mn =+    JSMemberSquare (JSIdentifier a "$PS") JSNoAnnot+      (str mn) JSNoAnnot++   str :: String -> JSExpression   str s = JSStringLiteral JSNoAnnot $ "\"" ++ s ++ "\"" @@ -635,31 +655,54 @@   emptyObj :: JSAnnot -> JSExpression   emptyObj a = JSObjectLiteral a (JSCTLNone JSLNil) JSNoAnnot -  wrap :: String -> [JSStatement] -> [JSStatement]-  wrap mn ds =-    [-    JSMethodCall (JSExpressionParen lf (JSFunctionExpression JSNoAnnot JSIdentNone JSNoAnnot-                                                (JSLOne (JSIdentName JSNoAnnot "exports")) JSNoAnnot-                                                (JSBlock sp (lfHead ds) lf)) -- \n not quite in right place-                                    JSNoAnnot)-                  JSNoAnnot-                  (JSLOne (JSAssignExpression (moduleReference JSNoAnnot mn) (JSAssign sp)-                            (JSExpressionBinary (moduleReference sp mn) (JSBinOpOr sp) (emptyObj sp))))-                  JSNoAnnot-                  (JSSemi JSNoAnnot)-    ]+  initializeObject :: JSAnnot -> (JSAnnot -> String -> JSExpression) -> String -> JSExpression+  initializeObject a makeReference mn =+    JSAssignExpression (makeReference a mn) (JSAssign sp)+    $ JSExpressionBinary (makeReference sp mn) (JSBinOpOr sp)+    $ emptyObj sp++  -- Like `somewhere`, but stops after the first successful transformation+  firstwhere :: MonadPlus m => GenericM m -> GenericM m+  firstwhere f x = f x `mplus` gmapMo (firstwhere f) x++  prependWhitespace :: String -> [JSStatement] -> [JSStatement]+  prependWhitespace val = fromMaybe <*> firstwhere (mkMp $ Just . reannotate)     where-      lfHead (h:t) = addAnn (WhiteSpace tokenPosnEmpty "\n  ") h : t-      lfHead x = x+    reannotate (JSAnnot rpos annots) = JSAnnot rpos (ws : annots)+    reannotate _ = JSAnnot tokenPosnEmpty [ws] -      addAnn :: CommentAnnotation -> JSStatement -> JSStatement-      addAnn a (JSExpressionStatement (JSStringLiteral ann s) _) =-        JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot)-      addAnn _ x = x+    ws = WhiteSpace tokenPosnEmpty val -      appendAnn a JSNoAnnot = JSAnnot tokenPosnEmpty [a]-      appendAnn a (JSAnnot _ anns) = JSAnnot tokenPosnEmpty (a:anns ++ [WhiteSpace tokenPosnEmpty "  "])-      appendAnn a JSAnnotSpace = JSAnnot tokenPosnEmpty [a]+  iife :: [JSStatement] -> String -> JSExpression -> JSStatement+  iife body param arg =+    JSMethodCall (JSExpressionParen lf (JSFunctionExpression JSNoAnnot JSIdentNone JSNoAnnot (JSLOne (JSIdentName JSNoAnnot param)) JSNoAnnot+                                                             (JSBlock sp (prependWhitespace "\n  " body) lf))+                                    JSNoAnnot)+                 JSNoAnnot+                 (JSLOne arg)+                 JSNoAnnot+                 (JSSemi JSNoAnnot)++  wrap :: ModuleIdentifier -> [JSStatement] -> [JSStatement]+  wrap (ModuleIdentifier mn mtype) ds =+    case mtype of+      Regular -> [iife (addModuleExports ds) "$PS" (JSIdentifier JSNoAnnot optionsNamespace)]+      Foreign -> [iife ds "exports" (initializeObject JSNoAnnot moduleReference mn)]+    where+      -- Insert the exports var after a directive prologue, if one is present.+      -- Per ECMA-262 5.1, "A Directive Prologue is the longest sequence of+      -- ExpressionStatement productions [...] where each ExpressionStatement+      -- [...] consists entirely of a StringLiteral [...]."+      -- (http://ecma-international.org/ecma-262/5.1/#sec-14.1)+      addModuleExports :: [JSStatement] -> [JSStatement]+      addModuleExports (x:xs) | isDirective x = x : addModuleExports xs+      addModuleExports xs+        = JSExpressionStatement (initializeObject lfsp innerModuleReference mn) (JSSemi JSNoAnnot)+        : JSVariable lfsp (JSLOne $ JSVarInitExpression (JSIdentifier sp "exports") $ JSVarInit sp (innerModuleReference sp mn)) (JSSemi JSNoAnnot)+        : xs++      isDirective (JSExpressionStatement (JSStringLiteral _ _) _) = True+      isDirective _ = False    runMain :: String -> [JSStatement]   runMain mn =

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

@@ -18,6 +18,7 @@ import Data.List ((\\), intersect) import qualified Data.Foldable as F import qualified Data.Map as M+import qualified Data.Set as S import Data.Maybe (fromMaybe, isNothing) import Data.String (fromString) import Data.Text (Text)@@ -53,11 +54,14 @@   rethrow (addHint (ErrorInModule mn)) $ do     let usedNames = concatMap getNames decls     let mnLookup = renameImports usedNames imps-    jsImports <- traverse (importToJs mnLookup)-      . (\\ (mn : C.primModules)) $ ordNub $ map snd imps     let decls' = renameModules mnLookup decls     jsDecls <- mapM bindToJs decls'     optimized <- traverse (traverse optimize) jsDecls+    let mnReverseLookup = M.fromList $ map (\(origName, (_, safeName)) -> (moduleNameToJs safeName, origName)) $ M.toList mnLookup+    let usedModuleNames = foldMap (foldMap (findModules mnReverseLookup)) optimized+    jsImports <- traverse (importToJs mnLookup)+      . filter (flip S.member usedModuleNames)+      . (\\ (mn : C.primModules)) $ ordNub $ map snd imps     F.traverse_ (F.traverse_ checkIntegers) optimized     comments <- not <$> asks optionsNoComments     let strict = AST.StringLiteral Nothing "use strict"@@ -125,6 +129,15 @@       let (_,mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup       in Qualified (Just mnSafe) a     renameQual q = q++  -- |+  -- Find the set of ModuleNames referenced by an AST.+  --+  findModules :: M.Map Text ModuleName -> AST -> S.Set ModuleName+  findModules mnReverseLookup = AST.everything mappend go+    where+    go (AST.Var _ name) = foldMap S.singleton $ M.lookup name mnReverseLookup+    go _ = mempty    -- |   -- Generate code in the simplified JavaScript intermediate representation for a declaration

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

@@ -122,9 +122,10 @@   Just (Right (mkDeclaration sa title info) { declChildren = children })   where   info = DataDeclaration dtype (fmap (fmap (fmap ($> ()))) args)-  children = map convertCtor (fmap (fmap (fmap ($> ()))) ctors)+  children = map convertCtor ctors+  convertCtor :: (P.ProperName 'P.ConstructorName, [(P.Ident, P.SourceType)]) -> ChildDeclaration   convertCtor (ctor', tys) =-    ChildDeclaration (P.runProperName ctor') Nothing Nothing (ChildDataConstructor tys)+    ChildDeclaration (P.runProperName ctor') Nothing Nothing (ChildDataConstructor (fmap (($> ()) . snd) tys)) convertDeclaration (P.ExternDataDeclaration sa _ kind') title =   basicDeclaration sa title (ExternDataDeclaration (kind' $> ())) convertDeclaration (P.ExternKindDeclaration sa _) title =

src/Language/PureScript/Docs/RenderedCode/RenderType.hs view

@@ -35,18 +35,16 @@     Just $ maybe (syntax "_") (syntax . ("?" <>)) name   match (PPTypeVar var) =     Just (typeVar var)-  match (PPRecord row) =+  match (PPRecord labels tail_) =     Just $ mintersperse sp               [ syntax "{"-              , renderRow row+              , renderRow labels tail_               , syntax "}"               ]   match (PPTypeConstructor n) =     Just (typeCtor n)-  match PPREmpty =-    Just (syntax "()")-  match row@PPRCons{} =-    Just (syntax "(" <> renderRow row <> syntax ")")+  match (PPRow labels tail_) =+    Just (syntax "(" <> renderRow labels tail_ <> syntax ")")   match (PPBinaryNoParensType op l r) =     Just $ renderTypeAtom' l <> sp <> renderTypeAtom' op <> sp <> renderTypeAtom' r   match (PPTypeOp n) =@@ -72,13 +70,8 @@ -- | -- Render code representing a Row ---renderRow :: PrettyPrintType -> RenderedCode-renderRow = uncurry renderRow' . go []-  where-  renderRow' h t = renderHead h <> renderTail t--  go ts (PPRCons l t r) = go ((l, t) : ts) r-  go ts t = (reverse ts, t)+renderRow :: [(Label, PrettyPrintType)] -> Maybe PrettyPrintType -> RenderedCode+renderRow h t = renderHead h <> renderTail t  renderHead :: [(Label, PrettyPrintType)] -> RenderedCode renderHead = mintersperse (syntax "," <> sp) . map renderLabel@@ -91,9 +84,9 @@     , renderType' ty     ] -renderTail :: PrettyPrintType -> RenderedCode-renderTail PPREmpty = mempty-renderTail other = sp <> syntax "|" <> sp <> renderType' other+renderTail :: Maybe PrettyPrintType -> RenderedCode+renderTail Nothing = mempty+renderTail (Just other) = sp <> syntax "|" <> sp <> renderType' other  typeApp :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType) typeApp = mkPattern match@@ -153,7 +146,7 @@ -- Render code representing a Type -- renderType :: Type a -> RenderedCode-renderType = renderType' . convertPrettyPrintType+renderType = renderType' . convertPrettyPrintType maxBound  renderType' :: PrettyPrintType -> RenderedCode renderType'@@ -164,7 +157,7 @@ -- Render code representing a Type, as it should appear inside parentheses -- renderTypeAtom :: Type a -> RenderedCode-renderTypeAtom = renderTypeAtom' . convertPrettyPrintType+renderTypeAtom = renderTypeAtom' . convertPrettyPrintType maxBound  renderTypeAtom' :: PrettyPrintType -> RenderedCode renderTypeAtom'

src/Language/PureScript/Errors.hs view

@@ -110,6 +110,7 @@   InvalidDoLet -> "InvalidDoLet"   CycleInDeclaration{} -> "CycleInDeclaration"   CycleInTypeSynonym{} -> "CycleInTypeSynonym"+  CycleInTypeClassDeclaration{} -> "CycleInTypeClassDeclaration"   CycleInModules{} -> "CycleInModules"   NameIsUndefined{} -> "NameIsUndefined"   UndefinedTypeVariable{} -> "UndefinedTypeVariable"@@ -508,7 +509,7 @@       line "The same name was used more than once in a let binding."     renderSimpleErrorMessage (InfiniteType ty) =       paras [ line "An infinite type was inferred for an expression: "-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             ]     renderSimpleErrorMessage (InfiniteKind ki) =       paras [ line "An infinite kind was inferred for a type: "@@ -574,6 +575,13 @@             , line "Cycles are disallowed because they can lead to loops in the type checker."             , line "Consider using a 'newtype' instead."             ]+    renderSimpleErrorMessage (CycleInTypeClassDeclaration [name]) =+      paras [ line $ "A type class '" <> markCode (runProperName name) <> "' may not have itself as a superclass." ]+    renderSimpleErrorMessage (CycleInTypeClassDeclaration names) =+      paras [ line $ "A cycle appears in a set of type class definitions:"+            , indent $ line $ "{" <> (T.intercalate ", " (map (markCode . runProperName) names)) <> "}"+            , line "Cycles are disallowed because they can lead to loops in the type checker."+            ]       renderSimpleErrorMessage (NameIsUndefined ident) =       line $ "Value " <> markCode (showIdent ident) <> " is undefined."     renderSimpleErrorMessage (UndefinedTypeVariable name) =@@ -584,13 +592,13 @@             ]     renderSimpleErrorMessage (EscapedSkolem name Nothing ty) =       paras [ line $ "The type variable " <> markCode name <> " has escaped its scope, appearing in the type"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             ]     renderSimpleErrorMessage (EscapedSkolem name (Just srcSpan) ty) =       paras [ line $ "The type variable " <> markCode name <> ", bound at"             , indent $ line $ displaySourceSpan relPath srcSpan             , line "has escaped its scope, appearing in the type"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             ]     renderSimpleErrorMessage (TypesDoNotUnify u1 u2)       = let (sorted1, sorted2) = sortRows u1 u2@@ -610,9 +618,9 @@                      , rowFromList (sort' unique2 ++ sort' common2, r2)                      )         in paras [ line "Could not match type"-                 , markCodeBox $ indent $ typeAsBox sorted1+                 , markCodeBox $ indent $ typeAsBox prettyDepth sorted1                  , line "with type"-                 , markCodeBox $ indent $ typeAsBox sorted2+                 , markCodeBox $ indent $ typeAsBox prettyDepth sorted2                  ]      renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =@@ -623,16 +631,16 @@             ]     renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =       paras [ line "Could not match constrained type"-            , markCodeBox $ indent $ typeAsBox t1+            , markCodeBox $ indent $ typeAsBox prettyDepth t1             , line "with type"-            , markCodeBox $ indent $ typeAsBox t2+            , markCodeBox $ indent $ typeAsBox prettyDepth t2             ]     renderSimpleErrorMessage (OverlappingInstances _ _ []) = internalError "OverlappingInstances: empty instance list"     renderSimpleErrorMessage (OverlappingInstances nm ts ds) =       paras [ line "Overlapping type class instances found for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , line "The following instances were found:"             , indent $ paras (map (line . showQualified showIdent) ds)@@ -659,7 +667,7 @@             ]     renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Discard [ty] _)) =       paras [ line "A result of type"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             , line "was implicitly discarded in a do notation block."             , line ("You can use " <> markCode "_ <- ..." <> " to explicitly discard the result.")             ]@@ -667,7 +675,7 @@       paras [ line "No type class instance was found for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."                     | any containsUnknowns ts@@ -681,14 +689,14 @@         go _ = False     renderSimpleErrorMessage (AmbiguousTypeVariables t _) =       paras [ line "The inferred type"-            , markCodeBox $ indent $ typeAsBox t+            , markCodeBox $ indent $ typeAsBox prettyDepth t             , line "has type variables which are not mentioned in the body of the type. Consider adding a type annotation."             ]     renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =       paras [ line "Type class instance for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , line "is possibly infinite."             ]@@ -696,7 +704,7 @@       paras [ line "Cannot derive a type class instance for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , line "since instances of this type class are not derivable."             ]@@ -704,7 +712,7 @@       paras [ line "Cannot derive newtype instance for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , line "Make sure this is a newtype."             ]@@ -712,7 +720,7 @@       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)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , line $ "does not include a derived superclass instance for " <> markCode (showQualified runProperName su) <> "."             ]@@ -720,7 +728,7 @@       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)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , line $ "implies an superclass instance for " <> markCode (showQualified runProperName su) <> " which could not be verified."             ]@@ -728,7 +736,7 @@       paras [ line "Cannot derive the type class instance"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , line $ fold $                 [ "because the "@@ -744,10 +752,10 @@       paras [ line "Cannot derive the type class instance"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , "because the type"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             , line "is not of the required form T a_1 ... a_n, where T is a type constructor defined in the same module."             ]     renderSimpleErrorMessage (CannotFindDerivingType nm) =@@ -755,7 +763,7 @@     renderSimpleErrorMessage (DuplicateLabel l expr) =       paras $ [ line $ "Label " <> markCode (prettyPrintLabel l) <> " appears more than once in a row type." ]                        <> foldMap (\expr' -> [ line "Relevant expression: "-                                             , markCodeBox $ indent $ prettyPrintValue valueDepth expr'+                                             , markCodeBox $ indent $ prettyPrintValue prettyDepth expr'                                              ]) expr     renderSimpleErrorMessage (DuplicateTypeArgument name) =       line $ "Type argument " <> markCode name <> " appears more than once."@@ -768,7 +776,7 @@     renderSimpleErrorMessage (MissingClassMember identsAndTypes) =       paras $ [ line "The following type class members have not been implemented:"               , Box.vcat Box.left-                [ markCodeBox $ Box.text (T.unpack (showIdent ident)) Box.<> " :: " Box.<> typeAsBox ty+                [ markCodeBox $ Box.text (T.unpack (showIdent ident)) Box.<> " :: " Box.<> typeAsBox prettyDepth ty                 | (ident, ty) <- NEL.toList identsAndTypes ]               ]     renderSimpleErrorMessage (ExtraneousClassMember ident className) =@@ -776,7 +784,7 @@     renderSimpleErrorMessage (ExpectedType ty kind) =       paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode (prettyPrintKind kindType) <> "."             , line "The error arises from the type"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             , line "having the kind"             , indent $ line $ markCode $ prettyPrintKind kind             , line "instead."@@ -787,9 +795,9 @@             ]     renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =       paras [ line "Expression"-            , markCodeBox $ indent $ prettyPrintValue valueDepth expr+            , markCodeBox $ indent $ prettyPrintValue prettyDepth expr             , line "does not have type"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             ]     renderSimpleErrorMessage (PropertyIsMissing prop) =       line $ "Type of expression lacks required label " <> markCode (prettyPrintLabel prop) <> "."@@ -801,7 +809,7 @@       paras [ line $ "Orphan instance " <> markCode (showIdent nm) <> " found for "             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName cnm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             , Box.vcat Box.left $ case modulesToList of                 [] -> [ line "There is nowhere this instance can be placed without being an orphan."@@ -821,7 +829,7 @@             ]     renderSimpleErrorMessage (InvalidInstanceHead ty) =       paras [ line "Type class instance head is invalid due to use of type"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             , line "All types appearing in instance declarations must be of the form T a_1 .. a_n, where each type a_i is of the same form, unless the type is fully determined by other type class arguments via functional dependencies."             ]     renderSimpleErrorMessage (TransitiveExportError x ys) =@@ -846,7 +854,7 @@             ]     renderSimpleErrorMessage (WildcardInferredType ty ctx) =       paras $ [ line "Wildcard type definition has the inferred type "-              , markCodeBox $ indent $ typeAsBox ty+              , markCodeBox $ indent $ typeAsBox prettyDepth ty               ] <> renderContext ctx     renderSimpleErrorMessage (HoleInferredType name ty ctx ts) =       let@@ -858,7 +866,7 @@                 let                   idBoxes = Box.text . T.unpack . showQualified id <$> names                   tyBoxes = (\t -> BoxHelpers.indented-                              (Box.text ":: " Box.<> typeAsBox t)) <$> types+                              (Box.text ":: " Box.<> typeAsBox prettyDepth t)) <$> types                   longestId = maximum (map Box.cols idBoxes)                 in                   Box.vcat Box.top $@@ -871,13 +879,13 @@           _ -> []       in         paras $ [ line $ "Hole '" <> markCode name <> "' has the inferred type "-                , markCodeBox (indent (typeAsBox ty))+                , markCodeBox (indent (typeAsBox maxBound ty))                 ] ++ tsResult ++ renderContext ctx     renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =       paras [ line $ "No type declaration was provided for the top-level declaration of " <> markCode (showIdent ident) <> "."             , line "It is good practice to provide type declarations as a form of documentation."             , line $ "The inferred type of " <> markCode (showIdent ident) <> " was:"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             ]     renderSimpleErrorMessage (OverlappingPattern bs b) =       paras $ [ line "A case expression contains unreachable cases:\n"@@ -964,7 +972,7 @@     renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =       paras [ line $ "Unable to generalize the type of the recursive function " <> markCode (showIdent ident) <> "."             , line $ "The inferred type of " <> markCode (showIdent ident) <> " was:"-            , markCodeBox $ indent $ typeAsBox ty+            , markCodeBox $ indent $ typeAsBox prettyDepth ty             , line "Try adding a type signature."             ] @@ -990,7 +998,7 @@           argsMsg = if expected > 1 then "arguments" else "argument"      renderSimpleErrorMessage (UserDefinedWarning msgTy) =-      let msg = fromMaybe (typeAsBox msgTy) (toTypelevelString msgTy) in+      let msg = fromMaybe (typeAsBox prettyDepth msgTy) (toTypelevelString msgTy) in       paras [ line "A custom warning occurred while solving type class constraints:"             , indent msg             ]@@ -1042,16 +1050,16 @@     renderHint (ErrorUnifyingTypes t1 t2) detail =       paras [ detail             , Box.hsep 1 Box.top [ line "while trying to match type"-                                 , markCodeBox $ typeAsBox t1+                                 , markCodeBox $ typeAsBox prettyDepth t1                                  ]             , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "with type"-                                                   , markCodeBox $ typeAsBox t2+                                                   , markCodeBox $ typeAsBox prettyDepth t2                                                    ]             ]     renderHint (ErrorInExpression expr) detail =       paras [ detail             , Box.hsep 1 Box.top [ Box.text "in the expression"-                                 , markCodeBox $ markCodeBox $ prettyPrintValue valueDepth expr+                                 , markCodeBox $ markCodeBox $ prettyPrintValue prettyDepth expr                                  ]             ]     renderHint (ErrorInModule mn) detail =@@ -1061,10 +1069,10 @@     renderHint (ErrorInSubsumption t1 t2) detail =       paras [ detail             , Box.hsep 1 Box.top [ line "while checking that type"-                                 , markCodeBox $ typeAsBox t1+                                 , markCodeBox $ typeAsBox prettyDepth t1                                  ]             , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "is at least as general as type"-                                                   , markCodeBox $ typeAsBox t2+                                                   , markCodeBox $ typeAsBox prettyDepth t2                                                    ]             ]     renderHint (ErrorInInstance nm ts) detail =@@ -1072,13 +1080,13 @@             , line "in type class instance"             , markCodeBox $ indent $ Box.hsep 1 Box.top                [ line $ showQualified runProperName nm-               , Box.vcat Box.left (map typeAtomAsBox ts)+               , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                ]             ]     renderHint (ErrorCheckingKind ty) detail =       paras [ detail             , Box.hsep 1 Box.top [ line "while checking the kind of"-                                 , markCodeBox $ typeAsBox ty+                                 , markCodeBox $ typeAsBox prettyDepth ty                                  ]             ]     renderHint ErrorCheckingGuard detail =@@ -1088,34 +1096,34 @@     renderHint (ErrorInferringType expr) detail =       paras [ detail             , Box.hsep 1 Box.top [ line "while inferring the type of"-                                 , markCodeBox $ prettyPrintValue valueDepth expr+                                 , markCodeBox $ prettyPrintValue prettyDepth expr                                  ]             ]     renderHint (ErrorCheckingType expr ty) detail =       paras [ detail             , Box.hsep 1 Box.top [ line "while checking that expression"-                                 , markCodeBox $ prettyPrintValue valueDepth expr+                                 , markCodeBox $ prettyPrintValue prettyDepth expr                                  ]             , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has type"-                                                   , markCodeBox $ typeAsBox ty+                                                   , markCodeBox $ typeAsBox prettyDepth ty                                                    ]             ]     renderHint (ErrorCheckingAccessor expr prop) detail =       paras [ detail             , Box.hsep 1 Box.top [ line "while checking type of property accessor"-                                 , markCodeBox $ prettyPrintValue valueDepth (Accessor prop expr)+                                 , markCodeBox $ prettyPrintValue prettyDepth (Accessor prop expr)                                  ]             ]     renderHint (ErrorInApplication f t a) detail =       paras [ detail             , Box.hsep 1 Box.top [ line "while applying a function"-                                 , markCodeBox $ prettyPrintValue valueDepth f+                                 , markCodeBox $ prettyPrintValue prettyDepth f                                  ]             , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "of type"-                                                   , markCodeBox $ typeAsBox t+                                                   , markCodeBox $ typeAsBox prettyDepth t                                                    ]             , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "to argument"-                                                   , markCodeBox $ prettyPrintValue valueDepth a+                                                   , markCodeBox $ prettyPrintValue prettyDepth a                                                    ]             ]     renderHint (ErrorInDataConstructor nm) detail =@@ -1159,7 +1167,7 @@             , line "while solving type class constraint"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map typeAtomAsBox ts)+                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             ]     renderHint (PositionedError srcSpan) detail =@@ -1173,7 +1181,7 @@       [ line "in the following context:"       , indent $ paras           [ Box.hcat Box.left [ Box.text (T.unpack (showIdent ident) ++ " :: ")-                              , markCodeBox $ typeAsBox ty'+                              , markCodeBox $ typeAsBox prettyDepth ty'                               ]           | (ident, ty') <- take 5 ctx           ]@@ -1212,9 +1220,9 @@     runName (Qualified _ ModName{}) =       internalError "qualified ModName in runName" -  valueDepth :: Int-  valueDepth | full = 1000-             | otherwise = 3+  prettyDepth :: Int+  prettyDepth | full = 1000+              | otherwise = 3    levelText :: Text   levelText = case level of@@ -1420,7 +1428,7 @@ toTypelevelString (TypeApp _ (TypeConstructor _ f) x)   | f == primSubName C.typeError "Text" = toTypelevelString x toTypelevelString (TypeApp _ (TypeConstructor _ f) x)-  | f == primSubName C.typeError "Quote" = Just (typeAsBox x)+  | f == primSubName C.typeError "Quote" = Just (typeAsBox maxBound x) toTypelevelString (TypeApp _ (TypeConstructor _ f) (TypeLevelString _ x))   | f == primSubName C.typeError "QuoteLabel" = Just . line . prettyPrintLabel . Label $ x toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ f) x) ret)

src/Language/PureScript/Ide.hs view

@@ -62,7 +62,9 @@     findType search filters currentModule   Complete filters matcher currentModule complOptions ->     findCompletions filters matcher currentModule complOptions-  List LoadedModules ->+  List LoadedModules -> do+    logWarnN+      "Listing the loaded modules command is DEPRECATED, use the completion command and filter it to modules instead"     printModules   List AvailableModules ->     listAvailableModules@@ -113,8 +115,8 @@   -> CompletionOptions   -> m Success findCompletions filters matcher currentModule complOptions = do-  modules <- Map.toList <$> getAllModules currentModule-  let insertPrim = (++) idePrimDeclarations+  modules <- getAllModules currentModule+  let insertPrim = Map.union idePrimDeclarations   pure (CompletionResult (getCompletions filters matcher complOptions (insertPrim modules)))  findType@@ -124,8 +126,8 @@   -> Maybe P.ModuleName   -> m Success findType search filters currentModule = do-  modules <- Map.toList <$> getAllModules currentModule-  let insertPrim = (++) idePrimDeclarations+  modules <- getAllModules currentModule+  let insertPrim = Map.union idePrimDeclarations   pure (CompletionResult (getExactCompletions search filters (insertPrim modules)))  printModules :: Ide m => m Success

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

@@ -45,18 +45,24 @@ noAnnotations :: WildcardAnnotations noAnnotations = WildcardAnnotations False -caseSplit :: (Ide m, MonadError IdeError m) =>-             Text -> m [Constructor]+type DataType = ([(Text, Maybe P.SourceKind)], [(P.ProperName 'P.ConstructorName, [P.SourceType])])++caseSplit+  :: (Ide m, MonadError IdeError m)+  => Text+  -> m [Constructor] caseSplit q = do   type' <- parseType' q   (tc, args) <- splitTypeConstructor type'-  (EDType _ _ (P.DataType typeVars ctors)) <- findTypeDeclaration tc+  (typeVars, ctors) <- findTypeDeclaration tc   let applyTypeVars = P.everywhereOnTypes (P.replaceAllTypeVars (zip (map fst typeVars) args))   let appliedCtors = map (second (map applyTypeVars)) ctors   pure appliedCtors -findTypeDeclaration :: (Ide m, MonadError IdeError m) =>-                         P.ProperName 'P.TypeName -> m ExternsDeclaration+findTypeDeclaration+  :: (Ide m, MonadError IdeError m)+  => P.ProperName 'P.TypeName+  -> m DataType findTypeDeclaration q = do   efs <- getExternFiles   efs' <- maybe efs (flip (uncurry M.insert) efs) <$> cachedRebuild@@ -65,14 +71,15 @@     Just mn -> pure mn     Nothing -> throwError (GeneralError "Not Found") -findTypeDeclaration' ::-  P.ProperName 'P.TypeName+findTypeDeclaration'+  :: P.ProperName 'P.TypeName   -> ExternsFile-  -> First ExternsDeclaration+  -> First DataType findTypeDeclaration' t ExternsFile{..} =-  First $ find (\case-            EDType tn _ _ -> tn == t-            _ -> False) efDeclarations+  First $ head $ mapMaybe (\case+            EDType tn _ (P.DataType typeVars ctors)+              | tn == t -> Just (typeVars, ctors)+            _ -> Nothing) efDeclarations  splitTypeConstructor :: (MonadError IdeError m) =>                         P.Type a -> m (P.ProperName 'P.TypeName, [P.Type a])@@ -93,7 +100,7 @@ prettyPrintWildcard (WildcardAnnotations False) = const "_"  prettyWildcard :: P.Type a -> Text-prettyWildcard t = "( _ :: " <> T.strip (T.pack (P.prettyPrintTypeAtom t)) <> ")"+prettyWildcard t = "( _ :: " <> T.strip (T.pack (P.prettyPrintTypeAtom maxBound t)) <> ")"  -- | Constructs Patterns to insert into a sourcefile makePattern :: Text -- ^ Current line

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

@@ -22,15 +22,13 @@ import           Language.PureScript.Ide.Util import           Lens.Micro.Platform hiding ((&)) -type Module = (P.ModuleName, [IdeDeclarationAnn])- -- | Applies the CompletionFilters and the Matcher to the given Modules --   and sorts the found Completions according to the Matching Score getCompletions   :: [Filter]   -> Matcher IdeDeclarationAnn   -> CompletionOptions-  -> [Module]+  -> ModuleMap [IdeDeclarationAnn]   -> [Completion] getCompletions filters matcher options modules =   modules@@ -40,23 +38,23 @@   & applyCompletionOptions options   <&> completionFromMatch -getExactMatches :: Text -> [Filter] -> [Module] -> [Match IdeDeclarationAnn]+getExactMatches :: Text -> [Filter] -> ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn] getExactMatches search filters modules =   modules-  & applyFilters (equalityFilter search : filters)+  & applyFilters (exactFilter search : filters)   & matchesFromModules -getExactCompletions :: Text -> [Filter] -> [Module] -> [Completion]+getExactCompletions :: Text -> [Filter] -> ModuleMap [IdeDeclarationAnn] -> [Completion] getExactCompletions search filters modules =   modules   & getExactMatches search filters   <&> simpleExport   <&> completionFromMatch -matchesFromModules :: [Module] -> [Match IdeDeclarationAnn]-matchesFromModules = foldMap completionFromModule+matchesFromModules :: ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn]+matchesFromModules = Map.foldMapWithKey completionFromModule   where-    completionFromModule (moduleName, decls) =+    completionFromModule moduleName decls =       map (\x -> Match (moduleName, x)) decls  data CompletionOptions = CompletionOptions@@ -121,6 +119,7 @@       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")+      IdeDeclModule mn -> (P.runModuleName mn, "module")      complExportedFrom = mns

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

@@ -83,4 +83,4 @@ textError (RebuildError err)          = show err  prettyPrintTypeSingleLine :: P.Type a -> Text-prettyPrintTypeSingleLine = T.unwords . map T.strip . T.lines . T.pack . P.prettyPrintTypeWithUnicode+prettyPrintTypeSingleLine = T.unwords . map T.strip . T.lines . T.pack . P.prettyPrintTypeWithUnicode maxBound

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

@@ -61,12 +61,13 @@ convertExterns ef =   (decls, exportDecls)   where-    decls = map+    decls = moduleDecl : map       (IdeDeclarationAnn emptyAnn)       (resolvedDeclarations <> operatorDecls <> tyOperatorDecls)     exportDecls = mapMaybe convertExport (P.efExports ef)     operatorDecls = convertOperator <$> P.efFixities ef     tyOperatorDecls = convertTypeOperator <$> P.efTypeFixities ef+    moduleDecl = IdeDeclarationAnn emptyAnn (IdeDeclModule (P.efModuleName ef))     (toResolve, declarations) =       second catMaybes (partitionEithers (map convertDecl (P.efDeclarations ef)))

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

@@ -16,111 +16,129 @@  module Language.PureScript.Ide.Filter        ( Filter-       , declarationTypeFilter-       , namespaceFilter        , moduleFilter+       , namespaceFilter+       , exactFilter        , prefixFilter-       , equalityFilter+       , declarationTypeFilter        , applyFilters        ) where -import           Protolude                     hiding (isPrefixOf)+import           Protolude                     hiding (isPrefixOf, Prefix) +import           Data.Bifunctor (first) import           Data.Aeson-import           Data.List.NonEmpty            (NonEmpty) import           Data.Text                     (isPrefixOf)-import qualified Language.PureScript.Ide.Filter.Declaration as D+import qualified Data.Set as Set+import qualified Data.Map as Map+import           Language.PureScript.Ide.Filter.Declaration (DeclarationType, declarationType) import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util import qualified Language.PureScript           as P -newtype Filter = Filter (Endo [Module])-  deriving (Semigroup, Monoid)+newtype Filter = Filter (Either (Set P.ModuleName) DeclarationFilter)+  deriving Show -type Module = (P.ModuleName, [IdeDeclarationAnn])+unFilter :: Filter -> Either (Set P.ModuleName) DeclarationFilter+unFilter (Filter f) = f -mkFilter :: ([Module] -> [Module]) -> Filter-mkFilter = Filter . Endo+data DeclarationFilter+  = Prefix Text+  | Exact Text+  | Namespace (Set IdeNamespace)+  | DeclType (Set DeclarationType)+  deriving Show --- | 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 Declarations in the given modules+moduleFilter :: Set P.ModuleName -> Filter+moduleFilter = Filter . Left --- | Only keeps the given Modules-moduleFilter :: [P.ModuleName] -> Filter-moduleFilter =-    mkFilter . moduleFilter'+-- | Only keeps Identifiers in the given Namespaces+namespaceFilter :: Set IdeNamespace -> Filter+namespaceFilter nss = Filter (Right (Namespace nss)) -moduleFilter' :: [P.ModuleName] -> [Module] -> [Module]-moduleFilter' moduleIdents = filter (flip elem moduleIdents . fst)+-- | Only keeps Identifiers that are equal to the search string+exactFilter :: Text -> Filter+exactFilter t = Filter (Right (Exact t))  -- | Only keeps Identifiers that start with the given prefix prefixFilter :: Text -> Filter-prefixFilter "" = mkFilter identity-prefixFilter t =-  mkFilter $ declarationFilter prefix t-  where-    prefix :: IdeDeclaration -> Text -> Bool-    prefix ed search = search `isPrefixOf` identifierFromIdeDeclaration ed+prefixFilter t = Filter (Right (Prefix t)) --- | Only keeps Identifiers that are equal to the search string-equalityFilter :: Text -> Filter-equalityFilter =-  mkFilter . declarationFilter equality+-- | Only keeps Identifiers in the given type declarations+declarationTypeFilter :: Set DeclarationType -> Filter+declarationTypeFilter dts = Filter (Right (DeclType dts))++optimizeFilters :: [Filter] -> (Maybe (Set P.ModuleName), [DeclarationFilter])+optimizeFilters = first smashModuleFilters . partitionEithers . map unFilter   where-    equality :: IdeDeclaration -> Text -> Bool-    equality ed search = identifierFromIdeDeclaration ed == search+    smashModuleFilters [] =+      Nothing+    smashModuleFilters (x:xs) =+      Just (foldr Set.intersection x xs) -declarationFilter :: (IdeDeclaration -> Text -> Bool) -> Text -> [Module] -> [Module]-declarationFilter predicate search =-  filterModuleDecls (flip predicate search)+applyFilters :: [Filter] -> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]+applyFilters fs modules = case optimizeFilters fs of+  (Nothing, declarationFilters) ->+    applyDeclarationFilters declarationFilters modules+  (Just moduleFilter', declarationFilters) ->+    applyDeclarationFilters declarationFilters (Map.restrictKeys modules moduleFilter') --- | Only keeps Identifiers in the given type declarations-declarationTypeFilter :: [D.IdeDeclaration] -> Filter-declarationTypeFilter [] = mkFilter identity-declarationTypeFilter decls =-    mkFilter $ filterModuleDecls filterDecls-    where-      filterDecls :: IdeDeclaration -> Bool-      filterDecls decl = D.typeDeclarationForDeclaration decl `elem` decls+applyDeclarationFilters+  :: [DeclarationFilter]+  -> ModuleMap [IdeDeclarationAnn]+  -> ModuleMap [IdeDeclarationAnn]+applyDeclarationFilters fs =+  Map.filter (not . null)+  . Map.map (foldr (.) identity (map applyDeclarationFilter fs)) -filterModuleDecls :: (IdeDeclaration -> Bool) -> [Module] -> [Module]-filterModuleDecls predicate =-  filter (not . null . snd) . fmap filterDecls-  where-    filterDecls (moduleIdent, decls) = (moduleIdent, filter (predicate . discardAnn) decls)+applyDeclarationFilter+  :: DeclarationFilter+  -> [IdeDeclarationAnn]+  -> [IdeDeclarationAnn]+applyDeclarationFilter f = case f of+  Prefix prefix -> prefixFilter' prefix+  Exact t -> exactFilter' t+  Namespace namespaces -> namespaceFilter' namespaces+  DeclType dts -> declarationTypeFilter' dts -runFilter :: Filter -> [Module] -> [Module]-runFilter (Filter f) = appEndo f+namespaceFilter' :: Set IdeNamespace -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]+namespaceFilter' namespaces =+  filter (\decl -> elem (namespaceForDeclaration (discardAnn decl)) namespaces) -applyFilters :: [Filter] -> [Module] -> [Module]-applyFilters = runFilter . fold+exactFilter' :: Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]+exactFilter' search =+  filter (\decl -> identifierFromIdeDeclaration (discardAnn decl) == search) +prefixFilter' :: Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]+prefixFilter' prefix =+  filter (\decl -> prefix `isPrefixOf` identifierFromIdeDeclaration (discardAnn decl))++declarationTypeFilter' :: Set DeclarationType -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]+declarationTypeFilter' declTypes =+  filter (\decl -> declarationType (discardAnn decl) `Set.member` declTypes)+ instance FromJSON Filter where   parseJSON = withObject "filter" $ \o -> do     (filter' :: Text) <- o .: "filter"     case filter' of+      "modules" -> do+        params <- o .: "params"+        modules <- map P.moduleNameFromString <$> params .: "modules"+        pure (moduleFilter (Set.fromList modules))       "exact" -> do         params <- o .: "params"         search <- params .: "search"-        return $ equalityFilter search+        pure (exactFilter search)       "prefix" -> do         params <- o.: "params"         search <- params .: "search"-        return $ prefixFilter search-      "modules" -> do-        params <- o .: "params"-        modules <- map P.moduleNameFromString <$> params .: "modules"-        return $ moduleFilter modules+        pure (prefixFilter search)       "namespace" -> do         params <- o .: "params"         namespaces <- params .: "namespaces"-        return $ namespaceFilter namespaces+        pure (namespaceFilter (Set.fromList namespaces))       "declarations" -> do         declarations <- o.: "params"-        return $ declarationTypeFilter declarations+        pure (declarationTypeFilter (Set.fromList declarations))       _ -> mzero

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

@@ -1,9 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Language.PureScript.Ide.Filter.Declaration-       ( IdeDeclaration(..)-       , DeclarationType(..)-       , typeDeclarationForDeclaration+       ( DeclarationType(..)+       , declarationType        ) where  import           Protolude                     hiding (isPrefixOf)@@ -11,7 +10,8 @@ import           Data.Aeson import qualified Language.PureScript.Ide.Types as PI -data DeclarationType = Value+data DeclarationType+  = Value   | Type   | Synonym   | DataConstructor@@ -19,6 +19,7 @@   | ValueOperator   | TypeOperator   | Kind+  | Module   deriving (Show, Eq, Ord)  instance FromJSON DeclarationType where@@ -32,24 +33,17 @@       "valueoperator"     -> pure ValueOperator       "typeoperator"      -> pure TypeOperator       "kind"              -> pure Kind+      "module"            -> pure Module       _                   -> mzero -newtype IdeDeclaration = IdeDeclaration-  { declarationtype :: DeclarationType-  } deriving (Show, Eq, Ord)--instance FromJSON IdeDeclaration where-  parseJSON (Object o) =-    IdeDeclaration <$> o .: "declarationtype"-  parseJSON _ = mzero--typeDeclarationForDeclaration :: PI.IdeDeclaration -> IdeDeclaration-typeDeclarationForDeclaration decl = case decl of-  PI.IdeDeclValue _ -> IdeDeclaration Value-  PI.IdeDeclType _ -> IdeDeclaration Type-  PI.IdeDeclTypeSynonym _ -> IdeDeclaration Synonym-  PI.IdeDeclDataConstructor _ -> IdeDeclaration DataConstructor-  PI.IdeDeclTypeClass _ -> IdeDeclaration TypeClass-  PI.IdeDeclValueOperator _ -> IdeDeclaration ValueOperator-  PI.IdeDeclTypeOperator _ -> IdeDeclaration TypeOperator-  PI.IdeDeclKind _ -> IdeDeclaration Kind+declarationType :: PI.IdeDeclaration -> DeclarationType+declarationType decl = case decl of+  PI.IdeDeclValue _ -> Value+  PI.IdeDeclType _ -> Type+  PI.IdeDeclTypeSynonym _ -> Synonym+  PI.IdeDeclDataConstructor _ -> DataConstructor+  PI.IdeDeclTypeClass _ -> TypeClass+  PI.IdeDeclValueOperator _ -> ValueOperator+  PI.IdeDeclTypeOperator _ -> TypeOperator+  PI.IdeDeclKind _ -> Kind+  PI.IdeDeclModule _ -> Module

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

@@ -44,7 +44,7 @@ import           Language.PureScript.Ide.Prim import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           Lens.Micro.Platform                ((^.), (%~), ix)+import           Lens.Micro.Platform                ((^.), (%~), ix, has) import           System.IO.UTF8                     (writeUTF8FileT) import qualified Text.Parsec as Parsec @@ -194,12 +194,14 @@         not (any (\case           Import C.Prim (P.Explicit _) Nothing -> True           _ -> False) imports)+    -- We can't import Modules from other modules+    isModule = has _IdeDeclModule decl      matches (Import mn (P.Explicit _) qualifier') = mn == moduleName && qualifier == qualifier'     matches _ = False     freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) qualifier   in-    if isImplicitlyImported || isNotExplicitlyImportedFromPrim+    if isImplicitlyImported || isNotExplicitlyImportedFromPrim || isModule     then imports     else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports   where@@ -273,8 +275,8 @@   -> [Filter] -- ^ Filters to apply before searching for the identifier   -> m (Either [Match IdeDeclaration] [Text]) addImportForIdentifier fp ident qual filters = do-  let addPrim = (++) idePrimDeclarations-  modules <- Map.toList <$> getAllModules Nothing+  let addPrim = Map.union idePrimDeclarations+  modules <- getAllModules Nothing   case map (fmap discardAnn) (getExactMatches ident filters (addPrim modules)) of     [] ->       throwError (NotFound "Couldn't find the given identifier. \

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

@@ -8,8 +8,8 @@ import qualified Language.PureScript.Environment as PEnv import           Language.PureScript.Ide.Types -idePrimDeclarations :: [(P.ModuleName, [IdeDeclarationAnn])]-idePrimDeclarations =+idePrimDeclarations :: ModuleMap [IdeDeclarationAnn]+idePrimDeclarations = Map.fromList   [ ( C.Prim     , mconcat [primTypes, primKinds, primClasses]     )

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

@@ -59,8 +59,11 @@ extractAstInformation   :: P.Module   -> (DefinitionSites P.SourceSpan, TypeAnnotations)-extractAstInformation (P.Module _ _ _ decls _) =-  let definitions = Map.fromList (concatMap extractSpans decls)+extractAstInformation (P.Module moduleSpan _ mn decls _) =+  let definitions =+        Map.insert+          (IdeNamespaced IdeNSModule (P.runModuleName mn)) moduleSpan+          (Map.fromList (concatMap extractSpans decls))       typeAnnotations = Map.fromList (extractTypeAnnotations decls)   in (definitions, typeAnnotations)

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

@@ -224,7 +224,13 @@   map convertDeclaration decls   where     convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn-    convertDeclaration (IdeDeclarationAnn ann d) = convertDeclaration' annotateFunction annotateValue annotateType annotateKind d+    convertDeclaration (IdeDeclarationAnn ann d) = convertDeclaration'+      annotateFunction+      annotateValue+      annotateType+      annotateKind+      annotateModule+      d       where         annotateFunction x = IdeDeclarationAnn (ann { _annLocation = Map.lookup (IdeNamespaced IdeNSValue (P.runIdent x)) defs                                                     , _annTypeAnnotation = Map.lookup x types@@ -232,15 +238,17 @@         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})+        annotateModule x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSModule x) defs})  convertDeclaration'   :: (P.Ident -> IdeDeclaration -> IdeDeclarationAnn)   -> (Text -> IdeDeclaration -> IdeDeclarationAnn)   -> (Text -> IdeDeclaration -> IdeDeclarationAnn)   -> (Text -> IdeDeclaration -> IdeDeclarationAnn)+  -> (Text -> IdeDeclaration -> IdeDeclarationAnn)   -> IdeDeclaration   -> IdeDeclarationAnn-convertDeclaration' annotateFunction annotateValue annotateType annotateKind d =+convertDeclaration' annotateFunction annotateValue annotateType annotateKind annotateModule d =   case d of     IdeDeclValue v ->       annotateFunction (v ^. ideValueIdent) d@@ -258,6 +266,8 @@       annotateType (operator ^. ideTypeOpName . opNameT) d     IdeDeclKind i ->       annotateKind (i ^. properNameT) d+    IdeDeclModule mn ->+      annotateModule (P.runModuleName mn) d  resolveDocumentation   :: ModuleMap P.Module@@ -271,26 +281,27 @@   :: P.Module     -> [IdeDeclarationAnn]     -> [IdeDeclarationAnn]-resolveDocumentationForModule (P.Module _ _ _ sdecls _) decls = map convertDecl decls-  where +resolveDocumentationForModule (P.Module _ moduleComments moduleName sdecls _) decls = map convertDecl decls+  where   comments :: Map P.Name [P.Comment]-  comments = Map.fromListWith (flip (<>)) $ mapMaybe (\d -> -    case name d of +  comments = Map.insert (P.ModName moduleName) moduleComments $ Map.fromListWith (flip (<>)) $ mapMaybe (\d ->+    case name d of       Just name' -> Just (name', snd $ P.declSourceAnn d)       _ -> Nothing)-    sdecls +    sdecls    name :: P.Declaration -> Maybe P.Name   name (P.TypeDeclaration d) = Just $ P.IdentName $ P.tydeclIdent d   name decl = P.declName decl    convertDecl :: IdeDeclarationAnn -> IdeDeclarationAnn-  convertDecl (IdeDeclarationAnn ann d) = +  convertDecl (IdeDeclarationAnn ann d) =     convertDeclaration'       (annotateValue . P.IdentName)-      (annotateValue . P.IdentName . P.Ident) +      (annotateValue . P.IdentName . P.Ident)       (annotateValue . P.TyName . P.ProperName)       (annotateValue . P.KiName . P.ProperName)+      (annotateValue . P.ModName . P.moduleNameFromString)       d     where       docs :: P.Name -> Text

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

@@ -39,6 +39,7 @@   | IdeDeclTypeClass IdeTypeClass   | IdeDeclValueOperator IdeValueOperator   | IdeDeclTypeOperator IdeTypeOperator+  | IdeDeclModule P.ModuleName   | IdeDeclKind (P.ProperName 'P.KindName)   deriving (Show, Eq, Ord, Generic, NFData) @@ -126,6 +127,10 @@ _IdeDeclKind f (IdeDeclKind x) = map IdeDeclKind (f x) _IdeDeclKind _ x = pure x +_IdeDeclModule :: Traversal' IdeDeclaration P.ModuleName+_IdeDeclModule f (IdeDeclModule x) = map IdeDeclModule (f x)+_IdeDeclModule _ x = pure x+ anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool anyOf g p = getAny . getConst . g (Const . Any . p) @@ -298,14 +303,15 @@              ] ++ map (\x -> "qualifier" .= x) (maybeToList qualifier)  -- | Denotes the different namespaces a name in PureScript can reside in.-data IdeNamespace = IdeNSValue | IdeNSType | IdeNSKind+data IdeNamespace = IdeNSValue | IdeNSType | IdeNSKind | IdeNSModule   deriving (Show, Eq, Ord, Generic, NFData)  instance FromJSON IdeNamespace where   parseJSON (String s) = case s of     "value" -> pure IdeNSValue-    "type"  -> pure IdeNSType-    "kind"  -> pure IdeNSKind+    "type" -> pure IdeNSType+    "kind" -> pure IdeNSKind+    "module" -> pure IdeNSModule     _       -> mzero   parseJSON _ = mzero

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

@@ -112,6 +112,9 @@   IdeDeclKind kind -> case ref of     P.KindRef _ kindName -> kindName == kind     _ -> False+  IdeDeclModule m -> case ref of+    P.ModuleRef _ mn -> m == mn+    _ -> False  eligibleModules   :: (P.ModuleName, IdeDeclaration)

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

@@ -53,6 +53,7 @@   IdeDeclValueOperator op -> op ^. ideValueOpName & P.runOpName   IdeDeclTypeOperator op -> op ^. ideTypeOpName & P.runOpName   IdeDeclKind name -> P.runProperName name+  IdeDeclModule name -> P.runModuleName name  namespaceForDeclaration :: IdeDeclaration -> IdeNamespace namespaceForDeclaration d = case d of@@ -64,6 +65,7 @@   IdeDeclValueOperator _ -> IdeNSValue   IdeDeclTypeOperator _ -> IdeNSType   IdeDeclKind _ -> IdeNSKind+  IdeDeclModule _ -> IdeNSModule  discardAnn :: IdeDeclarationAnn -> IdeDeclaration discardAnn (IdeDeclarationAnn _ d) = d

src/Language/PureScript/Interactive.hs view

@@ -274,7 +274,7 @@     Left errs -> printErrors errs     Right (_, env') ->       case M.lookup (P.mkQualified (P.Ident "it") (P.ModuleName [P.ProperName "$PSCI"])) (P.names env') of-        Just (ty, _, _) -> print' . P.prettyPrintType $ ty+        Just (ty, _, _) -> print' . P.prettyPrintType maxBound $ ty         Nothing -> print' "Could not find type"  -- | Takes a type and prints its kind

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

@@ -43,7 +43,7 @@         findNameType envNames m = (P.disqualify m, M.lookup m envNames)          showNameType :: (P.Ident, Maybe (P.SourceType, P.NameKind, P.NameVisibility)) -> Box.Box-        showNameType (mIdent, Just (mType, _, _)) = textT (P.showIdent mIdent <> " :: ") Box.<> P.typeAsBox mType+        showNameType (mIdent, Just (mType, _, _)) = textT (P.showIdent mIdent <> " :: ") Box.<> P.typeAsBox maxBound mType         showNameType _ = P.internalError "The impossible happened in printModuleSignatures."          findTypeClass@@ -61,13 +61,13 @@                     if null typeClassSuperclasses                     then Box.text ""                     else Box.text "("-                         Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Constraint _ (P.Qualified _ pn) lt _) -> textT (P.runProperName pn) Box.<+> Box.hcat Box.left (map P.typeAtomAsBox lt)) typeClassSuperclasses)+                         Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Constraint _ (P.Qualified _ pn) lt _) -> textT (P.runProperName pn) Box.<+> Box.hcat Box.left (map (P.typeAtomAsBox maxBound) lt)) typeClassSuperclasses)                          Box.<> Box.text ") <= "                 className =                     textT (P.runProperName name)                     Box.<> textT (foldMap ((" " <>) . fst) typeClassArguments)                 classBody =-                    Box.vcat Box.top (map (\(i, t) -> textT (P.showIdent i <> " ::") Box.<+> P.typeAsBox t) typeClassMembers)+                    Box.vcat Box.top (map (\(i, t) -> textT (P.showIdent i <> " ::") Box.<+> P.typeAsBox maxBound t) typeClassMembers)              in               Just $@@ -99,7 +99,7 @@                 else                   Just $                     textT ("type " <> P.runProperName name <> foldMap ((" " <>) . fst) typevars)-                    Box.// Box.moveRight 2 (Box.text "=" Box.<+> P.typeAsBox dtType)+                    Box.// Box.moveRight 2 (Box.text "=" Box.<+> P.typeAsBox maxBound dtType)              (Just (_, P.DataType typevars pt), _) ->               let prefix =@@ -122,7 +122,7 @@                     mapFirstRest (Box.text "=" Box.<+>) (Box.text "|" Box.<+>) $                     map (\(cons,idents) -> (textT (P.runProperName cons) Box.<> Box.hcat Box.left (map prettyPrintType idents))) pt -                prettyPrintType t = Box.text " " Box.<> P.typeAtomAsBox t+                prettyPrintType t = Box.text " " Box.<> P.typeAtomAsBox maxBound t                  mapFirstRest _ _ [] = []                 mapFirstRest f g (x:xs) = f x : map g xs

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

@@ -26,7 +26,7 @@ import           Data.Functor (($>)) import           Data.Maybe (fromMaybe) import qualified Data.Set as S-import           Data.Text (Text)+import           Data.Text (Text, pack) import           Language.PureScript.AST import           Language.PureScript.Environment import           Language.PureScript.Errors@@ -45,6 +45,9 @@ kindedIdent = (, Nothing) <$> identifier           <|> parens ((,) <$> identifier <*> (Just <$> (indented *> doubleColon *> indented *> parseKind))) +fields :: [Ident]+fields = [ Ident ("value" <> pack (show (n :: Integer))) | n <- [0..] ]+ parseDataDeclaration :: TokenParser Declaration parseDataDeclaration = withSourceAnnF $ do   dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)@@ -52,7 +55,10 @@   tyArgs <- many (indented *> kindedIdent)   ctors <- P.option [] $ do     indented *> equals-    P.sepBy1 ((,) <$> dataConstructorName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe+    flip P.sepBy1 pipe $ do+      ctorName <- dataConstructorName+      tys <- P.many (indented *> noWildcards parseTypeAtom)+      return (ctorName, zip fields tys)   return $ \sa -> DataDeclaration sa dtype name tyArgs ctors  parseTypeDeclaration :: TokenParser Declaration

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

@@ -6,15 +6,12 @@   , PrettyPrintConstraint   , convertPrettyPrintType   , typeAsBox-  , typeAsBox'   , suggestedTypeAsBox   , prettyPrintType   , prettyPrintTypeWithUnicode   , prettyPrintSuggestedType   , typeAtomAsBox-  , typeAtomAsBox'   , prettyPrintTypeAtom-  , prettyPrintRow   , prettyPrintLabel   , prettyPrintObjectKey   ) where@@ -56,36 +53,50 @@   | PPParensInType PrettyPrintType   | PPForAll [Text] PrettyPrintType   | PPFunction PrettyPrintType PrettyPrintType-  | PPRecord PrettyPrintType-  | PPRCons Label PrettyPrintType PrettyPrintType-  | PPREmpty+  | PPRecord [(Label, PrettyPrintType)] (Maybe PrettyPrintType)+  | PPRow [(Label, PrettyPrintType)] (Maybe PrettyPrintType)+  | PPTruncated  type PrettyPrintConstraint = (Qualified (ProperName 'ClassName), [PrettyPrintType]) -convertPrettyPrintType :: Type a -> PrettyPrintType+convertPrettyPrintType :: Int -> Type a -> PrettyPrintType convertPrettyPrintType = go   where-  go (TUnknown _ n) = PPTUnknown n-  go (TypeVar _ t) = PPTypeVar t-  go (TypeLevelString _ s) = PPTypeLevelString s-  go (TypeWildcard _ n) = PPTypeWildcard n-  go (TypeConstructor _ c) = PPTypeConstructor c-  go (TypeOp _ o) = PPTypeOp o-  go (Skolem _ t n _) = PPSkolem t n-  go (ConstrainedType _ (Constraint _ cls args _) ty) = PPConstrainedType (cls, go <$> args) (go ty)-  go (KindedType _ ty k) = PPKindedType (go ty) (k $> ())-  go (BinaryNoParensType _ ty1 ty2 ty3) = PPBinaryNoParensType (go ty1) (go ty2) (go ty3)-  go (ParensInType _ ty) = PPParensInType (go ty)-  go (REmpty _) = PPREmpty-  go (RCons _ l ty1 ty2) = PPRCons l (go ty1) (go ty2)-  go (ForAll _ v ty _) = goForAll [v] ty-  go (TypeApp _ (TypeApp _ f arg) ret) | eqType f tyFunction = PPFunction (go arg) (go ret)-  go (TypeApp _ o r) | eqType o tyRecord = PPRecord (go r)-  go (TypeApp _ a b) = PPTypeApp (go a) (go b)+  go d _ | d < 0 = PPTruncated+  go _ (TUnknown _ n) = PPTUnknown n+  go _ (TypeVar _ t) = PPTypeVar t+  go _ (TypeLevelString _ s) = PPTypeLevelString s+  go _ (TypeWildcard _ n) = PPTypeWildcard n+  go _ (TypeConstructor _ c) = PPTypeConstructor c+  go _ (TypeOp _ o) = PPTypeOp o+  go _ (Skolem _ t n _) = PPSkolem t n+  go d (ConstrainedType _ (Constraint _ cls args _) ty) = PPConstrainedType (cls, go (d-1) <$> args) (go (d-1) ty)+  go d (KindedType _ ty k) = PPKindedType (go (d-1) ty) (k $> ())+  go d (BinaryNoParensType _ ty1 ty2 ty3) = PPBinaryNoParensType (go (d-1) ty1) (go (d-1) ty2) (go (d-1) ty3)+  go d (ParensInType _ ty) = PPParensInType (go (d-1) ty)+  go _ (REmpty _) = PPRow [] Nothing+  go d ty@RCons{} = uncurry PPRow (goRow d ty)+  go d (ForAll _ v ty _) = goForAll d [v] ty+  go d (TypeApp _ a b) = goTypeApp d a b -  goForAll vs (ForAll _ v ty _) = goForAll (v : vs) ty-  goForAll vs ty = PPForAll vs (go ty)+  goForAll d vs (ForAll _ v ty _) = goForAll d (v : vs) ty+  goForAll d vs ty = PPForAll vs (go (d-1) ty) +  goRow d ty =+    let (items, tail_) = rowToSortedList ty+    in ( map (\item -> (rowListLabel item, go (d-1) (rowListType item))) items+       , case tail_ of+           REmpty _ -> Nothing+           _ -> Just (go (d-1) tail_)+       )++  goTypeApp d (TypeApp _ f a) b+    | eqType f tyFunction = PPFunction (go (d-1) a) (go (d-1) b)+    | otherwise = PPTypeApp (goTypeApp d f a) (go (d-1) b)+  goTypeApp d o ty@RCons{}+    | eqType o tyRecord = uncurry PPRecord (goRow d ty)+  goTypeApp d a b = PPTypeApp (go (d-1) a) (go (d-1) b)+ -- TODO(Christoph): get rid of T.unpack s  constraintsAsBox :: TypeRenderOptions -> PrettyPrintConstraint -> Box -> Box@@ -100,30 +111,27 @@ -- | -- Generate a pretty-printed string representing a Row ---prettyPrintRowWith :: TypeRenderOptions -> Char -> Char -> PrettyPrintType -> Box-prettyPrintRowWith tro open close = uncurry listToBox . toList []+prettyPrintRowWith :: TypeRenderOptions -> Char -> Char -> [(Label, PrettyPrintType)] -> Maybe PrettyPrintType -> Box+prettyPrintRowWith tro open close labels rest =+  case (labels, rest) of+    ([], Nothing) ->+      text [open, close]+    ([], Just _) ->+      text [ open, ' ' ] <> tailToPs rest <> text [ ' ', close ]+    _ ->+      vcat left $+        zipWith (\(nm, ty) i -> nameAndTypeToPs (if i == 0 then open else ',') nm ty) labels [0 :: Int ..] +++        [ tailToPs rest, text [close] ]+   where   nameAndTypeToPs :: Char -> Label -> PrettyPrintType -> Box   nameAndTypeToPs start name ty = text (start : ' ' : T.unpack (prettyPrintLabel name) ++ " " ++ doubleColon ++ " ") <> typeAsBox' ty    doubleColon = if troUnicode tro then "∷" else "::" -  tailToPs :: PrettyPrintType -> Box-  tailToPs PPREmpty = nullBox-  tailToPs other = text "| " <> typeAsBox' other--  listToBox :: [(Label, PrettyPrintType)] -> PrettyPrintType -> Box-  listToBox [] PPREmpty = text [open, close]-  listToBox [] rest = text [ open, ' ' ] <> tailToPs rest <> text [ ' ', close ]-  listToBox ts rest = vcat left $-    zipWith (\(nm, ty) i -> nameAndTypeToPs (if i == 0 then open else ',') nm ty) ts [0 :: Int ..] ++-    [ tailToPs rest, text [close] ]-  toList :: [(Label, PrettyPrintType)] -> PrettyPrintType -> ([(Label, PrettyPrintType)], PrettyPrintType)-  toList tys (PPRCons name ty row) = toList ((name, ty):tys) row-  toList tys r = (reverse tys, r)--prettyPrintRow :: PrettyPrintType -> String-prettyPrintRow = render . prettyPrintRowWith defaultOptions '(' ')'+  tailToPs :: Maybe PrettyPrintType -> Box+  tailToPs Nothing = nullBox+  tailToPs (Just other) = text "| " <> typeAsBox' other  typeApp :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType) typeApp = mkPattern match@@ -164,7 +172,6 @@       match (PPTypeWildcard name) = Just $ maybe (text "_") (text . ('?' :) . T.unpack) name       match (PPTypeVar var) = Just $ text $ T.unpack var       match (PPTypeLevelString s) = Just $ text $ T.unpack $ prettyPrintString s-      match (PPRecord row) = Just $ prettyPrintRowWith tro '{' '}' row       match (PPTypeConstructor ctor) = Just $ text $ T.unpack $ runProperName $ disqualify ctor       match (PPTUnknown u)         | suggesting = Just $ text "_"@@ -172,11 +179,12 @@       match (PPSkolem name s)         | suggesting =  Just $ text $ T.unpack name         | otherwise = Just $ text $ T.unpack name ++ show s-      match PPREmpty = Just $ text "()"-      match row@PPRCons{} = Just $ prettyPrintRowWith tro '(' ')' row+      match (PPRecord labels tail_) = Just $ prettyPrintRowWith tro '{' '}' labels tail_+      match (PPRow labels tail_) = Just $ prettyPrintRowWith tro '(' ')' labels tail_       match (PPBinaryNoParensType op l r) =         Just $ typeAsBox' l <> text " " <> typeAsBox' op <> text " " <> typeAsBox' r       match (PPTypeOp op) = Just $ text $ T.unpack $ showQualified runOpName op+      match PPTruncated = Just $ text "..."       match _ = Nothing  matchType :: TypeRenderOptions -> Pattern () PrettyPrintType Box@@ -213,18 +221,18 @@   = fromMaybe (internalError "Incomplete pattern")   . PA.pattern (matchTypeAtom defaultOptions) () -typeAtomAsBox :: Type a -> Box-typeAtomAsBox = typeAtomAsBox' . convertPrettyPrintType+typeAtomAsBox :: Int -> Type a -> Box+typeAtomAsBox maxDepth = typeAtomAsBox' . convertPrettyPrintType maxDepth  -- | Generate a pretty-printed string representing a Type, as it should appear inside parentheses-prettyPrintTypeAtom :: Type a -> String-prettyPrintTypeAtom = render . typeAtomAsBox+prettyPrintTypeAtom :: Int -> Type a -> String+prettyPrintTypeAtom maxDepth = render . typeAtomAsBox maxDepth  typeAsBox' :: PrettyPrintType -> Box typeAsBox' = typeAsBoxImpl defaultOptions -typeAsBox :: Type a -> Box-typeAsBox = typeAsBox' . convertPrettyPrintType+typeAsBox :: Int -> Type a -> Box+typeAsBox maxDepth = typeAsBox' . convertPrettyPrintType maxDepth  suggestedTypeAsBox :: PrettyPrintType -> Box suggestedTypeAsBox = typeAsBoxImpl suggestingOptions@@ -249,20 +257,20 @@   . PA.pattern (matchType tro) ()  -- | Generate a pretty-printed string representing a 'Type'-prettyPrintType :: Type a -> String-prettyPrintType = prettyPrintType' defaultOptions+prettyPrintType :: Int -> Type a -> String+prettyPrintType = flip prettyPrintType' defaultOptions  -- | Generate a pretty-printed string representing a 'Type' using unicode -- symbols where applicable-prettyPrintTypeWithUnicode :: Type a -> String-prettyPrintTypeWithUnicode = prettyPrintType' unicodeOptions+prettyPrintTypeWithUnicode :: Int -> Type a -> String+prettyPrintTypeWithUnicode = flip prettyPrintType' unicodeOptions  -- | Generate a pretty-printed string representing a suggested 'Type' prettyPrintSuggestedType :: Type a -> String-prettyPrintSuggestedType = prettyPrintType' suggestingOptions+prettyPrintSuggestedType = prettyPrintType' maxBound suggestingOptions -prettyPrintType' :: TypeRenderOptions -> Type a -> String-prettyPrintType' tro = render . typeAsBoxImpl tro . convertPrettyPrintType+prettyPrintType' :: Int -> TypeRenderOptions -> Type a -> String+prettyPrintType' maxDepth tro = render . typeAsBoxImpl tro . convertPrettyPrintType maxDepth  prettyPrintLabel :: Label -> Text prettyPrintLabel (Label s) =

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

@@ -86,7 +86,7 @@ prettyPrintValue d (Ado m els yield) =   textT (maybe "" ((Monoid.<> ".") . runModuleName) m) <> text "ado " <> vcat left (map (prettyPrintDoNotationElement (d - 1)) els) //   (text "in " <> prettyPrintValue (d - 1) yield)-prettyPrintValue _ (TypeClassDictionary (Constraint _ name tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ T.unpack (runProperName (disqualify name))) : map typeAtomAsBox tys+prettyPrintValue d (TypeClassDictionary (Constraint _ name tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ T.unpack (runProperName (disqualify name))) : map (typeAtomAsBox d) tys prettyPrintValue _ (DeferredDictionary name _) = text $ "#dict " ++ T.unpack (runProperName (disqualify name)) prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =     text "#dict-accessor " <> text (T.unpack (runProperName (disqualify className))) <> text "." <> text (T.unpack (showIdent ident)) <> text ">"@@ -130,8 +130,8 @@  prettyPrintDeclaration :: Int -> Declaration -> Box prettyPrintDeclaration d _ | d < 0 = ellipsis-prettyPrintDeclaration _ (TypeDeclaration td) =-  text (T.unpack (showIdent (tydeclIdent td)) ++ " :: ") <> typeAsBox (tydeclType td)+prettyPrintDeclaration d (TypeDeclaration td) =+  text (T.unpack (showIdent (tydeclIdent td)) ++ " :: ") <> typeAsBox d (tydeclType td) prettyPrintDeclaration d (ValueDecl _ ident _ [] [GuardedExpr [] val]) =   text (T.unpack (showIdent ident) ++ " = ") <> prettyPrintValue (d - 1) val prettyPrintDeclaration d (BindingGroupDeclaration ds) =

src/Language/PureScript/Publish.hs view

@@ -17,7 +17,6 @@   , getVersionFromGitTag   , getManifestRepositoryInfo   , getModules-  , getResolvedDependencies   ) where  import Protolude hiding (stdin)@@ -26,7 +25,7 @@ import Control.Category ((>>>)) import Control.Monad.Writer.Strict (MonadWriter, WriterT, runWriterT, tell) -import Data.Aeson.BetterErrors (Parse, parse, keyMay, eachInObjectWithKey, eachInObject, key, keyOrDefault, asBool, asString, asText)+import Data.Aeson.BetterErrors (Parse, parse, keyMay, eachInObjectWithKey, eachInObject, key, keyOrDefault, asBool, asString, withString, asText, withText) import qualified Data.ByteString.Lazy as BL import Data.Char (isSpace) import Data.String (String, lines)@@ -43,7 +42,7 @@ import System.FilePath.Glob (globDir1) import System.Process (readProcess) -import Web.Bower.PackageMeta (PackageMeta(..), PackageName, parsePackageName, Repository(..))+import Web.Bower.PackageMeta (PackageMeta(..), PackageName, Repository(..)) import qualified Web.Bower.PackageMeta as Bower  import Language.PureScript.Publish.ErrorsWarnings@@ -124,23 +123,26 @@   checkCleanWorkingTree opts    pkgMeta <- liftIO (Bower.decodeFile manifestFile)-                    >>= flip catchLeft (userError . CouldntDecodePackageManifest)+               >>= flip catchLeft (userError . CouldntDecodePackageManifest)   checkLicense pkgMeta    (pkgVersionTag, pkgVersion) <- publishGetVersion opts-  pkgTagTime                  <- Just <$> publishGetTagTime opts pkgVersionTag-  pkgGithub                   <- getManifestRepositoryInfo pkgMeta+  pkgTagTime <- Just <$> publishGetTagTime opts pkgVersionTag+  pkgGithub <- getManifestRepositoryInfo pkgMeta -  let declaredDeps = map fst (bowerDependencies pkgMeta ++-                              bowerDevDependencies pkgMeta)-  resolvedDeps                <- getResolvedDependencies resolutionsFile declaredDeps+  resolvedDeps <- parseResolutionsFile resolutionsFile    (pkgModules, pkgModuleMap)  <- getModules (map (second fst) resolvedDeps) +  let declaredDeps = map fst $+                       Bower.bowerDependencies pkgMeta+                       ++ Bower.bowerDevDependencies pkgMeta+  pkgResolvedDependencies <- handleDeps declaredDeps (map (second snd) resolvedDeps)+   let pkgUploader = D.NotYetKnown   let pkgCompilerVersion = P.version-  let pkgResolvedDependencies = map (second snd) resolvedDeps +   return D.Package{..}  getModules@@ -269,124 +271,137 @@   either (otherError . ProcessFailed prog args) return out  data DependencyStatus-  = Missing-    -- ^ Listed in package manifest, but not installed.-  | NoResolution+  = NoResolution     -- ^ In the resolutions file, there was no _resolution key.   | ResolvedOther Text     -- ^ Resolved, but to something other than a version. The Text argument     -- is the resolution type. The values it can take that I'm aware of are-    -- "commit" and "branch".-  | ResolvedVersion Text-    -- ^ Resolved to a version. The Text argument is the resolution tag (eg,-    -- "v0.1.0").+    -- "commit" and "branch". Note: this constructor is deprecated, and is only+    -- used when parsing legacy resolutions files.+  | ResolvedVersion Version+    -- ^ Resolved to a version.   deriving (Show, Eq) --- Go through all dependencies which contain purescript code, and--- extract their versions.------ In the case where a dependency is taken from a particular version,--- that's easy; take that version. In any other case (eg, a branch, or a commit--- sha) we print a warning that documentation links will not work, and avoid--- linking to documentation for any types from that package.------ The rationale for this is: people will prefer to use a released version--- where possible. If they are not using a released version, then this is--- probably for a reason. However, docs are only ever available for released--- versions. Therefore there will probably be no version of the docs which is--- appropriate to link to, and we should omit links.-getResolvedDependencies :: FilePath -> [PackageName] -> PrepareM [(PackageName, (FilePath, Version))]-getResolvedDependencies resolutionsFile declaredDeps = do+parseResolutionsFile :: FilePath -> PrepareM [(PackageName, (FilePath, DependencyStatus))]+parseResolutionsFile resolutionsFile = do   unlessM (liftIO (doesFileExist resolutionsFile)) (userError ResolutionsFileNotFound)   depsBS <- liftIO (BL.readFile resolutionsFile) -  -- Check for undeclared dependencies-  toplevels <- catchJSON (parse asToplevelDependencies depsBS)-  warnUndeclared declaredDeps toplevels+  case parse asResolutions depsBS of+    Right res ->+      pure res+    Left err ->+      case parse asLegacyResolutions depsBS of+        Right res -> do+          warn $ LegacyResolutionsFormat resolutionsFile+          pure res+        Left _ ->+          userError $ ResolutionsFileError resolutionsFile err -  deps <- catchJSON (parse asResolvedDependencies depsBS)-  handleDeps deps+-- | Parser for resolutions files, which contain information about the packages+-- which this package depends on. A resolutions file should look something like+-- this:+--+-- {+--   "purescript-prelude": {+--      "version": "4.0.0",+--      "path": "bower_components/purescript-prelude"+--   },+--   "purescript-lists": {+--      "version": "6.0.0",+--      "path": "bower_components/purescript-lists"+--   },+--   ...+-- }+--+-- where the version is used for generating links between packages on Pursuit,+-- and the path is used to obtain the source files while generating+-- documentation: all files matching the glob "src/**/*.purs" relative to the+-- `path` directory will be picked up.+--+-- The "version" field is optional, but omitting it will mean that no links+-- will be generated for any declarations from that package on Pursuit. The+-- "path" field is required.+asResolutions :: Parse D.PackageError [(PackageName, (FilePath, DependencyStatus))]+asResolutions =+  eachInObjectWithKey parsePackageName $+    (,) <$> key "path" asString+        <*> (maybe NoResolution ResolvedVersion <$> keyMay "version" asVersion) -  where-  catchJSON = flip catchLeft (internalError . JSONError FromResolutions)+asVersion :: Parse D.PackageError Version+asVersion =+  withString (note D.InvalidVersion . D.parseVersion') --- | Extracts all dependencies and their versions from a "resolutions" file, which--- is based on the output of `bower list --json --offline`-asResolvedDependencies :: Parse D.ManifestError [(PackageName, (Maybe FilePath, DependencyStatus))]-asResolvedDependencies = nubBy ((==) `on` fst) <$> go+-- | Extracts all dependencies and their versions from a legacy resolutions+-- file, which is based on the output of `bower list --json --offline`.+asLegacyResolutions :: Parse D.PackageError [(PackageName, (FilePath, DependencyStatus))]+asLegacyResolutions =+  nubBy ((==) `on` fst) <$> go True   where-  go =-    fmap (fromMaybe []) $-      keyMay "dependencies" $-        (++) <$> eachInObjectWithKey parsePackageName asDirectoryAndDependencyStatus-             <*> (concatMap snd <$> eachInObject asResolvedDependencies)+  go isToplevel =+    keyDependencies isToplevel $+        (++) <$> (takeJusts <$> eachInObjectWithKey parsePackageName asDirectoryAndDependencyStatus)+             <*> (concatMap snd <$> eachInObject (go False)) --- | Extracts only the top level dependency names from a resolutions file.-asToplevelDependencies :: Parse D.ManifestError [PackageName]-asToplevelDependencies =-  fmap (map fst) $-    key "dependencies" $-      eachInObjectWithKey parsePackageName (return ()) -asDirectoryAndDependencyStatus :: Parse e (Maybe FilePath, DependencyStatus)-asDirectoryAndDependencyStatus = do-  isMissing <- keyOrDefault "missing" False asBool-  if isMissing-    then-      return (Nothing, Missing)-    else do-      directory <- key "canonicalDir" asString-      status <- key "pkgMeta" $-        keyOrDefault "_resolution" NoResolution $ do-          type_ <- key "type" asText-          case type_ of-            "version" -> ResolvedVersion <$> key "tag" asText-            other -> return (ResolvedOther other)-      return (Just directory, status)+  keyDependencies isToplevel =+    if isToplevel+      then key "dependencies"+      else fmap (fromMaybe []) . keyMay "dependencies" -warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()-warnUndeclared declared actual =-  traverse_ (warn . UndeclaredDependency) (actual \\ declared)+  takeJusts :: [(a, Maybe b)] -> [(a,b)]+  takeJusts = mapMaybe $ \(x,y) -> (x,) <$> y +  asDirectoryAndDependencyStatus :: Parse D.PackageError (Maybe (FilePath, DependencyStatus))+  asDirectoryAndDependencyStatus = do+    isMissing <- keyOrDefault "missing" False asBool+    if isMissing+      then return Nothing+      else do+        directory <- key "canonicalDir" asString+        status <- key "pkgMeta" $+           keyOrDefault "_resolution" NoResolution $ do+             type_ <- key "type" asText+             case type_ of+              "version" ->+                key "tag" $ fmap ResolvedVersion $ withText $ \tag ->+                  let+                    tag' = fromMaybe tag (T.stripPrefix "v" tag)+                  in+                    note D.InvalidVersion (D.parseVersion' (T.unpack tag'))+              other ->+                return (ResolvedOther other)+        return $ Just (directory, status)++parsePackageName :: Text -> Either D.PackageError PackageName+parsePackageName = first D.ErrorInPackageMeta . Bower.parsePackageName+ handleDeps-  :: [(PackageName, (Maybe FilePath, DependencyStatus))]-  -> PrepareM [(PackageName, (FilePath, Version))]-handleDeps deps = do-  let (missing, noVersion, installed, missingPath) = partitionDeps deps+  :: [PackageName]+      -- ^ dependencies declared in package manifest file; we should emit+      -- warnings for any package name in this list which is not in the+      -- resolutions file.+  -> [(PackageName, DependencyStatus)]+      -- ^ Contents of resolutions file+  -> PrepareM [(PackageName, Version)]+handleDeps declared resolutions = do+  let missing = declared \\ map fst resolutions   case missing of     (x:xs) ->       userError (MissingDependencies (x :| xs))     [] -> do-      traverse_ (warn . NoResolvedVersion) noVersion-      traverse_ (warn . MissingPath) missingPath-      catMaybes <$> traverse tryExtractVersion' installed--  where-  partitionDeps = foldr go ([], [], [], [])-  go (pkgName, (Nothing, _)) (ms, os, is, mp) =-    (ms, os, is, pkgName : mp)-  go (pkgName, (Just path, d)) (ms, os, is, mp) =-    case d of-      Missing           -> (pkgName : ms, os, is, mp)-      NoResolution      -> (ms, pkgName : os, is, mp)-      ResolvedOther _   -> (ms, pkgName : os, is, mp)-      ResolvedVersion v -> (ms, os, (pkgName, (path, v)) : is, mp)--  -- Try to extract a version, and warn if unsuccessful.-  tryExtractVersion'-    :: (PackageName, (extra, Text))-    -> PrepareM (Maybe (PackageName, (extra, Version)))-  tryExtractVersion' pair =-    maybe (warn (UnacceptableVersion (fmap snd pair)) >> return Nothing)-          (return . Just)-          (tryExtractVersion pair)--tryExtractVersion-  :: (PackageName, (extra, Text))-  -> Maybe (PackageName, (extra, Version))-tryExtractVersion (pkgName, (extra, tag)) =-  let tag' = fromMaybe tag (T.stripPrefix "v" tag)-  in  (pkgName,) . (extra,) <$> D.parseVersion' (T.unpack tag')+      pkgs <-+        for resolutions $ \(pkgName, status) ->+          case status of+            NoResolution -> do+              warn (NoResolvedVersion pkgName)+              pure Nothing+            ResolvedOther other -> do+              warn (UnacceptableVersion (pkgName, other))+              pure Nothing+            ResolvedVersion version ->+              pure (Just (pkgName, version))+      pure (catMaybes pkgs)  getInputAndDepsFiles   :: [(PackageName, FilePath)]

src/Language/PureScript/Publish/ErrorsWarnings.hs view

@@ -21,18 +21,18 @@ import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe-import Data.Monoid+import Data.Monoid hiding (First, getFirst)+import Data.Semigroup (First(..)) import Data.Version import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) import qualified Data.Text as T -import Language.PureScript.Docs.Types (ManifestError)-import Language.PureScript.Publish.BoxesHelpers+import qualified Language.PureScript.Docs.Types as D import qualified Language.PureScript as P+import Language.PureScript.Publish.BoxesHelpers  import Web.Bower.PackageMeta (PackageName, runPackageName, showBowerError)-import qualified Web.Bower.PackageMeta as Bower  -- | An error which meant that it was not possible to retrieve metadata for a -- package.@@ -44,17 +44,16 @@  data PackageWarning   = NoResolvedVersion PackageName-  | UndeclaredDependency PackageName   | UnacceptableVersion (PackageName, Text)   | DirtyWorkingTree_Warn-  | MissingPath PackageName+  | LegacyResolutionsFormat FilePath   deriving (Show)  -- | An error that should be fixed by the user. data UserError   = PackageManifestNotFound   | ResolutionsFileNotFound-  | CouldntDecodePackageManifest (ParseError ManifestError)+  | CouldntDecodePackageManifest (ParseError D.ManifestError)   | TagMustBeCheckedOut   | AmbiguousVersions [Version] -- Invariant: should contain at least two elements   | BadRepositoryField RepositoryFieldError@@ -63,6 +62,7 @@   | MissingDependencies (NonEmpty PackageName)   | CompileError P.MultipleErrors   | DirtyWorkingTree+  | ResolutionsFileError FilePath (ParseError D.PackageError)   deriving (Show)  data RepositoryFieldError@@ -71,11 +71,9 @@   | NotOnGithub   deriving (Show) - -- | An error that probably indicates a bug in this module. data InternalError-  = JSONError JSONSource (ParseError ManifestError)-  | CouldntParseGitTagDate Text+  = CouldntParseGitTagDate Text   deriving (Show)  data JSONSource@@ -221,6 +219,10 @@         "Your git working tree is dirty. Please commit, discard, or stash " ++         "your changes first."         )+  ResolutionsFileError path err ->+    successivelyIndented $+      [ "Error in resolutions file (" ++ path ++ "):" ]+      ++ map T.unpack (displayError D.displayPackageError err)  spdxExamples :: [Box] spdxExamples =@@ -276,21 +278,10 @@  displayInternalError :: InternalError -> [String] displayInternalError e = case e of-  JSONError src r ->-    [ "Error in JSON " ++ displayJSONSource src ++ ":"-    , T.unpack (Bower.displayError r)-    ]   CouldntParseGitTagDate tag ->     [ "Unable to parse the date for a git tag: " ++ T.unpack tag     ] -displayJSONSource :: JSONSource -> String-displayJSONSource s = case s of-  FromFile fp ->-    "in file " ++ show fp-  FromResolutions ->-    "in resolutions file"- displayOtherError :: OtherError -> Box displayOtherError e = case e of   ProcessFailed prog args exc ->@@ -303,42 +294,43 @@       [ "An IO exception occurred:", show exc ]  data CollectedWarnings = CollectedWarnings-  { noResolvedVersions     :: [PackageName]-  , undeclaredDependencies :: [PackageName]-  , unacceptableVersions   :: [(PackageName, Text)]-  , dirtyWorkingTree       :: Any-  , missingPaths           :: [PackageName]+  { noResolvedVersions      :: [PackageName]+  , unacceptableVersions    :: [(PackageName, Text)]+  , dirtyWorkingTree        :: Any+  , legacyResolutionsFormat :: Maybe (First FilePath)   }   deriving (Show, Eq, Ord)  instance Semigroup CollectedWarnings where-  (CollectedWarnings as bs cs d es) <> (CollectedWarnings as' bs' cs' d' es') =-    CollectedWarnings (as <> as') (bs <> bs') (cs <> cs') (d <> d') (es <> es')+  (<>) (CollectedWarnings a b c d) (CollectedWarnings a' b' c' d') =+    CollectedWarnings (a <> a') (b <> b') (c <> c') (d <> d')  instance Monoid CollectedWarnings where-  mempty = CollectedWarnings mempty mempty mempty mempty mempty+  mempty = CollectedWarnings mempty mempty mempty mempty  collectWarnings :: [PackageWarning] -> CollectedWarnings collectWarnings = foldMap singular   where   singular w = case w of-    NoResolvedVersion    pn -> CollectedWarnings [pn] mempty mempty mempty mempty-    UndeclaredDependency pn -> CollectedWarnings mempty [pn] mempty mempty mempty-    UnacceptableVersion t   -> CollectedWarnings mempty mempty [t] mempty mempty-    DirtyWorkingTree_Warn   -> CollectedWarnings mempty mempty mempty (Any True) mempty-    MissingPath pn          -> CollectedWarnings mempty mempty mempty mempty [pn]+    NoResolvedVersion pn ->+      mempty { noResolvedVersions = [pn] }+    UnacceptableVersion t ->+      mempty { unacceptableVersions = [t] }+    DirtyWorkingTree_Warn ->+      mempty { dirtyWorkingTree = Any True }+    LegacyResolutionsFormat path ->+      mempty { legacyResolutionsFormat = Just (First path) }  renderWarnings :: [PackageWarning] -> Box renderWarnings warns =   let CollectedWarnings{..} = collectWarnings warns       go toBox warns' = toBox <$> NonEmpty.nonEmpty warns'-      mboxes = [ go warnNoResolvedVersions     noResolvedVersions-               , go warnUndeclaredDependencies undeclaredDependencies-               , go warnUnacceptableVersions   unacceptableVersions+      mboxes = [ go warnNoResolvedVersions noResolvedVersions+               , go warnUnacceptableVersions unacceptableVersions                , if getAny dirtyWorkingTree                    then Just warnDirtyWorkingTree                    else Nothing-               , go warnMissingPaths           missingPaths+               , fmap (warnLegacyResolutions . getFirst) legacyResolutionsFormat                ]   in case catMaybes mboxes of        []    -> nullBox@@ -369,21 +361,6 @@       ])     ] -warnUndeclaredDependencies :: NonEmpty PackageName -> Box-warnUndeclaredDependencies pkgNames =-  let singular = NonEmpty.length pkgNames == 1-      pl a b = if singular then b else a--      packages     = pl "packages" "package"-      are          = pl "are" "is"-      dependencies = pl "dependencies" "a dependency"-  in vcat $-    para (concat-      [ "The following ", packages, " ", are, " installed, but not "-      , "declared as ", dependencies, " in your package manifest file:"-      ])-    : bulletedListT runPackageName (NonEmpty.toList pkgNames)- warnUnacceptableVersions :: NonEmpty (PackageName, Text) -> Box warnUnacceptableVersions pkgs =   let singular = NonEmpty.length pkgs == 1@@ -419,18 +396,20 @@     ++ "were not a dry run)"     ) -warnMissingPaths :: NonEmpty PackageName -> Box-warnMissingPaths pkgs =-  let singular = NonEmpty.length pkgs == 1-      pl a b = if singular then b else a--      packages   = pl "packages" "package"-  in vcat $-    para (concat-      [ "The following installed ", packages, " were "-      , "missing path information in the resolutions file:"-      ])-    : bulletedListT runPackageName (NonEmpty.toList pkgs)+warnLegacyResolutions :: FilePath -> Box+warnLegacyResolutions path =+  vcat $+    [ para (concat+        [ "Your resolutions file (" ++ path ++ ") is using the deprecated "+        , "legacy format. Support for this format will be dropped in a future "+        , "version."+        ])+    , spacer+    , para (concat+        [ "In most cases, all you need to do to use the new format and silence "+        , "this warning is to upgrade Pulp."+        ])+    ]  printWarnings :: [PackageWarning] -> IO () printWarnings = printToStderr . renderWarnings

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

@@ -205,7 +205,7 @@     fmap (bound,) $       DataDeclaration sa dtype name         <$> updateTypeArguments args-        <*> traverse (sndM (traverse updateTypesEverywhere)) dctors+        <*> traverse (sndM (traverse (sndM updateTypesEverywhere))) dctors   updateDecl bound (TypeSynonymDeclaration sa name ps ty) =     fmap (bound,) $       TypeSynonymDeclaration sa name

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

@@ -315,7 +315,7 @@    goDecl :: Declaration -> m Declaration   goDecl (DataDeclaration sa@(ss, _) ddt name args dctors) =-    DataDeclaration sa ddt name args <$> traverse (sndM (traverse (goType' ss))) dctors+    DataDeclaration sa ddt name args <$> traverse (sndM (traverse (sndM (goType' ss)))) dctors   goDecl (ExternDeclaration sa@(ss, _) name ty) =     ExternDeclaration sa name <$> goType' ss ty   goDecl (TypeClassDeclaration sa@(ss, _) name args implies deps decls) = do

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

@@ -14,7 +14,8 @@ import           Control.Monad.Error.Class (MonadError(..)) import           Control.Monad.State import           Control.Monad.Supply.Class-import           Data.List (find, sortBy)+import           Data.Graph+import           Data.List (find, partition) import qualified Data.Map as M import           Data.Maybe (catMaybes, mapMaybe, isJust, fromMaybe) import qualified Data.List.NonEmpty as NEL@@ -72,14 +73,31 @@   => Module   -> Desugar m Module desugarModule (Module ss coms name decls (Just exps)) = do-  (newExpss, declss) <- unzip <$> parU (sortBy classesFirst decls) (desugarDecl name exps)-  return $ Module ss coms name (concat declss) $ Just (exps ++ catMaybes newExpss)+  let (classDecls, restDecls) = partition isTypeClassDeclaration decls+      classVerts = fmap (\d -> (d, classDeclName d, superClassesNames d)) classDecls+  (classNewExpss, classDeclss) <- unzip <$> parU (stronglyConnComp classVerts) (desugarClassDecl name exps)+  (restNewExpss, restDeclss) <- unzip <$> parU restDecls (desugarDecl name exps)+  return $ Module ss coms name (concat restDeclss ++ concat classDeclss) $ Just (exps ++ catMaybes restNewExpss ++ catMaybes classNewExpss)   where-  classesFirst :: Declaration -> Declaration -> Ordering-  classesFirst d1 d2-    | isTypeClassDeclaration d1 && not (isTypeClassDeclaration d2) = LT-    | not (isTypeClassDeclaration d1) && isTypeClassDeclaration d2 = GT-    | otherwise = EQ+  desugarClassDecl :: (MonadSupply m, MonadError MultipleErrors m)+    => ModuleName+    -> [DeclarationRef]+    -> SCC Declaration+    -> Desugar m (Maybe DeclarationRef, [Declaration])+  desugarClassDecl name' exps' (AcyclicSCC d) = desugarDecl name' exps' d+  desugarClassDecl _ _ (CyclicSCC ds') = throwError . errorMessage' (declSourceSpan (head ds')) $ CycleInTypeClassDeclaration (map classDeclName ds')++  superClassesNames :: Declaration -> [ProperName 'ClassName]+  superClassesNames (TypeClassDeclaration _ _ _ implies _ _) = fmap superClassName implies+  superClassesNames _ = []++  superClassName :: SourceConstraint -> ProperName 'ClassName+  superClassName (Constraint _ (Qualified _ cName) _ _) = cName++  classDeclName :: Declaration -> ProperName 'ClassName+  classDeclName (TypeClassDeclaration _ pn _ _ _ _) = pn+  classDeclName _ = internalError "Expected TypeClassDeclaration"+ desugarModule _ = internalError "Exports should have been elaborated in name desugaring"  {- Desugar type class and type class instance declarations

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

@@ -205,7 +205,7 @@     tyCon <- findTypeDecl ss tyConNm ds     go tyCon   where-    go (DataDeclaration _ Newtype _ tyArgNames [(_, [wrapped])]) = do+    go (DataDeclaration _ Newtype _ tyArgNames [(_, [(_, wrapped)])]) = do       -- The newtype might not be applied to all type arguments.       -- This is okay as long as the newtype wraps something which ends with       -- sufficiently many type applications to variables.@@ -337,10 +337,10 @@     compN n f = f . compN (n - 1) f      makeInst-      :: (ProperName 'ConstructorName, [SourceType])+      :: (ProperName 'ConstructorName, [(Ident, SourceType)])       -> m (SourceType, CaseAlternative, CaseAlternative)     makeInst (ctorName, args) = do-        args' <- mapM (replaceAllTypeSynonymsM syns) args+        args' <- mapM (replaceAllTypeSynonymsM syns . snd) args         (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args'         return ( srcTypeApp (srcTypeApp (srcTypeConstructor constructor)                                   (srcTypeLevelString $ mkString (runProperName ctorName)))@@ -468,11 +468,11 @@       where       catchAll = CaseAlternative [NullBinder, NullBinder] (unguarded (Literal ss (BooleanLiteral False))) -    mkCtorClause :: (ProperName 'ConstructorName, [SourceType]) -> m CaseAlternative+    mkCtorClause :: (ProperName 'ConstructorName, [(Ident, SourceType)]) -> m CaseAlternative     mkCtorClause (ctorName, tys) = do       identsL <- replicateM (length tys) (freshIdent "l")       identsR <- replicateM (length tys) (freshIdent "r")-      tys' <- mapM (replaceAllTypeSynonymsM syns) tys+      tys' <- mapM (replaceAllTypeSynonymsM syns . snd) tys       let tests = zipWith3 toEqTest (map (Var ss . Qualified Nothing) identsL) (map (Var ss . Qualified Nothing) identsR) tys'       return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (unguarded (conjAll tests))       where@@ -547,11 +547,11 @@     ordCompare1 :: Expr -> Expr -> Expr     ordCompare1 = App . App (Var ss (Qualified (Just dataOrd) (Ident C.compare1))) -    mkCtorClauses :: ((ProperName 'ConstructorName, [SourceType]), Bool) -> m [CaseAlternative]+    mkCtorClauses :: ((ProperName 'ConstructorName, [(Ident, SourceType)]), Bool) -> m [CaseAlternative]     mkCtorClauses ((ctorName, tys), isLast) = do       identsL <- replicateM (length tys) (freshIdent "l")       identsR <- replicateM (length tys) (freshIdent "r")-      tys' <- mapM (replaceAllTypeSynonymsM syns) tys+      tys' <- mapM (replaceAllTypeSynonymsM syns . snd) tys       let tests = zipWith3 toOrdering (map (Var ss . Qualified Nothing) identsL) (map (Var ss . Qualified Nothing) identsR) tys'           extras | not isLast = [ CaseAlternative [ ConstructorBinder ss (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)                                                   , NullBinder@@ -622,7 +622,7 @@       checkNewtype name dctors       wrappedIdent <- freshIdent "n"       unwrappedIdent <- freshIdent "a"-      let (ctorName, [ty]) = head dctors+      let (ctorName, [(_, ty)]) = head dctors       ty' <- replaceAllTypeSynonymsM syns ty       let inst =             [ ValueDecl (ss', []) (Ident "wrap") Public [] $ unguarded $@@ -707,10 +707,10 @@         lam ss' f . lamCase ss' m <$> mapM (mkCtorClause iTy f) ctors     mkMapFunction _ = internalError "mkMapFunction: expected DataDeclaration" -    mkCtorClause :: Text -> Ident -> (ProperName 'ConstructorName, [SourceType]) -> m CaseAlternative+    mkCtorClause :: Text -> Ident -> (ProperName 'ConstructorName, [(Ident, SourceType)]) -> m CaseAlternative     mkCtorClause iTyName f (ctorName, ctorTys) = do       idents <- replicateM (length ctorTys) (freshIdent "v")-      ctorTys' <- mapM (replaceAllTypeSynonymsM syns) ctorTys+      ctorTys' <- mapM (replaceAllTypeSynonymsM syns . snd) ctorTys       args <- zipWithM transformArg idents ctorTys'       let ctor = Constructor ss (Qualified (Just mn) ctorName)           rebuilt = foldl' App ctor args

src/Language/PureScript/TypeChecker.hs view

@@ -12,6 +12,7 @@ import Prelude.Compat import Protolude (ordNub) +import Control.Arrow (second) import Control.Monad (when, unless, void, forM) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (MonadState(..), modify, gets)@@ -49,15 +50,15 @@   -> DataDeclType   -> ProperName 'TypeName   -> [(Text, Maybe SourceKind)]-  -> [(ProperName 'ConstructorName, [SourceType])]+  -> [(ProperName 'ConstructorName, [(Ident, SourceType)])]   -> SourceKind   -> m () addDataType moduleName dtype name args dctors ctorKind = do   env <- getEnv-  putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (ctorKind, DataType args dctors) (types env) }-  for_ dctors $ \(dctor, tys) ->+  putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (ctorKind, DataType args (map (second (map snd)) dctors)) (types env) }+  for_ dctors $ \(dctor, fields) ->     warnAndRethrow (addHint (ErrorInDataConstructor dctor)) $-      addDataConstructor moduleName dtype name (map fst args) dctor tys+      addDataConstructor moduleName dtype name (map fst args) dctor fields  addDataConstructor   :: (MonadState CheckState m, MonadError MultipleErrors m)@@ -66,15 +67,15 @@   -> ProperName 'TypeName   -> [Text]   -> ProperName 'ConstructorName-  -> [SourceType]+  -> [(Ident, SourceType)]   -> m ()-addDataConstructor moduleName dtype name args dctor tys = do+addDataConstructor moduleName dtype name args dctor dctorArgs = do+  let (fields, tys) = unzip dctorArgs   env <- getEnv   traverse_ checkTypeSynonyms tys   let retTy = foldl srcTypeApp (srcTypeConstructor (Qualified (Just moduleName) name)) (map srcTypeVar args)   let dctorTy = foldr function retTy tys   let polyType = mkForAll (map (NullSourceAnn,) args) dctorTy-  let fields = [Ident ("value" <> T.pack (show n)) | n <- [0..(length tys - 1)]]   putEnv $ env { dataConstructors = M.insert (Qualified (Just moduleName) dctor) (dtype, name, polyType, fields) (dataConstructors env) }  addTypeSynonym@@ -236,7 +237,7 @@     warnAndRethrow (addHint (ErrorInTypeConstructor name) . addHint (positionedError ss)) $ do       when (dtype == Newtype) $ checkNewtype name dctors       checkDuplicateTypeArguments $ map fst args-      ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)+      ctorKind <- kindsOf True moduleName name args (concatMap (fmap snd . snd) dctors)       let args' = args `withKinds` ctorKind       addDataType moduleName dtype name args' dctors ctorKind     return $ DataDeclaration sa dtype name args dctors@@ -247,7 +248,7 @@         bindingGroupNames = ordNub ((syns^..traverse._2) ++ (dataDecls^..traverse._3))         sss = fmap declSourceSpan tys     warnAndRethrow (addHint (ErrorInDataBindingGroup bindingGroupNames) . addHint (PositionedError sss)) $ do-      (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(sa, _, name, args, dctors) -> (sa, name, args, concatMap snd dctors)) dataDecls)+      (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(sa, _, name, args, dctors) -> (sa, name, args, concatMap (fmap snd . snd) dctors)) dataDecls)       for_ (zip dataDecls data_ks) $ \((_, dtype, name, args, dctors), ctorKind) -> do         when (dtype == Newtype) $ checkNewtype name dctors         checkDuplicateTypeArguments $ map fst args@@ -494,7 +495,7 @@   :: forall m    . MonadError MultipleErrors m   => ProperName 'TypeName-  -> [(ProperName 'ConstructorName, [SourceType])]+  -> [(ProperName 'ConstructorName, [(Ident, SourceType)])]   -> m () checkNewtype _ [(_, [_])] = return () checkNewtype name _ = throwError . errorMessage $ InvalidNewtype name

stack.yaml view

@@ -1,4 +1,4 @@-resolver: lts-12.0+resolver: lts-13.12 packages: - '.' extra-deps:@@ -6,3 +6,7 @@   enable: false   packages:   - zlib+  # Test dependencies+  - nodejs+  - nodePackages.npm+  - nodePackages.bower

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

@@ -65,3 +65,10 @@                   , typ "withType"                   ]     result `shouldSatisfy` \res -> complDocumentation res == Just "Doc *123*\n"++  it "gets docs on module declaration" $ do+    ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpecDocs"]+                  , typ "CompletionSpecDocs"+                  ]+    result `shouldSatisfy` \res -> complDocumentation res == Just "Module Documentation\n"

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

@@ -3,7 +3,8 @@ module Language.PureScript.Ide.FilterSpec where  import           Protolude-import           Data.List.NonEmpty+import qualified Data.Map as Map+import qualified Data.Set as Set import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Filter.Declaration as D import           Language.PureScript.Ide.Types@@ -24,23 +25,23 @@ moduleH = (P.moduleNameFromString "Module.H", [T.ideValueOp "<$>" (P.Qualified Nothing (Left "")) 0 Nothing Nothing]) moduleI = (P.moduleNameFromString "Module.I", [T.ideTypeOp "~>" (P.Qualified Nothing "") 0 Nothing Nothing]) -modules :: [Module]-modules = [moduleA, moduleB]+modules :: ModuleMap [IdeDeclarationAnn]+modules = Map.fromList [moduleA, moduleB]  runEq :: Text -> [Module]-runEq s = applyFilters [equalityFilter s] modules+runEq s = Map.toList (applyFilters [exactFilter s] modules)  runPrefix :: Text -> [Module]-runPrefix s = applyFilters [prefixFilter s] modules+runPrefix s = Map.toList $ applyFilters [prefixFilter s] modules  runModule :: [P.ModuleName] -> [Module]-runModule ms = applyFilters [moduleFilter ms] modules+runModule ms = Map.toList $ applyFilters [moduleFilter (Set.fromList ms)] modules -runNamespace :: NonEmpty IdeNamespace -> [Module] -> [Module]-runNamespace namespaces = applyFilters [namespaceFilter namespaces]+runNamespace :: Set IdeNamespace -> [Module] -> [Module]+runNamespace namespaces = Map.toList . applyFilters [namespaceFilter namespaces] . Map.fromList -runDeclaration :: [D.IdeDeclaration] -> [Module] -> [Module]-runDeclaration decls = applyFilters [declarationTypeFilter decls]+runDeclaration :: [D.DeclarationType] -> [Module] -> [Module]+runDeclaration decls = Map.toList . applyFilters [declarationTypeFilter (Set.fromList decls)] . Map.fromList  spec :: Spec spec = do@@ -53,7 +54,7 @@       runEq "data1" `shouldBe` [moduleB]   describe "prefixFilter" $ do     it "keeps everything on empty string" $-      runPrefix "" `shouldBe` modules+      runPrefix "" `shouldBe` Map.toList modules     it "keeps functionname prefix matches" $       runPrefix "fun" `shouldBe` [moduleA]     it "keeps data decls prefix matches" $@@ -67,102 +68,91 @@       runModule (P.moduleNameFromString <$> ["Module.A", "Unknown"]) `shouldBe` [moduleA]   describe "namespaceFilter" $ do     it "extracts modules by filtering `value` namespaces" $-      runNamespace (fromList [IdeNSValue])+      runNamespace (Set.fromList [IdeNSValue])         [moduleA, moduleB, moduleD] `shouldBe` [moduleA, moduleB]     it "extracts no modules by filtering `value` namespaces" $-      runNamespace (fromList [IdeNSValue])+      runNamespace (Set.fromList [IdeNSValue])         [moduleD] `shouldBe` []     it "extracts modules by filtering `type` namespaces" $-      runNamespace (fromList [IdeNSType])+      runNamespace (Set.fromList [IdeNSType])         [moduleA, moduleB, moduleC] `shouldBe` [moduleC]     it "extracts no modules by filtering `type` namespaces" $-      runNamespace (fromList [IdeNSType])+      runNamespace (Set.fromList [IdeNSType])         [moduleA, moduleB] `shouldBe` []     it "extracts modules by filtering `kind` namespaces" $-      runNamespace (fromList [IdeNSKind])+      runNamespace (Set.fromList [IdeNSKind])         [moduleA, moduleB, moduleD] `shouldBe` [moduleD]     it "extracts no modules by filtering `kind` namespaces" $-      runNamespace (fromList [IdeNSKind])+      runNamespace (Set.fromList [IdeNSKind])         [moduleA, moduleB] `shouldBe` []     it "extracts modules by filtering `value` and `type` namespaces" $-      runNamespace (fromList [ IdeNSValue, IdeNSType])+      runNamespace (Set.fromList [ IdeNSValue, IdeNSType])         [moduleA, moduleB, moduleC, moduleD]         `shouldBe` [moduleA, moduleB, moduleC]     it "extracts modules by filtering `value` and `kind` namespaces" $-      runNamespace (fromList [ IdeNSValue, IdeNSKind])+      runNamespace (Set.fromList [ IdeNSValue, IdeNSKind])         [moduleA, moduleB, moduleC, moduleD]         `shouldBe` [moduleA, moduleB, moduleD]     it "extracts modules by filtering `type` and `kind` namespaces" $-      runNamespace (fromList [ IdeNSType, IdeNSKind])+      runNamespace (Set.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])+      runNamespace (Set.fromList [ IdeNSValue, IdeNSType, IdeNSKind])         [moduleA, moduleB, moduleC, moduleD]         `shouldBe` [moduleA, moduleB, moduleC, moduleD]   describe "declarationTypeFilter" $ do-    let moduleADecl = D.IdeDeclaration D.Value-        moduleCDecl = D.IdeDeclaration D.Type-        moduleDDecl = D.IdeDeclaration D.Kind-        moduleEDecl = D.IdeDeclaration D.Synonym-        moduleFDecl = D.IdeDeclaration D.DataConstructor-        moduleGDecl = D.IdeDeclaration D.TypeClass-        moduleHDecl = D.IdeDeclaration D.ValueOperator-        moduleIDecl = D.IdeDeclaration D.TypeOperator-    it "keeps everything on empty list of declarations" $-      runDeclaration []-        [moduleA, moduleB, moduleD] `shouldBe` [moduleA, moduleB, moduleD]     it "extracts modules by filtering `value` declarations" $-      runDeclaration [moduleADecl]+      runDeclaration [D.Value]         [moduleA, moduleB, moduleD] `shouldBe` [moduleA, moduleB]     it "removes everything if no `value` declarations has been found" $-      runDeclaration [moduleADecl]+      runDeclaration [D.Value]         [moduleD, moduleG, moduleE, moduleH] `shouldBe` []     it "extracts module by filtering `type` declarations" $-      runDeclaration [moduleCDecl]+      runDeclaration [D.Type]         [moduleA, moduleB, moduleC, moduleD, moduleE] `shouldBe` [moduleC]     it "removes everything if a `type` declaration have not been found" $-      runDeclaration [moduleCDecl]+      runDeclaration [D.Type]         [moduleA, moduleG, moduleE, moduleH] `shouldBe` []     it "extracts module by filtering `synonym` declarations" $-      runDeclaration [moduleEDecl]+      runDeclaration [D.Synonym]         [moduleA, moduleB, moduleD, moduleE] `shouldBe` [moduleE]     it "removes everything if a `synonym` declaration have not been found" $-      runDeclaration [moduleEDecl]+      runDeclaration [D.Synonym]         [moduleA, moduleB, moduleC, moduleH] `shouldBe` []     it "extracts module by filtering `constructor` declarations" $-      runDeclaration [moduleFDecl]+      runDeclaration [D.DataConstructor]         [moduleA, moduleB, moduleC, moduleF] `shouldBe` [moduleF]     it "removes everything if a `constructor` declaration have not been found" $-      runDeclaration [moduleFDecl]+      runDeclaration [D.DataConstructor]         [moduleA, moduleB, moduleC, moduleH] `shouldBe` []     it "extracts module by filtering `typeclass` declarations" $-      runDeclaration [moduleGDecl]+      runDeclaration [D.TypeClass]         [moduleA, moduleC, moduleG] `shouldBe` [moduleG]     it "removes everything if a `typeclass` declaration have not been found" $-      runDeclaration [moduleGDecl]+      runDeclaration [D.TypeClass]         [moduleA, moduleB, moduleC, moduleH] `shouldBe` []     it "extracts modules by filtering `valueoperator` declarations" $-      runDeclaration [moduleHDecl]+      runDeclaration [D.ValueOperator]         [moduleA, moduleC, moduleG, moduleH, moduleF] `shouldBe` [moduleH]     it "removes everything if a `valueoperator` declaration have not been found" $-      runDeclaration [moduleHDecl]+      runDeclaration [D.ValueOperator]         [moduleA, moduleB, moduleC, moduleD] `shouldBe` []     it "extracts modules by filtering `typeoperator` declarations" $-      runDeclaration [moduleIDecl]+      runDeclaration [D.TypeOperator]         [moduleA, moduleC, moduleG, moduleI, moduleF] `shouldBe` [moduleI]     it "removes everything if a `typeoperator` declaration have not been found" $-      runDeclaration [moduleIDecl]+      runDeclaration [D.TypeOperator]         [moduleA, moduleD] `shouldBe` []     it "extracts module by filtering `kind` declarations" $-      runDeclaration [moduleCDecl]-        [moduleA, moduleC, moduleG, moduleI, moduleF] `shouldBe` [moduleC]+      runDeclaration [D.Kind]+        [moduleA, moduleD, moduleG, moduleI, moduleF] `shouldBe` [moduleD]     it "removes everything if a `kind` declaration have not been found" $-      runDeclaration [moduleCDecl]-        [moduleA, moduleD] `shouldBe` []+      runDeclaration [D.Kind]+        [moduleA, moduleC] `shouldBe` []     it "extracts modules by filtering `value` and `synonym` declarations" $-      runDeclaration [moduleADecl, moduleEDecl]+      runDeclaration [D.Value, D.Synonym]         [moduleA, moduleB, moduleD, moduleE] `shouldBe` [moduleA, moduleB, moduleE]-    it "extracts modules by filtering `kind`, `synonym` and `valueoperator` declarations" $-      runDeclaration [moduleADecl, moduleDDecl, moduleHDecl]+    it "extracts modules by filtering `value`, `kind`, and `valueoperator` declarations" $+      runDeclaration [D.Value, D.Kind, D.ValueOperator]         [moduleA, moduleB, moduleD, moduleG, moduleE, moduleH] `shouldBe` [moduleA, moduleB, moduleD, moduleH]

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

@@ -3,9 +3,10 @@ module Language.PureScript.Ide.ImportsSpec where  import           Protolude hiding (moduleName)-import           Data.Maybe                      (fromJust)+import           Data.Maybe (fromJust)+import qualified Data.Set as Set -import qualified Language.PureScript             as P+import qualified Language.PureScript as P import           Language.PureScript.Ide.Command as Command import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.Imports@@ -48,9 +49,9 @@   ]  testSliceImportSection :: [Text] -> (P.ModuleName, [Text], [Import], [Text])-testSliceImportSection = fromRight . sliceImportSection+testSliceImportSection = unsafeFromRight . sliceImportSection   where-    fromRight = fromJust . rightToMaybe+    unsafeFromRight = fromJust . rightToMaybe  withImports :: [Text] -> [Text] withImports is =@@ -346,7 +347,7 @@  addExplicitImportFiltered :: Text -> [P.ModuleName] -> Command addExplicitImportFiltered i ms =-  Command.Import ("src" </> "ImportsSpec.purs") Nothing [moduleFilter ms] (Command.AddImportForIdentifier i Nothing)+  Command.Import ("src" </> "ImportsSpec.purs") Nothing [moduleFilter (Set.fromList ms)] (Command.AddImportForIdentifier i Nothing)  importShouldBe :: [Text] -> [Text] -> Expectation importShouldBe res importSection =

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

@@ -93,6 +93,9 @@     it "finds a type operator declaration" $ do       Just r <- getLocation "~>"       r `shouldBe` typeOpSS+    it "finds a module declaration" $ do+      Just r <- getLocation "SfModule"+      r `shouldBe` moduleSS  getLocation :: Text -> IO (Maybe P.SourceSpan) getLocation s = do@@ -102,7 +105,8 @@   where     ideState = emptyIdeState `volatileState`       [ ("Test",-         [ ideValue "sfValue" Nothing `annLoc` valueSS+         [ ideModule "SfModule" `annLoc` moduleSS+         , ideValue "sfValue" Nothing `annLoc` valueSS          , ideSynonym "SFType" Nothing Nothing `annLoc` synonymSS          , ideType "SFData" Nothing [] `annLoc` typeSS          , ideDtor "SFOne" "SFData" Nothing `annLoc` typeSS

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

@@ -101,7 +101,11 @@ ideKind :: Text -> IdeDeclarationAnn ideKind pn = ida (IdeDeclKind (P.ProperName pn)) -valueSS, synonymSS, typeSS, classSS, valueOpSS, typeOpSS :: P.SourceSpan+ideModule :: Text -> IdeDeclarationAnn+ideModule name = ida (IdeDeclModule (mn name))++moduleSS, valueSS, synonymSS, typeSS, classSS, valueOpSS, typeOpSS :: P.SourceSpan+moduleSS = ss 1 1 valueSS = ss 3 1 synonymSS = ss 5 1 typeSS = ss 7 1

tests/Main.hs view

@@ -18,6 +18,7 @@ import qualified TestPsci import qualified TestIde import qualified TestPscPublish+import qualified TestBundle import qualified TestUtils  import System.IO (hSetEncoding, stdout, stderr, utf8)@@ -29,14 +30,14 @@    heading "Updating support code"   TestUtils.updateSupportCode-  heading "Prim documentation test suite"-  TestPrimDocs.main    ideTests <- TestIde.main   compilerTests <- TestCompiler.main   psciTests <- TestPsci.main+  pscBundleTests <- TestBundle.main   coreFnTests <- TestCoreFn.main   docsTests <- TestDocs.main+  primDocsTests <- TestPrimDocs.main   publishTests <- TestPscPublish.main   hierarchyTests <- TestHierarchy.main @@ -45,9 +46,11 @@       "Tests"       [ compilerTests       , psciTests+      , pscBundleTests       , ideTests       , coreFnTests       , docsTests+      , primDocsTests       , publishTests       , hierarchyTests       ]

+ tests/TestBundle.hs view

@@ -0,0 +1,95 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module TestBundle where++import Prelude ()+import Prelude.Compat++import qualified Language.PureScript as P+import Language.PureScript.Bundle ++import Data.Function (on)+import Data.List (minimumBy)++import qualified Data.Map as M++import Control.Monad+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Except++import System.Exit+import System.Process+import System.FilePath+import System.IO+import System.IO.UTF8+import qualified System.FilePath.Glob as Glob++import TestUtils+import Test.Tasty+import Test.Tasty.Hspec++main :: IO TestTree+main = testSpec "bundle" spec++spec :: Spec+spec = do+  (supportModules, supportExterns, supportForeigns) <- runIO $ setupSupportModules+  bundleTestCases <- runIO $ getTestFiles "bundle"+  outputFile <- runIO $ createOutputFile logfile ++  context "Bundle examples" $+    forM_ bundleTestCases $ \testPurs -> do+      it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile, bundle and run without error") $+        assertBundles supportModules supportExterns supportForeigns testPurs outputFile+  where+  +  -- Takes the test entry point from a group of purs files - this is determined+  -- by the file with the shortest path name, as everything but the main file+  -- will be under a subdirectory.+  getTestMain :: [FilePath] -> FilePath+  getTestMain = minimumBy (compare `on` length)++assertBundles+  :: [P.Module]+  -> [P.ExternsFile]+  -> M.Map P.ModuleName FilePath+  -> [FilePath]+  -> Handle+  -> Expectation+assertBundles 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+        process <- findNodeProcess+        jsFiles <- Glob.globDir1 (Glob.compile "**/*.js") modulesDir+        let entryPoint = modulesDir </> "index.js"+        let entryModule = map (`ModuleIdentifier` Regular) ["Main"] +        bundled <- runExceptT $ do+          input <- forM jsFiles $ \filename -> do+            js <- liftIO $ readUTF8File filename+            mid <- guessModuleIdentifier filename+            length js `seq` return (mid, Just filename, js) +          bundleSM input entryModule (Just $ "Main") "PS" (Just entryPoint)+        case bundled of+            Right (_, js) -> do+              writeUTF8File entryPoint js+              result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process+              hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":"+              case result of+                Just (ExitSuccess, out, err)+                 | not (null err) -> return $ Just $ "Test wrote to stderr:\n\n" <> err+                 | not (null out) && trim (last (lines out)) == "Done" -> do+                     hPutStr outputFile out+                     return Nothing+                 | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out+                Just (ExitFailure _, _, err) -> return $ Just err+                Nothing -> return $ Just "Couldn't find node.js executable"+            Left err -> return . Just $ "Coud not bundle: " ++ show err++logfile :: FilePath+logfile = "bundle-tests.out"

tests/TestCompiler.hs view

@@ -26,29 +26,21 @@  import qualified Language.PureScript as P -import Data.Char (isSpace)+import Control.Arrow ((>>>)) import Data.Function (on)-import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy, minimumBy)+import Data.List (sort, stripPrefix, intercalate, minimumBy) import Data.Maybe (mapMaybe)-import Data.Time.Clock (UTCTime()) import qualified Data.Text as T-import Data.Tuple (swap)  import qualified Data.Map as M  import Control.Monad-import Control.Arrow ((***), (>>>)) -import Control.Monad.Reader-import Control.Monad.Trans.Except- import System.Exit-import System.Process hiding (cwd)+import System.Process import System.FilePath-import System.Directory import System.IO-import System.IO.UTF8-import qualified System.FilePath.Glob as Glob+import System.IO.UTF8 (readUTF8File)  import TestUtils import Test.Tasty@@ -59,29 +51,14 @@  spec :: Spec spec = do+  (supportModules, supportExterns, supportForeigns) <- runIO $ setupSupportModules -  (supportModules, supportExterns, supportForeigns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do-    cwd <- getCurrentDirectory-    let passing = cwd </> "tests" </> "purs" </> "passing"-    let warning = cwd </> "tests" </> "purs" </> "warning"-    let failing = cwd </> "tests" </> "purs" </> "failing"-    passingFiles <- getTestFiles passing <$> testGlob passing-    warningFiles <- getTestFiles warning <$> testGlob warning-    failingFiles <- getTestFiles failing <$> testGlob failing-    ms <- getSupportModuleTuples-    let modules = map snd ms-    supportExterns <- runExceptT $ do-      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 (modules, externs, foreigns, passingFiles, warningFiles, failingFiles)+  (passingTestCases, warningTestCases, failingTestCases) <- runIO $+    (,,) <$> getTestFiles "passing"+         <*> getTestFiles "warning"+         <*> getTestFiles "failing" -  outputFile <- runIO $ do-    tmp <- getTemporaryDirectory-    createDirectoryIfMissing False (tmp </> logpath)-    openFile (tmp </> logpath </> logfile) WriteMode+  outputFile <- runIO $ createOutputFile logfile    context "Passing examples" $     forM_ passingTestCases $ \testPurs ->@@ -104,36 +81,12 @@    where -  -- A glob for all purs and js files within a test directory-  testGlob :: FilePath -> IO [FilePath]-  testGlob = Glob.globDir1 (Glob.compile "**/*.purs")--  -- Groups the test files so that a top-level file can have dependencies in a-  -- subdirectory of the same name. The inner tuple contains a list of the-  -- .purs files and the .js files for the test case.-  getTestFiles :: FilePath -> [FilePath] -> [[FilePath]]-  getTestFiles baseDir-    = map (filter ((== ".purs") . takeExtensions) . map (baseDir </>))-    . groupBy ((==) `on` extractPrefix)-    . sortBy (compare `on` extractPrefix)-    . map (makeRelative baseDir)-   -- Takes the test entry point from a group of purs files - this is determined   -- by the file with the shortest path name, as everything but the main file   -- will be under a subdirectory.   getTestMain :: [FilePath] -> FilePath   getTestMain = minimumBy (compare `on` length) -  -- Extracts the filename part of a .purs file, or if the file is in a-  -- subdirectory, the first part of that directory path.-  extractPrefix :: FilePath -> FilePath-  extractPrefix fp =-    let dir = takeDirectory fp-        ext = reverse ".purs"-    in if dir == "."-       then maybe fp reverse $ stripPrefix ext $ reverse fp-       else dir-   -- Scans a file for @shouldFailWith directives in the comments, used to   -- determine expected failures   getShouldFailWith :: FilePath -> IO [String]@@ -147,81 +100,9 @@   extractPragma :: String -> FilePath -> IO [String]   extractPragma pragma = fmap go . readUTF8File     where-    go = lines >>> mapMaybe (stripPrefix ("-- @" ++ pragma ++ " ")) >>> map trim+      go = lines >>> mapMaybe (stripPrefix ("-- @" ++ pragma ++ " ")) >>> map trim -inferForeignModules-  :: MonadIO m-  => [(FilePath, P.Module)]-  -> m (M.Map P.ModuleName FilePath)-inferForeignModules = P.inferForeignModules . fromList-  where-    fromList :: [(FilePath, P.Module)] -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)-    fromList = M.fromList . map ((P.getModuleName *** Right) . swap) -trim :: String -> String-trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse--modulesDir :: FilePath-modulesDir = ".test_modules" </> "node_modules"--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-                               , P.progress = const (pure ())-                               }-  where-  getInputTimestamp :: P.ModuleName -> P.Make (Either P.RebuildPolicy (Maybe UTCTime))-  getInputTimestamp mn-    | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)-    | otherwise = return (Left P.RebuildAlways)-    where-    isSupportModule = flip elem (map (P.runModuleName . P.getModuleName) modules)--  getOutputTimestamp :: P.ModuleName -> P.Make (Maybe UTCTime)-  getOutputTimestamp mn = do-    let filePath = modulesDir </> T.unpack (P.runModuleName mn)-    exists <- liftIO $ doesDirectoryExist filePath-    return (if exists then Just (P.internalError "getOutputTimestamp: read timestamp") else Nothing)--runTest :: P.Make a -> IO (Either P.MultipleErrors a, P.MultipleErrors)-runTest = P.runMake P.defaultOptions--compile-  :: [P.Module]-  -> [P.ExternsFile]-  -> M.Map P.ModuleName FilePath-  -> [FilePath]-  -> ([P.Module] -> IO ())-  -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)-compile supportModules supportExterns supportForeigns inputFiles check = runTest $ do-  fs <- liftIO $ readInput inputFiles-  ms <- P.parseModulesFromFiles id fs-  foreigns <- inferForeignModules ms-  liftIO (check (map snd ms))-  let actions = makeActions supportModules (foreigns `M.union` supportForeigns)-  case ms of-    [singleModule] -> pure <$> P.rebuildModule actions supportExterns (snd singleModule)-    _ -> P.make actions (supportModules ++ map snd ms)--assert-  :: [P.Module]-  -> [P.ExternsFile]-  -> M.Map P.ModuleName FilePath-  -> [FilePath]-  -> ([P.Module] -> IO ())-  -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))-  -> Expectation-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--checkMain :: [P.Module] -> IO ()-checkMain ms =-  unless (any ((== P.moduleNameFromString "Main") . P.getModuleName) ms)-    (fail "Main module missing")- checkShouldFailWith :: [String] -> P.MultipleErrors -> Maybe String checkShouldFailWith expected errs =   let actual = map P.errorCode $ P.runMultipleErrors errs@@ -322,9 +203,6 @@    where   noPreCheck = const (return ())--logpath :: FilePath-logpath = "purescript-output"  logfile :: FilePath logfile = "psc-tests.out"

tests/TestDocs.hs view

@@ -275,7 +275,7 @@     "expected " <> decl <> " to be a " <> expected <> " declaration, but it" <>     " was a " <> actual <> " declaration"   DeclarationWrongType _ decl actual ->-    decl <> " had the wrong type; got " <> T.pack (P.prettyPrintType actual)+    decl <> " had the wrong type; got " <> T.pack (P.prettyPrintType maxBound actual)   TypeSynonymMismatch _ decl expected actual ->     "expected the RHS of " <> decl <> " to be " <> expected <>     "; got " <> actual@@ -294,8 +294,8 @@     "in rendered code for " <> decl <> ", bad link location for " <> target <>     ": expected " <> T.pack (show expected) <>     " got " <> T.pack (show actual)-  WrongOrder _ before after ->-    "expected to see " <> before <> " before " <> after+  WrongOrder _ before after' ->+    "expected to see " <> before <> " before " <> after'  displayTagsAssertionFailure :: TagsAssertionFailure -> Text displayTagsAssertionFailure = \case@@ -438,22 +438,22 @@             Nothing ->               Fail (LinkedDeclarationMissing mn decl destTitle) -    ShouldComeBefore mn before after ->+    ShouldComeBefore mn before after' ->       let         decls = declarationsFor mn          indexOf :: Text -> Maybe Int         indexOf title = findIndex ((==) title . Docs.declTitle) decls       in-        case (indexOf before, indexOf after) of+        case (indexOf before, indexOf after') of           (Just i, Just j) ->             if i < j               then Pass-              else Fail (WrongOrder mn before after)+              else Fail (WrongOrder mn before after')           (Nothing, _) ->             Fail (NotDocumented mn before)           (_, Nothing) ->-            Fail (NotDocumented mn after)+            Fail (NotDocumented mn after')    where   declarationsFor mn =

tests/TestPrimDocs.hs view

@@ -2,38 +2,40 @@  import Prelude -import Control.Monad-import Data.List ((\\))+import Data.List (sort)+import Control.Exception (evaluate)+import Control.DeepSeq (force) import qualified Data.Map as Map import qualified Data.Set as Set import qualified Language.PureScript as P import qualified Language.PureScript.Docs as D-import qualified Language.PureScript.Docs.AsMarkdown as D -main :: IO ()-main = do-  putStrLn "Test that there are no bottoms hiding in primDocsModule"-  seq (D.runDocs (D.modulesAsMarkdown D.primModules)) (return ())+import Test.Tasty+import Test.Tasty.Hspec (Spec, testSpec, it)+import Test.Hspec (shouldBe) -  putStrLn "Test that Prim is fully documented"-  let actualPrimNames =-        -- note that prim type classes are listed in P.primTypes-        (map (P.runProperName . P.disqualify . fst) $ Map.toList-          ( P.primTypes <>-            P.primBooleanTypes <>-            P.primOrderingTypes <>-            P.primRowTypes <>-            P.primRowListTypes <>-            P.primTypeErrorTypes <>-            P.primSymbolTypes )) ++-        (map (P.runProperName . P.disqualify) $ Set.toList P.allPrimKinds)-  let documentedPrimNames = map D.declTitle (concatMap D.modDeclarations D.primModules)+main :: IO TestTree+main = testSpec "prim docs" spec -  let undocumentedNames = actualPrimNames \\ documentedPrimNames-  let extraNames = documentedPrimNames \\ actualPrimNames+spec :: Spec+spec = do+  it "there are no bottoms hiding in primModules" $ do+    _ <- evaluate (force D.primModules)+    return () -  when (not (null undocumentedNames)) $-    error $ "Undocumented Prim names: " ++ show undocumentedNames+  it "all Prim modules are fully documented" $ do+    let actualPrimNames =+          -- note that prim type classes are listed in P.primTypes+          (map (P.runProperName . P.disqualify . fst) $ Map.toList+            ( P.primTypes <>+              P.primBooleanTypes <>+              P.primOrderingTypes <>+              P.primRowTypes <>+              P.primRowListTypes <>+              P.primTypeErrorTypes <>+              P.primSymbolTypes )) +++          (map (P.runProperName . P.disqualify) $ Set.toList P.allPrimKinds)+    let documentedPrimNames =+          map D.declTitle (concatMap D.modDeclarations D.primModules) -  when (not (null extraNames)) $-    error $ "Extra Prim names: " ++ show extraNames+    sort documentedPrimNames `shouldBe` sort actualPrimNames

tests/TestPscPublish.hs view

@@ -29,11 +29,22 @@  spec :: Spec spec = do-  it "roundtrips the json for purescript-prelude" $ do-    testPackage-      "tests/support/bower_components/purescript-prelude"-      "../../prelude-resolutions.json"+  context "preparePackage with json roundtrips" $ do+    it "purescript-prelude" $ do+      testPackage+        "tests/support/bower_components/purescript-prelude"+        "../../prelude-resolutions.json" +    it "basic example" $ do+      testPackage+        "tests/purs/publish/basic-example"+        "resolutions.json"++    it "basic example with legacy resolutions file" $ do+      testPackage+        "tests/purs/publish/basic-example"+        "resolutions-legacy.json"+   context "json compatibility" $ do     let compatDir = "tests" </> "json-compat"     versions <- runIO $ listDirectory compatDir@@ -61,10 +72,10 @@   in case A.eitherDecode before of        Left err -> ParseFailed err        Right parsed -> do-         let after = A.encode (parsed :: UploadedPackage)-         if before == after+         let after' = A.encode (parsed :: UploadedPackage)+         if before == after'            then Pass before-           else Mismatch before after+           else Mismatch before after'  testRunOptions :: PublishOptions testRunOptions = defaultPublishOptions

tests/TestUtils.hs view

@@ -1,5 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} + module TestUtils where  import Prelude ()@@ -7,21 +9,30 @@  import qualified Language.PureScript as P +import Control.Arrow ((***), (>>>)) import Control.Monad+import Control.Monad.Reader import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Control.Exception-import Data.List (sort)+import Data.Char (isSpace)+import Data.Function (on)+import Data.List (sort, sortBy, stripPrefix, groupBy)+import qualified Data.Map as M import qualified Data.Text as T-import System.Process+import Data.Time.Clock (UTCTime())+import Data.Tuple (swap)+import System.Process hiding (cwd) import System.Directory import System.Info import System.IO.UTF8 (readUTF8FileT) import System.Exit (exitFailure)-import System.FilePath ((</>))+import System.FilePath import qualified System.FilePath.Glob as Glob-import System.IO (stderr, hPutStrLn)+import System.IO +import Test.Tasty.Hspec + findNodeProcess :: IO (Maybe String) findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names   where@@ -86,3 +97,142 @@   result <- try act :: IO (Either IOException a)   setCurrentDirectory original   either throwIO return result+++createOutputFile :: FilePath -> IO Handle+createOutputFile logfileName = do+  tmp <- getTemporaryDirectory+  createDirectoryIfMissing False (tmp </> logpath)+  openFile (tmp </> logpath </> logfileName) WriteMode++setupSupportModules :: IO ([P.Module], [P.ExternsFile], M.Map P.ModuleName FilePath)+setupSupportModules = do+  ms <- getSupportModuleTuples+  let modules = map snd ms+  supportExterns <- runExceptT $ do+    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 (modules, externs, foreigns)++getTestFiles :: FilePath -> IO [[FilePath]]+getTestFiles testDir = do+  cwd <- getCurrentDirectory+  let dir = cwd </> "tests" </> "purs" </> testDir+  testsInPath <- getFiles dir <$> testGlob dir+  let rerunPath = dir </> "RerunCompilerTests.txt"+  hasRerunFile <- doesFileExist rerunPath+  rerunTests <-+    if hasRerunFile+    then let compilerTestDir = cwd </> "tests" </> "purs" </> "passing"+             textToTestFiles+               = mapM (\path -> ((path ++ ".purs") :) <$> testGlob path)+               . map ((compilerTestDir </>) . T.unpack)+               . filter (not . T.null)+               . map (T.strip . fst . T.breakOn "--")+               . T.lines+         in readUTF8FileT rerunPath >>= textToTestFiles+    else return []+  return $ testsInPath ++ rerunTests+  where+  -- A glob for all purs and js files within a test directory+  testGlob :: FilePath -> IO [FilePath]+  testGlob = Glob.globDir1 (Glob.compile "**/*.purs")+  -- Groups the test files so that a top-level file can have dependencies in a+  -- subdirectory of the same name. The inner tuple contains a list of the+  -- .purs files and the .js files for the test case.+  getFiles :: FilePath -> [FilePath] -> [[FilePath]]+  getFiles baseDir+    = map (filter ((== ".purs") . takeExtensions) . map (baseDir </>))+    . groupBy ((==) `on` extractPrefix)+    . sortBy (compare `on` extractPrefix)+    . map (makeRelative baseDir)+  -- Extracts the filename part of a .purs file, or if the file is in a+  -- subdirectory, the first part of that directory path.+  extractPrefix :: FilePath -> FilePath+  extractPrefix fp =+    let dir = takeDirectory fp+        ext = reverse ".purs"+    in if dir == "."+       then maybe fp reverse $ stripPrefix ext $ reverse fp+       else dir++compile+  :: [P.Module]+  -> [P.ExternsFile]+  -> M.Map P.ModuleName FilePath+  -> [FilePath]+  -> ([P.Module] -> IO ())+  -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)+compile supportModules supportExterns supportForeigns inputFiles check = runTest $ do+  fs <- liftIO $ readInput inputFiles+  ms <- P.parseModulesFromFiles id fs+  foreigns <- inferForeignModules ms+  liftIO (check (map snd ms))+  let actions = makeActions supportModules (foreigns `M.union` supportForeigns)+  case ms of+    [singleModule] -> pure <$> P.rebuildModule actions supportExterns (snd singleModule)+    _ -> P.make actions (supportModules ++ map snd ms)++assert+  :: [P.Module]+  -> [P.ExternsFile]+  -> M.Map P.ModuleName FilePath+  -> [FilePath]+  -> ([P.Module] -> IO ())+  -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))+  -> Expectation+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++checkMain :: [P.Module] -> IO ()+checkMain ms =+  unless (any ((== P.moduleNameFromString "Main") . P.getModuleName) ms)+    (fail "Main module missing")+++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+                               , P.progress = const (pure ())+                               }+  where+  getInputTimestamp :: P.ModuleName -> P.Make (Either P.RebuildPolicy (Maybe UTCTime))+  getInputTimestamp mn+    | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)+    | otherwise = return (Left P.RebuildAlways)+    where+    isSupportModule = flip elem (map (P.runModuleName . P.getModuleName) modules)++  getOutputTimestamp :: P.ModuleName -> P.Make (Maybe UTCTime)+  getOutputTimestamp mn = do+    let filePath = modulesDir </> T.unpack (P.runModuleName mn)+    exists <- liftIO $ doesDirectoryExist filePath+    return (if exists then Just (P.internalError "getOutputTimestamp: read timestamp") else Nothing)+++runTest :: P.Make a -> IO (Either P.MultipleErrors a, P.MultipleErrors)+runTest = P.runMake P.defaultOptions++inferForeignModules+  :: MonadIO m+  => [(FilePath, P.Module)]+  -> m (M.Map P.ModuleName FilePath)+inferForeignModules = P.inferForeignModules . fromList+  where+    fromList :: [(FilePath, P.Module)] -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)+    fromList = M.fromList . map ((P.getModuleName *** Right) . swap)++trim :: String -> String+trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse++modulesDir :: FilePath+modulesDir = ".test_modules" </> "node_modules"++logpath :: FilePath+logpath = "purescript-output"

+ tests/purs/bundle/PSasConstructor.purs view

@@ -0,0 +1,11 @@+module Main where++import Prelude+import Effect (Effect)+import Effect.Console (log)++data P = PS ++main :: Effect Unit+main = do+  log "Done"

tests/purs/failing/Superclasses2.purs view

@@ -1,5 +1,4 @@--- @shouldFailWith CycleInTypeSynonym--- TODO: Should this have its own error, perhaps CycleInTypeClassDeclaration?+-- @shouldFailWith CycleInTypeClassDeclaration module CycleInSuperclasses where  import Prelude

+ tests/purs/publish/basic-example/bower.json view

@@ -0,0 +1,13 @@+{+  "name": "basic-example",+  "repository": {+    "type": "git",+    "url": "https://github.com/purescript/test.git"+  },+  "license": "MIT",+  "dependencies": {+    "purescript-console": "^1.0.0",+    "purescript-prelude": "^1.0.0",+    "purescript-effect": "^1.0.0"+  }+}

+ tests/purs/publish/basic-example/resolutions-legacy.json view

@@ -0,0 +1,640 @@+{+  "endpoint": {+    "name": "basic-example",+    "source": ".",+    "target": "*"+  },+  "canonicalDir": ".",+  "pkgMeta": {+    "name": "basic-example",+    "ignore": [+      "**/.*",+      "node_modules",+      "bower_components",+      "output"+    ],+    "dependencies": {+      "purescript-prelude": "^4.1.0",+      "purescript-console": "^4.2.0",+      "purescript-effect": "^2.0.1",+      "purescript-newtype": "#master"+    },+    "devDependencies": {+      "purescript-psci-support": "^4.0.0"+    }+  },+  "dependencies": {+    "purescript-console": {+      "endpoint": {+        "name": "purescript-console",+        "source": "purescript-console",+        "target": "^4.2.0"+      },+      "canonicalDir": "../../../support/bower_components/purescript-console",+      "pkgMeta": {+        "name": "purescript-console",+        "homepage": "https://github.com/purescript/purescript-console",+        "license": "BSD-3-Clause",+        "repository": {+          "type": "git",+          "url": "git://github.com/purescript/purescript-console.git"+        },+        "ignore": [+          "**/.*",+          "bower_components",+          "node_modules",+          "output",+          "test",+          "bower.json",+          "package.json"+        ],+        "dependencies": {+          "purescript-effect": "^2.0.0",+          "purescript-prelude": "^4.0.0"+        },+        "version": "4.2.0",+        "_release": "4.2.0",+        "_resolution": {+          "type": "version",+          "tag": "v4.2.0",+          "commit": "add2bdb8a4af2213d993b728805f1f2a5e76deb8"+        },+        "_source": "https://github.com/purescript/purescript-console.git",+        "_target": "^4.2.0",+        "_originalSource": "purescript-console"+      },+      "dependencies": {+        "purescript-effect": {+          "endpoint": {+            "name": "purescript-effect",+            "source": "purescript-effect",+            "target": "^2.0.0"+          },+          "canonicalDir": "../../../support/bower_components/purescript-effect",+          "pkgMeta": {+            "name": "purescript-effect",+            "homepage": "https://github.com/purescript/purescript-effect",+            "license": "BSD-3-Clause",+            "repository": {+              "type": "git",+              "url": "git://github.com/purescript/purescript-effect.git"+            },+            "ignore": [+              "**/.*",+              "bower_components",+              "node_modules",+              "output",+              "test",+              "bower.json",+              "package.json"+            ],+            "dependencies": {+              "purescript-prelude": "^4.0.0"+            },+            "version": "2.0.1",+            "_release": "2.0.1",+            "_resolution": {+              "type": "version",+              "tag": "v2.0.1",+              "commit": "d2a11e69abcda3b81c750e86e8746cda278f47bf"+            },+            "_source": "https://github.com/purescript/purescript-effect.git",+            "_target": "^2.0.1",+            "_originalSource": "purescript-effect"+          },+          "dependencies": {+            "purescript-prelude": {+              "endpoint": {+                "name": "purescript-prelude",+                "source": "purescript-prelude",+                "target": "^4.0.0"+              },+              "canonicalDir": "../../../support/bower_components/purescript-prelude",+              "pkgMeta": {+                "name": "purescript-prelude",+                "homepage": "https://github.com/purescript/purescript-prelude",+                "description": "The PureScript Prelude",+                "license": "BSD-3-Clause",+                "repository": {+                  "type": "git",+                  "url": "git://github.com/purescript/purescript-prelude.git"+                },+                "ignore": [+                  "**/.*",+                  "bower_components",+                  "node_modules",+                  "output",+                  "test",+                  "bower.json",+                  "package.json"+                ],+                "version": "4.1.0",+                "_release": "4.1.0",+                "_resolution": {+                  "type": "version",+                  "tag": "v4.1.0",+                  "commit": "7a691ce2658bd8eaf28439391e29506dd154fb3d"+                },+                "_source": "https://github.com/purescript/purescript-prelude.git",+                "_target": "^4.1.0",+                "_originalSource": "purescript-prelude"+              },+              "dependencies": {},+              "nrDependants": 1+            }+          },+          "nrDependants": 1+        },+        "purescript-prelude": {+          "endpoint": {+            "name": "purescript-prelude",+            "source": "purescript-prelude",+            "target": "^4.0.0"+          },+          "canonicalDir": "../../../support/bower_components/purescript-prelude",+          "pkgMeta": {+            "name": "purescript-prelude",+            "homepage": "https://github.com/purescript/purescript-prelude",+            "description": "The PureScript Prelude",+            "license": "BSD-3-Clause",+            "repository": {+              "type": "git",+              "url": "git://github.com/purescript/purescript-prelude.git"+            },+            "ignore": [+              "**/.*",+              "bower_components",+              "node_modules",+              "output",+              "test",+              "bower.json",+              "package.json"+            ],+            "version": "4.1.0",+            "_release": "4.1.0",+            "_resolution": {+              "type": "version",+              "tag": "v4.1.0",+              "commit": "7a691ce2658bd8eaf28439391e29506dd154fb3d"+            },+            "_source": "https://github.com/purescript/purescript-prelude.git",+            "_target": "^4.1.0",+            "_originalSource": "purescript-prelude"+          },+          "dependencies": {},+          "nrDependants": 1+        }+      },+      "nrDependants": 1+    },+    "purescript-effect": {+      "endpoint": {+        "name": "purescript-effect",+        "source": "purescript-effect",+        "target": "^2.0.1"+      },+      "canonicalDir": "../../../support/bower_components/purescript-effect",+      "pkgMeta": {+        "name": "purescript-effect",+        "homepage": "https://github.com/purescript/purescript-effect",+        "license": "BSD-3-Clause",+        "repository": {+          "type": "git",+          "url": "git://github.com/purescript/purescript-effect.git"+        },+        "ignore": [+          "**/.*",+          "bower_components",+          "node_modules",+          "output",+          "test",+          "bower.json",+          "package.json"+        ],+        "dependencies": {+          "purescript-prelude": "^4.0.0"+        },+        "version": "2.0.1",+        "_release": "2.0.1",+        "_resolution": {+          "type": "version",+          "tag": "v2.0.1",+          "commit": "d2a11e69abcda3b81c750e86e8746cda278f47bf"+        },+        "_source": "https://github.com/purescript/purescript-effect.git",+        "_target": "^2.0.1",+        "_originalSource": "purescript-effect"+      },+      "dependencies": {},+      "nrDependants": 1+    },+    "purescript-newtype": {+      "endpoint": {+        "name": "purescript-newtype",+        "source": "purescript-newtype",+        "target": "master"+      },+      "canonicalDir": "../../../support/bower_components/purescript-newtype",+      "pkgMeta": {+        "name": "purescript-newtype",+        "homepage": "https://github.com/purescript/purescript-newtype",+        "description": "Type class and functions for working with newtypes",+        "license": "BSD-3-Clause",+        "repository": {+          "type": "git",+          "url": "git://github.com/purescript/purescript-newtype.git"+        },+        "ignore": [+          "**/.*",+          "bower_components",+          "node_modules",+          "output",+          "test",+          "bower.json",+          "package.json"+        ],+        "dependencies": {+          "purescript-prelude": "^4.0.0"+        },+        "_release": "7d85fa6a04",+        "_resolution": {+          "type": "branch",+          "branch": "master",+          "commit": "7d85fa6a040208c010b05f7c23af6a943ba08763"+        },+        "_source": "https://github.com/garyb/purescript-newtype.git",+        "_target": "master",+        "_originalSource": "purescript-newtype"+      },+      "dependencies": {+        "purescript-prelude": {+          "endpoint": {+            "name": "purescript-prelude",+            "source": "purescript-prelude",+            "target": "^4.0.0"+          },+          "canonicalDir": "../../../support/bower_components/purescript-prelude",+          "pkgMeta": {+            "name": "purescript-prelude",+            "homepage": "https://github.com/purescript/purescript-prelude",+            "description": "The PureScript Prelude",+            "license": "BSD-3-Clause",+            "repository": {+              "type": "git",+              "url": "git://github.com/purescript/purescript-prelude.git"+            },+            "ignore": [+              "**/.*",+              "bower_components",+              "node_modules",+              "output",+              "test",+              "bower.json",+              "package.json"+            ],+            "version": "4.1.0",+            "_release": "4.1.0",+            "_resolution": {+              "type": "version",+              "tag": "v4.1.0",+              "commit": "7a691ce2658bd8eaf28439391e29506dd154fb3d"+            },+            "_source": "https://github.com/purescript/purescript-prelude.git",+            "_target": "^4.1.0",+            "_originalSource": "purescript-prelude"+          },+          "dependencies": {},+          "nrDependants": 1+        }+      },+      "nrDependants": 1+    },+    "purescript-prelude": {+      "endpoint": {+        "name": "purescript-prelude",+        "source": "purescript-prelude",+        "target": "^4.1.0"+      },+      "canonicalDir": "../../../support/bower_components/purescript-prelude",+      "pkgMeta": {+        "name": "purescript-prelude",+        "homepage": "https://github.com/purescript/purescript-prelude",+        "description": "The PureScript Prelude",+        "license": "BSD-3-Clause",+        "repository": {+          "type": "git",+          "url": "git://github.com/purescript/purescript-prelude.git"+        },+        "ignore": [+          "**/.*",+          "bower_components",+          "node_modules",+          "output",+          "test",+          "bower.json",+          "package.json"+        ],+        "version": "4.1.0",+        "_release": "4.1.0",+        "_resolution": {+          "type": "version",+          "tag": "v4.1.0",+          "commit": "7a691ce2658bd8eaf28439391e29506dd154fb3d"+        },+        "_source": "https://github.com/purescript/purescript-prelude.git",+        "_target": "^4.1.0",+        "_originalSource": "purescript-prelude"+      },+      "dependencies": {},+      "nrDependants": 1+    },+    "purescript-psci-support": {+      "endpoint": {+        "name": "purescript-psci-support",+        "source": "purescript-psci-support",+        "target": "^4.0.0"+      },+      "canonicalDir": "../../../support/bower_components/purescript-psci-support",+      "pkgMeta": {+        "name": "purescript-psci-support",+        "homepage": "https://github.com/purescript/purescript-psci-support",+        "description": "Support module for the PSCI interactive mode",+        "license": "BSD-3-Clause",+        "repository": {+          "type": "git",+          "url": "git://github.com/purescript/purescript-psci-support.git"+        },+        "ignore": [+          "**/.*",+          "bower_components",+          "node_modules",+          "output",+          "bower.json",+          "package.json"+        ],+        "dependencies": {+          "purescript-console": "^4.0.0",+          "purescript-effect": "^2.0.0",+          "purescript-prelude": "^4.0.0"+        },+        "version": "4.0.0",+        "_release": "4.0.0",+        "_resolution": {+          "type": "version",+          "tag": "v4.0.0",+          "commit": "a66a0fa8661eb8b5fe75cc862f4e2df2835c058d"+        },+        "_source": "https://github.com/purescript/purescript-psci-support.git",+        "_target": "^4.0.0",+        "_originalSource": "purescript-psci-support"+      },+      "dependencies": {+        "purescript-console": {+          "endpoint": {+            "name": "purescript-console",+            "source": "purescript-console",+            "target": "^4.0.0"+          },+          "canonicalDir": "../../../support/bower_components/purescript-console",+          "pkgMeta": {+            "name": "purescript-console",+            "homepage": "https://github.com/purescript/purescript-console",+            "license": "BSD-3-Clause",+            "repository": {+              "type": "git",+              "url": "git://github.com/purescript/purescript-console.git"+            },+            "ignore": [+              "**/.*",+              "bower_components",+              "node_modules",+              "output",+              "test",+              "bower.json",+              "package.json"+            ],+            "dependencies": {+              "purescript-effect": "^2.0.0",+              "purescript-prelude": "^4.0.0"+            },+            "version": "4.2.0",+            "_release": "4.2.0",+            "_resolution": {+              "type": "version",+              "tag": "v4.2.0",+              "commit": "add2bdb8a4af2213d993b728805f1f2a5e76deb8"+            },+            "_source": "https://github.com/purescript/purescript-console.git",+            "_target": "^4.2.0",+            "_originalSource": "purescript-console"+          },+          "dependencies": {+            "purescript-effect": {+              "endpoint": {+                "name": "purescript-effect",+                "source": "purescript-effect",+                "target": "^2.0.0"+              },+              "canonicalDir": "../../../support/bower_components/purescript-effect",+              "pkgMeta": {+                "name": "purescript-effect",+                "homepage": "https://github.com/purescript/purescript-effect",+                "license": "BSD-3-Clause",+                "repository": {+                  "type": "git",+                  "url": "git://github.com/purescript/purescript-effect.git"+                },+                "ignore": [+                  "**/.*",+                  "bower_components",+                  "node_modules",+                  "output",+                  "test",+                  "bower.json",+                  "package.json"+                ],+                "dependencies": {+                  "purescript-prelude": "^4.0.0"+                },+                "version": "2.0.1",+                "_release": "2.0.1",+                "_resolution": {+                  "type": "version",+                  "tag": "v2.0.1",+                  "commit": "d2a11e69abcda3b81c750e86e8746cda278f47bf"+                },+                "_source": "https://github.com/purescript/purescript-effect.git",+                "_target": "^2.0.1",+                "_originalSource": "purescript-effect"+              },+              "dependencies": {+                "purescript-prelude": {+                  "endpoint": {+                    "name": "purescript-prelude",+                    "source": "purescript-prelude",+                    "target": "^4.0.0"+                  },+                  "canonicalDir": "../../../support/bower_components/purescript-prelude",+                  "pkgMeta": {+                    "name": "purescript-prelude",+                    "homepage": "https://github.com/purescript/purescript-prelude",+                    "description": "The PureScript Prelude",+                    "license": "BSD-3-Clause",+                    "repository": {+                      "type": "git",+                      "url": "git://github.com/purescript/purescript-prelude.git"+                    },+                    "ignore": [+                      "**/.*",+                      "bower_components",+                      "node_modules",+                      "output",+                      "test",+                      "bower.json",+                      "package.json"+                    ],+                    "version": "4.1.0",+                    "_release": "4.1.0",+                    "_resolution": {+                      "type": "version",+                      "tag": "v4.1.0",+                      "commit": "7a691ce2658bd8eaf28439391e29506dd154fb3d"+                    },+                    "_source": "https://github.com/purescript/purescript-prelude.git",+                    "_target": "^4.1.0",+                    "_originalSource": "purescript-prelude"+                  },+                  "dependencies": {},+                  "nrDependants": 1+                }+              },+              "nrDependants": 1+            },+            "purescript-prelude": {+              "endpoint": {+                "name": "purescript-prelude",+                "source": "purescript-prelude",+                "target": "^4.0.0"+              },+              "canonicalDir": "../../../support/bower_components/purescript-prelude",+              "pkgMeta": {+                "name": "purescript-prelude",+                "homepage": "https://github.com/purescript/purescript-prelude",+                "description": "The PureScript Prelude",+                "license": "BSD-3-Clause",+                "repository": {+                  "type": "git",+                  "url": "git://github.com/purescript/purescript-prelude.git"+                },+                "ignore": [+                  "**/.*",+                  "bower_components",+                  "node_modules",+                  "output",+                  "test",+                  "bower.json",+                  "package.json"+                ],+                "version": "4.1.0",+                "_release": "4.1.0",+                "_resolution": {+                  "type": "version",+                  "tag": "v4.1.0",+                  "commit": "7a691ce2658bd8eaf28439391e29506dd154fb3d"+                },+                "_source": "https://github.com/purescript/purescript-prelude.git",+                "_target": "^4.1.0",+                "_originalSource": "purescript-prelude"+              },+              "dependencies": {},+              "nrDependants": 1+            }+          },+          "nrDependants": 1+        },+        "purescript-effect": {+          "endpoint": {+            "name": "purescript-effect",+            "source": "purescript-effect",+            "target": "^2.0.0"+          },+          "canonicalDir": "../../../support/bower_components/purescript-effect",+          "pkgMeta": {+            "name": "purescript-effect",+            "homepage": "https://github.com/purescript/purescript-effect",+            "license": "BSD-3-Clause",+            "repository": {+              "type": "git",+              "url": "git://github.com/purescript/purescript-effect.git"+            },+            "ignore": [+              "**/.*",+              "bower_components",+              "node_modules",+              "output",+              "test",+              "bower.json",+              "package.json"+            ],+            "dependencies": {+              "purescript-prelude": "^4.0.0"+            },+            "version": "2.0.1",+            "_release": "2.0.1",+            "_resolution": {+              "type": "version",+              "tag": "v2.0.1",+              "commit": "d2a11e69abcda3b81c750e86e8746cda278f47bf"+            },+            "_source": "https://github.com/purescript/purescript-effect.git",+            "_target": "^2.0.1",+            "_originalSource": "purescript-effect"+          },+          "dependencies": {},+          "nrDependants": 1+        },+        "purescript-prelude": {+          "endpoint": {+            "name": "purescript-prelude",+            "source": "purescript-prelude",+            "target": "^4.0.0"+          },+          "canonicalDir": "../../../support/bower_components/purescript-prelude",+          "pkgMeta": {+            "name": "purescript-prelude",+            "homepage": "https://github.com/purescript/purescript-prelude",+            "description": "The PureScript Prelude",+            "license": "BSD-3-Clause",+            "repository": {+              "type": "git",+              "url": "git://github.com/purescript/purescript-prelude.git"+            },+            "ignore": [+              "**/.*",+              "bower_components",+              "node_modules",+              "output",+              "test",+              "bower.json",+              "package.json"+            ],+            "version": "4.1.0",+            "_release": "4.1.0",+            "_resolution": {+              "type": "version",+              "tag": "v4.1.0",+              "commit": "7a691ce2658bd8eaf28439391e29506dd154fb3d"+            },+            "_source": "https://github.com/purescript/purescript-prelude.git",+            "_target": "^4.1.0",+            "_originalSource": "purescript-prelude"+          },+          "dependencies": {},+          "nrDependants": 1+        }+      },+      "nrDependants": 1+    }+  },+  "nrDependants": 0+}

+ tests/purs/publish/basic-example/resolutions.json view

@@ -0,0 +1,17 @@+{+  "purescript-console": {+    "version": "1.0.0",+    "path": "../../../support/bower_components/purescript-console"+  },+  "purescript-effect": {+    "version": "1.0.0",+    "path": "../../../support/bower_components/purescript-effect"+  },+  "purescript-prelude": {+    "version": "1.0.0",+    "path": "../../../support/bower_components/purescript-prelude"+  },+  "purescript-newtype": {+    "path": "../../../support/bower_components/purescript-newtype"+  }+}

+ tests/purs/publish/basic-example/src/Main.purs view

@@ -0,0 +1,16 @@+module Main where++import Prelude+import Effect (Effect)+import Effect.Console (log)+import Data.Newtype (class Newtype, un)++newtype Target = Target String++derive instance newtypeTarget :: Newtype Target _++greetingTarget :: Target+greetingTarget = Target "world"++main :: Effect Unit+main = log ("hello, " <> un Target greetingTarget <> "!")

tests/support/package-lock.json view

@@ -8,9 +8,9 @@       "integrity": "sha1-ibTRmasr7kneFk6gK4nORi1xt2c="     },     "bower": {-      "version": "1.8.4",-      "resolved": "http://registry.npmjs.org/bower/-/bower-1.8.4.tgz",-      "integrity": "sha1-54dqB23rgTf30GUl3F6MZtuC8oo="+      "version": "1.8.8",+      "resolved": "https://registry.npmjs.org/bower/-/bower-1.8.8.tgz",+      "integrity": "sha512-1SrJnXnkP9soITHptSO+ahx3QKp3cVzn8poI6ujqc5SeOkg5iqM1pK9H+DSc2OQ8SnO0jC/NG4Ur/UIwy7574A=="     },     "brace-expansion": {       "version": "1.1.11",@@ -75,15 +75,15 @@     },     "path-is-absolute": {       "version": "1.0.1",-      "resolved": "http://registry.npmjs.org/path-is-absolute/-/path-is-absolute-1.0.1.tgz",+      "resolved": "https://registry.npmjs.org/path-is-absolute/-/path-is-absolute-1.0.1.tgz",       "integrity": "sha1-F0uSaHNVNP+8es5r9TpanhtcX18="     },     "rimraf": {-      "version": "2.6.2",-      "resolved": "https://registry.npmjs.org/rimraf/-/rimraf-2.6.2.tgz",-      "integrity": "sha512-lreewLK/BlghmxtfH36YYVg1i8IAce4TI7oao75I1g245+6BctqTVQiBP3YUJ9C6DQOXJmkYR9X9fCLtCOJc5w==",+      "version": "2.6.3",+      "resolved": "https://registry.npmjs.org/rimraf/-/rimraf-2.6.3.tgz",+      "integrity": "sha512-mwqeW5XsA2qAejG46gYdENaxXjx9onRNCfn7L0duuP4hCuTIi/QO7PDK07KJfp1d+izWPrzEJDcSqBa0OZQriA==",       "requires": {-        "glob": "^7.0.5"+        "glob": "^7.1.3"       },       "dependencies": {         "glob": {

tests/support/package.json view

@@ -1,7 +1,7 @@ {   "private": true,   "dependencies": {-    "bower": "^1.4.1",+    "bower": "^1.8.8",     "glob": "^5.0.14",     "rimraf": "^2.5.2"   }

tests/support/prelude-resolutions.json view

@@ -1,7 +1,1 @@-{-  "canonicalDir": "bower_components/purescript-prelude",-  "pkgMeta": {-    "dependencies": {}-  },-  "dependencies": {}-}+{}

tests/support/pscide/src/CompletionSpecDocs.purs view

@@ -1,3 +1,4 @@+-- | Module Documentation module CompletionSpecDocs where  -- | Doc x