summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorgaryb <>2018-11-22 00:41:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-11-22 00:41:00 (GMT)
commite475885477784963005d0b81bdc96f96002e07b4 (patch)
tree79f3c797bd8fede81aa85feee1b448dd09aec48a
parent25a279f1e1a547125036fd4b81f0549bf37f5339 (diff)
version 0.12.10.12.1
-rw-r--r--CONTRIBUTING.md2
-rw-r--r--CONTRIBUTORS.md3
-rw-r--r--README.md4
-rw-r--r--app/Command/Bundle.hs6
-rw-r--r--app/Command/Compile.hs17
-rw-r--r--app/Command/Hierarchy.hs1
-rw-r--r--app/Command/Publish.hs1
-rw-r--r--app/Command/REPL.hs9
-rw-r--r--app/Main.hs1
-rw-r--r--purescript.cabal42
-rw-r--r--src/Language/PureScript/AST/Binders.hs2
-rw-r--r--src/Language/PureScript/AST/Declarations.hs2
-rw-r--r--src/Language/PureScript/AST/SourcePos.hs1
-rw-r--r--src/Language/PureScript/AST/Traversals.hs147
-rw-r--r--src/Language/PureScript/CodeGen/JS.hs1
-rw-r--r--src/Language/PureScript/CodeGen/JS/Common.hs1
-rw-r--r--src/Language/PureScript/CodeGen/JS/Printer.hs1
-rw-r--r--src/Language/PureScript/Constants.hs33
-rw-r--r--src/Language/PureScript/CoreFn/Traversals.hs30
-rw-r--r--src/Language/PureScript/CoreImp/AST.hs40
-rw-r--r--src/Language/PureScript/CoreImp/Optimizer.hs5
-rw-r--r--src/Language/PureScript/CoreImp/Optimizer/Inliner.hs1
-rw-r--r--src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs31
-rw-r--r--src/Language/PureScript/CoreImp/Optimizer/TCO.hs1
-rw-r--r--src/Language/PureScript/Docs/AsHtml.hs1
-rw-r--r--src/Language/PureScript/Docs/AsMarkdown.hs1
-rw-r--r--src/Language/PureScript/Docs/Convert/ReExports.hs8
-rw-r--r--src/Language/PureScript/Docs/Convert/Single.hs2
-rw-r--r--src/Language/PureScript/Docs/Prim.hs13
-rw-r--r--src/Language/PureScript/Docs/Render.hs1
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/RenderKind.hs1
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/RenderType.hs1
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/Types.hs3
-rw-r--r--src/Language/PureScript/Docs/Utils/MonoidExtras.hs1
-rw-r--r--src/Language/PureScript/Environment.hs1
-rw-r--r--src/Language/PureScript/Errors.hs12
-rw-r--r--src/Language/PureScript/Errors/JSON.hs1
-rw-r--r--src/Language/PureScript/Hierarchy.hs1
-rw-r--r--src/Language/PureScript/Ide.hs8
-rw-r--r--src/Language/PureScript/Ide/Command.hs10
-rw-r--r--src/Language/PureScript/Ide/Completion.hs2
-rw-r--r--src/Language/PureScript/Ide/Externs.hs2
-rw-r--r--src/Language/PureScript/Ide/Filter.hs2
-rw-r--r--src/Language/PureScript/Ide/Imports.hs2
-rw-r--r--src/Language/PureScript/Ide/Matcher.hs2
-rw-r--r--src/Language/PureScript/Ide/Rebuild.hs21
-rw-r--r--src/Language/PureScript/Ide/Reexports.hs2
-rw-r--r--src/Language/PureScript/Ide/State.hs4
-rw-r--r--src/Language/PureScript/Ide/Types.hs38
-rw-r--r--src/Language/PureScript/Ide/Usage.hs2
-rw-r--r--src/Language/PureScript/Ide/Util.hs16
-rw-r--r--src/Language/PureScript/Interactive.hs3
-rw-r--r--src/Language/PureScript/Interactive/Printer.hs1
-rw-r--r--src/Language/PureScript/Interactive/Types.hs13
-rw-r--r--src/Language/PureScript/Kinds.hs6
-rw-r--r--src/Language/PureScript/Label.hs2
-rw-r--r--src/Language/PureScript/Linter.hs1
-rw-r--r--src/Language/PureScript/Linter/Exhaustive.hs1
-rw-r--r--src/Language/PureScript/Make.hs1
-rw-r--r--src/Language/PureScript/Make/Actions.hs42
-rw-r--r--src/Language/PureScript/Names.hs1
-rw-r--r--src/Language/PureScript/Options.hs9
-rw-r--r--src/Language/PureScript/PSString.hs3
-rw-r--r--src/Language/PureScript/Parser/Common.hs1
-rw-r--r--src/Language/PureScript/Parser/Declarations.hs1
-rw-r--r--src/Language/PureScript/Parser/Lexer.hs1
-rw-r--r--src/Language/PureScript/Pretty/Common.hs8
-rw-r--r--src/Language/PureScript/Pretty/Kinds.hs1
-rw-r--r--src/Language/PureScript/Pretty/Types.hs2
-rw-r--r--src/Language/PureScript/Pretty/Values.hs2
-rw-r--r--src/Language/PureScript/Publish.hs9
-rw-r--r--src/Language/PureScript/Publish/ErrorsWarnings.hs7
-rw-r--r--src/Language/PureScript/Renamer.hs1
-rw-r--r--src/Language/PureScript/Sugar/DoNotation.hs57
-rw-r--r--src/Language/PureScript/Sugar/Names/Env.hs4
-rw-r--r--src/Language/PureScript/Sugar/Names/Exports.hs1
-rw-r--r--src/Language/PureScript/Sugar/TypeClasses.hs16
-rw-r--r--src/Language/PureScript/Sugar/TypeClasses/Deriving.hs26
-rw-r--r--src/Language/PureScript/TypeChecker.hs4
-rw-r--r--src/Language/PureScript/TypeChecker/Entailment.hs11
-rw-r--r--src/Language/PureScript/TypeChecker/Skolems.hs1
-rw-r--r--src/Language/PureScript/TypeChecker/Types.hs1
-rw-r--r--src/Language/PureScript/TypeClassDictionaries.hs1
-rw-r--r--src/Language/PureScript/Types.hs1
-rw-r--r--stack.yaml6
-rw-r--r--tests/Language/PureScript/Ide/CompletionSpec.hs7
-rw-r--r--tests/Language/PureScript/Ide/RebuildSpec.hs26
-rw-r--r--tests/Language/PureScript/Ide/StateSpec.hs4
-rw-r--r--tests/TestCompiler.hs15
-rw-r--r--tests/TestCoreFn.hs16
-rw-r--r--tests/TestPrimDocs.hs1
-rw-r--r--tests/TestPsci/CommandTest.hs21
-rw-r--r--tests/TestPsci/CompletionTest.hs8
-rw-r--r--tests/TestPsci/TestEnv.hs53
-rw-r--r--tests/TestUtils.hs10
-rw-r--r--tests/purs/failing/3405.purs8
-rw-r--r--tests/purs/failing/MissingClassMember.purs3
-rw-r--r--tests/purs/passing/3388.purs10
-rw-r--r--tests/purs/passing/3410.purs11
-rw-r--r--tests/purs/warning/CustomWarning4.purs31
-rw-r--r--tests/support/bower.json107
-rw-r--r--tests/support/package-lock.json171
-rw-r--r--tests/support/psci/Reload.edit4
-rw-r--r--tests/support/psci/Reload.purs4
-rw-r--r--tests/support/psci/Sample.purs0
105 files changed, 657 insertions, 638 deletions
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index 0cb15ff..dc455d6 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -23,7 +23,7 @@ or `hierarchy`.
To build and run a specific test in `tests/purs/passing/` or `tests/purs/failing/`, add test arguments like so:
-`stack test --fast --test-arguments="-p compiler/**1110.purs*"`
+`stack test --fast --test-arguments="-p 1110.purs"`
This will run whatever test uses the example file `1110.purs`.
diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md
index 78a5abc..17b6b5a 100644
--- a/CONTRIBUTORS.md
+++ b/CONTRIBUTORS.md
@@ -93,7 +93,7 @@ If you would prefer to use different terms, please use the section below instead
| [@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) |
| [@rightfold](https://github.com/rightfold) | rightfold | [MIT license](https://opensource.org/licenses/MIT) |
-| [@rndnoise](https://github.com/rndnoise) | rndnoise | [MIT license](http://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) |
| [@RossMeikleham](https://github.com/RossMeikleham) | Ross Meikleham | [MIT license](http://opensource.org/licenses/MIT) |
| [@Rufflewind](https://github.com/Rufflewind) | Phil Ruffwind | [MIT license](https://opensource.org/licenses/MIT) |
@@ -126,6 +126,7 @@ If you would prefer to use different terms, please use the section below instead
| [@sloosch](https://github.com/sloosch) | Simon Looschen | [MIT license](http://opensource.org/licenses/MIT) |
| [@rgrinberg](https://github.com/rgrinberg) | Rudi Grinberg | [MIT license](http://opensource.org/licenses/MIT) |
| [@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) |
### Contributors using Modified Terms
diff --git a/README.md b/README.md
index f5db507..f2239f3 100644
--- a/README.md
+++ b/README.md
@@ -20,7 +20,5 @@ A small strongly typed programming language with expressive types that compiles
## Help!
- [#purescript @ FP Slack](https://functionalprogramming.slack.com/)
-- [PureScript Language Forum](https://purescript-users.ml/)
+- [PureScript Language Forum](https://discourse.purescript.org/)
- [PureScript on StackOverflow](http://stackoverflow.com/questions/tagged/purescript)
-- [Google Group](https://groups.google.com/forum/#!forum/purescript)
-- [Gitter Channel](https://gitter.im/purescript/purescript?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
diff --git a/app/Command/Bundle.hs b/app/Command/Bundle.hs
index 4ea338a..5666a0f 100644
--- a/app/Command/Bundle.hs
+++ b/app/Command/Bundle.hs
@@ -7,7 +7,6 @@
module Command.Bundle (command) where
import Data.Traversable (for)
-import Data.Monoid ((<>))
import Data.Aeson (encode)
import Data.Maybe (isNothing)
import Control.Applicative
@@ -21,8 +20,7 @@ import System.Exit (exitFailure)
import System.IO (stderr, hPutStr, hPutStrLn)
import System.IO.UTF8 (readUTF8File, writeUTF8File)
import System.Directory (createDirectoryIfMissing, getCurrentDirectory)
-import qualified Data.ByteString.Lazy as B
-import qualified Data.ByteString.UTF8 as BU8
+import qualified Data.ByteString.Lazy.UTF8 as LBU8
import Language.PureScript.Bundle
import Options.Applicative (Parser)
import qualified Options.Applicative as Opts
@@ -124,6 +122,6 @@ command = run <$> (Opts.helper <*> options) where
case sourcemap of
Just sm -> do
writeUTF8File outputFile $ js ++ "\n//# sourceMappingURL=" ++ (takeFileName outputFile <.> "map") ++ "\n"
- writeUTF8File (outputFile <.> "map") $ BU8.toString . B.toStrict . encode $ generate sm
+ writeUTF8File (outputFile <.> "map") $ LBU8.toString . encode $ generate sm
Nothing -> writeUTF8File outputFile js
Nothing -> putStrLn js
diff --git a/app/Command/Compile.hs b/app/Command/Compile.hs
index cb91b61..555fc5b 100644
--- a/app/Command/Compile.hs
+++ b/app/Command/Compile.hs
@@ -8,11 +8,9 @@ module Command.Compile (command) where
import Control.Applicative
import Control.Monad
-import Control.Monad.Writer.Strict
import qualified Data.Aeson as A
import Data.Bool (bool)
-import qualified Data.ByteString.Lazy as B
-import qualified Data.ByteString.UTF8 as BU8
+import qualified Data.ByteString.Lazy.UTF8 as LBU8
import Data.List (intercalate)
import qualified Data.Map as M
import qualified Data.Set as S
@@ -52,7 +50,7 @@ printWarningsAndErrors verbose False warnings errors = do
exitFailure
Right _ -> return ()
printWarningsAndErrors verbose True warnings errors = do
- hPutStrLn stderr . BU8.toString . B.toStrict . A.encode $
+ hPutStrLn stderr . LBU8.toString . A.encode $
JSONResult (toJSONErrors verbose P.Warning warnings)
(either (toJSONErrors verbose P.Error) (const []) errors)
either (const exitFailure) (const (return ())) errors
@@ -137,22 +135,15 @@ codegenTargets = Opts.option targetParser $
<> " The default target is 'js', but if this option is used only the targets specified will be used."
)
-targets :: M.Map String P.CodegenTarget
-targets = M.fromList
- [ ("js", P.JS)
- , ("sourcemaps", P.JSSourceMap)
- , ("corefn", P.CoreFn)
- ]
-
targetsMessage :: String
-targetsMessage = "Accepted codegen targets are '" <> intercalate "', '" (M.keys targets) <> "'."
+targetsMessage = "Accepted codegen targets are '" <> intercalate "', '" (M.keys P.codegenTargets) <> "'."
targetParser :: Opts.ReadM [P.CodegenTarget]
targetParser =
Opts.str >>= \s ->
for (T.split (== ',') s)
$ maybe (Opts.readerError targetsMessage) pure
- . flip M.lookup targets
+ . flip M.lookup P.codegenTargets
. T.unpack
. T.strip
diff --git a/app/Command/Hierarchy.hs b/app/Command/Hierarchy.hs
index 1bb9346..0966c9a 100644
--- a/app/Command/Hierarchy.hs
+++ b/app/Command/Hierarchy.hs
@@ -22,7 +22,6 @@ import Protolude (catMaybes)
import Control.Applicative (optional)
import Data.Foldable (for_)
-import Data.Monoid ((<>))
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Options.Applicative (Parser)
diff --git a/app/Command/Publish.hs b/app/Command/Publish.hs
index 0440bae..bffb3e8 100644
--- a/app/Command/Publish.hs
+++ b/app/Command/Publish.hs
@@ -5,7 +5,6 @@ module Command.Publish (command) where
import Control.Monad.IO.Class (liftIO)
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.Char8 as BL
-import Data.Monoid ((<>))
import Data.Time.Clock (getCurrentTime)
import Data.Version (Version(..))
import Language.PureScript.Publish
diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs
index 04033b5..c2ddb69 100644
--- a/app/Command/REPL.hs
+++ b/app/Command/REPL.hs
@@ -31,7 +31,6 @@ import Control.Monad.Trans.State.Strict (StateT, evalStateT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Data.FileEmbed (embedStringFile)
import Data.Foldable (for_)
-import Data.Monoid ((<>))
import Data.String (IsString(..))
import Data.Text (Text, unpack)
import Data.Traversable (for)
@@ -319,19 +318,19 @@ command = loop <$> options
unless (supportModuleIsDefined (map snd modules)) . liftIO $ do
putStr supportModuleMessage
exitFailure
- (externs, env) <- ExceptT . runMake . make $ modules
- return (modules, externs, env)
+ (externs, _) <- ExceptT . runMake . make $ modules
+ return (modules, externs)
case psciBackend of
Backend setup eval reload (shutdown :: state -> IO ()) ->
case e of
Left errs -> do
pwd <- getCurrentDirectory
putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions {P.ppeRelativeDirectory = pwd} errs) >> exitFailure
- Right (modules, externs, env) -> do
+ Right (modules, externs) -> do
historyFilename <- getHistoryFilename
let settings = defaultSettings { historyFile = Just historyFilename }
initialState = updateLoadedExterns (const (zip (map snd modules) externs)) initialPSCiState
- config = PSCiConfig psciInputGlob env
+ config = PSCiConfig psciInputGlob
runner = flip runReaderT config
. flip evalStateT initialState
. runInputT (setComplete completion settings)
diff --git a/app/Main.hs b/app/Main.hs
index 1f5ec06..f3e72ab 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -15,7 +15,6 @@ import qualified Command.Ide as Ide
import qualified Command.Publish as Publish
import qualified Command.REPL as REPL
import Data.Foldable (fold)
-import Data.Monoid ((<>))
import qualified Options.Applicative as Opts
import System.Environment (getArgs)
import qualified System.IO as IO
diff --git a/purescript.cabal b/purescript.cabal
index e5bc04f..d1bf5fc 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -2,10 +2,10 @@
--
-- see: https://github.com/sol/hpack
--
--- hash: ed9acbb7111e989600e6d412bddce7d96a240dabdfa42338b1d3a2434ac6c976
+-- hash: 628bcaed9683521da81533454c6e643bda4bea5445007164d4783767f98f0173
name: purescript
-version: 0.12.0
+version: 0.12.1
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
@@ -108,6 +108,7 @@ extra-source-files:
tests/purs/failing/3275-BindingGroupErrorPos.purs
tests/purs/failing/3275-DataBindingGroupErrorPos.purs
tests/purs/failing/3335-TypeOpAssociativityError.purs
+ tests/purs/failing/3405.purs
tests/purs/failing/365.purs
tests/purs/failing/438.purs
tests/purs/failing/881.purs
@@ -366,6 +367,8 @@ extra-source-files:
tests/purs/passing/3114/VendoredVariant.purs
tests/purs/passing/3125.purs
tests/purs/passing/3187-UnusedNameClash.purs
+ tests/purs/passing/3388.purs
+ tests/purs/passing/3410.purs
tests/purs/passing/652.purs
tests/purs/passing/810.purs
tests/purs/passing/862.purs
@@ -659,6 +662,7 @@ extra-source-files:
tests/purs/warning/CustomWarning.purs
tests/purs/warning/CustomWarning2.purs
tests/purs/warning/CustomWarning3.purs
+ tests/purs/warning/CustomWarning4.purs
tests/purs/warning/DuplicateExportRef.purs
tests/purs/warning/DuplicateImport.purs
tests/purs/warning/DuplicateImportRef.purs
@@ -693,10 +697,10 @@ extra-source-files:
tests/purs/warning/UnusedTypeVar.purs
tests/purs/warning/WildcardInferredType.purs
tests/support/bower.json
- tests/support/package-lock.json
tests/support/package.json
tests/support/prelude-resolutions.json
- tests/support/psci/Sample.purs
+ tests/support/psci/Reload.edit
+ tests/support/psci/Reload.purs
tests/support/pscide/src/CompletionSpecDocs.purs
tests/support/pscide/src/FindUsage.purs
tests/support/pscide/src/FindUsage/Definition.purs
@@ -732,11 +736,12 @@ library
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:
- Glob >=0.9 && <0.10
- , aeson >=1.0 && <1.3
+ 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.11
+ , 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
@@ -755,8 +760,8 @@ library
, fsnotify >=0.2.1
, haskeline >=0.7.0.0
, language-javascript >=0.6.0.9 && <0.7
- , lens ==4.*
, 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
@@ -770,7 +775,6 @@ library
, scientific >=0.3.4.9 && <0.4
, semigroups >=0.16.2 && <0.19
, sourcemap >=0.1.6
- , spdx ==0.2.*
, split
, stm >=0.2.4.0
, stringsearch
@@ -949,12 +953,13 @@ executable purs
app
ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N
build-depends:
- Glob >=0.9 && <0.10
- , aeson >=1.0 && <1.3
+ 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
, ansi-wl-pprint
- , base >=4.8 && <4.11
+ , 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
@@ -974,8 +979,8 @@ executable purs
, haskeline >=0.7.0.0
, http-types
, language-javascript >=0.6.0.9 && <0.7
- , lens ==4.*
, 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
@@ -992,7 +997,6 @@ executable purs
, scientific >=0.3.4.9 && <0.4
, semigroups >=0.16.2 && <0.19
, sourcemap >=0.1.6
- , spdx ==0.2.*
, split
, stm >=0.2.4.0
, stringsearch
@@ -1035,12 +1039,13 @@ test-suite tests
default-extensions: NoImplicitPrelude
ghc-options: -Wall
build-depends:
- Glob >=0.9 && <0.10
+ Cabal >=2.2
+ , Glob >=0.9 && <0.10
, HUnit
- , aeson >=1.0 && <1.3
+ , aeson >=1.0 && <1.4
, aeson-better-errors >=0.8
, ansi-terminal >=0.7.1 && <0.9
- , base >=4.8 && <4.11
+ , 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
@@ -1061,8 +1066,8 @@ test-suite tests
, hspec
, hspec-discover
, language-javascript >=0.6.0.9 && <0.7
- , lens ==4.*
, 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
@@ -1077,7 +1082,6 @@ test-suite tests
, scientific >=0.3.4.9 && <0.4
, semigroups >=0.16.2 && <0.19
, sourcemap >=0.1.6
- , spdx ==0.2.*
, split
, stm >=0.2.4.0
, stringsearch
diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs
index 82d23e0..19e1d18 100644
--- a/src/Language/PureScript/AST/Binders.hs
+++ b/src/Language/PureScript/AST/Binders.hs
@@ -5,8 +5,6 @@ module Language.PureScript.AST.Binders where
import Prelude.Compat
-import Data.Semigroup
-
import Language.PureScript.AST.SourcePos
import Language.PureScript.AST.Literals
import Language.PureScript.Names
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
index 9c82007..2725f5d 100644
--- a/src/Language/PureScript/AST/Declarations.hs
+++ b/src/Language/PureScript/AST/Declarations.hs
@@ -124,7 +124,7 @@ data SimpleErrorMessage
| DuplicateValueDeclaration Ident
| ArgListLengthsDiffer Ident
| OverlappingArgNames (Maybe Ident)
- | MissingClassMember Ident
+ | MissingClassMember (NEL.NonEmpty (Ident, Type))
| ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))
| ExpectedType Type Kind
-- | constructor name, expected argument count, actual argument count
diff --git a/src/Language/PureScript/AST/SourcePos.hs b/src/Language/PureScript/AST/SourcePos.hs
index 60605d7..6ad6754 100644
--- a/src/Language/PureScript/AST/SourcePos.hs
+++ b/src/Language/PureScript/AST/SourcePos.hs
@@ -8,7 +8,6 @@ import Prelude.Compat
import Control.DeepSeq (NFData)
import Data.Aeson ((.=), (.:))
-import Data.Monoid
import Data.Text (Text)
import GHC.Generics (Generic)
import Language.PureScript.Comments
diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
index f4a35f5..50bf45d 100644
--- a/src/Language/PureScript/AST/Traversals.hs
+++ b/src/Language/PureScript/AST/Traversals.hs
@@ -132,7 +132,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds
f' (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f' <=< f) ds
f' (TypeInstanceDeclaration sa ch idx name cs className args ds) = TypeInstanceDeclaration sa ch idx name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds
- f' (BoundValueDeclaration sa b expr) = BoundValueDeclaration sa <$> h' b <*> g' expr
+ f' (BoundValueDeclaration sa b expr) = BoundValueDeclaration sa <$> (h' <=< h) b <*> (g' <=< g) expr
f' other = f other
g' :: Expr -> m Expr
@@ -264,66 +264,66 @@ everythingOnValues
, CaseAlternative -> r
, DoNotationElement -> r
)
-everythingOnValues (<>) f g h i j = (f', g', h', i', j')
+everythingOnValues (<>.) f g h i j = (f', g', h', i', j')
where
f' :: Declaration -> r
- f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (fmap f' ds)
- f' d@(ValueDeclaration vd) = foldl (<>) (f d) (fmap h' (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) (valdeclExpression vd))
- f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (fmap (\(_, _, val) -> g' val) ds)
- f' d@(TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>) (f d) (fmap f' ds)
- f' d@(TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (fmap f' ds)
- f' d@(BoundValueDeclaration _ b expr) = f d <> h' b <> g' expr
+ f' d@(DataBindingGroupDeclaration ds) = foldl (<>.) (f d) (fmap f' ds)
+ f' d@(ValueDeclaration vd) = foldl (<>.) (f d) (fmap h' (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) (valdeclExpression vd))
+ f' d@(BindingGroupDeclaration ds) = foldl (<>.) (f d) (fmap (\(_, _, val) -> g' val) ds)
+ f' d@(TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>.) (f d) (fmap f' ds)
+ f' d@(TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>.) (f d) (fmap f' ds)
+ f' d@(BoundValueDeclaration _ b expr) = f d <>. h' b <>. g' expr
f' d = f d
g' :: Expr -> r
g' v@(Literal _ l) = lit (g v) g' l
- g' v@(UnaryMinus _ v1) = g v <> g' v1
- g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2
- g' v@(Parens v1) = g v <> g' v1
- g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
- g' v@(Accessor _ v1) = g v <> g' v1
- g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (fmap (g' . snd) vs)
- g' v@(ObjectUpdateNested obj vs) = foldl (<>) (g v <> g' obj) (fmap g' vs)
- g' v@(Abs b v1) = g v <> h' b <> g' v1
- g' v@(App v1 v2) = g v <> g' v1 <> g' v2
- g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3
- g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (fmap g' vs)) (fmap i' alts)
- g' v@(TypedValue _ v1 _) = g v <> g' v1
- g' v@(Let _ ds v1) = foldl (<>) (g v) (fmap f' ds) <> g' v1
- g' v@(Do es) = foldl (<>) (g v) (fmap j' es)
- g' v@(Ado es v1) = foldl (<>) (g v) (fmap j' es) <> g' v1
- g' v@(PositionedValue _ _ v1) = g v <> g' v1
+ g' v@(UnaryMinus _ v1) = g v <>. g' v1
+ g' v@(BinaryNoParens op v1 v2) = g v <>. g' op <>. g' v1 <>. g' v2
+ g' v@(Parens v1) = g v <>. g' v1
+ g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <>. g' v1
+ g' v@(Accessor _ v1) = g v <>. g' v1
+ g' v@(ObjectUpdate obj vs) = foldl (<>.) (g v <>. g' obj) (fmap (g' . snd) vs)
+ g' v@(ObjectUpdateNested obj vs) = foldl (<>.) (g v <>. g' obj) (fmap g' vs)
+ g' v@(Abs b v1) = g v <>. h' b <>. g' v1
+ g' v@(App v1 v2) = g v <>. g' v1 <>. g' v2
+ g' v@(IfThenElse v1 v2 v3) = g v <>. g' v1 <>. g' v2 <>. g' v3
+ g' v@(Case vs alts) = foldl (<>.) (foldl (<>.) (g v) (fmap g' vs)) (fmap i' alts)
+ g' v@(TypedValue _ v1 _) = g v <>. g' v1
+ g' v@(Let _ ds v1) = foldl (<>.) (g v) (fmap f' ds) <>. g' v1
+ g' v@(Do es) = foldl (<>.) (g v) (fmap j' es)
+ g' v@(Ado es v1) = foldl (<>.) (g v) (fmap j' es) <>. g' v1
+ g' v@(PositionedValue _ _ v1) = g v <>. g' v1
g' v = g v
h' :: Binder -> r
h' b@(LiteralBinder _ l) = lit (h b) h' l
- h' b@(ConstructorBinder _ _ bs) = foldl (<>) (h b) (fmap h' bs)
- h' b@(BinaryNoParensBinder b1 b2 b3) = h b <> h' b1 <> h' b2 <> h' b3
- h' b@(ParensInBinder b1) = h b <> h' b1
- h' b@(NamedBinder _ _ b1) = h b <> h' b1
- h' b@(PositionedBinder _ _ b1) = h b <> h' b1
- h' b@(TypedBinder _ b1) = h b <> h' b1
+ h' b@(ConstructorBinder _ _ bs) = foldl (<>.) (h b) (fmap h' bs)
+ h' b@(BinaryNoParensBinder b1 b2 b3) = h b <>. h' b1 <>. h' b2 <>. h' b3
+ h' b@(ParensInBinder b1) = h b <>. h' b1
+ h' b@(NamedBinder _ _ b1) = h b <>. h' b1
+ h' b@(PositionedBinder _ _ b1) = h b <>. h' b1
+ h' b@(TypedBinder _ b1) = h b <>. h' b1
h' b = h b
lit :: r -> (a -> r) -> Literal a -> r
- lit r go (ArrayLiteral as) = foldl (<>) r (fmap go as)
- lit r go (ObjectLiteral as) = foldl (<>) r (fmap (go . snd) as)
+ lit r go (ArrayLiteral as) = foldl (<>.) r (fmap go as)
+ lit r go (ObjectLiteral as) = foldl (<>.) r (fmap (go . snd) as)
lit r _ _ = r
i' :: CaseAlternative -> r
i' ca@(CaseAlternative bs gs) =
- foldl (<>) (i ca) (fmap h' bs ++ concatMap (\(GuardedExpr grd val) -> fmap k' grd ++ [g' val]) gs)
+ foldl (<>.) (i ca) (fmap h' bs ++ concatMap (\(GuardedExpr grd val) -> fmap k' grd ++ [g' val]) gs)
j' :: DoNotationElement -> r
- j' e@(DoNotationValue v) = j e <> g' v
- j' e@(DoNotationBind b v) = j e <> h' b <> g' v
- j' e@(DoNotationLet ds) = foldl (<>) (j e) (fmap f' ds)
- j' e@(PositionedDoNotationElement _ _ e1) = j e <> j' e1
+ j' e@(DoNotationValue v) = j e <>. g' v
+ j' e@(DoNotationBind b v) = j e <>. h' b <>. g' v
+ j' e@(DoNotationLet ds) = foldl (<>.) (j e) (fmap f' ds)
+ j' e@(PositionedDoNotationElement _ _ e1) = j e <>. j' e1
k' :: Guard -> r
k' (ConditionGuard e) = g' e
- k' (PatternGuard b e) = h' b <> g' e
+ k' (PatternGuard b e) = h' b <>. g' e
everythingWithContextOnValues
:: forall s r
@@ -340,50 +340,50 @@ everythingWithContextOnValues
, Binder -> r
, CaseAlternative -> r
, DoNotationElement -> r)
-everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
+everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
where
f'' :: s -> Declaration -> r
- f'' s d = let (s', r) = f s d in r <> f' s' d
+ f'' s d = let (s', r) = f s d in r <>. f' s' d
f' :: s -> Declaration -> r
- f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (fmap (f'' s) ds)
- f' s (ValueDeclaration vd) = foldl (<>) r0 (fmap (h'' s) (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) (valdeclExpression vd))
- f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (fmap (\(_, _, val) -> g'' s val) ds)
- f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>) r0 (fmap (f'' s) ds)
- f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (fmap (f'' s) ds)
+ f' s (DataBindingGroupDeclaration ds) = foldl (<>.) r0 (fmap (f'' s) ds)
+ f' s (ValueDeclaration vd) = foldl (<>.) r0 (fmap (h'' s) (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) (valdeclExpression vd))
+ f' s (BindingGroupDeclaration ds) = foldl (<>.) r0 (fmap (\(_, _, val) -> g'' s val) ds)
+ f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>.) r0 (fmap (f'' s) ds)
+ f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>.) r0 (fmap (f'' s) ds)
f' _ _ = r0
g'' :: s -> Expr -> r
- g'' s v = let (s', r) = g s v in r <> g' s' v
+ g'' s v = let (s', r) = g s v in r <>. g' s' v
g' :: s -> Expr -> r
g' s (Literal _ l) = lit g'' s l
g' s (UnaryMinus _ v1) = g'' s v1
- g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
+ g' s (BinaryNoParens op v1 v2) = g'' s op <>. g'' s v1 <>. g'' s v2
g' s (Parens v1) = g'' s v1
g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
g' s (Accessor _ v1) = g'' s v1
- g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (fmap (g'' s . snd) vs)
- g' s (ObjectUpdateNested obj vs) = foldl (<>) (g'' s obj) (fmap (g'' s) vs)
- g' s (Abs binder v1) = h'' s binder <> g'' s v1
- g' s (App v1 v2) = g'' s v1 <> g'' s v2
- g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
- g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts)
+ g' s (ObjectUpdate obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s . snd) vs)
+ g' s (ObjectUpdateNested obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s) vs)
+ g' s (Abs binder v1) = h'' s binder <>. g'' s v1
+ g' s (App v1 v2) = g'' s v1 <>. g'' s v2
+ g' s (IfThenElse v1 v2 v3) = g'' s v1 <>. g'' s v2 <>. g'' s v3
+ g' s (Case vs alts) = foldl (<>.) (foldl (<>.) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts)
g' s (TypedValue _ v1 _) = g'' s v1
- g' s (Let _ ds v1) = foldl (<>) r0 (fmap (f'' s) ds) <> g'' s v1
- g' s (Do es) = foldl (<>) r0 (fmap (j'' s) es)
- g' s (Ado es v1) = foldl (<>) r0 (fmap (j'' s) es) <> g'' s v1
+ g' s (Let _ ds v1) = foldl (<>.) r0 (fmap (f'' s) ds) <>. g'' s v1
+ g' s (Do es) = foldl (<>.) r0 (fmap (j'' s) es)
+ g' s (Ado es v1) = foldl (<>.) r0 (fmap (j'' s) es) <>. g'' s v1
g' s (PositionedValue _ _ v1) = g'' s v1
g' _ _ = r0
h'' :: s -> Binder -> r
- h'' s b = let (s', r) = h s b in r <> h' s' b
+ h'' s b = let (s', r) = h s b in r <>. h' s' b
h' :: s -> Binder -> r
h' s (LiteralBinder _ l) = lit h'' s l
- h' s (ConstructorBinder _ _ bs) = foldl (<>) r0 (fmap (h'' s) bs)
- h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <> h'' s b2 <> h'' s b3
+ h' s (ConstructorBinder _ _ bs) = foldl (<>.) r0 (fmap (h'' s) bs)
+ h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <>. h'' s b2 <>. h'' s b3
h' s (ParensInBinder b) = h'' s b
h' s (NamedBinder _ _ b1) = h'' s b1
h' s (PositionedBinder _ _ b1) = h'' s b1
@@ -391,28 +391,28 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
h' _ _ = r0
lit :: (s -> a -> r) -> s -> Literal a -> r
- lit go s (ArrayLiteral as) = foldl (<>) r0 (fmap (go s) as)
- lit go s (ObjectLiteral as) = foldl (<>) r0 (fmap (go s . snd) as)
+ lit go s (ArrayLiteral as) = foldl (<>.) r0 (fmap (go s) as)
+ lit go s (ObjectLiteral as) = foldl (<>.) r0 (fmap (go s . snd) as)
lit _ _ _ = r0
i'' :: s -> CaseAlternative -> r
- i'' s ca = let (s', r) = i s ca in r <> i' s' ca
+ i'' s ca = let (s', r) = i s ca in r <>. i' s' ca
i' :: s -> CaseAlternative -> r
- i' s (CaseAlternative bs gs) = foldl (<>) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd val) -> fmap (k' s) grd ++ [g'' s val]) gs)
+ i' s (CaseAlternative bs gs) = foldl (<>.) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd val) -> fmap (k' s) grd ++ [g'' s val]) gs)
j'' :: s -> DoNotationElement -> r
- j'' s e = let (s', r) = j s e in r <> j' s' e
+ j'' s e = let (s', r) = j s e in r <>. j' s' e
j' :: s -> DoNotationElement -> r
j' s (DoNotationValue v) = g'' s v
- j' s (DoNotationBind b v) = h'' s b <> g'' s v
- j' s (DoNotationLet ds) = foldl (<>) r0 (fmap (f'' s) ds)
+ j' s (DoNotationBind b v) = h'' s b <>. g'' s v
+ j' s (DoNotationLet ds) = foldl (<>.) r0 (fmap (f'' s) ds)
j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
k' :: s -> Guard -> r
k' s (ConditionGuard e) = g'' s e
- k' s (PatternGuard b e) = h'' s b <> g'' s e
+ k' s (PatternGuard b e) = h'' s b <>. g'' s e
everywhereWithContextOnValuesM
:: forall m s
@@ -514,9 +514,6 @@ everythingWithScope
)
everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
where
- -- Avoid importing Data.Monoid and getting shadowed names above
- (<>) = mappend
-
f'' :: S.Set ScopedIdent -> Declaration -> r
f'' s a = f s a <> f' s a
@@ -635,7 +632,7 @@ accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (con
forDecls (DataDeclaration _ _ _ _ dctors) = mconcat (concatMap (fmap f . snd) dctors)
forDecls (ExternDeclaration _ _ ty) = f ty
forDecls (TypeClassDeclaration _ _ _ implies _ _) = mconcat (concatMap (fmap f . constraintArgs) implies)
- forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) = mconcat (concatMap (fmap f . constraintArgs) cs) `mappend` mconcat (fmap f tys)
+ forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) = mconcat (concatMap (fmap f . constraintArgs) cs) <> mconcat (fmap f tys)
forDecls (TypeSynonymDeclaration _ _ _ ty) = f ty
forDecls (TypeDeclaration td) = f (tydeclType td)
forDecls _ = mempty
@@ -657,16 +654,16 @@ accumKinds
accumKinds f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
where
forDecls (DataDeclaration _ _ _ args dctors) =
- foldMap (foldMap f . snd) args `mappend`
+ foldMap (foldMap f . snd) args <>
foldMap (foldMap forTypes . snd) dctors
forDecls (TypeClassDeclaration _ _ args implies _ _) =
- foldMap (foldMap f . snd) args `mappend`
+ foldMap (foldMap f . snd) args <>
foldMap (foldMap forTypes . constraintArgs) implies
forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) =
- foldMap (foldMap forTypes . constraintArgs) cs `mappend`
+ foldMap (foldMap forTypes . constraintArgs) cs <>
foldMap forTypes tys
forDecls (TypeSynonymDeclaration _ _ args ty) =
- foldMap (foldMap f . snd) args `mappend`
+ foldMap (foldMap f . snd) args <>
forTypes ty
forDecls (TypeDeclaration td) = forTypes (tydeclType td)
forDecls (ExternDeclaration _ _ ty) = forTypes ty
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 266c560..adf235f 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -19,7 +19,6 @@ import Data.List ((\\), intersect)
import qualified Data.Foldable as F
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing)
-import Data.Monoid ((<>))
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/CodeGen/JS/Common.hs b/src/Language/PureScript/CodeGen/JS/Common.hs
index 259cd4a..603b75d 100644
--- a/src/Language/PureScript/CodeGen/JS/Common.hs
+++ b/src/Language/PureScript/CodeGen/JS/Common.hs
@@ -4,7 +4,6 @@ module Language.PureScript.CodeGen.JS.Common where
import Prelude.Compat
import Data.Char
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs
index d8b59dc..da67fa7 100644
--- a/src/Language/PureScript/CodeGen/JS/Printer.hs
+++ b/src/Language/PureScript/CodeGen/JS/Printer.hs
@@ -13,7 +13,6 @@ import Control.PatternArrows
import qualified Control.Arrow as A
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/Constants.hs b/src/Language/PureScript/Constants.hs
index fd94137..b4e3a5e 100644
--- a/src/Language/PureScript/Constants.hs
+++ b/src/Language/PureScript/Constants.hs
@@ -204,29 +204,23 @@ unit = "unit"
-- Core lib values
-untilE :: forall a. (IsString a) => a
-untilE = "untilE"
-
-whileE :: forall a. (IsString a) => a
-whileE = "whileE"
-
runST :: forall a. (IsString a) => a
-runST = "runST"
+runST = "run"
stRefValue :: forall a. (IsString a) => a
stRefValue = "value"
newSTRef :: forall a. (IsString a) => a
-newSTRef = "newSTRef"
+newSTRef = "new"
readSTRef :: forall a. (IsString a) => a
-readSTRef = "readSTRef"
+readSTRef = "read"
writeSTRef :: forall a. (IsString a) => a
-writeSTRef = "writeSTRef"
+writeSTRef = "write"
modifySTRef :: forall a. (IsString a) => a
-modifySTRef = "modifySTRef"
+modifySTRef = "modify"
mkFn :: forall a. (IsString a) => a
mkFn = "mkFn"
@@ -257,6 +251,8 @@ data EffectDictionaries = EffectDictionaries
{ edApplicativeDict :: PSString
, edBindDict :: PSString
, edMonadDict :: PSString
+ , edWhile :: PSString
+ , edUntil :: PSString
}
effDictionaries :: EffectDictionaries
@@ -264,6 +260,8 @@ effDictionaries = EffectDictionaries
{ edApplicativeDict = "applicativeEff"
, edBindDict = "bindEff"
, edMonadDict = "monadEff"
+ , edWhile = "whileE"
+ , edUntil = "untilE"
}
effectDictionaries :: EffectDictionaries
@@ -271,6 +269,17 @@ effectDictionaries = EffectDictionaries
{ edApplicativeDict = "applicativeEffect"
, edBindDict = "bindEffect"
, edMonadDict = "monadEffect"
+ , edWhile = "whileE"
+ , edUntil = "untilE"
+ }
+
+stDictionaries :: EffectDictionaries
+stDictionaries = EffectDictionaries
+ { edApplicativeDict = "applicativeST"
+ , edBindDict = "bindST"
+ , edMonadDict = "monadST"
+ , edWhile = "while"
+ , edUntil = "until"
}
discardUnitDictionary :: forall a. (IsString a) => a
@@ -507,7 +516,7 @@ effect :: forall a. (IsString a) => a
effect = "Effect"
st :: forall a. (IsString a) => a
-st = "Control_Monad_ST"
+st = "Control_Monad_ST_Internal"
controlApplicative :: forall a. (IsString a) => a
controlApplicative = "Control_Applicative"
diff --git a/src/Language/PureScript/CoreFn/Traversals.hs b/src/Language/PureScript/CoreFn/Traversals.hs
index 20b0cd3..5415911 100644
--- a/src/Language/PureScript/CoreFn/Traversals.hs
+++ b/src/Language/PureScript/CoreFn/Traversals.hs
@@ -50,27 +50,27 @@ everythingOnValues :: (r -> r -> r) ->
(Binder a -> r) ->
(CaseAlternative a -> r) ->
(Bind a -> r, Expr a -> r, Binder a -> r, CaseAlternative a -> r)
-everythingOnValues (<>) f g h i = (f', g', h', i')
+everythingOnValues (<>.) f g h i = (f', g', h', i')
where
- f' b@(NonRec _ _ e) = f b <> g' e
- f' b@(Rec es) = foldl (<>) (f b) (map (g' . snd) es)
+ f' b@(NonRec _ _ e) = f b <>. g' e
+ f' b@(Rec es) = foldl (<>.) (f b) (map (g' . snd) es)
- g' v@(Literal _ l) = foldl (<>) (g v) (map g' (extractLiteral l))
- g' v@(Accessor _ _ e1) = g v <> g' e1
- g' v@(ObjectUpdate _ obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
- g' v@(Abs _ _ e1) = g v <> g' e1
- g' v@(App _ e1 e2) = g v <> g' e1 <> g' e2
- g' v@(Case _ vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
- g' v@(Let _ ds e1) = foldl (<>) (g v) (map f' ds) <> g' e1
+ g' v@(Literal _ l) = foldl (<>.) (g v) (map g' (extractLiteral l))
+ g' v@(Accessor _ _ e1) = g v <>. g' e1
+ g' v@(ObjectUpdate _ obj vs) = foldl (<>.) (g v <>. g' obj) (map (g' . snd) vs)
+ g' v@(Abs _ _ e1) = g v <>. g' e1
+ g' v@(App _ e1 e2) = g v <>. g' e1 <>. g' e2
+ g' v@(Case _ vs alts) = foldl (<>.) (foldl (<>.) (g v) (map g' vs)) (map i' alts)
+ g' v@(Let _ ds e1) = foldl (<>.) (g v) (map f' ds) <>. g' e1
g' v = g v
- h' b@(LiteralBinder _ l) = foldl (<>) (h b) (map h' (extractLiteral l))
- h' b@(ConstructorBinder _ _ _ bs) = foldl (<>) (h b) (map h' bs)
- h' b@(NamedBinder _ _ b1) = h b <> h' b1
+ h' b@(LiteralBinder _ l) = foldl (<>.) (h b) (map h' (extractLiteral l))
+ h' b@(ConstructorBinder _ _ _ bs) = foldl (<>.) (h b) (map h' bs)
+ h' b@(NamedBinder _ _ b1) = h b <>. h' b1
h' b = h b
- i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
- i' ca@(CaseAlternative bs (Left gs)) = foldl (<>) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
+ i' ca@(CaseAlternative bs (Right val)) = foldl (<>.) (i ca) (map h' bs) <>. g' val
+ i' ca@(CaseAlternative bs (Left gs)) = foldl (<>.) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
extractLiteral (ArrayLiteral xs) = xs
extractLiteral (ObjectLiteral xs) = map snd xs
diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs
index 3606233..b6dcad1 100644
--- a/src/Language/PureScript/CoreImp/AST.hs
+++ b/src/Language/PureScript/CoreImp/AST.hs
@@ -201,24 +201,24 @@ everywhereTopDownM f = f >=> go where
go other = f other
everything :: (r -> r -> r) -> (AST -> r) -> AST -> r
-everything (<>) f = go where
- go j@(Unary _ _ j1) = f j <> go j1
- go j@(Binary _ _ j1 j2) = f j <> go j1 <> go j2
- go j@(ArrayLiteral _ js) = foldl (<>) (f j) (map go js)
- go j@(Indexer _ j1 j2) = f j <> go j1 <> go j2
- go j@(ObjectLiteral _ js) = foldl (<>) (f j) (map (go . snd) js)
- go j@(Function _ _ _ j1) = f j <> go j1
- go j@(App _ j1 js) = foldl (<>) (f j <> go j1) (map go js)
- go j@(Block _ js) = foldl (<>) (f j) (map go js)
- go j@(VariableIntroduction _ _ (Just j1)) = f j <> go j1
- go j@(Assignment _ j1 j2) = f j <> go j1 <> go j2
- go j@(While _ j1 j2) = f j <> go j1 <> go j2
- go j@(For _ _ j1 j2 j3) = f j <> go j1 <> go j2 <> go j3
- go j@(ForIn _ _ j1 j2) = f j <> go j1 <> go j2
- go j@(IfElse _ j1 j2 Nothing) = f j <> go j1 <> go j2
- go j@(IfElse _ j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3
- go j@(Return _ j1) = f j <> go j1
- go j@(Throw _ j1) = f j <> go j1
- go j@(InstanceOf _ j1 j2) = f j <> go j1 <> go j2
- go j@(Comment _ _ j1) = f j <> go j1
+everything (<>.) f = go where
+ go j@(Unary _ _ j1) = f j <>. go j1
+ go j@(Binary _ _ j1 j2) = f j <>. go j1 <>. go j2
+ go j@(ArrayLiteral _ js) = foldl (<>.) (f j) (map go js)
+ go j@(Indexer _ j1 j2) = f j <>. go j1 <>. go j2
+ go j@(ObjectLiteral _ js) = foldl (<>.) (f j) (map (go . snd) js)
+ go j@(Function _ _ _ j1) = f j <>. go j1
+ go j@(App _ j1 js) = foldl (<>.) (f j <>. go j1) (map go js)
+ go j@(Block _ js) = foldl (<>.) (f j) (map go js)
+ go j@(VariableIntroduction _ _ (Just j1)) = f j <>. go j1
+ go j@(Assignment _ j1 j2) = f j <>. go j1 <>. go j2
+ go j@(While _ j1 j2) = f j <>. go j1 <>. go j2
+ go j@(For _ _ j1 j2 j3) = f j <>. go j1 <>. go j2 <>. go j3
+ go j@(ForIn _ _ j1 j2) = f j <>. go j1 <>. go j2
+ go j@(IfElse _ j1 j2 Nothing) = f j <>. go j1 <>. go j2
+ go j@(IfElse _ j1 j2 (Just j3)) = f j <>. go j1 <>. go j2 <>. go j3
+ go j@(Return _ j1) = f j <>. go j1
+ go j@(Throw _ j1) = f j <>. go j1
+ go j@(InstanceOf _ j1 j2) = f j <>. go j1 <>. go j2
+ go j@(Comment _ _ j1) = f j <>. go j1
go other = f other
diff --git a/src/Language/PureScript/CoreImp/Optimizer.hs b/src/Language/PureScript/CoreImp/Optimizer.hs
index 9994deb..de92116 100644
--- a/src/Language/PureScript/CoreImp/Optimizer.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer.hs
@@ -38,8 +38,9 @@ optimize js = do
, inlineCommonOperators
]) js
untilFixedPoint (return . tidyUp) . tco . inlineST
- =<< untilFixedPoint (return . magicDo')
- =<< untilFixedPoint (return . magicDo) js'
+ =<< untilFixedPoint (return . magicDoST)
+ =<< untilFixedPoint (return . magicDoEff)
+ =<< untilFixedPoint (return . magicDoEffect) js'
where
tidyUp :: AST -> AST
tidyUp = applyAll
diff --git a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
index 391f939..96001d3 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
@@ -16,7 +16,6 @@ import Prelude.Compat
import Control.Monad.Supply.Class (MonadSupply, freshName)
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import Data.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
index 2067e38..1a2cde1 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
@@ -1,6 +1,6 @@
-- | This module implements the "Magic Do" optimization, which inlines calls to return
-- and bind for the Eff monad, as well as some of its actions.
-module Language.PureScript.CoreImp.Optimizer.MagicDo (magicDo, magicDo', inlineST) where
+module Language.PureScript.CoreImp.Optimizer.MagicDo (magicDoEffect, magicDoEff, magicDoST, inlineST) where
import Prelude.Compat
import Protolude (ordNub)
@@ -27,14 +27,17 @@ import qualified Language.PureScript.Constants as C
-- var x = m1();
-- ...
-- }
-magicDo :: AST -> AST
-magicDo = magicDo'' C.eff C.effDictionaries
+magicDoEff :: AST -> AST
+magicDoEff = magicDo C.eff C.effDictionaries
-magicDo' :: AST -> AST
-magicDo' = magicDo'' C.effect C.effectDictionaries
+magicDoEffect :: AST -> AST
+magicDoEffect = magicDo C.effect C.effectDictionaries
-magicDo'' :: Text -> C.EffectDictionaries -> AST -> AST
-magicDo'' effectModule C.EffectDictionaries{..} = everywhereTopDown convert
+magicDoST :: AST -> AST
+magicDoST = magicDo C.st C.stDictionaries
+
+magicDo :: Text -> C.EffectDictionaries -> AST -> AST
+magicDo effectModule C.EffectDictionaries{..} = everywhereTopDown convert
where
-- The name of the function block which is added to denote a do block
fnName = "__do"
@@ -49,10 +52,10 @@ magicDo'' effectModule C.EffectDictionaries{..} = everywhereTopDown convert
convert (App _ (App _ bind [m]) [Function s1 Nothing [arg] (Block s2 js)]) | isBind bind =
Function s1 (Just fnName) [] $ Block s2 (VariableIntroduction s2 arg (Just (App s2 m [])) : map applyReturns js)
-- Desugar untilE
- convert (App s1 (App _ f [arg]) []) | isEffFunc C.untilE f =
+ convert (App s1 (App _ f [arg]) []) | isEffFunc edUntil f =
App s1 (Function s1 Nothing [] (Block s1 [ While s1 (Unary s1 Not (App s1 arg [])) (Block s1 []), Return s1 $ ObjectLiteral s1 []])) []
-- Desugar whileE
- convert (App _ (App _ (App s1 f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
+ convert (App _ (App _ (App s1 f [arg1]) [arg2]) []) | isEffFunc edWhile f =
App s1 (Function s1 Nothing [] (Block s1 [ While s1 (App s1 arg1 []) (Block s1 [ App s1 arg2 [] ]), Return s1 $ ObjectLiteral s1 []])) []
-- Inline __do returns
convert (Return _ (App _ (Function _ (Just ident) [] body) [])) | ident == fnName = body
@@ -98,12 +101,12 @@ inlineST = everywhere convertBlock
-- Look for runST blocks and inline the STRefs there.
-- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then
-- we can be more aggressive about inlining, and actually turn STRefs into local variables.
- convertBlock (App _ f [arg]) | isSTFunc C.runST f =
+ convertBlock (App s1 f [arg]) | isSTFunc C.runST f =
let refs = ordNub . findSTRefsIn $ arg
usages = findAllSTUsagesIn arg
allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages
localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs
- in everywhere (convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg
+ in App s1 (everywhere (convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg) []
convertBlock other = other
-- Convert a block in a safe way, preserving object wrappers of references,
-- or in a more aggressive way, turning wrappers into local variables depending on the
@@ -112,9 +115,9 @@ inlineST = everywhere convertBlock
Function s1 Nothing [] (Block s1 [Return s1 $ if agg then arg else ObjectLiteral s1 [(mkString C.stRefValue, arg)]])
convert agg (App _ (App s1 f [ref]) []) | isSTFunc C.readSTRef f =
if agg then ref else Indexer s1 (StringLiteral s1 C.stRefValue) ref
- convert agg (App _ (App _ (App s1 f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =
+ convert agg (App _ (App _ (App s1 f [arg]) [ref]) []) | isSTFunc C.writeSTRef f =
if agg then Assignment s1 ref arg else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) arg
- convert agg (App _ (App _ (App s1 f [ref]) [func]) []) | isSTFunc C.modifySTRef f =
+ convert agg (App _ (App _ (App s1 f [func]) [ref]) []) | isSTFunc C.modifySTRef f =
if agg then Assignment s1 ref (App s1 func [ref]) else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) (App s1 func [Indexer s1 (StringLiteral s1 C.stRefValue) ref])
convert _ other = other
-- Check if an expression represents a function in the ST module
@@ -129,7 +132,7 @@ inlineST = everywhere convertBlock
findAllSTUsagesIn = everything (++) isSTUsage
where
isSTUsage (App _ (App _ f [ref]) []) | isSTFunc C.readSTRef f = [ref]
- isSTUsage (App _ (App _ (App _ f [ref]) [_]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]
+ isSTUsage (App _ (App _ (App _ f [_]) [ref]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]
isSTUsage _ = []
-- Find all uses of a variable
appearingIn ref = everything (++) isVar
diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
index 0a5d949..fcf49fc 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
@@ -4,7 +4,6 @@ module Language.PureScript.CoreImp.Optimizer.TCO (tco) where
import Prelude.Compat
import Data.Text (Text)
-import Data.Monoid ((<>))
import Language.PureScript.CoreImp.AST
import Language.PureScript.AST.SourcePos (SourceSpan)
import Safe (headDef, tailSafe)
diff --git a/src/Language/PureScript/Docs/AsHtml.hs b/src/Language/PureScript/Docs/AsHtml.hs
index 80856c9..adeeab7 100644
--- a/src/Language/PureScript/Docs/AsHtml.hs
+++ b/src/Language/PureScript/Docs/AsHtml.hs
@@ -20,7 +20,6 @@ import Control.Monad (unless)
import Data.Char (isUpper)
import Data.Either (isRight)
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import Data.Foldable (for_)
import Data.String (fromString)
diff --git a/src/Language/PureScript/Docs/AsMarkdown.hs b/src/Language/PureScript/Docs/AsMarkdown.hs
index 6cb3b4e..13c513b 100644
--- a/src/Language/PureScript/Docs/AsMarkdown.hs
+++ b/src/Language/PureScript/Docs/AsMarkdown.hs
@@ -13,7 +13,6 @@ import Control.Monad.Error.Class (MonadError)
import Control.Monad.Writer (Writer, tell, execWriter)
import Data.Foldable (for_)
-import Data.Monoid ((<>))
import Data.List (partition)
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/Docs/Convert/ReExports.hs b/src/Language/PureScript/Docs/Convert/ReExports.hs
index 4d48cb1..241acaa 100644
--- a/src/Language/PureScript/Docs/Convert/ReExports.hs
+++ b/src/Language/PureScript/Docs/Convert/ReExports.hs
@@ -14,7 +14,6 @@ import Control.Monad.Trans.State.Strict (execState)
import Data.Either
import Data.Map (Map)
import Data.Maybe (mapMaybe)
-import Data.Monoid ((<>))
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as T
@@ -415,12 +414,13 @@ data TypeClassEnv = TypeClassEnv
}
deriving (Show)
+instance Semigroup TypeClassEnv where
+ (TypeClassEnv a1 b1 c1) <> (TypeClassEnv a2 b2 c2) =
+ TypeClassEnv (a1 <> a2) (b1 <> b2) (c1 <> c2)
+
instance Monoid TypeClassEnv where
mempty =
TypeClassEnv mempty mempty mempty
- mappend (TypeClassEnv a1 b1 c1)
- (TypeClassEnv a2 b2 c2) =
- TypeClassEnv (a1 <> a2) (b1 <> b2) (c1 <> c2)
-- |
-- Take a TypeClassEnv and handle all of the type class members in it, either
diff --git a/src/Language/PureScript/Docs/Convert/Single.hs b/src/Language/PureScript/Docs/Convert/Single.hs
index deaccf2..045fe34 100644
--- a/src/Language/PureScript/Docs/Convert/Single.hs
+++ b/src/Language/PureScript/Docs/Convert/Single.hs
@@ -114,7 +114,7 @@ convertDeclaration (P.ValueDecl sa _ _ _ [P.MkUnguarded (P.TypedValue _ _ ty)])
convertDeclaration (P.ValueDecl sa _ _ _ _) title =
-- If no explicit type declaration was provided, insert a wildcard, so that
-- the actual type will be added during type checking.
- basicDeclaration sa title (ValueDeclaration P.TypeWildcard{})
+ basicDeclaration sa title (ValueDeclaration (P.TypeWildcard (fst sa)))
convertDeclaration (P.ExternDeclaration sa _ ty) title =
basicDeclaration sa title (ValueDeclaration ty)
convertDeclaration (P.DataDeclaration sa dtype _ args ctors) title =
diff --git a/src/Language/PureScript/Docs/Prim.hs b/src/Language/PureScript/Docs/Prim.hs
index ed16e73..a6ee336 100644
--- a/src/Language/PureScript/Docs/Prim.hs
+++ b/src/Language/PureScript/Docs/Prim.hs
@@ -7,7 +7,6 @@ module Language.PureScript.Docs.Prim
) where
import Prelude.Compat hiding (fail)
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map as Map
@@ -106,6 +105,7 @@ primTypeErrorDocsModule = Module
, kindDoc
, textDoc
, quoteDoc
+ , quoteLabelDoc
, besideDoc
, aboveDoc
]
@@ -442,7 +442,7 @@ kindDoc = primKindOf (P.primSubName "TypeError") "Doc" $ T.unlines
[ "`Doc` is the kind of type-level documents."
, ""
, "This kind is used with the `Fail` and `Warn` type clases."
- , "Build up a `Doc` with `Text`, `Quote`, `Beside`, and `Above`."
+ , "Build up a `Doc` with `Text`, `Quote`, `QuoteLabel`, `Beside`, and `Above`."
]
textDoc :: Declaration
@@ -463,6 +463,15 @@ quoteDoc = primTypeOf (P.primSubName "TypeError") "Quote" $ T.unlines
, "[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
]
+quoteLabelDoc :: Declaration
+quoteLabelDoc = primTypeOf (P.primSubName "TypeError") "QuoteLabel" $ T.unlines
+ [ "The `QuoteLabel` type constructor will produce a `Doc` when given a `Symbol`. When the resulting `Doc` is rendered"
+ , "for a `Warn` or `Fail` constraint, a syntactically valid label will be produced, escaping with quotes as needed."
+ , ""
+ , "For more information, see"
+ , "[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
+ ]
+
besideDoc :: Declaration
besideDoc = primTypeOf (P.primSubName "TypeError") "Beside" $ T.unlines
[ "The Beside type constructor combines two Docs horizontally"
diff --git a/src/Language/PureScript/Docs/Render.hs b/src/Language/PureScript/Docs/Render.hs
index 5724493..c0c6565 100644
--- a/src/Language/PureScript/Docs/Render.hs
+++ b/src/Language/PureScript/Docs/Render.hs
@@ -12,7 +12,6 @@ module Language.PureScript.Docs.Render where
import Prelude.Compat
import Data.Maybe (maybeToList)
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/Docs/RenderedCode/RenderKind.hs b/src/Language/PureScript/Docs/RenderedCode/RenderKind.hs
index 3539a12..bbdbe8c 100644
--- a/src/Language/PureScript/Docs/RenderedCode/RenderKind.hs
+++ b/src/Language/PureScript/Docs/RenderedCode/RenderKind.hs
@@ -12,7 +12,6 @@ import Prelude.Compat
import Control.Arrow (ArrowPlus(..))
import Control.PatternArrows as PA
-import Data.Monoid ((<>))
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs
index 15f51dc..3857dfd 100644
--- a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs
+++ b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs
@@ -13,7 +13,6 @@ module Language.PureScript.Docs.RenderedCode.RenderType
import Prelude.Compat
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import Data.Text (Text)
import Control.Arrow ((<+>))
diff --git a/src/Language/PureScript/Docs/RenderedCode/Types.hs b/src/Language/PureScript/Docs/RenderedCode/Types.hs
index 0d64e30..ecf1b0a 100644
--- a/src/Language/PureScript/Docs/RenderedCode/Types.hs
+++ b/src/Language/PureScript/Docs/RenderedCode/Types.hs
@@ -49,7 +49,6 @@ import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Control.Monad.Error.Class (MonadError(..))
-import Data.Monoid ((<>))
import Data.Aeson.BetterErrors (Parse, nth, withText, withValue, toAesonParser, perhaps, asText, eachInArray)
import qualified Data.Aeson as A
import Data.Text (Text)
@@ -248,7 +247,7 @@ asRenderedCodeElement =
--
newtype RenderedCode
= RC { unRC :: [RenderedCodeElement] }
- deriving (Show, Eq, Ord, Monoid)
+ deriving (Show, Eq, Ord, Semigroup, Monoid)
instance A.ToJSON RenderedCode where
toJSON (RC elems) = A.toJSON elems
diff --git a/src/Language/PureScript/Docs/Utils/MonoidExtras.hs b/src/Language/PureScript/Docs/Utils/MonoidExtras.hs
index a9d317e..0d4d0bf 100644
--- a/src/Language/PureScript/Docs/Utils/MonoidExtras.hs
+++ b/src/Language/PureScript/Docs/Utils/MonoidExtras.hs
@@ -6,4 +6,3 @@ mintersperse :: (Monoid m) => m -> [m] -> m
mintersperse _ [] = mempty
mintersperse _ [x] = x
mintersperse sep (x:xs) = x <> sep <> mintersperse sep xs
-
diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs
index abb25bc..c806470 100644
--- a/src/Language/PureScript/Environment.hs
+++ b/src/Language/PureScript/Environment.hs
@@ -449,6 +449,7 @@ primTypeErrorTypes =
, (primSubName C.typeError "Warn", (kindDoc -:> kindConstraint, ExternData))
, (primSubName C.typeError "Text", (kindSymbol -:> kindDoc, ExternData))
, (primSubName C.typeError "Quote", (kindType -:> kindDoc, ExternData))
+ , (primSubName C.typeError "QuoteLabel", (kindSymbol -:> kindDoc, ExternData))
, (primSubName C.typeError "Beside", (kindDoc -:> kindDoc -:> kindDoc, ExternData))
, (primSubName C.typeError "Above", (kindDoc -:> kindDoc -:> kindDoc, ExternData))
]
diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
index 135f98a..d4807d6 100644
--- a/src/Language/PureScript/Errors.hs
+++ b/src/Language/PureScript/Errors.hs
@@ -186,7 +186,7 @@ errorCode em = case unwrapErrorMessage em of
-- | A stack trace for an error
newtype MultipleErrors = MultipleErrors
{ runMultipleErrors :: [ErrorMessage]
- } deriving (Show, Monoid)
+ } deriving (Show, Semigroup, Monoid)
-- | Check whether a collection of errors is empty or not.
nonEmpty :: MultipleErrors -> Bool
@@ -753,8 +753,12 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
line $ "Argument list lengths differ in declaration " <> markCode (showIdent ident)
renderSimpleErrorMessage (OverlappingArgNames ident) =
line $ "Overlapping names in function/binder" <> foldMap ((" in declaration " <>) . showIdent) ident
- renderSimpleErrorMessage (MissingClassMember ident) =
- line $ "Type class member " <> markCode (showIdent ident) <> " has not been implemented."
+ 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
+ | (ident, ty) <- NEL.toList identsAndTypes ]
+ ]
renderSimpleErrorMessage (ExtraneousClassMember ident className) =
line $ "" <> markCode (showIdent ident) <> " is not a member of type class " <> markCode (showQualified runProperName className)
renderSimpleErrorMessage (ExpectedType ty kind) =
@@ -1405,6 +1409,8 @@ 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)
+toTypelevelString (TypeApp (TypeConstructor f) (TypeLevelString x))
+ | f == primSubName C.typeError "QuoteLabel" = Just . line . prettyPrintLabel . Label $ x
toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)
| f == primSubName C.typeError "Beside" =
(Box.<>) <$> toTypelevelString x <*> toTypelevelString ret
diff --git a/src/Language/PureScript/Errors/JSON.hs b/src/Language/PureScript/Errors/JSON.hs
index 65f872d..f552f91 100644
--- a/src/Language/PureScript/Errors/JSON.hs
+++ b/src/Language/PureScript/Errors/JSON.hs
@@ -6,7 +6,6 @@ import Prelude.Compat
import qualified Data.Aeson.TH as A
import qualified Data.List.NonEmpty as NEL
-import Data.Monoid ((<>))
import qualified Data.Text as T
import Data.Text (Text)
diff --git a/src/Language/PureScript/Hierarchy.hs b/src/Language/PureScript/Hierarchy.hs
index 837fd3a..db6b9b1 100644
--- a/src/Language/PureScript/Hierarchy.hs
+++ b/src/Language/PureScript/Hierarchy.hs
@@ -19,7 +19,6 @@ import Prelude.Compat
import Protolude (ordNub)
import Data.List (sort)
-import Data.Monoid ((<>))
import qualified Data.Text as T
import qualified Language.PureScript as P
diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs
index 0970c07..c904a49 100644
--- a/src/Language/PureScript/Ide.hs
+++ b/src/Language/PureScript/Ide.hs
@@ -94,10 +94,10 @@ handleCommand c = case c of
Right rs' -> answerRequest outfp rs'
Left question ->
pure (CompletionResult (map (completionFromMatch . simpleExport . map withEmptyAnn) question))
- Rebuild file actualFile ->
- rebuildFileAsync file actualFile
- RebuildSync file actualFile ->
- rebuildFileSync file actualFile
+ Rebuild file actualFile targets ->
+ rebuildFileAsync file actualFile targets
+ RebuildSync file actualFile targets ->
+ rebuildFileSync file actualFile targets
Cwd ->
TextResult . T.pack <$> liftIO getCurrentDirectory
Reset ->
diff --git a/src/Language/PureScript/Ide/Command.hs b/src/Language/PureScript/Ide/Command.hs
index 233d8b3..ac6991b 100644
--- a/src/Language/PureScript/Ide/Command.hs
+++ b/src/Language/PureScript/Ide/Command.hs
@@ -17,6 +17,8 @@ module Language.PureScript.Ide.Command where
import Protolude
import Data.Aeson
+import qualified Data.Map as Map
+import qualified Data.Set as Set
import qualified Language.PureScript as P
import Language.PureScript.Ide.CaseSplit
import Language.PureScript.Ide.Completion
@@ -57,8 +59,8 @@ data Command
-- Import InputFile OutputFile
| Import FilePath (Maybe FilePath) [Filter] ImportCommand
| List { listType :: ListType }
- | Rebuild FilePath (Maybe FilePath)
- | RebuildSync FilePath (Maybe FilePath)
+ | Rebuild FilePath (Maybe FilePath) (Set P.CodegenTarget)
+ | RebuildSync FilePath (Maybe FilePath) (Set P.CodegenTarget)
| Cwd
| Reset
| Quit
@@ -172,7 +174,11 @@ instance FromJSON Command where
Rebuild
<$> params .: "file"
<*> params .:? "actualFile"
+ <*> (parseCodegenTargets =<< params .:? "codegen" .!= [ "js" ])
_ -> mzero
where
+ parseCodegenTargets =
+ maybe mzero (pure . Set.fromList) . traverse (flip Map.lookup P.codegenTargets)
+
mkAnnotations True = explicitAnnotations
mkAnnotations False = noAnnotations
diff --git a/src/Language/PureScript/Ide/Completion.hs b/src/Language/PureScript/Ide/Completion.hs
index eace77b..d03ac60 100644
--- a/src/Language/PureScript/Ide/Completion.hs
+++ b/src/Language/PureScript/Ide/Completion.hs
@@ -11,7 +11,6 @@ module Language.PureScript.Ide.Completion
import Protolude hiding ((<&>), moduleName)
-import Control.Lens hiding ((&), op)
import Data.Aeson
import qualified Data.Map as Map
import qualified Data.Text as T
@@ -21,6 +20,7 @@ import Language.PureScript.Ide.Filter
import Language.PureScript.Ide.Matcher
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
+import Lens.Micro.Platform hiding ((&))
type Module = (P.ModuleName, [IdeDeclarationAnn])
diff --git a/src/Language/PureScript/Ide/Externs.hs b/src/Language/PureScript/Ide/Externs.hs
index ca7a53d..df65a9a 100644
--- a/src/Language/PureScript/Ide/Externs.hs
+++ b/src/Language/PureScript/Ide/Externs.hs
@@ -21,7 +21,6 @@ module Language.PureScript.Ide.Externs
import Protolude hiding (to, from, (&))
-import Control.Lens
import "monad-logger" Control.Monad.Logger
import Data.Aeson (decodeStrict)
import Data.Aeson.Types (withObject, parseMaybe, (.:))
@@ -29,6 +28,7 @@ import qualified Data.ByteString as BS
import Data.Version (showVersion)
import Language.PureScript.Ide.Error (IdeError (..))
import Language.PureScript.Ide.Types
+import Lens.Micro.Platform
import qualified Language.PureScript as P
diff --git a/src/Language/PureScript/Ide/Filter.hs b/src/Language/PureScript/Ide/Filter.hs
index cdb29f4..b08bb06 100644
--- a/src/Language/PureScript/Ide/Filter.hs
+++ b/src/Language/PureScript/Ide/Filter.hs
@@ -35,7 +35,7 @@ import Language.PureScript.Ide.Util
import qualified Language.PureScript as P
newtype Filter = Filter (Endo [Module])
- deriving (Monoid)
+ deriving (Semigroup, Monoid)
type Module = (P.ModuleName, [IdeDeclarationAnn])
diff --git a/src/Language/PureScript/Ide/Imports.hs b/src/Language/PureScript/Ide/Imports.hs
index 382523e..f52cd63 100644
--- a/src/Language/PureScript/Ide/Imports.hs
+++ b/src/Language/PureScript/Ide/Imports.hs
@@ -32,7 +32,6 @@ module Language.PureScript.Ide.Imports
import Protolude hiding (moduleName)
-import Control.Lens ((^.), (%~), ix)
import Data.List (findIndex, nubBy, partition)
import qualified Data.Map as Map
import qualified Data.Text as T
@@ -45,6 +44,7 @@ import Language.PureScript.Ide.State
import Language.PureScript.Ide.Prim
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
+import Lens.Micro.Platform ((^.), (%~), ix)
import System.IO.UTF8 (writeUTF8FileT)
import qualified Text.Parsec as Parsec
diff --git a/src/Language/PureScript/Ide/Matcher.hs b/src/Language/PureScript/Ide/Matcher.hs
index 531a29e..e5bf21e 100644
--- a/src/Language/PureScript/Ide/Matcher.hs
+++ b/src/Language/PureScript/Ide/Matcher.hs
@@ -35,7 +35,7 @@ import Text.Regex.TDFA ((=~))
type ScoredMatch a = (Match a, Double)
-newtype Matcher a = Matcher (Endo [Match a]) deriving (Monoid)
+newtype Matcher a = Matcher (Endo [Match a]) deriving (Semigroup, Monoid)
instance FromJSON (Matcher IdeDeclarationAnn) where
parseJSON = withObject "matcher" $ \o -> do
diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs
index 84555a5..6ad0313 100644
--- a/src/Language/PureScript/Ide/Rebuild.hs
+++ b/src/Language/PureScript/Ide/Rebuild.hs
@@ -42,10 +42,12 @@ rebuildFile
-- ^ The file to rebuild
-> Maybe FilePath
-- ^ The file to use as the location for parsing and errors
+ -> Set P.CodegenTarget
+ -- ^ The targets to codegen
-> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())
-- ^ A runner for the second build with open exports
-> m Success
-rebuildFile file actualFile runOpenBuild = do
+rebuildFile file actualFile codegenTargets runOpenBuild = do
input <- ideReadFile file
@@ -69,7 +71,7 @@ rebuildFile file actualFile runOpenBuild = do
-- Rebuild the single module using the cached externs
(result, warnings) <- logPerf (labelTimespec "Rebuilding Module") $
liftIO
- . P.runMake P.defaultOptions
+ . P.runMake (P.defaultOptions { P.optionsCodegenTargets = codegenTargets })
. P.rebuildModule (buildMakeActions
>>= shushProgress $ makeEnv) externs $ m
case result of
@@ -87,8 +89,8 @@ isEditorMode = asks (confEditorMode . ideConfiguration)
rebuildFileAsync
:: forall m. (Ide m, MonadLogger m, MonadError IdeError m)
- => FilePath -> Maybe FilePath -> m Success
-rebuildFileAsync fp fp' = rebuildFile fp fp' asyncRun
+ => FilePath -> Maybe FilePath -> Set P.CodegenTarget -> m Success
+rebuildFileAsync fp fp' ts = rebuildFile fp fp' ts asyncRun
where
asyncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
asyncRun action = do
@@ -98,8 +100,8 @@ rebuildFileAsync fp fp' = rebuildFile fp fp' asyncRun
rebuildFileSync
:: forall m. (Ide m, MonadLogger m, MonadError IdeError m)
- => FilePath -> Maybe FilePath -> m Success
-rebuildFileSync fp fp' = rebuildFile fp fp' syncRun
+ => FilePath -> Maybe FilePath -> Set P.CodegenTarget -> m Success
+rebuildFileSync fp fp' ts = rebuildFile fp fp' ts syncRun
where
syncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
syncRun action = do
@@ -154,11 +156,12 @@ shushProgress :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make
shushProgress ma _ =
ma { P.progress = \_ -> pure () }
--- | Stops any kind of codegen (also silences errors about missing or unused FFI
--- files though)
+-- | Stops any kind of codegen
shushCodegen :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make
shushCodegen ma MakeActionsEnv{..} =
- ma { P.codegen = \_ _ _ -> pure () }
+ ma { P.codegen = \_ _ _ -> pure ()
+ , P.ffiCodegen = \_ -> pure ()
+ }
-- | Returns a topologically sorted list of dependent ExternsFiles for the given
-- module. Throws an error if there is a cyclic dependency within the
diff --git a/src/Language/PureScript/Ide/Reexports.hs b/src/Language/PureScript/Ide/Reexports.hs
index 82a639c..71c73d4 100644
--- a/src/Language/PureScript/Ide/Reexports.hs
+++ b/src/Language/PureScript/Ide/Reexports.hs
@@ -25,11 +25,11 @@ module Language.PureScript.Ide.Reexports
import Protolude hiding (moduleName)
-import Control.Lens hiding ((&))
import qualified Data.Map as Map
import qualified Language.PureScript as P
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
+import Lens.Micro.Platform hiding ((&))
-- | Contains the module with resolved reexports, and possible failures
data ReexportResult a
diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs
index b34f465..3ab0ece 100644
--- a/src/Language/PureScript/Ide/State.hs
+++ b/src/Language/PureScript/Ide/State.hs
@@ -41,7 +41,6 @@ import Protolude hiding (moduleName)
import Control.Arrow
import Control.Concurrent.STM
-import Control.Lens hiding (op, (&))
import "monad-logger" Control.Monad.Logger
import qualified Data.Map.Lazy as Map
import qualified Language.PureScript as P
@@ -52,6 +51,7 @@ import Language.PureScript.Ide.Reexports
import Language.PureScript.Ide.SourceFile
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
+import Lens.Micro.Platform hiding ((&))
-- | Resets all State inside psc-ide
resetIdeState :: Ide m => m ()
@@ -329,7 +329,7 @@ resolveInstances externs declarations =
mapIf matchTC (idaDeclaration
. _IdeDeclTypeClass
. ideTCInstances
- %~ cons ideInstance)
+ %~ (ideInstance :))
in
acc' & ix classModule %~ updateDeclaration
diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs
index 585b59e..f096769 100644
--- a/src/Language/PureScript/Ide/Types.hs
+++ b/src/Language/PureScript/Ide/Types.hs
@@ -22,11 +22,11 @@ module Language.PureScript.Ide.Types where
import Protolude hiding (moduleName)
import Control.Concurrent.STM
-import Control.Lens.TH
import Data.Aeson
import qualified Data.Map.Lazy as M
import qualified Language.PureScript as P
import qualified Language.PureScript.Errors.JSON as P
+import Lens.Micro.Platform hiding ((.=))
type ModuleIdent = Text
type ModuleMap a = Map P.ModuleName a
@@ -94,7 +94,41 @@ data IdeTypeOperator = IdeTypeOperator
, _ideTypeOpKind :: Maybe P.Kind
} deriving (Show, Eq, Ord, Generic, NFData)
-makePrisms ''IdeDeclaration
+_IdeDeclValue :: Traversal' IdeDeclaration IdeValue
+_IdeDeclValue f (IdeDeclValue x) = map IdeDeclValue (f x)
+_IdeDeclValue _ x = pure x
+
+_IdeDeclType :: Traversal' IdeDeclaration IdeType
+_IdeDeclType f (IdeDeclType x) = map IdeDeclType (f x)
+_IdeDeclType _ x = pure x
+
+_IdeDeclTypeSynonym :: Traversal' IdeDeclaration IdeTypeSynonym
+_IdeDeclTypeSynonym f (IdeDeclTypeSynonym x) = map IdeDeclTypeSynonym (f x)
+_IdeDeclTypeSynonym _ x = pure x
+
+_IdeDeclDataConstructor :: Traversal' IdeDeclaration IdeDataConstructor
+_IdeDeclDataConstructor f (IdeDeclDataConstructor x) = map IdeDeclDataConstructor (f x)
+_IdeDeclDataConstructor _ x = pure x
+
+_IdeDeclTypeClass :: Traversal' IdeDeclaration IdeTypeClass
+_IdeDeclTypeClass f (IdeDeclTypeClass x) = map IdeDeclTypeClass (f x)
+_IdeDeclTypeClass _ x = pure x
+
+_IdeDeclValueOperator :: Traversal' IdeDeclaration IdeValueOperator
+_IdeDeclValueOperator f (IdeDeclValueOperator x) = map IdeDeclValueOperator (f x)
+_IdeDeclValueOperator _ x = pure x
+
+_IdeDeclTypeOperator :: Traversal' IdeDeclaration IdeTypeOperator
+_IdeDeclTypeOperator f (IdeDeclTypeOperator x) = map IdeDeclTypeOperator (f x)
+_IdeDeclTypeOperator _ x = pure x
+
+_IdeDeclKind :: Traversal' IdeDeclaration (P.ProperName 'P.KindName)
+_IdeDeclKind f (IdeDeclKind x) = map IdeDeclKind (f x)
+_IdeDeclKind _ x = pure x
+
+anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool
+anyOf g p = getAny . getConst . g (Const . Any . p)
+
makeLenses ''IdeValue
makeLenses ''IdeType
makeLenses ''IdeTypeSynonym
diff --git a/src/Language/PureScript/Ide/Usage.hs b/src/Language/PureScript/Ide/Usage.hs
index 9ffa5e9..1890329 100644
--- a/src/Language/PureScript/Ide/Usage.hs
+++ b/src/Language/PureScript/Ide/Usage.hs
@@ -8,13 +8,13 @@ module Language.PureScript.Ide.Usage
import Protolude hiding (moduleName)
-import Control.Lens (preview)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Language.PureScript as P
import Language.PureScript.Ide.State (getAllModules, getFileState)
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
+import Lens.Micro.Platform (preview)
-- |
-- How we find usages, given an IdeDeclaration and the module it was defined in:
diff --git a/src/Language/PureScript/Ide/Util.hs b/src/Language/PureScript/Ide/Util.hs
index 47489e8..46824c1 100644
--- a/src/Language/PureScript/Ide/Util.hs
+++ b/src/Language/PureScript/Ide/Util.hs
@@ -30,9 +30,8 @@ module Language.PureScript.Ide.Util
) where
import Protolude hiding (decodeUtf8,
- encodeUtf8)
+ encodeUtf8, to)
-import Control.Lens hiding ((&), op)
import Data.Aeson
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Encoding as TLE
@@ -40,6 +39,7 @@ import qualified Language.PureScript as P
import Language.PureScript.Ide.Error (IdeError(..))
import Language.PureScript.Ide.Logging
import Language.PureScript.Ide.Types
+import Lens.Micro.Platform hiding ((&))
import System.IO.UTF8 (readUTF8FileT)
import System.Directory (makeAbsolute)
@@ -90,14 +90,14 @@ encodeT = TL.toStrict . TLE.decodeUtf8 . encode
decodeT :: (FromJSON a) => Text -> Maybe a
decodeT = decode . TLE.encodeUtf8 . TL.fromStrict
-properNameT :: Iso' (P.ProperName a) Text
-properNameT = iso P.runProperName P.ProperName
+properNameT :: Getting r (P.ProperName a) Text
+properNameT = to P.runProperName
-identT :: Iso' P.Ident Text
-identT = iso P.runIdent P.Ident
+identT :: Getting r P.Ident Text
+identT = to P.runIdent
-opNameT :: Iso' (P.OpName a) Text
-opNameT = iso P.runOpName P.OpName
+opNameT :: Getting r (P.OpName a) Text
+opNameT = to P.runOpName
ideReadFile'
:: (MonadIO m, MonadError IdeError m)
diff --git a/src/Language/PureScript/Interactive.hs b/src/Language/PureScript/Interactive.hs
index 6fbfc5d..3205316 100644
--- a/src/Language/PureScript/Interactive.hs
+++ b/src/Language/PureScript/Interactive.hs
@@ -16,7 +16,6 @@ import Protolude (ordNub)
import Data.List (sort, find, foldl')
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Map as M
-import Data.Monoid ((<>))
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
@@ -292,7 +291,7 @@ handleBrowse
-> m ()
handleBrowse print' moduleName = do
st <- get
- env <- asks psciEnvironment
+ let env = psciEnvironment st
case findMod moduleName (psciLoadedExterns st) (psciImportedModules st) of
Just qualName -> print' $ printModuleSignatures qualName env
Nothing -> failNotInEnv moduleName
diff --git a/src/Language/PureScript/Interactive/Printer.hs b/src/Language/PureScript/Interactive/Printer.hs
index 38022a7..6081294 100644
--- a/src/Language/PureScript/Interactive/Printer.hs
+++ b/src/Language/PureScript/Interactive/Printer.hs
@@ -5,7 +5,6 @@ import Prelude.Compat
import Data.List (intersperse)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
-import Data.Monoid ((<>))
import qualified Data.Text as T
import Data.Text (Text)
import qualified Language.PureScript as P
diff --git a/src/Language/PureScript/Interactive/Types.hs b/src/Language/PureScript/Interactive/Types.hs
index 15e1427..521b61d 100644
--- a/src/Language/PureScript/Interactive/Types.hs
+++ b/src/Language/PureScript/Interactive/Types.hs
@@ -3,6 +3,7 @@
--
module Language.PureScript.Interactive.Types
( PSCiConfig(..)
+ , psciEnvironment
, PSCiState -- constructor is not exported, to prevent psciImports and psciExports from
-- becoming inconsistent with importedModules, letBindings and loadedExterns
, ImportedModule
@@ -29,6 +30,7 @@ import Prelude.Compat
import qualified Language.PureScript as P
import qualified Data.Map as M
+import Data.List (foldl')
import Language.PureScript.Sugar.Names.Env (nullImports, primExports)
import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Writer.Strict (runWriterT)
@@ -38,9 +40,8 @@ import Control.Monad.Writer.Strict (runWriterT)
--
-- These configuration values do not change during execution.
--
-data PSCiConfig = PSCiConfig
- { psciFileGlobs :: [String]
- , psciEnvironment :: P.Environment
+newtype PSCiConfig = PSCiConfig
+ { psciFileGlobs :: [String]
} deriving Show
-- | The PSCI state.
@@ -78,6 +79,10 @@ psciExports (PSCiState _ _ _ _ x) = x
initialPSCiState :: PSCiState
initialPSCiState = PSCiState [] [] [] nullImports primExports
+psciEnvironment :: PSCiState -> P.Environment
+psciEnvironment st = foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment externs
+ where externs = map snd (psciLoadedExterns st)
+
-- | All of the data that is contained by an ImportDeclaration in the AST.
-- That is:
--
@@ -137,7 +142,7 @@ updateImportedModules f (PSCiState x a b c d) =
-- | Updates the loaded externs files in the state record.
updateLoadedExterns :: ([(P.Module, P.ExternsFile)] -> [(P.Module, P.ExternsFile)]) -> PSCiState -> PSCiState
updateLoadedExterns f (PSCiState a b x c d) =
- PSCiState a b (f x) c d
+ updateImportExports (PSCiState a b (f x) c d)
-- | Updates the let bindings in the state record.
updateLets :: ([P.Declaration] -> [P.Declaration]) -> PSCiState -> PSCiState
diff --git a/src/Language/PureScript/Kinds.hs b/src/Language/PureScript/Kinds.hs
index 2088a3f..01df9dc 100644
--- a/src/Language/PureScript/Kinds.hs
+++ b/src/Language/PureScript/Kinds.hs
@@ -102,8 +102,8 @@ everywhereOnKindsM f = go
go other = f other
everythingOnKinds :: (r -> r -> r) -> (Kind -> r) -> Kind -> r
-everythingOnKinds (<>) f = go
+everythingOnKinds (<>.) f = go
where
- go k@(Row k1) = f k <> go k1
- go k@(FunKind k1 k2) = f k <> go k1 <> go k2
+ go k@(Row k1) = f k <>. go k1
+ go k@(FunKind k1 k2) = f k <>. go k1 <>. go k2
go other = f other
diff --git a/src/Language/PureScript/Label.hs b/src/Language/PureScript/Label.hs
index b00db4f..accd314 100644
--- a/src/Language/PureScript/Label.hs
+++ b/src/Language/PureScript/Label.hs
@@ -17,6 +17,6 @@ import Language.PureScript.PSString (PSString)
-- because records are indexable by PureScript strings at runtime.
--
newtype Label = Label { runLabel :: PSString }
- deriving (Show, Eq, Ord, IsString, Monoid, A.ToJSON, A.FromJSON, Generic)
+ deriving (Show, Eq, Ord, IsString, Semigroup, Monoid, A.ToJSON, A.FromJSON, Generic)
instance NFData Label
diff --git a/src/Language/PureScript/Linter.hs b/src/Language/PureScript/Linter.hs
index 59f936a..49ede59 100644
--- a/src/Language/PureScript/Linter.hs
+++ b/src/Language/PureScript/Linter.hs
@@ -10,7 +10,6 @@ import Control.Monad.Writer.Class
import Data.List ((\\))
import Data.Maybe (mapMaybe)
-import Data.Monoid
import qualified Data.Set as S
import Data.Text (Text)
diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs
index 1965925..4278f50 100644
--- a/src/Language/PureScript/Linter/Exhaustive.hs
+++ b/src/Language/PureScript/Linter/Exhaustive.hs
@@ -20,7 +20,6 @@ import Control.Monad.Supply.Class (MonadSupply, fresh, freshName)
import Data.Function (on)
import Data.List (foldl', sortBy)
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs
index 112ddbd..0341ee2 100644
--- a/src/Language/PureScript/Make.hs
+++ b/src/Language/PureScript/Make.hs
@@ -75,6 +75,7 @@ rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do
optimized = CF.optimizeCoreFn corefn
[renamed] = renameInModules [optimized]
exts = moduleToExternsFile mod' env'
+ ffiCodegen renamed
evalSupplyT nextVar' . codegen renamed env' . encode $ exts
return exts
diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs
index 254b83b..f7c6d5e 100644
--- a/src/Language/PureScript/Make/Actions.hs
+++ b/src/Language/PureScript/Make/Actions.hs
@@ -4,6 +4,7 @@ module Language.PureScript.Make.Actions
, Externs()
, ProgressMessage(..)
, buildMakeActions
+ , checkForeignDecls
) where
import Prelude
@@ -18,13 +19,12 @@ import Control.Monad.Writer.Class (MonadWriter(..))
import Data.Aeson (encode)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy as LB
-import qualified Data.ByteString.UTF8 as BU8
+import qualified Data.ByteString.Lazy.UTF8 as LBU8
import Data.Either (partitionEithers)
import Data.Foldable (for_, minimum)
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@@ -44,7 +44,7 @@ import Language.PureScript.Errors
import Language.PureScript.Make.Monad
import Language.PureScript.Names
import Language.PureScript.Names (runModuleName, ModuleName)
-import Language.PureScript.Options
+import Language.PureScript.Options hiding (codegenTargets)
import qualified Language.PureScript.Parser as PSParser
import Language.PureScript.Pretty.Common (SMap(..))
import qualified Paths_purescript as Paths
@@ -96,6 +96,8 @@ data MakeActions m = MakeActions
-- path for the file.
, codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT m ()
-- ^ Run the code generator for the module and write any required output files.
+ , ffiCodegen :: CF.Module CF.Ann -> m ()
+ -- ^ Check ffi and print it in the output directory.
, progress :: ProgressMessage -> m ()
-- ^ Respond to a progress update.
}
@@ -112,7 +114,7 @@ buildMakeActions
-- ^ Generate a prefix comment?
-> MakeActions Make
buildMakeActions outputDir filePathMap foreigns usePrefix =
- MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
+ MakeActions getInputTimestamp getOutputTimestamp readExterns codegen ffiCodegen progress
where
getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime))
@@ -156,12 +158,10 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
lift $ writeTextFile coreFnFile (encode json)
when (S.member JS codegenTargets) $ do
foreignInclude <- case mn `M.lookup` foreigns of
- Just path
+ Just _
| not $ requiresForeign m -> do
- tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path
return Nothing
| otherwise -> do
- checkForeignDecls m path
return $ Just $ Imp.App Nothing (Imp.Var Nothing "require") [Imp.StringLiteral Nothing "./foreign.js"]
Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn
| otherwise -> return Nothing
@@ -169,7 +169,6 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
dir <- lift $ makeIO (const (ErrorMessage [] $ CannotGetFileInfo ".")) getCurrentDirectory
let sourceMaps = S.member JSSourceMap codegenTargets
(pjs, mappings) = if sourceMaps then prettyPrintJSWithSourceMaps rawJs else (prettyPrintJS rawJs, [])
- foreignFile = outputFilename mn "foreign.js"
jsFile = targetFilename mn JS
mapFile = targetFilename mn JSSourceMap
prefix = ["Generated by purs version " <> T.pack (showVersion Paths.version) | usePrefix]
@@ -177,9 +176,24 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
mapRef = if sourceMaps then "//# sourceMappingURL=index.js.map\n" else ""
lift $ do
writeTextFile jsFile (B.fromStrict $ TE.encodeUtf8 $ js <> mapRef)
- for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)
when sourceMaps $ genSourceMap dir mapFile (length prefix) mappings
+ ffiCodegen :: CF.Module CF.Ann -> Make ()
+ ffiCodegen m = do
+ codegenTargets <- asks optionsCodegenTargets
+ when (S.member JS codegenTargets) $ do
+ let mn = CF.moduleName m
+ foreignFile = outputFilename mn "foreign.js"
+ case mn `M.lookup` foreigns of
+ Just path
+ | not $ requiresForeign m ->
+ tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path
+ | otherwise ->
+ checkForeignDecls m path
+ Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn
+ | otherwise -> return ()
+ for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)
+
genSourceMap :: String -> String -> Int -> [SMap] -> Make ()
genSourceMap dir mapFile extraLines mappings = do
let pathToDir = iterate (".." </>) ".." !! length (splitPath $ normalise outputDir)
@@ -227,10 +241,10 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
-- | Check that the declarations in a given PureScript module match with those
-- in its corresponding foreign module.
-checkForeignDecls :: CF.Module ann -> FilePath -> SupplyT Make ()
+checkForeignDecls :: CF.Module ann -> FilePath -> Make ()
checkForeignDecls m path = do
- jsStr <- lift $ readTextFile path
- js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parse (BU8.toString (B.toStrict jsStr)) path
+ jsStr <- readTextFile path
+ js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parse (LBU8.toString jsStr) path
foreignIdentsStrs <- either errorParsingModule pure $ getExps js
foreignIdents <- either
@@ -253,13 +267,13 @@ checkForeignDecls m path = do
mname = CF.moduleName m
modSS = CF.moduleSourceSpan m
- errorParsingModule :: Bundle.ErrorMessage -> SupplyT Make a
+ errorParsingModule :: Bundle.ErrorMessage -> Make a
errorParsingModule = throwError . errorMessage' modSS . ErrorParsingFFIModule path . Just
getExps :: JS.JSAST -> Either Bundle.ErrorMessage [String]
getExps = Bundle.getExportedIdentifiers (T.unpack (runModuleName mname))
- errorInvalidForeignIdentifiers :: [String] -> SupplyT Make a
+ errorInvalidForeignIdentifiers :: [String] -> Make a
errorInvalidForeignIdentifiers =
throwError . mconcat . map (errorMessage . InvalidFFIIdentifier mname . T.pack)
diff --git a/src/Language/PureScript/Names.hs b/src/Language/PureScript/Names.hs
index 16f135f..e2327c1 100644
--- a/src/Language/PureScript/Names.hs
+++ b/src/Language/PureScript/Names.hs
@@ -16,7 +16,6 @@ import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
import Data.Aeson
import Data.Aeson.TH
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/Options.hs b/src/Language/PureScript/Options.hs
index 3055946..1de91c9 100644
--- a/src/Language/PureScript/Options.hs
+++ b/src/Language/PureScript/Options.hs
@@ -3,6 +3,8 @@ module Language.PureScript.Options where
import Prelude.Compat
import qualified Data.Set as S
+import Data.Map (Map)
+import qualified Data.Map as Map
-- | The data type of compiler options
data Options = Options
@@ -20,3 +22,10 @@ defaultOptions = Options False False (S.singleton JS)
data CodegenTarget = JS | JSSourceMap | CoreFn
deriving (Eq, Ord, Show)
+
+codegenTargets :: Map String CodegenTarget
+codegenTargets = Map.fromList
+ [ ("js", JS)
+ , ("sourcemaps", JSSourceMap)
+ , ("corefn", CoreFn)
+ ]
diff --git a/src/Language/PureScript/PSString.hs b/src/Language/PureScript/PSString.hs
index 0dcb3b4..f466257 100644
--- a/src/Language/PureScript/PSString.hs
+++ b/src/Language/PureScript/PSString.hs
@@ -21,7 +21,6 @@ import Control.Applicative ((<|>))
import Data.Char (chr)
import Data.Bits (shiftR)
import Data.List (unfoldr)
-import Data.Monoid ((<>))
import Data.Scientific (toBoundedInteger)
import Data.String (IsString(..))
import Data.ByteString (ByteString)
@@ -52,7 +51,7 @@ import qualified Data.Aeson.Types as A
-- and arrays of UTF-16 code units (integers) otherwise.
--
newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }
- deriving (Eq, Ord, Monoid, Generic)
+ deriving (Eq, Ord, Semigroup, Monoid, Generic)
instance NFData PSString
diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hs
index 6f21f9f..0b430ba 100644
--- a/src/Language/PureScript/Parser/Common.hs
+++ b/src/Language/PureScript/Parser/Common.hs
@@ -6,7 +6,6 @@ import Prelude.Compat
import Control.Applicative ((<|>))
import Control.Monad (guard)
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Language.PureScript.AST.SourcePos
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index 12fc38f..bfc7701 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -25,7 +25,6 @@ import Control.Monad.Error.Class (MonadError(..))
import Control.Parallel.Strategies (withStrategy, parList, rseq)
import Data.Functor (($>))
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import qualified Data.Set as S
import Data.Text (Text)
import Language.PureScript.AST
diff --git a/src/Language/PureScript/Parser/Lexer.hs b/src/Language/PureScript/Parser/Lexer.hs
index 71812e8..377d9b1 100644
--- a/src/Language/PureScript/Parser/Lexer.hs
+++ b/src/Language/PureScript/Parser/Lexer.hs
@@ -70,7 +70,6 @@ import Control.Applicative ((<|>))
import Control.Monad (void, guard)
import Control.Monad.Identity (Identity)
import Data.Char (isSpace, isAscii, isSymbol, isAlphaNum)
-import Data.Monoid ((<>))
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs
index b728023..e26fa2a 100644
--- a/src/Language/PureScript/Pretty/Common.hs
+++ b/src/Language/PureScript/Pretty/Common.hs
@@ -10,7 +10,6 @@ import Prelude.Compat
import Control.Monad.State (StateT, modify, get)
import Data.List (elemIndices, intersperse)
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Char (isUpper)
@@ -55,11 +54,12 @@ newtype StrPos = StrPos (SourcePos, Text, [SMap])
-- appropriately and advancing source mappings on the right hand side to account for
-- the length of the left.
--
+instance Semigroup StrPos where
+ StrPos (a,b,c) <> StrPos (a',b',c') = StrPos (a `addPos` a', b <> b', c ++ (bumpPos a <$> c'))
+
instance Monoid StrPos where
mempty = StrPos (SourcePos 0 0, "", [])
- StrPos (a,b,c) `mappend` StrPos (a',b',c') = StrPos (a `addPos` a', b <> b', c ++ (bumpPos a <$> c'))
-
mconcat ms =
let s' = foldMap (\(StrPos(_, s, _)) -> s) ms
(p, maps) = foldl plus (SourcePos 0 0, []) ms
@@ -88,7 +88,7 @@ instance Emit StrPos where
mapping = SMap (T.pack file) startPos zeroPos
zeroPos = SourcePos 0 0
-newtype PlainString = PlainString Text deriving Monoid
+newtype PlainString = PlainString Text deriving (Semigroup, Monoid)
runPlainString :: PlainString -> Text
runPlainString (PlainString s) = s
diff --git a/src/Language/PureScript/Pretty/Kinds.hs b/src/Language/PureScript/Pretty/Kinds.hs
index 24d4451..9f950af 100644
--- a/src/Language/PureScript/Pretty/Kinds.hs
+++ b/src/Language/PureScript/Pretty/Kinds.hs
@@ -10,7 +10,6 @@ import Prelude.Compat
import Control.Arrow (ArrowPlus(..))
import Control.PatternArrows as PA
-import Data.Monoid ((<>))
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text (Text)
diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs
index bee62db..40c2956 100644
--- a/src/Language/PureScript/Pretty/Types.hs
+++ b/src/Language/PureScript/Pretty/Types.hs
@@ -14,7 +14,7 @@ module Language.PureScript.Pretty.Types
, prettyPrintObjectKey
) where
-import Prelude.Compat
+import Prelude.Compat hiding ((<>))
import Control.Arrow ((<+>))
import Control.PatternArrows as PA
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index bbabf08..7902526 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -7,7 +7,7 @@ module Language.PureScript.Pretty.Values
, prettyPrintBinderAtom
) where
-import Prelude.Compat
+import Prelude.Compat hiding ((<>))
import Control.Arrow (second)
diff --git a/src/Language/PureScript/Publish.hs b/src/Language/PureScript/Publish.hs
index 73545bf..7d1c630 100644
--- a/src/Language/PureScript/Publish.hs
+++ b/src/Language/PureScript/Publish.hs
@@ -36,7 +36,8 @@ import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Version
-import qualified Data.SPDX as SPDX
+import qualified Distribution.SPDX as SPDX
+import qualified Distribution.Parsec.Class as CabalParsec
import System.Directory (doesFileExist)
import System.FilePath.Glob (globDir1)
@@ -230,7 +231,11 @@ checkLicense pkgMeta =
-- Check if a string is a valid SPDX license expression.
--
isValidSPDX :: String -> Bool
-isValidSPDX = (== 1) . length . SPDX.parseExpression
+isValidSPDX input = case CabalParsec.simpleParsec input of
+ Nothing -> False
+ Just SPDX.NONE -> False
+ Just _ -> True
+
extractGithub :: Text -> Maybe (D.GithubUser, D.GithubRepo)
extractGithub = stripGitHubPrefixes
diff --git a/src/Language/PureScript/Publish/ErrorsWarnings.hs b/src/Language/PureScript/Publish/ErrorsWarnings.hs
index 8067395..38ebc36 100644
--- a/src/Language/PureScript/Publish/ErrorsWarnings.hs
+++ b/src/Language/PureScript/Publish/ErrorsWarnings.hs
@@ -311,11 +311,12 @@ data CollectedWarnings = CollectedWarnings
}
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')
+
instance Monoid CollectedWarnings where
mempty = CollectedWarnings mempty mempty mempty mempty mempty
- mappend (CollectedWarnings as bs cs d es)
- (CollectedWarnings as' bs' cs' d' es') =
- CollectedWarnings (as <> as') (bs <> bs') (cs <> cs') (d <> d') (es <> es')
collectWarnings :: [PackageWarning] -> CollectedWarnings
collectWarnings = foldMap singular
diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs
index b99cd9d..4ee82ad 100644
--- a/src/Language/PureScript/Renamer.hs
+++ b/src/Language/PureScript/Renamer.hs
@@ -10,7 +10,6 @@ import Control.Monad.State
import Data.List (find)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Map as M
-import Data.Monoid ((<>))
import qualified Data.Set as S
import qualified Data.Text as T
diff --git a/src/Language/PureScript/Sugar/DoNotation.hs b/src/Language/PureScript/Sugar/DoNotation.hs
index 71adaa1..a3d46bf 100644
--- a/src/Language/PureScript/Sugar/DoNotation.hs
+++ b/src/Language/PureScript/Sugar/DoNotation.hs
@@ -25,46 +25,47 @@ desugarDoModule (Module ss coms mn ds exts) = Module ss coms mn <$> parU ds desu
-- | Desugar a single do statement
desugarDo :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration
desugarDo d =
- let (f, _, _) = everywhereOnValuesM return replace return
- in rethrowWithPosition (declSourceSpan d) $ f d
+ let ss = declSourceSpan d
+ (f, _, _) = everywhereOnValuesM return (replace ss) return
+ in rethrowWithPosition ss $ f d
where
- bind :: Expr
- bind = Var nullSourceSpan (Qualified Nothing (Ident C.bind))
+ bind :: SourceSpan -> Expr
+ bind = flip Var (Qualified Nothing (Ident C.bind))
- discard :: Expr
- discard = Var nullSourceSpan (Qualified Nothing (Ident C.discard))
+ discard :: SourceSpan -> Expr
+ discard = flip Var (Qualified Nothing (Ident C.discard))
- replace :: Expr -> m Expr
- replace (Do els) = go els
- replace (PositionedValue pos com v) = PositionedValue pos com <$> rethrowWithPosition pos (replace v)
- replace other = return other
+ replace :: SourceSpan -> Expr -> m Expr
+ replace pos (Do els) = go pos els
+ replace _ (PositionedValue pos com v) = PositionedValue pos com <$> rethrowWithPosition pos (replace pos v)
+ replace _ other = return other
- go :: [DoNotationElement] -> m Expr
- go [] = internalError "The impossible happened in desugarDo"
- go [DoNotationValue val] = return val
- go (DoNotationValue val : rest) = do
- rest' <- go rest
- return $ App (App discard val) (Abs (VarBinder nullSourceSpan UnusedIdent) rest')
- go [DoNotationBind _ _] = throwError . errorMessage $ InvalidDoBind
- go (DoNotationBind b _ : _) | First (Just ident) <- foldMap fromIdent (binderNames b) =
+ go :: SourceSpan -> [DoNotationElement] -> m Expr
+ go _ [] = internalError "The impossible happened in desugarDo"
+ go _ [DoNotationValue val] = return val
+ go pos (DoNotationValue val : rest) = do
+ rest' <- go pos rest
+ return $ App (App (discard pos) val) (Abs (VarBinder pos UnusedIdent) rest')
+ go _ [DoNotationBind _ _] = throwError . errorMessage $ InvalidDoBind
+ go _ (DoNotationBind b _ : _) | First (Just ident) <- foldMap fromIdent (binderNames b) =
throwError . errorMessage $ CannotUseBindWithDo (Ident ident)
where
fromIdent (Ident i) | i `elem` [ C.bind, C.discard ] = First (Just i)
fromIdent _ = mempty
- go (DoNotationBind (VarBinder ss ident) val : rest) = do
- rest' <- go rest
- return $ App (App bind val) (Abs (VarBinder ss ident) rest')
- go (DoNotationBind binder val : rest) = do
- rest' <- go rest
+ go pos (DoNotationBind (VarBinder ss ident) val : rest) = do
+ rest' <- go pos rest
+ return $ App (App (bind pos) val) (Abs (VarBinder ss ident) rest')
+ go pos (DoNotationBind binder val : rest) = do
+ rest' <- go pos rest
ident <- freshIdent'
- return $ App (App bind val) (Abs (VarBinder nullSourceSpan ident) (Case [Var nullSourceSpan (Qualified Nothing ident)] [CaseAlternative [binder] [MkUnguarded rest']]))
- go [DoNotationLet _] = throwError . errorMessage $ InvalidDoLet
- go (DoNotationLet ds : rest) = do
+ return $ App (App (bind pos) val) (Abs (VarBinder pos ident) (Case [Var pos (Qualified Nothing ident)] [CaseAlternative [binder] [MkUnguarded rest']]))
+ go _ [DoNotationLet _] = throwError . errorMessage $ InvalidDoLet
+ go pos (DoNotationLet ds : rest) = do
let checkBind :: Declaration -> m ()
checkBind (ValueDecl (ss, _) i@(Ident name) _ _ _)
| name `elem` [ C.bind, C.discard ] = throwError . errorMessage' ss $ CannotUseBindWithDo i
checkBind _ = pure ()
mapM_ checkBind ds
- rest' <- go rest
+ rest' <- go pos rest
return $ Let FromLet ds rest'
- go (PositionedDoNotationElement pos com el : rest) = rethrowWithPosition pos $ PositionedValue pos com <$> go (el : rest)
+ go _ (PositionedDoNotationElement pos com el : rest) = rethrowWithPosition pos $ PositionedValue pos com <$> go pos (el : rest)
diff --git a/src/Language/PureScript/Sugar/Names/Env.hs b/src/Language/PureScript/Sugar/Names/Env.hs
index 88eda55..d939336 100644
--- a/src/Language/PureScript/Sugar/Names/Env.hs
+++ b/src/Language/PureScript/Sugar/Names/Env.hs
@@ -32,6 +32,7 @@ import Data.Function (on)
import Data.Foldable (find)
import Data.List (groupBy, sortBy, delete)
import Data.Maybe (fromJust, mapMaybe)
+import Safe (headMay)
import qualified Data.Map as M
import qualified Data.Set as S
@@ -469,8 +470,9 @@ checkImportConflicts ss currentModule toName xs =
in
if length groups > 1
then case nonImplicit of
- [ImportRecord (Qualified (Just mnNew) _) mnOrig ss' _] -> do
+ [ImportRecord (Qualified (Just mnNew) _) mnOrig _ _] -> do
let warningModule = if mnNew == currentModule then Nothing else Just mnNew
+ ss' = maybe nullSourceSpan importSourceSpan . headMay . filter ((== FromImplicit) . importProvenance) $ xs
tell . errorMessage' ss' $ ScopeShadowing name warningModule $ delete mnNew conflictModules
return (mnNew, mnOrig)
_ -> throwError . errorMessage' ss $ ScopeConflict name conflictModules
diff --git a/src/Language/PureScript/Sugar/Names/Exports.hs b/src/Language/PureScript/Sugar/Names/Exports.hs
index 18ef78f..8c0600a 100644
--- a/src/Language/PureScript/Sugar/Names/Exports.hs
+++ b/src/Language/PureScript/Sugar/Names/Exports.hs
@@ -147,6 +147,7 @@ resolveExports env ss mn imps exps refs =
-- values if that fails to see whether the value has been imported at all.
testQuals :: (forall a b. M.Map (Qualified a) b -> [Qualified a]) -> ModuleName -> Bool
testQuals f mn' = any (isQualifiedWith mn') (f (importedTypes imps))
+ || any (isQualifiedWith mn') (f (importedTypeOps imps))
|| any (isQualifiedWith mn') (f (importedDataConstructors imps))
|| any (isQualifiedWith mn') (f (importedTypeClasses imps))
|| any (isQualifiedWith mn') (f (importedValues imps))
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index a6c8075..0645bcd 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -14,9 +14,11 @@ import Control.Arrow (first, second)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.State
import Control.Monad.Supply.Class
-import Data.List ((\\), find, sortBy)
+import Data.List (find, sortBy)
import qualified Data.Map as M
import Data.Maybe (catMaybes, mapMaybe, isJust, fromMaybe)
+import qualified Data.List.NonEmpty as NEL
+import qualified Data.Set as S
import Data.Text (Text)
import qualified Language.PureScript.Constants as C
import Language.PureScript.Crash
@@ -285,12 +287,14 @@ typeInstanceDictionaryDeclaration sa@(ss, _) name mn deps className tys decls =
maybe (throwError . errorMessage' ss . UnknownName $ fmap TyClassName className) return $
M.lookup (qualify mn className) m
- case map fst typeClassMembers \\ mapMaybe declIdent decls of
- member : _ -> throwError . errorMessage' ss $ MissingClassMember member
- [] -> do
- -- Replace the type arguments with the appropriate types in the member types
- let memberTypes = map (second (replaceAllTypeVars (zip (map fst typeClassArguments) tys))) typeClassMembers
+ -- Replace the type arguments with the appropriate types in the member types
+ let memberTypes = map (second (replaceAllTypeVars (zip (map fst typeClassArguments) tys))) typeClassMembers
+
+ let declaredMembers = S.fromList $ mapMaybe declIdent decls
+ case filter (\(ident, _) -> not $ S.member ident declaredMembers) memberTypes of
+ hd : tl -> throwError . errorMessage' ss $ MissingClassMember (hd NEL.:| tl)
+ [] -> do
-- Create values for the type instance members
members <- zip (map typeClassMemberName decls) <$> traverse (memberToValue memberTypes) decls
diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
index a91cbe7..32398ad 100644
--- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
@@ -12,7 +12,6 @@ import Control.Monad.Supply.Class (MonadSupply)
import Data.Foldable (for_)
import Data.List (foldl', find, sortBy, unzip5)
import qualified Data.Map as M
-import Data.Monoid ((<>))
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord (comparing)
import qualified Data.Set as S
@@ -42,13 +41,15 @@ data NewtypeDerivedInstances = NewtypeDerivedInstances
-- ^ A list of newtype instances which were derived in this module.
} deriving Show
-instance Monoid NewtypeDerivedInstances where
- mempty = NewtypeDerivedInstances mempty mempty
- mappend x y =
+instance Semigroup NewtypeDerivedInstances where
+ x <> y =
NewtypeDerivedInstances { ndiClasses = ndiClasses x <> ndiClasses y
, ndiDerivedInstances = ndiDerivedInstances x <> ndiDerivedInstances y
}
+instance Monoid NewtypeDerivedInstances where
+ mempty = NewtypeDerivedInstances mempty mempty
+
-- | Extract the name of the newtype appearing in the last type argument of
-- a derived newtype instance.
--
@@ -201,7 +202,7 @@ deriveNewtypeInstance
-> m Expr
deriveNewtypeInstance ss mn syns ndis className ds tys tyConNm dargs = do
verifySuperclasses
- tyCon <- findTypeDecl tyConNm ds
+ tyCon <- findTypeDecl ss tyConNm ds
go tyCon
where
go (DataDeclaration _ Newtype _ tyArgNames [(_, [wrapped])]) = do
@@ -287,7 +288,7 @@ deriveGenericRep
-> m ([Declaration], Type)
deriveGenericRep ss mn syns ds tyConNm tyConArgs repTy = do
checkIsWildcard ss tyConNm repTy
- go =<< findTypeDecl tyConNm ds
+ go =<< findTypeDecl ss tyConNm ds
where
go :: Declaration -> m ([Declaration], Type)
go (DataDeclaration (ss', _) _ _ args dctors) = do
@@ -440,7 +441,7 @@ deriveEq
-> ProperName 'TypeName
-> m [Declaration]
deriveEq ss mn syns ds tyConNm = do
- tyCon <- findTypeDecl tyConNm ds
+ tyCon <- findTypeDecl ss tyConNm ds
eqFun <- mkEqFunction tyCon
return [ ValueDecl (ss, []) (Ident C.eq) Public [] (unguarded eqFun) ]
where
@@ -508,7 +509,7 @@ deriveOrd
-> ProperName 'TypeName
-> m [Declaration]
deriveOrd ss mn syns ds tyConNm = do
- tyCon <- findTypeDecl tyConNm ds
+ tyCon <- findTypeDecl ss tyConNm ds
compareFun <- mkCompareFunction tyCon
return [ ValueDecl (ss, []) (Ident C.compare) Public [] (unguarded compareFun) ]
where
@@ -612,7 +613,7 @@ deriveNewtype
-> m ([Declaration], Type)
deriveNewtype ss mn syns ds tyConNm tyConArgs unwrappedTy = do
checkIsWildcard ss tyConNm unwrappedTy
- go =<< findTypeDecl tyConNm ds
+ go =<< findTypeDecl ss tyConNm ds
where
go :: Declaration -> m ([Declaration], Type)
go (DataDeclaration (ss', _) Data name _ _) =
@@ -639,10 +640,11 @@ deriveNewtype ss mn syns ds tyConNm tyConArgs unwrappedTy = do
findTypeDecl
:: (MonadError MultipleErrors m)
- => ProperName 'TypeName
+ => SourceSpan
+ -> ProperName 'TypeName
-> [Declaration]
-> m Declaration
-findTypeDecl tyConNm = maybe (throwError . errorMessage $ CannotFindDerivingType tyConNm) return . find isTypeDecl
+findTypeDecl ss tyConNm = maybe (throwError . errorMessage' ss $ CannotFindDerivingType tyConNm) return . find isTypeDecl
where
isTypeDecl :: Declaration -> Bool
isTypeDecl (DataDeclaration _ _ nm _ _) | nm == tyConNm = True
@@ -692,7 +694,7 @@ deriveFunctor
-> ProperName 'TypeName
-> m [Declaration]
deriveFunctor ss mn syns ds tyConNm = do
- tyCon <- findTypeDecl tyConNm ds
+ tyCon <- findTypeDecl ss tyConNm ds
mapFun <- mkMapFunction tyCon
return [ ValueDecl (ss, []) (Ident C.map) Public [] (unguarded mapFun) ]
where
diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs
index 3e293e3..3a490e3 100644
--- a/src/Language/PureScript/TypeChecker.hs
+++ b/src/Language/PureScript/TypeChecker.hs
@@ -17,12 +17,10 @@ import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.State.Class (MonadState(..), modify, gets)
import Control.Monad.Supply.Class (MonadSupply)
import Control.Monad.Writer.Class (MonadWriter(..))
-import Control.Lens ((^..), _1, _2)
import Data.Foldable (for_, traverse_, toList)
import Data.List (nub, nubBy, (\\), sort, group)
import Data.Maybe
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map as M
@@ -43,6 +41,8 @@ import Language.PureScript.TypeChecker.Types as T
import Language.PureScript.TypeClassDictionaries
import Language.PureScript.Types
+import Lens.Micro.Platform ((^..), _1, _2)
+
addDataType
:: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
=> ModuleName
diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs
index b11f064..13f8697 100644
--- a/src/Language/PureScript/TypeChecker/Entailment.hs
+++ b/src/Language/PureScript/TypeChecker/Entailment.hs
@@ -135,14 +135,15 @@ data Matched t
| Unknown
deriving (Eq, Show, Functor)
+instance Semigroup t => Semigroup (Matched t) where
+ (Match l) <> (Match r) = Match (l <> r)
+ Apart <> _ = Apart
+ _ <> Apart = Apart
+ _ <> _ = Unknown
+
instance Monoid t => Monoid (Matched t) where
mempty = Match mempty
- mappend (Match l) (Match r) = Match (l <> r)
- mappend Apart _ = Apart
- mappend _ Apart = Apart
- mappend _ _ = Unknown
-
-- | Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
-- return a type class dictionary reference.
entails
diff --git a/src/Language/PureScript/TypeChecker/Skolems.hs b/src/Language/PureScript/TypeChecker/Skolems.hs
index f80d87e..ed7659c 100644
--- a/src/Language/PureScript/TypeChecker/Skolems.hs
+++ b/src/Language/PureScript/TypeChecker/Skolems.hs
@@ -14,7 +14,6 @@ import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.State.Class (MonadState(..), gets, modify)
import Data.Foldable (traverse_)
import Data.Functor.Identity (Identity(), runIdentity)
-import Data.Monoid
import Data.Set (Set, fromList, notMember)
import Data.Text (Text)
import Language.PureScript.AST
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index 920d159..51dac64 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -39,7 +39,6 @@ import Data.Either (partitionEithers)
import Data.Functor (($>))
import Data.List (transpose, (\\), partition, delete)
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import Data.Traversable (for)
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map as M
diff --git a/src/Language/PureScript/TypeClassDictionaries.hs b/src/Language/PureScript/TypeClassDictionaries.hs
index af00286..84b569c 100644
--- a/src/Language/PureScript/TypeClassDictionaries.hs
+++ b/src/Language/PureScript/TypeClassDictionaries.hs
@@ -7,7 +7,6 @@ import Prelude.Compat
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
-import Data.Monoid ((<>))
import Data.Text (Text, pack)
import Language.PureScript.Names
diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs
index d600bf4..3ec7943 100644
--- a/src/Language/PureScript/Types.hs
+++ b/src/Language/PureScript/Types.hs
@@ -18,7 +18,6 @@ import qualified Data.Aeson.TH as A
import Data.List (sortBy)
import Data.Ord (comparing)
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
diff --git a/stack.yaml b/stack.yaml
index 54c5cf3..332e29d 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,8 @@
-resolver: lts-11.7
+resolver: lts-12.0
packages:
- '.'
extra-deps:
+nix:
+ enable: false
+ packages:
+ - zlib
diff --git a/tests/Language/PureScript/Ide/CompletionSpec.hs b/tests/Language/PureScript/Ide/CompletionSpec.hs
index 4df331a..c9a84cf 100644
--- a/tests/Language/PureScript/Ide/CompletionSpec.hs
+++ b/tests/Language/PureScript/Ide/CompletionSpec.hs
@@ -4,7 +4,8 @@ module Language.PureScript.Ide.CompletionSpec where
import Protolude
-import Language.PureScript as P
+import qualified Data.Set as Set
+import qualified Language.PureScript as P
import Language.PureScript.Ide.Test as Test
import Language.PureScript.Ide.Command as Command
import Language.PureScript.Ide.Completion
@@ -30,7 +31,7 @@ load :: [Text] -> Command
load = LoadSync . map Test.mn
rebuildSync :: FilePath -> Command
-rebuildSync fp = RebuildSync ("src" </> fp) Nothing
+rebuildSync fp = RebuildSync ("src" </> fp) Nothing (Set.singleton P.JS)
spec :: Spec
spec = describe "Applying completion options" $ do
@@ -63,4 +64,4 @@ spec = describe "Applying completion options" $ do
Test.runIde [ load ["CompletionSpecDocs"]
, typ "withType"
]
- result `shouldSatisfy` \res -> complDocumentation res == Just "Doc *123*\n" \ No newline at end of file
+ result `shouldSatisfy` \res -> complDocumentation res == Just "Doc *123*\n"
diff --git a/tests/Language/PureScript/Ide/RebuildSpec.hs b/tests/Language/PureScript/Ide/RebuildSpec.hs
index 03ea688..0aea8e2 100644
--- a/tests/Language/PureScript/Ide/RebuildSpec.hs
+++ b/tests/Language/PureScript/Ide/RebuildSpec.hs
@@ -4,6 +4,8 @@ module Language.PureScript.Ide.RebuildSpec where
import Protolude
+import qualified Data.Set as Set
+import qualified Language.PureScript as P
import Language.PureScript.AST.SourcePos (spanName)
import Language.PureScript.Ide.Command
import Language.PureScript.Ide.Completion
@@ -11,16 +13,20 @@ import Language.PureScript.Ide.Matcher
import Language.PureScript.Ide.Types
import qualified Language.PureScript.Ide.Test as Test
import System.FilePath
+import System.Directory (doesFileExist, removePathForcibly)
import Test.Hspec
+defaultTarget :: Set P.CodegenTarget
+defaultTarget = Set.singleton P.JS
+
load :: [Text] -> Command
load = LoadSync . map Test.mn
rebuild :: FilePath -> Command
-rebuild fp = Rebuild ("src" </> fp) Nothing
+rebuild fp = Rebuild ("src" </> fp) Nothing defaultTarget
rebuildSync :: FilePath -> Command
-rebuildSync fp = RebuildSync ("src" </> fp) Nothing
+rebuildSync fp = RebuildSync ("src" </> fp) Nothing defaultTarget
spec :: Spec
spec = describe "Rebuilding single modules" $ do
@@ -67,6 +73,20 @@ spec = describe "Rebuilding single modules" $ do
Test.runIde'
editorConfig
emptyIdeState
- [ RebuildSync ("src" </> "RebuildSpecWithHiddenIdent.purs") (Just "actualFile")
+ [ RebuildSync ("src" </> "RebuildSpecWithHiddenIdent.purs") (Just "actualFile") defaultTarget
, Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent")) defaultCompletionOptions]
map spanName (complLocation result) `shouldBe` Just "actualFile"
+ it "doesn't produce JS when an empty target list is supplied" $ do
+ exists <- Test.inProject $ do
+ let indexJs = "output" </> "RebuildSpecSingleModule" </> "index.js"
+ removePathForcibly ("output" </> "RebuildSpecSingleModule")
+ _ <- Test.runIde [ RebuildSync ("src" </> "RebuildSpecSingleModule.purs") Nothing Set.empty ]
+ doesFileExist indexJs
+ exists `shouldBe` False
+ it "does produce corefn if it's a codegen target" $ do
+ exists <- Test.inProject $ do
+ let corefn = "output" </> "RebuildSpecSingleModule" </> "corefn.json"
+ removePathForcibly ("output" </> "RebuildSpecSingleModule")
+ _ <- Test.runIde [ RebuildSync ("src" </> "RebuildSpecSingleModule.purs") Nothing (Set.singleton P.CoreFn) ]
+ doesFileExist corefn
+ exists `shouldBe` True
diff --git a/tests/Language/PureScript/Ide/StateSpec.hs b/tests/Language/PureScript/Ide/StateSpec.hs
index 67a6671..33d9f30 100644
--- a/tests/Language/PureScript/Ide/StateSpec.hs
+++ b/tests/Language/PureScript/Ide/StateSpec.hs
@@ -3,11 +3,11 @@
module Language.PureScript.Ide.StateSpec where
import Protolude
-import Control.Lens hiding ((&))
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.State
import Language.PureScript.Ide.Test
import qualified Language.PureScript as P
+import Lens.Micro.Platform hiding ((&))
import Test.Hspec
import qualified Data.Map as Map
@@ -91,7 +91,7 @@ spec = do
it "resolves an instance for an existing type class" $ do
resolveInstances (Map.singleton (mn "InstanceModule") ef) moduleMap
`shouldSatisfy`
- elemOf (ix (mn "ClassModule") . ix 0 . idaDeclaration . _IdeDeclTypeClass . ideTCInstances . folded) ideInstance
+ anyOf (ix (mn "ClassModule") . ix 0 . idaDeclaration . _IdeDeclTypeClass . ideTCInstances . folded) (ideInstance ==)
describe "resolving data constructors" $ do
it "resolves a constructor" $ do
resolveDataConstructorsForModule (snd testModule)
diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs
index 9c3bed7..ddd7eda 100644
--- a/tests/TestCompiler.hs
+++ b/tests/TestCompiler.hs
@@ -40,7 +40,6 @@ import Control.Monad
import Control.Arrow ((***), (>>>))
import Control.Monad.Reader
-import Control.Monad.Writer.Strict
import Control.Monad.Trans.Except
import System.Exit
@@ -234,13 +233,25 @@ checkShouldFailWith expected errs =
checkPositioned :: P.MultipleErrors -> Maybe String
checkPositioned errs =
- case mapMaybe (\err -> maybe (Just err) (const Nothing) (P.errorSpan err)) (P.runMultipleErrors errs) of
+ case mapMaybe guardSpans (P.runMultipleErrors errs) of
[] ->
Nothing
errs' ->
Just
$ "Found errors with missing source spans:\n"
++ unlines (map (P.renderBox . P.prettyPrintSingleError P.defaultPPEOptions) errs')
+ where
+ guardSpans :: P.ErrorMessage -> Maybe P.ErrorMessage
+ guardSpans err = case P.errorSpan err of
+ Just ss | any (not . isNonsenseSpan) ss -> Nothing
+ _ -> Just err
+
+ isNonsenseSpan :: P.SourceSpan -> Bool
+ isNonsenseSpan (P.SourceSpan spanName spanStart spanEnd) =
+ spanName == "" || spanName == "<module>" || (spanStart == emptyPos && spanEnd == emptyPos)
+
+ emptyPos :: P.SourcePos
+ emptyPos = P.SourcePos 0 0
assertCompiles
:: [P.Module]
diff --git a/tests/TestCoreFn.hs b/tests/TestCoreFn.hs
index 7c27220..2fcb158 100644
--- a/tests/TestCoreFn.hs
+++ b/tests/TestCoreFn.hs
@@ -9,7 +9,7 @@ import Prelude ()
import Prelude.Compat
import Data.Aeson
-import Data.Aeson.Types
+import Data.Aeson.Types as Aeson
import Data.Version
import Language.PureScript.AST.Literals
@@ -37,7 +37,7 @@ parseMod m =
in snd <$> parseModule (moduleToJSON v m)
isSuccess :: Result a -> Bool
-isSuccess (Success _) = True
+isSuccess (Aeson.Success _) = True
isSuccess _ = False
spec :: Spec
@@ -52,42 +52,42 @@ spec = context "CoreFnFromJsonTest" $ do
r `shouldSatisfy` isSuccess
case r of
Error _ -> return ()
- Success m -> moduleName m `shouldBe` mn
+ Aeson.Success m -> moduleName m `shouldBe` mn
specify "should parse source span" $ do
let r = parseMod $ Module ss [] mn mp [] [] [] []
r `shouldSatisfy` isSuccess
case r of
Error _ -> return ()
- Success m -> moduleSourceSpan m `shouldBe` ss
+ Aeson.Success m -> moduleSourceSpan m `shouldBe` ss
specify "should parse module path" $ do
let r = parseMod $ Module ss [] mn mp [] [] [] []
r `shouldSatisfy` isSuccess
case r of
Error _ -> return ()
- Success m -> modulePath m `shouldBe` mp
+ Aeson.Success m -> modulePath m `shouldBe` mp
specify "should parse imports" $ do
let r = parseMod $ Module ss [] mn mp [(ann, mn)] [] [] []
r `shouldSatisfy` isSuccess
case r of
Error _ -> return ()
- Success m -> moduleImports m `shouldBe` [(ann, mn)]
+ Aeson.Success m -> moduleImports m `shouldBe` [(ann, mn)]
specify "should parse exports" $ do
let r = parseMod $ Module ss [] mn mp [] [Ident "exp"] [] []
r `shouldSatisfy` isSuccess
case r of
Error _ -> return ()
- Success m -> moduleExports m `shouldBe` [Ident "exp"]
+ Aeson.Success m -> moduleExports m `shouldBe` [Ident "exp"]
specify "should parse foreign" $ do
let r = parseMod $ Module ss [] mn mp [] [] [Ident "exp"] []
r `shouldSatisfy` isSuccess
case r of
Error _ -> return ()
- Success m -> moduleForeign m `shouldBe` [Ident "exp"]
+ Aeson.Success m -> moduleForeign m `shouldBe` [Ident "exp"]
context "Expr" $ do
specify "should parse literals" $ do
diff --git a/tests/TestPrimDocs.hs b/tests/TestPrimDocs.hs
index 1eb68d5..584c8a9 100644
--- a/tests/TestPrimDocs.hs
+++ b/tests/TestPrimDocs.hs
@@ -3,7 +3,6 @@ module TestPrimDocs where
import Prelude
import Control.Monad
-import Data.Monoid ((<>))
import Data.List ((\\))
import qualified Data.Map as Map
import qualified Data.Set as Set
diff --git a/tests/TestPsci/CommandTest.hs b/tests/TestPsci/CommandTest.hs
index a84fdca..7de6412 100644
--- a/tests/TestPsci/CommandTest.hs
+++ b/tests/TestPsci/CommandTest.hs
@@ -1,10 +1,16 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module TestPsci.CommandTest where
import Prelude ()
import Prelude.Compat
+import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.RWS.Strict (get)
+import Language.PureScript (moduleNameFromString)
import Language.PureScript.Interactive
+import System.FilePath ((</>))
+import System.Directory (getCurrentDirectory)
import Test.Hspec
import TestPsci.TestEnv
@@ -42,5 +48,20 @@ commandTests = context "commandTests" $ do
":complete M.a" `prints` unlines ["M.ap", "M.apply"]
specPSCi ":browse" $ do
+ ":browse Data.Void" `printed` flip shouldContain "data Void"
+ ":browse Data.Void" `printed` flip shouldContain "absurd ::"
+
+ specPSCi ":reload, :browse" $ do
+ cwd <- liftIO getCurrentDirectory
+ let new = cwd </> "tests" </> "support" </> "psci" </> "Reload.edit"
+
+ ":browse Reload" `printed` flip shouldContain "reload ::"
+ ":browse Reload" `printed` flip shouldNotContain "edited ::"
+
+ simulateModuleEdit (moduleNameFromString "Reload") new $ do
+ run ":reload"
+ ":browse Reload" `printed` flip shouldNotContain "reload ::"
+ ":browse Reload" `printed` flip shouldContain "edited ::"
+
":browse Mirp" `printed` flip shouldContain "is not valid"
":browse Prim" `printed` flip shouldContain "class Partial"
diff --git a/tests/TestPsci/CompletionTest.hs b/tests/TestPsci/CompletionTest.hs
index c513cb4..13ba6c0 100644
--- a/tests/TestPsci/CompletionTest.hs
+++ b/tests/TestPsci/CompletionTest.hs
@@ -34,12 +34,12 @@ completionTestData supportModuleNames =
, (":b", [":browse"])
-- :browse should complete module names
- , (":b Eff", map (":b Effect" ++) ["", ".Unsafe", ".Class", ".Console", ".Uncurried", ".Ref"])
- , (":b Effect.", map (":b Effect" ++) [".Unsafe", ".Class", ".Console", ".Uncurried", ".Ref"])
+ , (":b Eff", map (":b Effect" ++) ["", ".Unsafe", ".Class", ".Class.Console", ".Console", ".Uncurried", ".Ref"])
+ , (":b Effect.", map (":b Effect" ++) [".Unsafe", ".Class", ".Class.Console", ".Console", ".Uncurried", ".Ref"])
-- import should complete module names
- , ("import Eff", map ("import Effect" ++) ["", ".Unsafe", ".Class", ".Console", ".Uncurried", ".Ref"])
- , ("import Effect.", map ("import Effect" ++) [".Unsafe", ".Class", ".Console", ".Uncurried", ".Ref"])
+ , ("import Eff", map ("import Effect" ++) ["", ".Unsafe", ".Class", ".Class.Console", ".Console", ".Uncurried", ".Ref"])
+ , ("import Effect.", map ("import Effect" ++) [".Unsafe", ".Class", ".Class.Console", ".Console", ".Uncurried", ".Ref"])
-- :quit, :help, :reload, :clear should not complete
, (":help ", [])
diff --git a/tests/TestPsci/TestEnv.hs b/tests/TestPsci/TestEnv.hs
index a41c018..84cb90f 100644
--- a/tests/TestPsci/TestEnv.hs
+++ b/tests/TestPsci/TestEnv.hs
@@ -1,16 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module TestPsci.TestEnv where
import Prelude ()
import Prelude.Compat
-import Control.Monad (void)
+import Control.Exception.Lifted (bracket_)
+import Control.Monad (void, when)
import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.RWS.Strict (evalRWST, RWST)
+import Control.Monad.Trans.RWS.Strict (evalRWST, asks, local, RWST)
+import Data.List (isSuffixOf)
+import qualified Data.Text as T
import qualified Language.PureScript as P
import Language.PureScript.Interactive
-import System.Directory (getCurrentDirectory)
+import System.Directory (getCurrentDirectory, doesPathExist, removeFile)
import System.Exit
-import System.FilePath ((</>))
+import System.FilePath ((</>), pathSeparator)
import qualified System.FilePath.Glob as Glob
import System.Process (readProcessWithExitCode)
import Test.Hspec (shouldBe, Expectation)
@@ -23,9 +28,10 @@ initTestPSCiEnv :: IO (PSCiState, PSCiConfig)
initTestPSCiEnv = do
-- Load test support packages
cwd <- getCurrentDirectory
- let supportDir = cwd </> "tests" </> "support" </> "bower_components"
- let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/src/**/*." ++ ext)) supportDir
- pursFiles <- supportFiles "purs"
+ let supportDir = cwd </> "tests" </> "support"
+ psciFiles <- Glob.globDir1 (Glob.compile "**/*.purs") (supportDir </> "psci")
+ libraries <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") (supportDir </> "bower_components")
+ let pursFiles = psciFiles ++ libraries
modulesOrError <- loadAllModules pursFiles
case modulesOrError of
Left err ->
@@ -35,8 +41,8 @@ initTestPSCiEnv = do
makeResultOrError <- runMake . make $ modules
case makeResultOrError of
Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure
- Right (externs, env) ->
- return (updateLoadedExterns (const (zip (map snd modules) externs)) initialPSCiState, PSCiConfig pursFiles env)
+ Right (externs, _) ->
+ return (updateLoadedExterns (const (zip (map snd modules) externs)) initialPSCiState, PSCiConfig pursFiles)
-- | Execute a TestPSCi, returning IO
execTestPSCi :: TestPSCi a -> IO a
@@ -71,9 +77,8 @@ runAndEval comm jsOutputEval textOutputEval =
-- | Run a PSCi command, evaluate compiled JS, and ignore evaluation output and printed output
run :: String -> TestPSCi ()
-run comm = runAndEval comm evalJsAndIgnore ignorePrinted
+run comm = runAndEval comm (void jsEval) ignorePrinted
where
- evalJsAndIgnore = jsEval *> return ()
ignorePrinted _ = return ()
-- | A lifted evaluation of Hspec 'shouldBe' for the TestPSCi
@@ -95,3 +100,29 @@ prints command expected = printed command (`shouldBe` expected)
printed :: String -> (String -> Expectation) -> TestPSCi ()
printed command f = runAndEval command (void jsEval) (liftIO . f)
+
+simulateModuleEdit :: P.ModuleName -> FilePath -> TestPSCi a -> TestPSCi a
+simulateModuleEdit mn newPath action = do
+ ms <- asks psciFileGlobs
+ case replacePath ms of
+ Nothing -> fail $ "Did not find " ++ inputPath ++ " in psciFileGlobs"
+ Just xs' -> local (\c -> c { psciFileGlobs = xs' }) temporarily <* rebuild
+
+ where
+ outputPath = modulesDir </> T.unpack (P.runModuleName mn) </> "index.js"
+ inputPath = T.unpack (T.replace "." slash (P.runModuleName mn)) ++ ".purs"
+ slash = T.singleton pathSeparator
+
+ replacePath :: [String] -> Maybe [String]
+ replacePath (x:xs)
+ | inputPath `isSuffixOf` x = Just (newPath : xs)
+ | otherwise = fmap (x:) (replacePath xs)
+ replacePath [] = Nothing
+
+ -- Simply adding the file to `PSCiConfig.fileGlobs` isn't sufficient; running
+ -- ":reload" might not rebuild because the compiled JS artifact has a more
+ -- recent timestamp than the "new" source file `newPath`.
+ temporarily = bracket_ enableRebuild enableRebuild action
+ enableRebuild = liftIO $ do { b <- doesPathExist outputPath; when b (removeFile outputPath) }
+ rebuild = handleCommand discard (return ()) discard ReloadState
+ discard _ = return ()
diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs
index 9c3a692..6c70807 100644
--- a/tests/TestUtils.hs
+++ b/tests/TestUtils.hs
@@ -66,10 +66,12 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do
getSupportModuleTuples :: IO [(FilePath, P.Module)]
getSupportModuleTuples = do
cd <- getCurrentDirectory
- let supportDir = cd </> "tests" </> "support" </> "bower_components"
- supportPurs <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") supportDir
- supportPursFiles <- readInput supportPurs
- modules <- runExceptT $ ExceptT . return $ P.parseModulesFromFiles id supportPursFiles
+ let supportDir = cd </> "tests" </> "support"
+ psciFiles <- Glob.globDir1 (Glob.compile "**/*.purs") (supportDir </> "psci")
+ libraries <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") (supportDir </> "bower_components")
+ let pursFiles = psciFiles ++ libraries
+ fileContents <- readInput pursFiles
+ modules <- runExceptT $ ExceptT . return $ P.parseModulesFromFiles id fileContents
case modules of
Right ms -> return ms
Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)
diff --git a/tests/purs/failing/3405.purs b/tests/purs/failing/3405.purs
new file mode 100644
index 0000000..de7ab7c
--- /dev/null
+++ b/tests/purs/failing/3405.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith CannotFindDerivingType
+module Main where
+
+import Prelude
+
+type Something = Int
+
+derive instance eqSomething ∷ Eq Something
diff --git a/tests/purs/failing/MissingClassMember.purs b/tests/purs/failing/MissingClassMember.purs
index 488fccf..42a06a9 100644
--- a/tests/purs/failing/MissingClassMember.purs
+++ b/tests/purs/failing/MissingClassMember.purs
@@ -1,11 +1,10 @@
-- @shouldFailWith MissingClassMember
module Main where
-import Prelude
-
class A a where
a :: a -> String
b :: a -> Number
+ c :: forall f. a -> f a
instance aString :: A String where
a s = s
diff --git a/tests/purs/passing/3388.purs b/tests/purs/passing/3388.purs
new file mode 100644
index 0000000..71feafb
--- /dev/null
+++ b/tests/purs/passing/3388.purs
@@ -0,0 +1,10 @@
+module Main where
+
+import Prelude
+import Effect.Console (log)
+
+main = do
+ let
+ x = { a: 42, b: "foo" }
+ { a, b } = x { a = 43 }
+ log "Done"
diff --git a/tests/purs/passing/3410.purs b/tests/purs/passing/3410.purs
new file mode 100644
index 0000000..42e1cfb
--- /dev/null
+++ b/tests/purs/passing/3410.purs
@@ -0,0 +1,11 @@
+module Main
+ ( module Prelude
+ , module DEN
+ , main
+ ) where
+
+import Prelude
+import Data.Either.Nested (type (\/)) as DEN
+import Effect.Console (log)
+
+main = log "Done"
diff --git a/tests/purs/warning/CustomWarning4.purs b/tests/purs/warning/CustomWarning4.purs
new file mode 100644
index 0000000..5ab9de6
--- /dev/null
+++ b/tests/purs/warning/CustomWarning4.purs
@@ -0,0 +1,31 @@
+-- @shouldWarnWith UserDefinedWarning
+-- @shouldWarnWith UserDefinedWarning
+-- @shouldWarnWith UserDefinedWarning
+-- @shouldWarnWith UserDefinedWarning
+module Main where
+
+import Prim.TypeError (class Warn, Beside, QuoteLabel, Text)
+import Prim
+import Type.Row (class RowToList, Cons, Nil)
+
+data Label (l :: Symbol) = Label
+
+baz ::
+ forall row label typ.
+ RowToList row (Cons label typ Nil) =>
+ Warn (Beside (Text "Custom label ") (QuoteLabel label)) =>
+ Record row ->
+ String
+baz _ = ""
+
+baz' :: String
+baz' = baz { hello: 1 }
+
+baz'' :: String
+baz'' = baz { "hello": 1 }
+
+baz''' :: String
+baz''' = baz { "h e l l o": 1 }
+
+baz'''' :: String
+baz'''' = baz { "hel\"lo": 1 }
diff --git a/tests/support/bower.json b/tests/support/bower.json
index b44fb23..4d66df9 100644
--- a/tests/support/bower.json
+++ b/tests/support/bower.json
@@ -1,77 +1,40 @@
{
"name": "purescript-test-suite-support",
"dependencies": {
- "purescript-arrays": "purescript/purescript-arrays#compiler/0.12",
- "purescript-assert": "purescript/purescript-assert#compiler/0.12",
- "purescript-bifunctors": "purescript/purescript-bifunctors#compiler/0.12",
- "purescript-console": "purescript/purescript-console#compiler/0.12",
- "purescript-control": "purescript/purescript-control#compiler/0.12",
- "purescript-distributive": "purescript/purescript-distributive#compiler/0.12",
- "purescript-effect": "purescript/purescript-effect#compiler/0.12",
- "purescript-either": "purescript/purescript-either#compiler/0.12",
- "purescript-foldable-traversable": "purescript/purescript-foldable-traversable#compiler/0.12",
- "purescript-functions": "purescript/purescript-functions#compiler/0.12",
- "purescript-gen": "purescript/purescript-gen#compiler/0.12",
- "purescript-generics-rep": "purescript/purescript-generics-rep#compiler/0.12",
- "purescript-globals": "purescript/purescript-globals#compiler/0.12",
- "purescript-identity": "purescript/purescript-identity#compiler/0.12",
- "purescript-integers": "purescript/purescript-integers#compiler/0.12",
- "purescript-invariant": "purescript/purescript-invariant#compiler/0.12",
- "purescript-lazy": "purescript/purescript-lazy#compiler/0.12",
- "purescript-lists": "purescript/purescript-lists#compiler/0.12",
- "purescript-math": "purescript/purescript-math#compiler/0.12",
- "purescript-maybe": "purescript/purescript-maybe#compiler/0.12",
- "purescript-newtype": "purescript/purescript-newtype#compiler/0.12",
- "purescript-nonempty": "purescript/purescript-nonempty#compiler/0.12",
- "purescript-partial": "purescript/purescript-partial#compiler/0.12",
- "purescript-prelude": "purescript/purescript-prelude#compiler/0.12",
- "purescript-proxy": "purescript/purescript-proxy#compiler/0.12",
- "purescript-psci-support": "purescript/purescript-psci-support#compiler/0.12",
- "purescript-refs": "purescript/purescript-refs#compiler/0.12",
- "purescript-st": "purescript/purescript-st#compiler/0.12",
- "purescript-strings": "purescript/purescript-strings#compiler/0.12",
- "purescript-tailrec": "purescript/purescript-tailrec#compiler/0.12",
- "purescript-tuples": "purescript/purescript-tuples#compiler/0.12",
- "purescript-type-equality": "purescript/purescript-type-equality#compiler/0.12",
- "purescript-typelevel-prelude": "purescript/purescript-typelevel-prelude#compiler/0.12",
- "purescript-unfoldable": "purescript/purescript-unfoldable#compiler/0.12",
- "purescript-unsafe-coerce": "purescript/purescript-unsafe-coerce#compiler/0.12"
- },
- "resolutions": {
- "purescript-arrays": "compiler/0.12",
- "purescript-assert": "compiler/0.12",
- "purescript-bifunctors": "compiler/0.12",
- "purescript-console": "compiler/0.12",
- "purescript-control": "compiler/0.12",
- "purescript-distributive": "compiler/0.12",
- "purescript-effect": "compiler/0.12",
- "purescript-either": "compiler/0.12",
- "purescript-foldable-traversable": "compiler/0.12",
- "purescript-functions": "compiler/0.12",
- "purescript-gen": "compiler/0.12",
- "purescript-generics-rep": "compiler/0.12",
- "purescript-globals": "compiler/0.12",
- "purescript-identity": "compiler/0.12",
- "purescript-integers": "compiler/0.12",
- "purescript-invariant": "compiler/0.12",
- "purescript-lazy": "compiler/0.12",
- "purescript-lists": "compiler/0.12",
- "purescript-math": "compiler/0.12",
- "purescript-maybe": "compiler/0.12",
- "purescript-newtype": "compiler/0.12",
- "purescript-nonempty": "compiler/0.12",
- "purescript-partial": "compiler/0.12",
- "purescript-prelude": "compiler/0.12",
- "purescript-proxy": "compiler/0.12",
- "purescript-psci-support": "compiler/0.12",
- "purescript-refs": "compiler/0.12",
- "purescript-st": "compiler/0.12",
- "purescript-strings": "compiler/0.12",
- "purescript-tailrec": "compiler/0.12",
- "purescript-tuples": "compiler/0.12",
- "purescript-type-equality": "compiler/0.12",
- "purescript-typelevel-prelude": "compiler/0.12",
- "purescript-unfoldable": "compiler/0.12",
- "purescript-unsafe-coerce": "compiler/0.12"
+ "purescript-arrays": "5.0.0",
+ "purescript-assert": "4.0.0",
+ "purescript-bifunctors": "4.0.0",
+ "purescript-console": "4.1.0",
+ "purescript-control": "4.0.0",
+ "purescript-distributive": "4.0.0",
+ "purescript-effect": "2.0.0",
+ "purescript-either": "4.0.0",
+ "purescript-foldable-traversable": "4.0.0",
+ "purescript-functions": "4.0.0",
+ "purescript-gen": "2.0.0",
+ "purescript-generics-rep": "6.0.0",
+ "purescript-globals": "4.0.0",
+ "purescript-identity": "4.0.0",
+ "purescript-integers": "4.0.0",
+ "purescript-invariant": "4.0.0",
+ "purescript-lazy": "4.0.0",
+ "purescript-lists": "5.0.0",
+ "purescript-math": "2.1.1",
+ "purescript-maybe": "4.0.0",
+ "purescript-newtype": "3.0.0",
+ "purescript-nonempty": "5.0.0",
+ "purescript-partial": "2.0.0",
+ "purescript-prelude": "4.0.0",
+ "purescript-proxy": "3.0.0",
+ "purescript-psci-support": "4.0.0",
+ "purescript-refs": "4.1.0",
+ "purescript-st": "4.0.0",
+ "purescript-strings": "4.0.0",
+ "purescript-tailrec": "4.0.0",
+ "purescript-tuples": "5.0.0",
+ "purescript-type-equality": "3.0.0",
+ "purescript-typelevel-prelude": "3.0.0",
+ "purescript-unfoldable": "4.0.0",
+ "purescript-unsafe-coerce": "4.0.0"
}
}
diff --git a/tests/support/package-lock.json b/tests/support/package-lock.json
deleted file mode 100644
index 4e3a140..0000000
--- a/tests/support/package-lock.json
+++ /dev/null
@@ -1,171 +0,0 @@
-{
- "requires": true,
- "lockfileVersion": 1,
- "dependencies": {
- "bower": {
- "version": "1.8.2",
- "resolved": "https://registry.npmjs.org/bower/-/bower-1.8.2.tgz",
- "integrity": "sha1-rfU1KcjUrwLvJPuNU0HBQZ0z4vc="
- },
- "fs.realpath": {
- "version": "1.0.0",
- "resolved": "https://registry.npmjs.org/fs.realpath/-/fs.realpath-1.0.0.tgz",
- "integrity": "sha1-FQStJSMVjKpA20onh8sBQRmU6k8="
- },
- "glob": {
- "version": "5.0.15",
- "resolved": "https://registry.npmjs.org/glob/-/glob-5.0.15.tgz",
- "integrity": "sha1-G8k2ueAvSmA/zCIuz3Yz0wuLk7E=",
- "requires": {
- "inflight": "1.0.6",
- "inherits": "2.0.3",
- "minimatch": "3.0.4",
- "once": "1.4.0",
- "path-is-absolute": "1.0.1"
- },
- "dependencies": {
- "balanced-match": {
- "version": "1.0.0",
- "resolved": "https://registry.npmjs.org/balanced-match/-/balanced-match-1.0.0.tgz",
- "integrity": "sha1-ibTRmasr7kneFk6gK4nORi1xt2c="
- },
- "brace-expansion": {
- "version": "1.1.11",
- "resolved": "https://registry.npmjs.org/brace-expansion/-/brace-expansion-1.1.11.tgz",
- "integrity": "sha512-iCuPHDFgrHX7H2vEI/5xpz07zSHB00TpugqhmYtVmMO6518mCuRMoOYFldEBl0g187ufozdaHgWKcYFb61qGiA==",
- "requires": {
- "balanced-match": "1.0.0",
- "concat-map": "0.0.1"
- }
- },
- "concat-map": {
- "version": "0.0.1",
- "resolved": "https://registry.npmjs.org/concat-map/-/concat-map-0.0.1.tgz",
- "integrity": "sha1-2Klr13/Wjfd5OnMDajug1UBdR3s="
- },
- "inflight": {
- "version": "1.0.6",
- "resolved": "https://registry.npmjs.org/inflight/-/inflight-1.0.6.tgz",
- "integrity": "sha1-Sb1jMdfQLQwJvJEKEHW6gWW1bfk=",
- "requires": {
- "once": "1.4.0",
- "wrappy": "1.0.2"
- }
- },
- "inherits": {
- "version": "2.0.3",
- "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.3.tgz",
- "integrity": "sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4="
- },
- "minimatch": {
- "version": "3.0.4",
- "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-3.0.4.tgz",
- "integrity": "sha512-yJHVQEhyqPLUTgt9B83PXu6W3rx4MvvHvSUvToogpwoGDOUQ+yDrR0HRot+yOCdCO7u4hX3pWft6kWBBcqh0UA==",
- "requires": {
- "brace-expansion": "1.1.11"
- }
- },
- "once": {
- "version": "1.4.0",
- "resolved": "https://registry.npmjs.org/once/-/once-1.4.0.tgz",
- "integrity": "sha1-WDsap3WWHUsROsF9nFC6753Xa9E=",
- "requires": {
- "wrappy": "1.0.2"
- }
- },
- "path-is-absolute": {
- "version": "1.0.1",
- "resolved": "https://registry.npmjs.org/path-is-absolute/-/path-is-absolute-1.0.1.tgz",
- "integrity": "sha1-F0uSaHNVNP+8es5r9TpanhtcX18="
- },
- "wrappy": {
- "version": "1.0.2",
- "resolved": "https://registry.npmjs.org/wrappy/-/wrappy-1.0.2.tgz",
- "integrity": "sha1-tSQ9jz7BqjXxNkYFvA0QNuMKtp8="
- }
- }
- },
- "rimraf": {
- "version": "2.6.2",
- "resolved": "https://registry.npmjs.org/rimraf/-/rimraf-2.6.2.tgz",
- "integrity": "sha512-lreewLK/BlghmxtfH36YYVg1i8IAce4TI7oao75I1g245+6BctqTVQiBP3YUJ9C6DQOXJmkYR9X9fCLtCOJc5w==",
- "requires": {
- "glob": "7.1.2"
- },
- "dependencies": {
- "balanced-match": {
- "version": "1.0.0",
- "resolved": "https://registry.npmjs.org/balanced-match/-/balanced-match-1.0.0.tgz",
- "integrity": "sha1-ibTRmasr7kneFk6gK4nORi1xt2c="
- },
- "brace-expansion": {
- "version": "1.1.11",
- "resolved": "https://registry.npmjs.org/brace-expansion/-/brace-expansion-1.1.11.tgz",
- "integrity": "sha512-iCuPHDFgrHX7H2vEI/5xpz07zSHB00TpugqhmYtVmMO6518mCuRMoOYFldEBl0g187ufozdaHgWKcYFb61qGiA==",
- "requires": {
- "balanced-match": "1.0.0",
- "concat-map": "0.0.1"
- }
- },
- "concat-map": {
- "version": "0.0.1",
- "resolved": "https://registry.npmjs.org/concat-map/-/concat-map-0.0.1.tgz",
- "integrity": "sha1-2Klr13/Wjfd5OnMDajug1UBdR3s="
- },
- "glob": {
- "version": "7.1.2",
- "resolved": "https://registry.npmjs.org/glob/-/glob-7.1.2.tgz",
- "integrity": "sha512-MJTUg1kjuLeQCJ+ccE4Vpa6kKVXkPYJ2mOCQyUuKLcLQsdrMCpBPUi8qVE6+YuaJkozeA9NusTAw3hLr8Xe5EQ==",
- "requires": {
- "fs.realpath": "1.0.0",
- "inflight": "1.0.6",
- "inherits": "2.0.3",
- "minimatch": "3.0.4",
- "once": "1.4.0",
- "path-is-absolute": "1.0.1"
- }
- },
- "inflight": {
- "version": "1.0.6",
- "resolved": "https://registry.npmjs.org/inflight/-/inflight-1.0.6.tgz",
- "integrity": "sha1-Sb1jMdfQLQwJvJEKEHW6gWW1bfk=",
- "requires": {
- "once": "1.4.0",
- "wrappy": "1.0.2"
- }
- },
- "inherits": {
- "version": "2.0.3",
- "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.3.tgz",
- "integrity": "sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4="
- },
- "minimatch": {
- "version": "3.0.4",
- "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-3.0.4.tgz",
- "integrity": "sha512-yJHVQEhyqPLUTgt9B83PXu6W3rx4MvvHvSUvToogpwoGDOUQ+yDrR0HRot+yOCdCO7u4hX3pWft6kWBBcqh0UA==",
- "requires": {
- "brace-expansion": "1.1.11"
- }
- },
- "once": {
- "version": "1.4.0",
- "resolved": "https://registry.npmjs.org/once/-/once-1.4.0.tgz",
- "integrity": "sha1-WDsap3WWHUsROsF9nFC6753Xa9E=",
- "requires": {
- "wrappy": "1.0.2"
- }
- },
- "path-is-absolute": {
- "version": "1.0.1",
- "resolved": "https://registry.npmjs.org/path-is-absolute/-/path-is-absolute-1.0.1.tgz",
- "integrity": "sha1-F0uSaHNVNP+8es5r9TpanhtcX18="
- },
- "wrappy": {
- "version": "1.0.2",
- "resolved": "https://registry.npmjs.org/wrappy/-/wrappy-1.0.2.tgz",
- "integrity": "sha1-tSQ9jz7BqjXxNkYFvA0QNuMKtp8="
- }
- }
- }
- }
-}
diff --git a/tests/support/psci/Reload.edit b/tests/support/psci/Reload.edit
new file mode 100644
index 0000000..21e8978
--- /dev/null
+++ b/tests/support/psci/Reload.edit
@@ -0,0 +1,4 @@
+module Reload where
+
+edited :: String
+edited = "reload"
diff --git a/tests/support/psci/Reload.purs b/tests/support/psci/Reload.purs
new file mode 100644
index 0000000..dae46c4
--- /dev/null
+++ b/tests/support/psci/Reload.purs
@@ -0,0 +1,4 @@
+module Reload where
+
+reload :: Int
+reload = 0
diff --git a/tests/support/psci/Sample.purs b/tests/support/psci/Sample.purs
deleted file mode 100644
index e69de29..0000000
--- a/tests/support/psci/Sample.purs
+++ /dev/null