packages feed

purescript 0.12.0 → 0.12.1

raw patch · 105 files changed

+656/−637 lines, 105 filesdep +Cabaldep +microlens-platformdep −lensdep −spdxdep ~aesondep ~base

Dependencies added: Cabal, microlens-platform

Dependencies removed: lens, spdx

Dependency ranges changed: aeson, base

Files

CONTRIBUTING.md view
@@ -23,7 +23,7 @@  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`. 
CONTRIBUTORS.md view
@@ -93,7 +93,7 @@ | [@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 @@ | [@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 
README.md view
@@ -20,7 +20,5 @@ ## 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)
app/Command/Bundle.hs view
@@ -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.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 @@             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
app/Command/Compile.hs view
@@ -8,11 +8,9 @@  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 @@       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 @@       <> " 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 
app/Command/Hierarchy.hs view
@@ -22,7 +22,6 @@  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)
app/Command/Publish.hs view
@@ -5,7 +5,6 @@ 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
app/Command/REPL.hs view
@@ -31,7 +31,6 @@ 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 @@           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)
app/Main.hs view
@@ -15,7 +15,6 @@ 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
purescript.cabal view
@@ -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 @@     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 @@     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 @@     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 @@     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 @@   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 @@     , 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 @@     , 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 @@       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 @@     , 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 @@     , 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 @@   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 @@     , 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 @@     , 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
src/Language/PureScript/AST/Binders.hs view
@@ -5,8 +5,6 @@  import Prelude.Compat -import Data.Semigroup- import Language.PureScript.AST.SourcePos import Language.PureScript.AST.Literals import Language.PureScript.Names
src/Language/PureScript/AST/Declarations.hs view
@@ -124,7 +124,7 @@   | 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
src/Language/PureScript/AST/SourcePos.hs view
@@ -8,7 +8,6 @@  import Control.DeepSeq (NFData) import Data.Aeson ((.=), (.:))-import Data.Monoid import Data.Text (Text) import GHC.Generics (Generic) import Language.PureScript.Comments
src/Language/PureScript/AST/Traversals.hs view
@@ -132,7 +132,7 @@   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 @@      , 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 @@      , 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 @@   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 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 @@   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 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
src/Language/PureScript/CodeGen/JS.hs view
@@ -19,7 +19,6 @@ 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
src/Language/PureScript/CodeGen/JS/Common.hs view
@@ -4,7 +4,6 @@ import Prelude.Compat  import Data.Char-import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T 
src/Language/PureScript/CodeGen/JS/Printer.hs view
@@ -13,7 +13,6 @@ import qualified Control.Arrow as A  import Data.Maybe (fromMaybe)-import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T 
src/Language/PureScript/Constants.hs view
@@ -204,29 +204,23 @@  -- 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 @@   { edApplicativeDict :: PSString   , edBindDict :: PSString   , edMonadDict :: PSString+  , edWhile :: PSString+  , edUntil :: PSString   }  effDictionaries :: EffectDictionaries@@ -264,6 +260,8 @@   { edApplicativeDict = "applicativeEff"   , edBindDict = "bindEff"   , edMonadDict = "monadEff"+  , edWhile = "whileE"+  , edUntil = "untilE"   }  effectDictionaries :: EffectDictionaries@@ -271,8 +269,19 @@   { 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 discardUnitDictionary = "discardUnit" @@ -507,7 +516,7 @@ 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"
src/Language/PureScript/CoreFn/Traversals.hs view
@@ -50,27 +50,27 @@                       (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
src/Language/PureScript/CoreImp/AST.hs view
@@ -201,24 +201,24 @@   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
src/Language/PureScript/CoreImp/Optimizer.hs view
@@ -38,8 +38,9 @@       , 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
src/Language/PureScript/CoreImp/Optimizer/Inliner.hs view
@@ -16,7 +16,6 @@ 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
src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs view
@@ -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 @@ --    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 @@   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 @@   -- 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 @@    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 @@   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
src/Language/PureScript/CoreImp/Optimizer/TCO.hs view
@@ -4,7 +4,6 @@ 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)
src/Language/PureScript/Docs/AsHtml.hs view
@@ -20,7 +20,6 @@ import Data.Char (isUpper) import Data.Either (isRight) import Data.Maybe (fromMaybe)-import Data.Monoid ((<>)) import Data.Foldable (for_) import Data.String (fromString) 
src/Language/PureScript/Docs/AsMarkdown.hs view
@@ -13,7 +13,6 @@ 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
src/Language/PureScript/Docs/Convert/ReExports.hs view
@@ -14,7 +14,6 @@ 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 @@   }   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
src/Language/PureScript/Docs/Convert/Single.hs view
@@ -114,7 +114,7 @@ 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 =
src/Language/PureScript/Docs/Prim.hs view
@@ -7,7 +7,6 @@   ) 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 @@       , kindDoc       , textDoc       , quoteDoc+      , quoteLabelDoc       , besideDoc       , aboveDoc       ]@@ -442,7 +442,7 @@   [ "`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@@ -458,6 +458,15 @@ quoteDoc = primTypeOf (P.primSubName "TypeError") "Quote" $ T.unlines   [ "The Quote type constructor renders any concrete type as a Doc"   , "to be used in a custom type error."+  , ""+  , "For more information, see"+  , "[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)."
src/Language/PureScript/Docs/Render.hs view
@@ -12,7 +12,6 @@ import Prelude.Compat  import Data.Maybe (maybeToList)-import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T 
src/Language/PureScript/Docs/RenderedCode/RenderKind.hs view
@@ -12,7 +12,6 @@ import Control.Arrow (ArrowPlus(..)) import Control.PatternArrows as PA -import Data.Monoid ((<>)) import Data.Maybe (fromMaybe) import qualified Data.Text as T 
src/Language/PureScript/Docs/RenderedCode/RenderType.hs view
@@ -13,7 +13,6 @@ import Prelude.Compat  import Data.Maybe (fromMaybe)-import Data.Monoid ((<>)) import Data.Text (Text)  import Control.Arrow ((<+>))
src/Language/PureScript/Docs/RenderedCode/Types.hs view
@@ -49,7 +49,6 @@ 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 @@ -- 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
src/Language/PureScript/Docs/Utils/MonoidExtras.hs view
@@ -6,4 +6,3 @@ mintersperse _ []       = mempty mintersperse _ [x]      = x mintersperse sep (x:xs) = x <> sep <> mintersperse sep xs-
src/Language/PureScript/Environment.hs view
@@ -449,6 +449,7 @@     , (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))     ]
src/Language/PureScript/Errors.hs view
@@ -186,7 +186,7 @@ -- | 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 @@       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 @@   | 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
src/Language/PureScript/Errors/JSON.hs view
@@ -6,7 +6,6 @@  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) 
src/Language/PureScript/Hierarchy.hs view
@@ -19,7 +19,6 @@ import           Protolude (ordNub)  import           Data.List (sort)-import           Data.Monoid ((<>)) import qualified Data.Text as T import qualified Language.PureScript as P 
src/Language/PureScript/Ide.hs view
@@ -94,10 +94,10 @@       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 ->
src/Language/PureScript/Ide/Command.hs view
@@ -17,6 +17,8 @@ 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 @@       -- 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 @@         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
src/Language/PureScript/Ide/Completion.hs view
@@ -11,7 +11,6 @@  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.Matcher import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util+import           Lens.Micro.Platform hiding ((&))  type Module = (P.ModuleName, [IdeDeclarationAnn]) 
src/Language/PureScript/Ide/Externs.hs view
@@ -21,7 +21,6 @@  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           Data.Version (showVersion) import           Language.PureScript.Ide.Error (IdeError (..)) import           Language.PureScript.Ide.Types+import           Lens.Micro.Platform  import qualified Language.PureScript as P 
src/Language/PureScript/Ide/Filter.hs view
@@ -35,7 +35,7 @@ import qualified Language.PureScript           as P  newtype Filter = Filter (Endo [Module])-  deriving (Monoid)+  deriving (Semigroup, Monoid)  type Module = (P.ModuleName, [IdeDeclarationAnn]) 
src/Language/PureScript/Ide/Imports.hs view
@@ -32,7 +32,6 @@  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.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 
src/Language/PureScript/Ide/Matcher.hs view
@@ -35,7 +35,7 @@  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
src/Language/PureScript/Ide/Rebuild.hs view
@@ -42,10 +42,12 @@   -- ^ 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 @@   -- 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 @@  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 @@  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 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
src/Language/PureScript/Ide/Reexports.hs view
@@ -25,11 +25,11 @@  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
src/Language/PureScript/Ide/State.hs view
@@ -41,7 +41,6 @@  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.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 @@           mapIf matchTC (idaDeclaration                          . _IdeDeclTypeClass                          . ideTCInstances-                         %~ cons ideInstance)+                         %~ (ideInstance :))       in         acc' & ix classModule %~ updateDeclaration 
src/Language/PureScript/Ide/Types.hs view
@@ -22,11 +22,11 @@ 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 @@   , _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
src/Language/PureScript/Ide/Usage.hs view
@@ -8,13 +8,13 @@  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:
src/Language/PureScript/Ide/Util.hs view
@@ -30,9 +30,8 @@   ) 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           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 @@ 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)
src/Language/PureScript/Interactive.hs view
@@ -16,7 +16,6 @@ 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 @@   -> 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
src/Language/PureScript/Interactive/Printer.hs view
@@ -5,7 +5,6 @@ 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
src/Language/PureScript/Interactive/Types.hs view
@@ -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 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 @@ -- -- 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 @@ 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 @@ -- | 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
src/Language/PureScript/Kinds.hs view
@@ -102,8 +102,8 @@   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
src/Language/PureScript/Label.hs view
@@ -17,6 +17,6 @@ -- 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
src/Language/PureScript/Linter.hs view
@@ -10,7 +10,6 @@  import Data.List ((\\)) import Data.Maybe (mapMaybe)-import Data.Monoid import qualified Data.Set as S import Data.Text (Text) 
src/Language/PureScript/Linter/Exhaustive.hs view
@@ -20,7 +20,6 @@ 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
src/Language/PureScript/Make.hs view
@@ -75,6 +75,7 @@       optimized = CF.optimizeCoreFn corefn       [renamed] = renameInModules [optimized]       exts = moduleToExternsFile mod' env'+  ffiCodegen renamed   evalSupplyT nextVar' . codegen renamed env' . encode $ exts   return exts 
src/Language/PureScript/Make/Actions.hs view
@@ -4,6 +4,7 @@   , Externs()   , ProgressMessage(..)   , buildMakeActions+  , checkForeignDecls   ) where  import           Prelude@@ -18,13 +19,12 @@ 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.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 @@   -- 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 @@   -- ^ 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 @@       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 @@       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 @@           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 @@  -- | 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 @@   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) 
src/Language/PureScript/Names.hs view
@@ -16,7 +16,6 @@ import GHC.Generics (Generic) import Data.Aeson import Data.Aeson.TH-import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T 
src/Language/PureScript/Options.hs view
@@ -3,6 +3,8 @@  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 @@  data CodegenTarget = JS | JSSourceMap | CoreFn   deriving (Eq, Ord, Show)++codegenTargets :: Map String CodegenTarget+codegenTargets = Map.fromList+  [ ("js", JS)+  , ("sourcemaps", JSSourceMap)+  , ("corefn", CoreFn)+  ]
src/Language/PureScript/PSString.hs view
@@ -21,7 +21,6 @@ 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 @@ -- 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 
src/Language/PureScript/Parser/Common.hs view
@@ -6,7 +6,6 @@ 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
src/Language/PureScript/Parser/Declarations.hs view
@@ -25,7 +25,6 @@ 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
src/Language/PureScript/Parser/Lexer.hs view
@@ -70,7 +70,6 @@ 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
src/Language/PureScript/Pretty/Common.hs view
@@ -10,7 +10,6 @@ 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 @@ -- 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 @@       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
src/Language/PureScript/Pretty/Kinds.hs view
@@ -10,7 +10,6 @@ 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)
src/Language/PureScript/Pretty/Types.hs view
@@ -14,7 +14,7 @@   , prettyPrintObjectKey   ) where -import Prelude.Compat+import Prelude.Compat hiding ((<>))  import Control.Arrow ((<+>)) import Control.PatternArrows as PA
src/Language/PureScript/Pretty/Values.hs view
@@ -7,7 +7,7 @@   , prettyPrintBinderAtom   ) where -import Prelude.Compat+import Prelude.Compat hiding ((<>))  import Control.Arrow (second) 
src/Language/PureScript/Publish.hs view
@@ -36,7 +36,8 @@ 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 @@ -- 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
src/Language/PureScript/Publish/ErrorsWarnings.hs view
@@ -311,11 +311,12 @@   }   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
src/Language/PureScript/Renamer.hs view
@@ -10,7 +10,6 @@ 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 
src/Language/PureScript/Sugar/DoNotation.hs view
@@ -25,46 +25,47 @@ -- | 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)
src/Language/PureScript/Sugar/Names/Env.hs view
@@ -32,6 +32,7 @@ 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 @@   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
src/Language/PureScript/Sugar/Names/Exports.hs view
@@ -147,6 +147,7 @@     -- 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))
src/Language/PureScript/Sugar/TypeClasses.hs view
@@ -14,9 +14,11 @@ 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 @@     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 
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs view
@@ -12,7 +12,6 @@ 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 @@   -- ^ 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 @@   -> 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 @@   -> 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 @@   -> 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 @@   -> 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 @@   -> 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 @@  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 @@   -> 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
src/Language/PureScript/TypeChecker.hs view
@@ -17,12 +17,10 @@ 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@@ -42,6 +40,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)
src/Language/PureScript/TypeChecker/Entailment.hs view
@@ -135,13 +135,14 @@   | 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.
src/Language/PureScript/TypeChecker/Skolems.hs view
@@ -14,7 +14,6 @@ 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
src/Language/PureScript/TypeChecker/Types.hs view
@@ -39,7 +39,6 @@ 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
src/Language/PureScript/TypeClassDictionaries.hs view
@@ -7,7 +7,6 @@  import GHC.Generics (Generic) import Control.DeepSeq (NFData)-import Data.Monoid ((<>)) import Data.Text (Text, pack)  import Language.PureScript.Names
src/Language/PureScript/Types.hs view
@@ -18,7 +18,6 @@ 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)
stack.yaml view
@@ -1,4 +1,8 @@-resolver: lts-11.7+resolver: lts-12.0 packages: - '.' extra-deps:+nix:+  enable: false+  packages:+  - zlib
tests/Language/PureScript/Ide/CompletionSpec.hs view
@@ -4,7 +4,8 @@  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 = 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
tests/Language/PureScript/Ide/RebuildSpec.hs view
@@ -4,6 +4,8 @@  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.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 @@         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
tests/Language/PureScript/Ide/StateSpec.hs view
@@ -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 @@     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)
tests/TestCompiler.hs view
@@ -40,7 +40,6 @@ import Control.Arrow ((***), (>>>))  import Control.Monad.Reader-import Control.Monad.Writer.Strict import Control.Monad.Trans.Except  import System.Exit@@ -234,13 +233,25 @@  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]
tests/TestCoreFn.hs view
@@ -9,7 +9,7 @@ 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 @@   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 @@     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
tests/TestPrimDocs.hs view
@@ -3,7 +3,6 @@ import Prelude  import Control.Monad-import Data.Monoid ((<>)) import Data.List ((\\)) import qualified Data.Map as Map import qualified Data.Set as Set
tests/TestPsci/CommandTest.hs view
@@ -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 @@     ":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"
tests/TestPsci/CompletionTest.hs view
@@ -34,12 +34,12 @@   , (":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 ", [])
tests/TestPsci/TestEnv.hs view
@@ -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 = 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 @@       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 @@  -- | 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 @@  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 ()
tests/TestUtils.hs view
@@ -66,10 +66,12 @@ 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)
+ tests/purs/failing/3405.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith CannotFindDerivingType+module Main where++import Prelude++type Something = Int++derive instance eqSomething ∷ Eq Something
tests/purs/failing/MissingClassMember.purs view
@@ -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
+ tests/purs/passing/3388.purs view
@@ -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"
+ tests/purs/passing/3410.purs view
@@ -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"
+ tests/purs/warning/CustomWarning4.purs view
@@ -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 }
tests/support/bower.json view
@@ -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"   } }
− tests/support/package-lock.json
@@ -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="-        }-      }-    }-  }-}
+ tests/support/psci/Reload.edit view
@@ -0,0 +1,4 @@+module Reload where++edited :: String+edited = "reload"
+ tests/support/psci/Reload.purs view
@@ -0,0 +1,4 @@+module Reload where++reload :: Int+reload = 0
− tests/support/psci/Sample.purs