packages feed

purescript 0.15.0 → 0.15.1

raw patch · 112 files changed

+1728/−1151 lines, 112 filesdep +generic-randomdep +lensdep +newtypedep −microlensdep −microlens-platform

Dependencies added: generic-random, lens, newtype

Dependencies removed: microlens, microlens-platform

Files

CONTRIBUTORS.md view
@@ -86,6 +86,7 @@ | [@mrhania](https://github.com/mrhania) | Łukasz Hanuszczak | [MIT license](http://opensource.org/licenses/MIT) | | [@natefaubion](https://github.com/natefaubion) | Nathan Faubion | [MIT license](http://opensource.org/licenses/MIT) | | [@ncaq](https://github.com/ncaq) | ncaq | [MIT license](http://opensource.org/licenses/MIT) |+| [@NickMolloy](https://github.com/NickMolloy) | Nick Molloy | [MIT license](http://opensource.org/licenses/MIT) | | [@nicodelpiano](https://github.com/nicodelpiano) | Nicolas Del Piano | [MIT license](http://opensource.org/licenses/MIT) | | [@noraesae](https://github.com/noraesae) | Hyunje Jun | [MIT license](http://opensource.org/licenses/MIT) | | [@nullobject](https://github.com/nullobject) | Josh Bassett | [MIT license](http://opensource.org/licenses/MIT) |
LICENSE view
@@ -95,11 +95,6 @@   lifted-async   lifted-base   memory-  microlens-  microlens-ghc-  microlens-mtl-  microlens-platform-  microlens-th   monad-control   monad-logger   monad-loops@@ -2769,180 +2764,6 @@   LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY   OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF   SUCH DAMAGE.--microlens LICENSE file:--  Copyright (c) 2013-2016 Edward Kmett,-                2015-2016 Artyom Kazak,-                2018 Monadfix--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Monadfix nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--microlens-ghc LICENSE file:--  Copyright (c) 2013-2016 Edward Kmett,-                2015-2016 Artyom Kazak,-                2018 Monadfix--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Monadfix nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--microlens-mtl LICENSE file:--  Copyright (c) 2013-2016 Edward Kmett,-                2015-2016 Artyom Kazak,-                2018 Monadfix--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Monadfix nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--microlens-platform LICENSE file:--  Copyright (c) 2012-2016 Edward Kmett,-                2015-2016 Artyom Kazak,-                2018 Monadfix--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Monadfix nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--microlens-th LICENSE file:--  Copyright (c) 2013-2016 Eric Mertens, Edward Kmett, Artyom Kazak-                2018 Monadfix--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Monadfix nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  monad-control LICENSE file:
README.md view
@@ -19,6 +19,15 @@  ## Help! +### Community Spaces++The following spaces are governed by the [PureScript Community Code of Conduct](https://github.com/purescript/governance/blob/master/CODE_OF_CONDUCT.md). The majority of PureScript users use these spaces to discuss and collaborate on PureScript-related topics: - [PureScript Discord](https://purescript.org/chat) - [PureScript Discourse](https://discourse.purescript.org/)++### Unaffiliated Spaces++Some PureScript users also collaborate in the below spaces. These do not fall under the code of conduct linked above. They may have no code of conduct or one very different than the one linked above.+- [PureScript Matrix](https://matrix.to/#/#purescript:matrix.org) - [PureScript on StackOverflow](http://stackoverflow.com/questions/tagged/purescript)+- [The `#purescript` channel on Libera.Chat](https://libera.chat/)
+ VERSIONING_POLICY.md view
@@ -0,0 +1,9 @@+# Versioning Policy++PureScript can be perceived from two different perspectives:+1. PureScript-the-application (e.g. using `purs` to compile code)+1. PureScript-the-library (e.g. building a tool that depends on the [`purescript` package](https://hackage.haskell.org/package/purescript))++This project is versioned using [SemVer 2.0.0](https://semver.org/), not [PVP](https://pvp.haskell.org/) because users of PureScript-the-application are the intended audience. Thus, breaking changes to PureScript-the-application are reflected in this project's version. Since `CoreFn` is considered part of PureScript-the-application, a breaking change to that format is reflected in the project version.++Since PureScript-the-library is used by internal tools like [Try PureScript](https://github.com/purescript/trypurescript) and [Pursuit](https://github.com/purescript/pursuit), it must be published to Hackage as a library. However, PureScript-the-library is considered unstable and can make breaking changes to library users without reflecting that in the version.
app/Command/Bundle.hs view
@@ -11,7 +11,7 @@ app = do   hPutStrLn stderr $ unlines     [ "'purs bundle' was removed in the v0.15.0 release."-    , "See https://www.github.com/purescript/documentation/migration-guides/0.15-Migration-Guide.md "+    , "See https://github.com/purescript/documentation/blob/master/migration-guides/0.15-Migration-Guide.md"     , "for more information and bundler alternatives."     ]   exitFailure
purescript.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               purescript-version:            0.15.0+version:            0.15.1 license:            BSD-3-Clause license-file:       LICENSE copyright:@@ -40,6 +40,7 @@     INSTALL.md     CONTRIBUTORS.md     CONTRIBUTING.md+    VERSIONING_POLICY.md     .hspec  source-repository head@@ -67,6 +68,7 @@         Language.PureScript.AST.Operators         Language.PureScript.AST.SourcePos         Language.PureScript.AST.Traversals+        Language.PureScript.AST.Utils         Language.PureScript.Bundle         Language.PureScript.CodeGen         Language.PureScript.CodeGen.JS@@ -211,6 +213,7 @@         Language.PureScript.Sugar.TypeDeclarations         Language.PureScript.Traversals         Language.PureScript.TypeChecker+        Language.PureScript.TypeChecker.Deriving         Language.PureScript.TypeChecker.Entailment         Language.PureScript.TypeChecker.Entailment.Coercible         Language.PureScript.TypeChecker.Entailment.IntCompare@@ -276,11 +279,10 @@         Glob >=0.10.1 && <0.11,         haskeline >=0.8.2 && <0.9,         language-javascript ==0.7.0.0,+        lens >=4.19.2 && <4.20,         lifted-async >=0.10.2.2 && <0.11,         lifted-base >=0.2.3.12 && <0.3,         memory >=0.15.0 && <0.16,-        microlens >=0.4.12.0 && <0.5,-        microlens-platform >=0.4.2 && <0.5,         monad-control >=1.0.3.1 && <1.1,         monad-logger >=0.3.36 && <0.4,         monoidal-containers >=0.6.2.0 && <0.7,@@ -373,11 +375,10 @@         Glob >=0.10.1 && <0.11,         haskeline >=0.8.2 && <0.9,         language-javascript ==0.7.0.0,+        lens >=4.19.2 && <4.20,         lifted-async >=0.10.2.2 && <0.11,         lifted-base >=0.2.3.12 && <0.3,         memory >=0.15.0 && <0.16,-        microlens >=0.4.12.0 && <0.5,-        microlens-platform >=0.4.2 && <0.5,         monad-control >=1.0.3.1 && <1.1,         monad-logger >=0.3.36 && <0.4,         monoidal-containers >=0.6.2.0 && <0.7,@@ -440,6 +441,7 @@         Language.PureScript.Ide.Test         Language.PureScript.Ide.UsageSpec         PscIdeSpec+        TestAst         TestCompiler         TestCoreFn         TestCst@@ -500,11 +502,10 @@         Glob >=0.10.1 && <0.11,         haskeline >=0.8.2 && <0.9,         language-javascript ==0.7.0.0,+        lens >=4.19.2 && <4.20,         lifted-async >=0.10.2.2 && <0.11,         lifted-base >=0.2.3.12 && <0.3,         memory >=0.15.0 && <0.16,-        microlens >=0.4.12.0 && <0.5,-        microlens-platform >=0.4.2 && <0.5,         monad-control >=1.0.3.1 && <1.1,         monad-logger >=0.3.36 && <0.4,         monoidal-containers >=0.6.2.0 && <0.7,@@ -534,7 +535,9 @@         utf8-string >=1.0.2 && <1.1,         vector >=0.12.3.1 && <0.13,         purescript -any,+        generic-random >=1.4.0.0 && <1.5,         hspec >=2.8.3 && <2.9,         HUnit >=1.6.2.0 && <1.7,+        newtype >=0.2.2.0 && <0.3,         QuickCheck >=2.14.2 && <2.15,         regex-base >=0.94.0.1 && <0.95
src/Language/PureScript/AST/Declarations.hs view
@@ -441,15 +441,17 @@ pattern TypeFixityDeclaration :: SourceAnn -> Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration pattern TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (TypeFixity fixity name op)) +data InstanceDerivationStrategy+  = KnownClassStrategy+  | NewtypeStrategy+  deriving (Show)+ -- | The members of a type class instance declaration data TypeInstanceBody   = DerivedInstance   -- ^ This is a derived instance   | NewtypeInstance   -- ^ This is an instance derived from a newtype-  | NewtypeInstanceWithDictionary Expr-  -- ^ This is an instance derived from a newtype, desugared to include a-  -- dictionary for the type under the newtype.   | ExplicitInstance [Declaration]   -- ^ This is a regular (explicit) instance   deriving (Show)@@ -724,6 +726,10 @@   -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking   --   | DeferredDictionary (Qualified (ProperName 'ClassName)) [SourceType]+  -- |+  -- A placeholder for a type class instance to be derived during typechecking+  --+  | DerivedInstancePlaceholder (Qualified (ProperName 'ClassName)) InstanceDerivationStrategy   -- |   -- A placeholder for an anonymous function argument   --
+ src/Language/PureScript/AST/Utils.hs view
@@ -0,0 +1,49 @@+module Language.PureScript.AST.Utils where++import Protolude++import Language.PureScript.AST+import Language.PureScript.Names+import Language.PureScript.Types++lam :: Ident -> Expr -> Expr+lam = Abs . mkBinder++lamCase :: Ident -> [CaseAlternative] -> Expr+lamCase s = lam s . Case [mkVar s]++lamCase2 :: Ident -> Ident -> [CaseAlternative] -> Expr+lamCase2 s t = lam s . lam t . Case [mkVar s, mkVar t]++mkRef :: Qualified Ident -> Expr+mkRef = Var nullSourceSpan++mkVarMn :: Maybe ModuleName -> Ident -> Expr+mkVarMn mn = mkRef . Qualified mn++mkVar :: Ident -> Expr+mkVar = mkVarMn Nothing++mkBinder :: Ident -> Binder+mkBinder = VarBinder nullSourceSpan++mkLit :: Literal Expr -> Expr+mkLit = Literal nullSourceSpan++mkCtor :: ModuleName -> ProperName 'ConstructorName -> Expr+mkCtor mn name = Constructor nullSourceSpan (Qualified (Just mn) name)++mkCtorBinder :: ModuleName -> ProperName 'ConstructorName -> [Binder] -> Binder+mkCtorBinder mn name = ConstructorBinder nullSourceSpan (Qualified (Just mn) name)++unguarded :: Expr -> [GuardedExpr]+unguarded e = [MkUnguarded e]++unwrapTypeConstructor :: SourceType -> Maybe (Qualified (ProperName 'TypeName), [SourceType], [SourceType])+unwrapTypeConstructor = go [] []+  where+  go kargs args = \case+    TypeConstructor _ tyCon -> Just (tyCon, kargs, args)+    TypeApp _ ty arg -> go kargs (arg : args) ty+    KindApp _ ty karg -> go (karg : kargs) args ty+    _ -> Nothing
src/Language/PureScript/CodeGen/JS.hs view
@@ -59,23 +59,20 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude =   rethrow (addHint (ErrorInModule mn)) $ do     let usedNames = concatMap getNames decls-    let mnLookup = renameImports usedNames imps-    let decls' = renameModules mnLookup decls-    (jsDecls, Any needRuntimeLazy) <- runWriterT $ mapM (moduleBindToJs mn) decls'-    let mnReverseLookup = M.fromList $ map (\(origName, (_, safeName)) -> (moduleNameToJs safeName, origName)) $ M.toList mnLookup-    let moduleObjectNames = "$foreign" `S.insert` M.keysSet mnReverseLookup-    optimized <- traverse (traverse (fmap (annotatePure moduleObjectNames) . optimize)) (if needRuntimeLazy then [runtimeLazy] : jsDecls else jsDecls)-    let usedModuleNames = foldMap (foldMap (findModules mnReverseLookup)) optimized-          `S.union` M.keysSet reExps-    let jsImports-          = map (importToJs mnLookup)-          . filter (flip S.member usedModuleNames)-          . (\\ (mn : C.primModules)) $ ordNub $ map snd imps+    let imps' = ordNub $ map snd imps+    let mnLookup = renameImports usedNames imps'+    (jsDecls, Any needRuntimeLazy) <- runWriterT $ mapM (moduleBindToJs mn) decls+    optimized <- traverse (traverse (fmap annotatePure . optimize)) (if needRuntimeLazy then [runtimeLazy] : jsDecls else jsDecls)     F.traverse_ (F.traverse_ checkIntegers) optimized     comments <- not <$> asks optionsNoComments     let header = if comments then coms else []-    let foreign' = maybe [] (pure . AST.Import "$foreign") $ if null foreigns then Nothing else foreignInclude+    let foreign' = maybe [] (pure . AST.Import FFINamespace) $ if null foreigns then Nothing else foreignInclude     let moduleBody = concat optimized+    let (S.union (M.keysSet reExps) -> usedModuleNames, renamedModuleBody) = traverse (replaceModuleAccessors mnLookup) moduleBody+    let jsImports+          = map (importToJs mnLookup)+          . filter (flip S.member usedModuleNames)+          $ (\\ (mn : C.primModules)) imps'     let foreignExps = exps `intersect` foreigns     let standardExps = exps \\ foreignExps     let reExps' = M.toList (M.withoutKeys reExps (S.fromList C.primModules))@@ -83,15 +80,15 @@           =  (maybeToList . exportsToJs foreignInclude $ foreignExps)           ++ (maybeToList . exportsToJs Nothing $ standardExps)           ++  mapMaybe reExportsToJs reExps'-    return $ AST.Module header (foreign' ++ jsImports) moduleBody jsExports+    return $ AST.Module header (foreign' ++ jsImports) renamedModuleBody jsExports    where   -- | Adds purity annotations to top-level values for bundlers.   -- The semantics here derive from treating top-level module evaluation as pure, which lets   -- us remove any unreferenced top-level declarations. To achieve this, we wrap any non-trivial   -- top-level values in an IIFE marked with a pure annotation.-  annotatePure :: S.Set Text -> AST -> AST-  annotatePure moduleObjectNames = annotateOrWrap+  annotatePure :: AST -> AST+  annotatePure = annotateOrWrap     where     annotateOrWrap = liftA2 fromMaybe pureIife maybePure @@ -113,19 +110,18 @@     maybePureGen alreadyAnnotated = \case       AST.VariableIntroduction ss name j -> Just (AST.VariableIntroduction ss name (annotateOrWrap <$> j))       AST.App ss f args -> (if alreadyAnnotated then AST.App else pureApp) ss <$> maybePure' f <*> traverse maybePure args-      -- In general, indexers can be effectful, but not when indexing into an-      -- ES module object.-      AST.Indexer ss idx v@(AST.Var _ name)-        | name `S.member` moduleObjectNames -> (\idx' -> AST.Indexer ss idx' v) <$> maybePure idx       AST.ArrayLiteral ss jss -> AST.ArrayLiteral ss <$> traverse maybePure jss       AST.ObjectLiteral ss props -> AST.ObjectLiteral ss <$> traverse (traverse maybePure) props       AST.Comment c js -> AST.Comment c <$> maybePure js +      js@(AST.Indexer _ _ (AST.Var _ FFINamespace)) -> Just js+       js@AST.NumericLiteral{} -> Just js       js@AST.StringLiteral{}  -> Just js       js@AST.BooleanLiteral{} -> Just js       js@AST.Function{}       -> Just js       js@AST.Var{}            -> Just js+      js@AST.ModuleAccessor{} -> Just js        _ -> Nothing @@ -142,31 +138,31 @@    -- | Creates alternative names for each module to ensure they don't collide   -- with declaration names.-  renameImports :: [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)+  renameImports :: [Ident] -> [ModuleName] -> M.Map ModuleName Text   renameImports = go M.empty     where-    go :: M.Map ModuleName (Ann, ModuleName) -> [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)-    go acc used ((ann, mn') : mns') =-      let mni = Ident $ moduleNameToJs mn'-      in if mn' /= mn && mni `elem` used-         then let newName = freshModuleName 1 mn' used-              in go (M.insert mn' (ann, newName) acc) (Ident (runModuleName newName) : used) mns'-         else go (M.insert mn' (ann, mn') acc) used mns'+    go :: M.Map ModuleName Text -> [Ident] -> [ModuleName] -> M.Map ModuleName Text+    go acc used (mn' : mns') =+      let mnj = moduleNameToJs mn'+      in if mn' /= mn && Ident mnj `elem` used+         then let newName = freshModuleName 1 mnj used+              in go (M.insert mn' newName acc) (Ident newName : used) mns'+         else go (M.insert mn' mnj acc) used mns'     go acc _ [] = acc -    freshModuleName :: Integer -> ModuleName -> [Ident] -> ModuleName-    freshModuleName i mn'@(ModuleName name) used =-      let newName = ModuleName $ name <> "_" <> T.pack (show i)-      in if Ident (runModuleName newName) `elem` used+    freshModuleName :: Integer -> Text -> [Ident] -> Text+    freshModuleName i mn' used =+      let newName = mn' <> "_" <> T.pack (show i)+      in if Ident newName `elem` used          then freshModuleName (i + 1) mn' used          else newName    -- | Generates JavaScript code for a module import, binding the required module   -- to the alternative-  importToJs :: M.Map ModuleName (Ann, ModuleName) -> ModuleName -> AST.Import+  importToJs :: M.Map ModuleName Text -> ModuleName -> AST.Import   importToJs mnLookup mn' =-    let (_, mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup-    in AST.Import (moduleNameToJs mnSafe) (moduleImportPath mn')+    let mnSafe = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup+    in AST.Import mnSafe (moduleImportPath mn')    -- | Generates JavaScript code for exporting at least one identifier,   -- eventually from another module.@@ -181,33 +177,15 @@   moduleImportPath :: ModuleName -> PSString   moduleImportPath mn' = fromString (".." </> T.unpack (runModuleName mn') </> "index.js") -  -- | Replaces the `ModuleName`s in the AST so that the generated code refers to-  -- the collision-avoiding renamed module imports.-  renameModules :: M.Map ModuleName (Ann, ModuleName) -> [Bind Ann] -> [Bind Ann]-  renameModules mnLookup binds =-    let (f, _, _) = everywhereOnValues id goExpr goBinder-    in map f binds-    where-    goExpr :: Expr a -> Expr a-    goExpr (Var ann q) = Var ann (renameQual q)-    goExpr e = e-    goBinder :: Binder a -> Binder a-    goBinder (ConstructorBinder ann q1 q2 bs) = ConstructorBinder ann (renameQual q1) (renameQual q2) bs-    goBinder b = b-    renameQual :: Qualified a -> Qualified a-    renameQual (Qualified (Just mn') a) =-      let (_,mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup-      in Qualified (Just mnSafe) a-    renameQual q = q--  -- |-  -- Find the set of ModuleNames referenced by an AST.-  ---  findModules :: M.Map Text ModuleName -> AST -> S.Set ModuleName-  findModules mnReverseLookup = AST.everything mappend go-    where-    go (AST.Var _ name) = foldMap S.singleton $ M.lookup name mnReverseLookup-    go _ = mempty+  -- | Replaces the `ModuleAccessor`s in the AST with `Indexer`s, ensuring that+  -- the generated code refers to the collision-avoiding renamed module+  -- imports. Also returns set of used module names.+  replaceModuleAccessors :: M.Map ModuleName Text -> AST -> (S.Set ModuleName, AST)+  replaceModuleAccessors mnLookup = everywhereTopDownM $ \case+    AST.ModuleAccessor _ mn' name ->+      let mnSafe = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup+      in (S.singleton mn', accessorString name $ AST.Var Nothing mnSafe)+    other -> pure other    -- Check that all integers fall within the valid int range for JavaScript.   checkIntegers :: AST -> m ()@@ -297,21 +275,6 @@   var :: Ident -> AST   var = AST.Var Nothing . identToJs -  -- | Generate code in the simplified JavaScript intermediate representation for an accessor based on-  -- a PureScript identifier. If the name is not valid in JavaScript (symbol based, reserved name) an-  -- indexer is returned.-  moduleAccessor :: Ident -> AST -> AST-  moduleAccessor (Ident prop) = moduleAccessorString prop-  moduleAccessor (GenIdent _ _) = internalError "GenIdent in moduleAccessor"-  moduleAccessor UnusedIdent = internalError "UnusedIdent in moduleAccessor"-  moduleAccessor InternalIdent{} = internalError "InternalIdent in moduleAccessor"--  moduleAccessorString :: Text -> AST -> AST-  moduleAccessorString = accessorString . mkString . T.replace "'" "$prime"--  accessorString :: PSString -> AST -> AST-  accessorString prop = AST.Indexer Nothing (AST.StringLiteral Nothing prop)-   -- | Generate code in the simplified JavaScript intermediate representation for a value or expression.   valueToJs :: Expr Ann -> m AST   valueToJs e =@@ -425,11 +388,11 @@   -- variable that may have a qualified name.   qualifiedToJS :: (a -> Ident) -> Qualified a -> AST   qualifiedToJS f (Qualified (Just C.Prim) a) = AST.Var Nothing . runIdent $ f a-  qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = moduleAccessor (f a) (AST.Var Nothing (moduleNameToJs mn'))+  qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = AST.ModuleAccessor Nothing mn' . mkString . T.concatMap identCharToText . runIdent $ f a   qualifiedToJS f (Qualified _ a) = AST.Var Nothing $ identToJs (f a)    foreignIdent :: Ident -> AST-  foreignIdent ident = accessorString (mkString $ runIdent ident) (AST.Var Nothing "$foreign")+  foreignIdent ident = accessorString (mkString $ runIdent ident) (AST.Var Nothing FFINamespace)    -- | Generate code in the simplified JavaScript intermediate representation for pattern match binders   -- and guards.@@ -541,3 +504,9 @@       done'' <- go done' (index + 1) bs'       js <- binderToJs elVar done'' binder       return (AST.VariableIntroduction Nothing elVar (Just (AST.Indexer Nothing (AST.NumericLiteral Nothing (Left index)) (AST.Var Nothing varName))) : js)++accessorString :: PSString -> AST -> AST+accessorString prop = AST.Indexer Nothing (AST.StringLiteral Nothing prop)++pattern FFINamespace :: Text+pattern FFINamespace = "$foreign"
src/Language/PureScript/Constants/Prelude.hs view
@@ -1,7 +1,7 @@ -- | Various constants which refer to things in the Prelude module Language.PureScript.Constants.Prelude where -import Prelude.Compat+import Prelude.Compat hiding (compare, map)  import Data.String (IsString) import Language.PureScript.PSString (PSString)@@ -300,77 +300,101 @@ pattern GT :: Qualified (ProperName 'ConstructorName) pattern GT = Qualified (Just DataOrdering) (ProperName "GT") -dataArray :: forall a. (IsString a) => a-dataArray = "Data_Array"+pattern DataArray :: ModuleName+pattern DataArray = ModuleName "Data.Array" -eff :: forall a. (IsString a) => a-eff = "Control_Monad_Eff"+pattern Eff :: ModuleName+pattern Eff = ModuleName "Control.Monad.Eff" -effect :: forall a. (IsString a) => a-effect = "Effect"+pattern Effect :: ModuleName+pattern Effect = ModuleName "Effect" -st :: forall a. (IsString a) => a-st = "Control_Monad_ST_Internal"+pattern ST :: ModuleName+pattern ST = ModuleName "Control.Monad.ST.Internal" -controlApplicative :: forall a. (IsString a) => a-controlApplicative = "Control_Applicative"+pattern ControlApplicative :: ModuleName+pattern ControlApplicative = ModuleName "Control.Applicative" -controlSemigroupoid :: forall a. (IsString a) => a-controlSemigroupoid = "Control_Semigroupoid"+pattern ControlSemigroupoid :: ModuleName+pattern ControlSemigroupoid = ModuleName "Control.Semigroupoid"  pattern ControlBind :: ModuleName pattern ControlBind = ModuleName "Control.Bind" -controlBind :: forall a. (IsString a) => a-controlBind = "Control_Bind"+pattern ControlMonadEffUncurried :: ModuleName+pattern ControlMonadEffUncurried = ModuleName "Control.Monad.Eff.Uncurried" -controlMonadEffUncurried :: forall a. (IsString a) => a-controlMonadEffUncurried = "Control_Monad_Eff_Uncurried"+pattern EffectUncurried :: ModuleName+pattern EffectUncurried = ModuleName "Effect.Uncurried" -effectUncurried :: forall a. (IsString a) => a-effectUncurried = "Effect_Uncurried"+pattern DataBounded :: ModuleName+pattern DataBounded = ModuleName "Data.Bounded" -dataBounded :: forall a. (IsString a) => a-dataBounded = "Data_Bounded"+pattern DataSemigroup :: ModuleName+pattern DataSemigroup = ModuleName "Data.Semigroup" -dataSemigroup :: forall a. (IsString a) => a-dataSemigroup = "Data_Semigroup"+pattern DataHeytingAlgebra :: ModuleName+pattern DataHeytingAlgebra = ModuleName "Data.HeytingAlgebra" -dataHeytingAlgebra :: forall a. (IsString a) => a-dataHeytingAlgebra = "Data_HeytingAlgebra"+pattern DataEq :: ModuleName+pattern DataEq = ModuleName "Data.Eq" -dataEq :: forall a. (IsString a) => a-dataEq = "Data_Eq"+pattern Eq :: Qualified (ProperName 'ClassName)+pattern Eq = Qualified (Just DataEq) (ProperName "Eq") -dataOrd :: forall a. (IsString a) => a-dataOrd = "Data_Ord"+pattern Eq1 :: Qualified (ProperName 'ClassName)+pattern Eq1 = Qualified (Just DataEq) (ProperName "Eq1") -dataSemiring :: forall a. (IsString a) => a-dataSemiring = "Data_Semiring"+identEq :: Qualified Ident+identEq = Qualified (Just DataEq) (Ident eq) -dataRing :: forall a. (IsString a) => a-dataRing = "Data_Ring"+identEq1 :: Qualified Ident+identEq1 = Qualified (Just DataEq) (Ident eq1) -dataEuclideanRing :: forall a. (IsString a) => a-dataEuclideanRing = "Data_EuclideanRing"+pattern DataOrd :: ModuleName+pattern DataOrd = ModuleName "Data.Ord" -dataFunction :: forall a. (IsString a) => a-dataFunction = "Data_Function"+pattern Ord :: Qualified (ProperName 'ClassName)+pattern Ord = Qualified (Just DataOrd) (ProperName "Ord") -dataFunctionUncurried :: forall a. (IsString a) => a-dataFunctionUncurried = "Data_Function_Uncurried"+pattern Ord1 :: Qualified (ProperName 'ClassName)+pattern Ord1 = Qualified (Just DataOrd) (ProperName "Ord1") -dataIntBits :: forall a. (IsString a) => a-dataIntBits = "Data_Int_Bits"+identCompare :: Qualified Ident+identCompare = Qualified (Just DataOrd) (Ident compare) -partialUnsafe :: forall a. (IsString a) => a-partialUnsafe = "Partial_Unsafe"+identCompare1 :: Qualified Ident+identCompare1 = Qualified (Just DataOrd) (Ident compare1) +pattern DataFunctor :: ModuleName+pattern DataFunctor = ModuleName "Data.Functor"++pattern Functor :: Qualified (ProperName 'ClassName)+pattern Functor = Qualified (Just DataFunctor) (ProperName "Functor")++identMap :: Qualified Ident+identMap = Qualified (Just DataFunctor) (Ident map)++pattern DataSemiring :: ModuleName+pattern DataSemiring = ModuleName "Data.Semiring"++pattern DataRing :: ModuleName+pattern DataRing = ModuleName "Data.Ring"++pattern DataEuclideanRing :: ModuleName+pattern DataEuclideanRing = ModuleName "Data.EuclideanRing"++pattern DataFunction :: ModuleName+pattern DataFunction = ModuleName "Data.Function"++pattern DataIntBits :: ModuleName+pattern DataIntBits = ModuleName "Data.Int.Bits"+ unsafePartial :: forall a. (IsString a) => a unsafePartial = "unsafePartial" -unsafeCoerce :: forall a. (IsString a) => a-unsafeCoerce = "Unsafe_Coerce"+pattern UnsafeCoerce :: ModuleName+pattern UnsafeCoerce = ModuleName "Unsafe.Coerce"  unsafeCoerceFn :: forall a. (IsString a) => a unsafeCoerceFn = "unsafeCoerce"
src/Language/PureScript/CoreFn/Optimizer.hs view
@@ -3,14 +3,13 @@ import Protolude hiding (Type)  import Data.List (lookup)-import qualified Data.Text as T import Language.PureScript.AST.Literals import Language.PureScript.AST.SourcePos import Language.PureScript.CoreFn.Ann import Language.PureScript.CoreFn.Expr import Language.PureScript.CoreFn.Module import Language.PureScript.CoreFn.Traversals-import Language.PureScript.Names (Ident(..), ModuleName(..), Qualified(..))+import Language.PureScript.Names (Ident(..), Qualified(..)) import Language.PureScript.Label import Language.PureScript.Types import qualified Language.PureScript.Constants.Prelude as C@@ -53,10 +52,7 @@  optimizeDataFunctionApply :: Expr a -> Expr a optimizeDataFunctionApply e = case e of-  (App a (App _ (Var _ (Qualified (Just (ModuleName mn)) (Ident fn))) x) y)-    | mn == dataFunction && fn == C.apply -> App a x y-    | mn == dataFunction && fn == C.applyFlipped -> App a y x+  (App a (App _ (Var _ (Qualified (Just C.DataFunction) (Ident fn))) x) y)+    | fn == C.apply -> App a x y+    | fn == C.applyFlipped -> App a y x   _ -> e-  where-  dataFunction :: Text-  dataFunction = T.replace "_" "." C.dataFunction
src/Language/PureScript/CoreImp/AST.hs view
@@ -9,6 +9,7 @@  import Language.PureScript.AST (SourceSpan(..)) import Language.PureScript.Comments+import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (PSString) import Language.PureScript.Traversals @@ -75,6 +76,8 @@   -- ^ Function application   | Var (Maybe SourceSpan) Text   -- ^ Variable+  | ModuleAccessor (Maybe SourceSpan) ModuleName PSString+  -- ^ Value from another module   | Block (Maybe SourceSpan) [AST]   -- ^ A block of expressions in braces   | VariableIntroduction (Maybe SourceSpan) Text (Maybe AST)@@ -118,6 +121,7 @@   go (Function _ name args j) = Function ss name args j   go (App _ j js) = App ss j js   go (Var _ s) = Var ss s+  go (ModuleAccessor _ s1 s2) = ModuleAccessor ss s1 s2   go (Block _ js) = Block ss js   go (VariableIntroduction _ name j) = VariableIntroduction ss name j   go (Assignment _ j1 j2) = Assignment ss j1 j2@@ -145,6 +149,7 @@   go (Function ss _ _ _) = ss   go (App ss _ _) = ss   go (Var ss _) = ss+  go (ModuleAccessor ss _ _) = ss   go (Block ss _) = ss   go (VariableIntroduction ss _ _) = ss   go (Assignment ss _ _) = ss
src/Language/PureScript/CoreImp/Optimizer/Common.hs view
@@ -9,6 +9,7 @@  import Language.PureScript.Crash import Language.PureScript.CoreImp.AST+import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (PSString)  applyAll :: [a -> a] -> a -> a@@ -59,10 +60,10 @@ removeFromBlock go (Block ss sts) = Block ss (go sts) removeFromBlock _  js = js -isDict :: (Text, PSString) -> AST -> Bool-isDict (moduleName, dictName) (Indexer _ (StringLiteral _ x) (Var _ y)) =-  x == dictName && y == moduleName+isDict :: (ModuleName, PSString) -> AST -> Bool+isDict (moduleName, dictName) (ModuleAccessor _ x y) =+  x == moduleName && y == dictName isDict _ _ = False -isDict' :: [(Text, PSString)] -> AST -> Bool+isDict' :: [(ModuleName, PSString)] -> AST -> Bool isDict' xs js = any (`isDict` js) xs
src/Language/PureScript/CoreImp/Optimizer/Inliner.hs view
@@ -21,6 +21,7 @@ import Data.Text (Text) import qualified Data.Text as T +import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (PSString) import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common@@ -34,6 +35,7 @@ -- Probably needs to be fixed in pretty-printer instead. shouldInline :: AST -> Bool shouldInline (Var _ _) = True+shouldInline (ModuleAccessor _ _ _) = True shouldInline (NumericLiteral _ _) = True shouldInline (StringLiteral _ _) = True shouldInline (BooleanLiteral _ _) = True@@ -98,14 +100,14 @@     | isDict semiringInt dict && isDict fnMultiply fn = intOp ss Multiply x y     | isDict ringInt dict && isDict fnSubtract fn = intOp ss Subtract x y   convert other = other-  fnZero = (C.dataSemiring, C.zero)-  fnOne = (C.dataSemiring, C.one)-  fnBottom = (C.dataBounded, C.bottom)-  fnTop = (C.dataBounded, C.top)-  fnAdd = (C.dataSemiring, C.add)-  fnMultiply = (C.dataSemiring, C.mul)-  fnSubtract = (C.dataRing, C.sub)-  fnNegate = (C.dataRing, C.negate)+  fnZero = (C.DataSemiring, C.zero)+  fnOne = (C.DataSemiring, C.one)+  fnBottom = (C.DataBounded, C.bottom)+  fnTop = (C.DataBounded, C.top)+  fnAdd = (C.DataSemiring, C.add)+  fnMultiply = (C.DataSemiring, C.mul)+  fnSubtract = (C.DataRing, C.sub)+  fnNegate = (C.DataRing, C.negate)   intOp ss op x y = Binary ss BitwiseOr (Binary ss op x y) (NumericLiteral ss (Left 0))  inlineCommonOperators :: AST -> AST@@ -156,50 +158,50 @@   , binary heytingAlgebraBoolean opDisj Or   , unary  heytingAlgebraBoolean opNot Not -  , binary' C.dataIntBits C.or BitwiseOr-  , binary' C.dataIntBits C.and BitwiseAnd-  , binary' C.dataIntBits C.xor BitwiseXor-  , binary' C.dataIntBits C.shl ShiftLeft-  , binary' C.dataIntBits C.shr ShiftRight-  , binary' C.dataIntBits C.zshr ZeroFillShiftRight-  , unary'  C.dataIntBits C.complement BitwiseNot+  , binary' C.DataIntBits C.or BitwiseOr+  , binary' C.DataIntBits C.and BitwiseAnd+  , binary' C.DataIntBits C.xor BitwiseXor+  , binary' C.DataIntBits C.shl ShiftLeft+  , binary' C.DataIntBits C.shr ShiftRight+  , binary' C.DataIntBits C.zshr ZeroFillShiftRight+  , unary'  C.DataIntBits C.complement BitwiseNot -  , inlineNonClassFunction (isModFnWithDict (C.dataArray, C.unsafeIndex)) $ flip (Indexer Nothing)+  , inlineNonClassFunction (isModFnWithDict (C.DataArray, C.unsafeIndex)) $ flip (Indexer Nothing)   ] ++   [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ] ++-  [ fn | i <- [0..10], fn <- [ mkEffFn C.controlMonadEffUncurried C.mkEffFn i, runEffFn C.controlMonadEffUncurried C.runEffFn i ] ] ++-  [ fn | i <- [0..10], fn <- [ mkEffFn C.effectUncurried C.mkEffectFn i, runEffFn C.effectUncurried C.runEffectFn i ] ]+  [ fn | i <- [0..10], fn <- [ mkEffFn C.ControlMonadEffUncurried C.mkEffFn i, runEffFn C.ControlMonadEffUncurried C.runEffFn i ] ] +++  [ fn | i <- [0..10], fn <- [ mkEffFn C.EffectUncurried C.mkEffectFn i, runEffFn C.EffectUncurried C.runEffectFn i ] ]   where-  binary :: (Text, PSString) -> (Text, PSString) -> BinaryOperator -> AST -> AST+  binary :: (ModuleName, PSString) -> (ModuleName, PSString) -> BinaryOperator -> AST -> AST   binary dict fns op = convert where     convert :: AST -> AST     convert (App ss (App _ (App _ fn [dict']) [x]) [y]) | isDict dict dict' && isDict fns fn = Binary ss op x y     convert other = other-  binary' :: Text -> PSString -> BinaryOperator -> AST -> AST+  binary' :: ModuleName -> PSString -> BinaryOperator -> AST -> AST   binary' moduleName opString op = convert where     convert :: AST -> AST     convert (App ss (App _ fn [x]) [y]) | isDict (moduleName, opString) fn = Binary ss op x y     convert other = other-  unary :: (Text, PSString) -> (Text, PSString) -> UnaryOperator -> AST -> AST+  unary :: (ModuleName, PSString) -> (ModuleName, PSString) -> UnaryOperator -> AST -> AST   unary dicts fns op = convert where     convert :: AST -> AST     convert (App ss (App _ fn [dict']) [x]) | isDict dicts dict' && isDict fns fn = Unary ss op x     convert other = other-  unary' :: Text -> PSString -> UnaryOperator -> AST -> AST+  unary' :: ModuleName -> PSString -> UnaryOperator -> AST -> AST   unary' moduleName fnName op = convert where     convert :: AST -> AST     convert (App ss fn [x]) | isDict (moduleName, fnName) fn = Unary ss op x     convert other = other    mkFn :: Int -> AST -> AST-  mkFn = mkFn' C.dataFunctionUncurried C.mkFn $ \ss1 ss2 ss3 args js ->+  mkFn = mkFn' C.DataFunctionUncurried C.mkFn $ \ss1 ss2 ss3 args js ->     Function ss1 Nothing args (Block ss2 [Return ss3 js]) -  mkEffFn :: Text -> Text -> Int -> AST -> AST+  mkEffFn :: ModuleName -> Text -> Int -> AST -> AST   mkEffFn modName fnName = mkFn' modName fnName $ \ss1 ss2 ss3 args js ->     Function ss1 Nothing args (Block ss2 [Return ss3 (App ss3 js [])]) -  mkFn' :: Text -> Text -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST+  mkFn' :: ModuleName -> Text -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST   mkFn' modName fnName res 0 = convert where     convert :: AST -> AST     convert (App _ mkFnN [Function s1 Nothing [_] (Block s2 [Return s3 js])]) | isNFn modName fnName 0 mkFnN =@@ -217,19 +219,19 @@     collectArgs m acc (Function _ Nothing [oneArg] (Block _ [Return _ ret])) = collectArgs (m - 1) (oneArg : acc) ret     collectArgs _ _   _ = Nothing -  isNFn :: Text -> Text -> Int -> AST -> Bool-  isNFn expectMod prefix n (Indexer _ (StringLiteral _ name) (Var _ modName)) | modName == expectMod =+  isNFn :: ModuleName -> Text -> Int -> AST -> Bool+  isNFn expectMod prefix n (ModuleAccessor _ modName name) | modName == expectMod =     name == fromString (T.unpack prefix <> show n)   isNFn _ _ _ _ = False    runFn :: Int -> AST -> AST-  runFn = runFn' C.dataFunctionUncurried C.runFn App+  runFn = runFn' C.DataFunctionUncurried C.runFn App -  runEffFn :: Text -> Text -> Int -> AST -> AST+  runEffFn :: ModuleName -> Text -> Int -> AST -> AST   runEffFn modName fnName = runFn' modName fnName $ \ss fn acc ->     Function ss Nothing [] (Block ss [Return ss (App ss fn acc)]) -  runFn' :: Text -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST+  runFn' :: ModuleName -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST   runFn' modName runFnName res n = convert where     convert :: AST -> AST     convert js = fromMaybe js $ go n [] js@@ -246,8 +248,8 @@     convert (App _ (App _ op' [x]) [y]) | p op' = f x y     convert other = other -  isModFnWithDict :: (Text, PSString) -> AST -> Bool-  isModFnWithDict (m, op) (App _ (Indexer _ (StringLiteral _ op') (Var _ m')) [Var _ _]) =+  isModFnWithDict :: (ModuleName, PSString) -> AST -> Bool+  isModFnWithDict (m, op) (App _ (ModuleAccessor _ m' op') [Var _ _]) =     m == m' && op == op'   isModFnWithDict _ _ = False @@ -286,126 +288,126 @@   isFnComposeFlipped :: AST -> AST -> Bool   isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isDict fnComposeFlipped fn -  fnCompose :: forall a b. (IsString a, IsString b) => (a, b)-  fnCompose = (C.controlSemigroupoid, C.compose)+  fnCompose :: forall a. IsString a => (ModuleName, a)+  fnCompose = (C.ControlSemigroupoid, C.compose) -  fnComposeFlipped :: forall a b. (IsString a, IsString b) => (a, b)-  fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)+  fnComposeFlipped :: forall a. IsString a => (ModuleName, a)+  fnComposeFlipped = (C.ControlSemigroupoid, C.composeFlipped)  inlineUnsafeCoerce :: AST -> AST inlineUnsafeCoerce = everywhereTopDown convert where-  convert (App _ (Indexer _ (StringLiteral _ unsafeCoerceFn) (Var _ unsafeCoerce)) [ comp ])-    | unsafeCoerceFn == C.unsafeCoerceFn && unsafeCoerce == C.unsafeCoerce+  convert (App _ (ModuleAccessor _ C.UnsafeCoerce unsafeCoerceFn) [ comp ])+    | unsafeCoerceFn == C.unsafeCoerceFn     = comp   convert other = other  inlineUnsafePartial :: AST -> AST inlineUnsafePartial = everywhereTopDown convert where-  convert (App ss (Indexer _ (StringLiteral _ unsafePartial) (Var _ partialUnsafe)) [ comp ])-    | unsafePartial == C.unsafePartial && partialUnsafe == C.partialUnsafe+  convert (App ss (ModuleAccessor _ C.PartialUnsafe unsafePartial) [ comp ])+    | unsafePartial == C.unsafePartial     -- Apply to undefined here, the application should be optimized away     -- if it is safe to do so     = App ss comp [ Var ss C.undefined ]   convert other = other -semiringNumber :: forall a b. (IsString a, IsString b) => (a, b)-semiringNumber = (C.dataSemiring, C.semiringNumber)+semiringNumber :: forall a. IsString a => (ModuleName, a)+semiringNumber = (C.DataSemiring, C.semiringNumber) -semiringInt :: forall a b. (IsString a, IsString b) => (a, b)-semiringInt = (C.dataSemiring, C.semiringInt)+semiringInt :: forall a. IsString a => (ModuleName, a)+semiringInt = (C.DataSemiring, C.semiringInt) -ringNumber :: forall a b. (IsString a, IsString b) => (a, b)-ringNumber = (C.dataRing, C.ringNumber)+ringNumber :: forall a. IsString a => (ModuleName, a)+ringNumber = (C.DataRing, C.ringNumber) -ringInt :: forall a b. (IsString a, IsString b) => (a, b)-ringInt = (C.dataRing, C.ringInt)+ringInt :: forall a. IsString a => (ModuleName, a)+ringInt = (C.DataRing, C.ringInt) -euclideanRingNumber :: forall a b. (IsString a, IsString b) => (a, b)-euclideanRingNumber = (C.dataEuclideanRing, C.euclideanRingNumber)+euclideanRingNumber :: forall a. IsString a => (ModuleName, a)+euclideanRingNumber = (C.DataEuclideanRing, C.euclideanRingNumber) -eqNumber :: forall a b. (IsString a, IsString b) => (a, b)-eqNumber = (C.dataEq, C.eqNumber)+eqNumber :: forall a. IsString a => (ModuleName, a)+eqNumber = (C.DataEq, C.eqNumber) -eqInt :: forall a b. (IsString a, IsString b) => (a, b)-eqInt = (C.dataEq, C.eqInt)+eqInt :: forall a. IsString a => (ModuleName, a)+eqInt = (C.DataEq, C.eqInt) -eqString :: forall a b. (IsString a, IsString b) => (a, b)-eqString = (C.dataEq, C.eqString)+eqString :: forall a. IsString a => (ModuleName, a)+eqString = (C.DataEq, C.eqString) -eqChar :: forall a b. (IsString a, IsString b) => (a, b)-eqChar = (C.dataEq, C.eqChar)+eqChar :: forall a. IsString a => (ModuleName, a)+eqChar = (C.DataEq, C.eqChar) -eqBoolean :: forall a b. (IsString a, IsString b) => (a, b)-eqBoolean = (C.dataEq, C.eqBoolean)+eqBoolean :: forall a. IsString a => (ModuleName, a)+eqBoolean = (C.DataEq, C.eqBoolean) -ordBoolean :: forall a b. (IsString a, IsString b) => (a, b)-ordBoolean = (C.dataOrd, C.ordBoolean)+ordBoolean :: forall a. IsString a => (ModuleName, a)+ordBoolean = (C.DataOrd, C.ordBoolean) -ordNumber :: forall a b. (IsString a, IsString b) => (a, b)-ordNumber = (C.dataOrd, C.ordNumber)+ordNumber :: forall a. IsString a => (ModuleName, a)+ordNumber = (C.DataOrd, C.ordNumber) -ordInt :: forall a b. (IsString a, IsString b) => (a, b)-ordInt = (C.dataOrd, C.ordInt)+ordInt :: forall a. IsString a => (ModuleName, a)+ordInt = (C.DataOrd, C.ordInt) -ordString :: forall a b. (IsString a, IsString b) => (a, b)-ordString = (C.dataOrd, C.ordString)+ordString :: forall a. IsString a => (ModuleName, a)+ordString = (C.DataOrd, C.ordString) -ordChar :: forall a b. (IsString a, IsString b) => (a, b)-ordChar = (C.dataOrd, C.ordChar)+ordChar :: forall a. IsString a => (ModuleName, a)+ordChar = (C.DataOrd, C.ordChar) -semigroupString :: forall a b. (IsString a, IsString b) => (a, b)-semigroupString = (C.dataSemigroup, C.semigroupString)+semigroupString :: forall a. IsString a => (ModuleName, a)+semigroupString = (C.DataSemigroup, C.semigroupString) -boundedBoolean :: forall a b. (IsString a, IsString b) => (a, b)-boundedBoolean = (C.dataBounded, C.boundedBoolean)+boundedBoolean :: forall a. IsString a => (ModuleName, a)+boundedBoolean = (C.DataBounded, C.boundedBoolean) -heytingAlgebraBoolean :: forall a b. (IsString a, IsString b) => (a, b)-heytingAlgebraBoolean = (C.dataHeytingAlgebra, C.heytingAlgebraBoolean)+heytingAlgebraBoolean :: forall a. IsString a => (ModuleName, a)+heytingAlgebraBoolean = (C.DataHeytingAlgebra, C.heytingAlgebraBoolean) -semigroupoidFn :: forall a b. (IsString a, IsString b) => (a, b)-semigroupoidFn = (C.controlSemigroupoid, C.semigroupoidFn)+semigroupoidFn :: forall a. IsString a => (ModuleName, a)+semigroupoidFn = (C.ControlSemigroupoid, C.semigroupoidFn) -opAdd :: forall a b. (IsString a, IsString b) => (a, b)-opAdd = (C.dataSemiring, C.add)+opAdd :: forall a. IsString a => (ModuleName, a)+opAdd = (C.DataSemiring, C.add) -opMul :: forall a b. (IsString a, IsString b) => (a, b)-opMul = (C.dataSemiring, C.mul)+opMul :: forall a. IsString a => (ModuleName, a)+opMul = (C.DataSemiring, C.mul) -opEq :: forall a b. (IsString a, IsString b) => (a, b)-opEq = (C.dataEq, C.eq)+opEq :: forall a. IsString a => (ModuleName, a)+opEq = (C.DataEq, C.eq) -opNotEq :: forall a b. (IsString a, IsString b) => (a, b)-opNotEq = (C.dataEq, C.notEq)+opNotEq :: forall a. IsString a => (ModuleName, a)+opNotEq = (C.DataEq, C.notEq) -opLessThan :: forall a b. (IsString a, IsString b) => (a, b)-opLessThan = (C.dataOrd, C.lessThan)+opLessThan :: forall a. IsString a => (ModuleName, a)+opLessThan = (C.DataOrd, C.lessThan) -opLessThanOrEq :: forall a b. (IsString a, IsString b) => (a, b)-opLessThanOrEq = (C.dataOrd, C.lessThanOrEq)+opLessThanOrEq :: forall a. IsString a => (ModuleName, a)+opLessThanOrEq = (C.DataOrd, C.lessThanOrEq) -opGreaterThan :: forall a b. (IsString a, IsString b) => (a, b)-opGreaterThan = (C.dataOrd, C.greaterThan)+opGreaterThan :: forall a. IsString a => (ModuleName, a)+opGreaterThan = (C.DataOrd, C.greaterThan) -opGreaterThanOrEq :: forall a b. (IsString a, IsString b) => (a, b)-opGreaterThanOrEq = (C.dataOrd, C.greaterThanOrEq)+opGreaterThanOrEq :: forall a. IsString a => (ModuleName, a)+opGreaterThanOrEq = (C.DataOrd, C.greaterThanOrEq) -opAppend :: forall a b. (IsString a, IsString b) => (a, b)-opAppend = (C.dataSemigroup, C.append)+opAppend :: forall a. IsString a => (ModuleName, a)+opAppend = (C.DataSemigroup, C.append) -opSub :: forall a b. (IsString a, IsString b) => (a, b)-opSub = (C.dataRing, C.sub)+opSub :: forall a. IsString a => (ModuleName, a)+opSub = (C.DataRing, C.sub) -opNegate :: forall a b. (IsString a, IsString b) => (a, b)-opNegate = (C.dataRing, C.negate)+opNegate :: forall a. IsString a => (ModuleName, a)+opNegate = (C.DataRing, C.negate) -opDiv :: forall a b. (IsString a, IsString b) => (a, b)-opDiv = (C.dataEuclideanRing, C.div)+opDiv :: forall a. IsString a => (ModuleName, a)+opDiv = (C.DataEuclideanRing, C.div) -opConj :: forall a b. (IsString a, IsString b) => (a, b)-opConj = (C.dataHeytingAlgebra, C.conj)+opConj :: forall a. IsString a => (ModuleName, a)+opConj = (C.DataHeytingAlgebra, C.conj) -opDisj :: forall a b. (IsString a, IsString b) => (a, b)-opDisj = (C.dataHeytingAlgebra, C.disj)+opDisj :: forall a. IsString a => (ModuleName, a)+opDisj = (C.DataHeytingAlgebra, C.disj) -opNot :: forall a b. (IsString a, IsString b) => (a, b)-opNot = (C.dataHeytingAlgebra, C.not)+opNot :: forall a. IsString a => (ModuleName, a)+opNot = (C.DataHeytingAlgebra, C.not)
src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs view
@@ -6,10 +6,10 @@ import Protolude (ordNub)  import Data.Maybe (fromJust, isJust)-import Data.Text (Text)  import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common+import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (mkString) import qualified Language.PureScript.Constants.Prelude as C @@ -28,15 +28,15 @@ --    ... --  } magicDoEff :: AST -> AST-magicDoEff = magicDo C.eff C.effDictionaries+magicDoEff = magicDo C.Eff C.effDictionaries  magicDoEffect :: AST -> AST-magicDoEffect = magicDo C.effect C.effectDictionaries+magicDoEffect = magicDo C.Effect C.effectDictionaries  magicDoST :: AST -> AST-magicDoST = magicDo C.st C.stDictionaries+magicDoST = magicDo C.ST C.stDictionaries -magicDo :: Text -> C.EffectDictionaries -> AST -> AST+magicDo :: ModuleName -> 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@@ -72,7 +72,7 @@   isBind _ = False   -- Check if an expression represents a call to @discard@   isDiscard (App _ (App _ fn [dict1]) [dict2])-    | isDict (C.controlBind, C.discardUnitDictionary) dict1 &&+    | isDict (C.ControlBind, C.discardUnitDictionary) dict1 &&       isDict (effectModule, edBindDict) dict2 &&       isDiscardPoly fn = True   isDiscard _ = False@@ -80,13 +80,13 @@   isPure (App _ fn [dict]) | isDict (effectModule, edApplicativeDict) dict && isPurePoly fn = True   isPure _ = False   -- Check if an expression represents the polymorphic >>= function-  isBindPoly = isDict (C.controlBind, C.bind)+  isBindPoly = isDict (C.ControlBind, C.bind)   -- Check if an expression represents the polymorphic pure function-  isPurePoly = isDict (C.controlApplicative, C.pure')+  isPurePoly = isDict (C.ControlApplicative, C.pure')   -- Check if an expression represents the polymorphic discard function-  isDiscardPoly = isDict (C.controlBind, C.discard)+  isDiscardPoly = isDict (C.ControlBind, C.discard)   -- Check if an expression represents a function in the Effect module-  isEffFunc name (Indexer _ (StringLiteral _ name') (Var _ eff)) = eff == effectModule && name == name'+  isEffFunc name (ModuleAccessor _ eff name') = eff == effectModule && name == name'   isEffFunc _ _ = False    applyReturns :: AST -> AST@@ -125,7 +125,7 @@     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-  isSTFunc name (Indexer _ (StringLiteral _ name') (Var _ st)) = st == C.st && name == name'+  isSTFunc name (ModuleAccessor _ C.ST name') = name == name'   isSTFunc _ _ = False   -- Find all ST Refs initialized in this block   findSTRefsIn = everything (++) isSTRef
src/Language/PureScript/Docs/Prim.hs view
@@ -258,12 +258,22 @@   , ""   , "Construct types of this kind using the same literal syntax as documented"   , "for strings."+  , ""+  , "    type Hello :: Symbol"+  , "    type Hello = \"Hello, world\""+  , ""   ]  kindRow :: Declaration kindRow = primType "Row" $ T.unlines   [ "`Row` is the kind constructor of label-indexed types which map type-level strings to other types."-  , "For example, the kind of `Record` is `Row Type -> Type`, mapping field names to values."+  , "The most common use of `Row` is `Row Type`, a row mapping labels to basic (of kind `Type`) types:"+  , ""+  , "    type ExampleRow :: Row Type"+  , "    type ExampleRow = ( name :: String, values :: Array Int )"+  , ""+  , "This is the kind of `Row` expected by the `Record` type constructor."+  , "More advanced row kinds like `Row (Type -> Type)` are used much less frequently."   ]  function :: Declaration@@ -322,20 +332,46 @@ number = primType "Number" $ T.unlines   [ "A double precision floating point number (IEEE 754)."   , ""-  , "Construct values of this type with literals:"+  , "Construct values of this type with literals."+  , "Negative literals must be wrapped in parentheses if the negation sign could be mistaken"+  , "for an infix operator:"   , ""-  , "    y = 35.23 :: Number"-  , "    z = 1.224e6 :: Number"+  , "    x = 35.23 :: Number"+  , "    y = -1.224e6 :: Number"+  , "    z = exp (-1.0) :: Number"   ]  int :: Declaration int = primType "Int" $ T.unlines-  [ "A 32-bit signed integer. See the purescript-integers package for details"+  [ "A 32-bit signed integer. See the `purescript-integers` package for details"   , "of how this is accomplished when compiling to JavaScript."   , ""-  , "Construct values of this type with literals:"+  , "Construct values of this type with literals. Hexadecimal syntax is supported."+  , "Negative literals must be wrapped in parentheses if the negation sign could be mistaken"+  , "for an infix operator:"   , ""-  , "    x = 23 :: Int"+  , "    x = -23 :: Int"+  , "    y = 0x17 :: Int"+  , "    z = complement (-24) :: Int"+  , ""+  , "Integers used as types are considered to have kind `Int`."+  , "Unlike value-level `Int`s, which must be representable as a 32-bit signed integer,"+  , "type-level `Int`s are unbounded. Hexadecimal support is also supported at the type level."+  , ""+  , "    type One :: Int"+  , "    type One = 1"+  , "    "+  , "    type Beyond32BitSignedInt :: Int"+  , "    type Beyond32BitSignedInt = 2147483648"+  , "    "+  , "    type HexInt :: Int"+  , "    type HexInt = 0x17"+  , ""+  , "Negative integer literals at the type level must be"+  , "wrapped in parentheses if the negation sign could be mistaken for an infix operator."+  , ""+  , "    type NegativeOne = -1"+  , "    foo :: Proxy (-1) -> ..."   ]  string :: Declaration@@ -348,26 +384,37 @@   , ""   , "    x = \"hello, world\" :: String"   , ""-  , "Multi-line string literals are also supported with triple quotes (`\"\"\"`)."+  , "Multi-line string literals are also supported with triple quotes (`\"\"\"`):"+  , ""+  , "    x = \"\"\"multi"+  , "       line\"\"\""+  , ""+  , "At the type level, string literals represent types with kind `Symbol`."+  , "These types will have kind `String` in a future release:"+  , ""+  , "    type Hello :: Symbol"+  , "    type Hello = \"Hello, world\""   ]  char :: Declaration char = primType "Char" $ T.unlines-   [ "A single character (UTF-16 code unit). The JavaScript representation is a"-   , "normal String, which is guaranteed to contain one code unit. This means"-   , "that astral plane characters (i.e. those with code point values greater"-   , "than 0xFFFF) cannot be represented as Char values."-   , ""-   , "Construct values of this type with literals, using single quotes `'`:"-   , ""-   , "    x = 'a' :: Char"-   ]+  [ "A single character (UTF-16 code unit). The JavaScript representation is a"+  , "normal `String`, which is guaranteed to contain one code unit. This means"+  , "that astral plane characters (i.e. those with code point values greater"+  , "than `0xFFFF`) cannot be represented as `Char` values."+  , ""+  , "Construct values of this type with literals, using single quotes `'`:"+  , ""+  , "    x = 'a' :: Char"+  ]  boolean :: Declaration boolean = primType "Boolean" $ T.unlines   [ "A JavaScript Boolean value."   , ""   , "Construct values of this type with the literals `true` and `false`."+  , ""+  , "The `True` and `False` types defined in `Prim.Boolean` have this type as their kind."   ]  partial :: Declaration
src/Language/PureScript/Environment.hs view
@@ -581,8 +581,8 @@     -- class Compare (left :: Int) (right :: Int) (ordering :: Ordering) | left right -> ordering     , (primSubName C.moduleInt "Compare", makeTypeClassData         [ ("left", Just tyInt)-        , ("right", Just kindSymbol)-        , ("ordering", Just kindSymbol)+        , ("right", Just tyInt)+        , ("ordering", Just kindOrdering)         ] [] []         [ FunctionalDependency [0, 1] [2]         ] True)
src/Language/PureScript/Errors.hs view
@@ -429,7 +429,7 @@ unwrapErrorMessage (ErrorMessage _ se) = se  replaceUnknowns :: SourceType -> State TypeMap SourceType-replaceUnknowns = everywhereOnTypesM replaceTypes where+replaceUnknowns = everywhereOnTypesTopDownM replaceTypes where   replaceTypes :: SourceType -> State TypeMap SourceType   replaceTypes (TUnknown ann u) = do     m <- get@@ -439,14 +439,17 @@         put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextIndex = u' + 1 }         return (TUnknown ann u')       Just u' -> return (TUnknown ann u')-  replaceTypes (Skolem ann name mbK s sko) = do+  -- We intentionally remove the kinds from skolems, because they are never+  -- presented when pretty-printing. Any unknowns in those kinds shouldn't+  -- appear in the list of unknowns unless used somewhere else.+  replaceTypes (Skolem ann name _ s sko) = do     m <- get     case M.lookup s (umSkolemMap m) of       Nothing -> do         let s' = umNextIndex m         put $ m { umSkolemMap = M.insert s (T.unpack name, s', Just (fst ann)) (umSkolemMap m), umNextIndex = s' + 1 }-        return (Skolem ann name mbK s' sko)-      Just (_, s', _) -> return (Skolem ann name mbK s' sko)+        return (Skolem ann name Nothing s' sko)+      Just (_, s', _) -> return (Skolem ann name Nothing s' sko)   replaceTypes other = return other  onTypesInErrorMessage :: (SourceType -> SourceType) -> ErrorMessage -> ErrorMessage
src/Language/PureScript/Ide/Completion.hs view
@@ -11,6 +11,7 @@  import           Protolude hiding ((<&>), moduleName) +import           Control.Lens hiding (op, (&)) import           Data.Aeson import qualified Data.Map as Map import qualified Data.Text as T@@ -20,7 +21,6 @@ import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           Lens.Micro.Platform hiding ((&))  -- | Applies the CompletionFilters and the Matcher to the given Modules --   and sorts the found Completions according to the Matching Score
src/Language/PureScript/Ide/Externs.hs view
@@ -8,6 +8,7 @@ import           Protolude hiding (to, from, (&))  import           Codec.CBOR.Term as Term+import           Control.Lens hiding (anyOf) import           "monad-logger" Control.Monad.Logger import           Data.Version (showVersion) import qualified Data.Text as Text@@ -16,7 +17,6 @@ import           Language.PureScript.Ide.Error (IdeError (..)) import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util (properNameT)-import           Lens.Micro.Platform  readExternFile   :: (MonadIO m, MonadError IdeError m, MonadLogger m)
src/Language/PureScript/Ide/Imports.hs view
@@ -32,6 +32,7 @@  import           Protolude hiding (moduleName) +import           Control.Lens                       ((^.), (%~), ix, has) import           Data.List                          (findIndex, nubBy, partition) import qualified Data.List.NonEmpty                 as NE import qualified Data.Map                           as Map@@ -46,7 +47,6 @@ import           Language.PureScript.Ide.Prim import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           Lens.Micro.Platform                ((^.), (%~), ix, has) import           System.IO.UTF8                     (writeUTF8FileT)  data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)
src/Language/PureScript/Ide/Reexports.hs view
@@ -24,11 +24,11 @@  import           Protolude hiding (moduleName) +import           Control.Lens                  hiding (anyOf, (&)) 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,6 +41,7 @@  import           Control.Arrow import           Control.Concurrent.STM+import           Control.Lens                       hiding (anyOf, op, (&)) import           "monad-logger" Control.Monad.Logger import           Data.IORef import qualified Data.Map.Lazy                      as Map@@ -54,7 +55,6 @@ import           Language.PureScript.Ide.SourceFile import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           Lens.Micro.Platform                hiding ((&)) import           System.Directory (getModificationTime)  -- | Resets all State inside psc-ide
src/Language/PureScript/Ide/Types.hs view
@@ -8,6 +8,7 @@ import           Protolude hiding (moduleName)  import           Control.Concurrent.STM (TVar)+import           Control.Lens hiding (op, (.=)) import           Control.Monad.Fail (fail) import           Data.Aeson (ToJSON, FromJSON, (.=)) import qualified Data.Aeson as Aeson@@ -17,7 +18,6 @@ import qualified Language.PureScript as P import qualified Language.PureScript.Errors.JSON as P import           Language.PureScript.Ide.Filter.Declaration (DeclarationType(..))-import           Lens.Micro.Platform hiding ((.=))  type ModuleIdent = Text type ModuleMap a = Map P.ModuleName a
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
@@ -32,6 +32,7 @@ import           Protolude                           hiding (decodeUtf8,                                                       encodeUtf8, to) +import           Control.Lens                        hiding (op, (&)) import           Data.Aeson import qualified Data.Text                           as T import qualified Data.Text.Lazy                      as TL@@ -40,7 +41,6 @@ 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)
src/Language/PureScript/Linter.hs view
@@ -235,6 +235,7 @@     go (Constructor _ _) = mempty     go (TypeClassDictionary _ _ _) = mempty     go (DeferredDictionary _ _) = mempty+    go (DerivedInstancePlaceholder _ _) = mempty     go AnonymousArgument = mempty     go (Hole _) = mempty
src/Language/PureScript/Linter/Wildcards.hs view
@@ -22,11 +22,18 @@ ignoreWildcardsUnderCompleteTypeSignatures :: Declaration -> Declaration ignoreWildcardsUnderCompleteTypeSignatures = onDecl   where-  (onDecl, _, _, _, _) = everywhereWithContextOnValues False (,) handleExpr (,) (,) (,)+  (onDecl, _, _, _, _) = everywhereWithContextOnValues False (,) handleExpr handleBinder (,) (,)+   handleExpr isCovered = \case     tv@(TypedValue chk v ty)       | isCovered -> (True, TypedValue chk v $ ignoreWildcards ty)       | otherwise -> (isComplete ty, tv)+    other -> (isCovered, other)++  handleBinder isCovered = \case+    tb@(TypedBinder ty b)+      | isCovered -> (True, TypedBinder (ignoreWildcards ty) b)+      | otherwise -> (isComplete ty, tb)     other -> (isCovered, other)  ignoreWildcards :: Type a -> Type a
src/Language/PureScript/Pretty/Values.hs view
@@ -87,6 +87,7 @@ -- TODO: constraint kind args prettyPrintValue d (TypeClassDictionary (Constraint _ name _ tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ T.unpack (runProperName (disqualify name))) : map (typeAtomAsBox d) tys prettyPrintValue _ (DeferredDictionary name _) = text $ "#dict " ++ T.unpack (runProperName (disqualify name))+prettyPrintValue _ (DerivedInstancePlaceholder name _) = text $ "#derived " ++ T.unpack (runProperName (disqualify name)) prettyPrintValue d (TypedValue _ val _) = prettyPrintValue d val prettyPrintValue d (PositionedValue _ _ val) = prettyPrintValue d val prettyPrintValue d (Literal _ l) = prettyPrintLiteralValue d l
src/Language/PureScript/Sugar.hs view
@@ -3,23 +3,17 @@ -- module Language.PureScript.Sugar (desugar, module S) where -import Prelude- import Control.Category ((>>>)) import Control.Monad import Control.Monad.Error.Class (MonadError) import Control.Monad.Supply.Class (MonadSupply) import Control.Monad.State.Class (MonadState) import Control.Monad.Writer.Class (MonadWriter)-import Data.Maybe (mapMaybe) -import qualified Data.Map as M- import Language.PureScript.AST import Language.PureScript.Errors import Language.PureScript.Externs import Language.PureScript.Linter.Imports-import Language.PureScript.Names import Language.PureScript.Sugar.BindingGroups as S import Language.PureScript.Sugar.CaseDeclarations as S import Language.PureScript.Sugar.DoNotation as S@@ -31,7 +25,6 @@ import Language.PureScript.Sugar.TypeClasses as S import Language.PureScript.Sugar.TypeClasses.Deriving as S import Language.PureScript.Sugar.TypeDeclarations as S-import Language.PureScript.TypeChecker.Synonyms (SynonymMap)  -- | -- The desugaring pipeline proceeds as follows:@@ -77,25 +70,6 @@     >=> desugarImports     >=> rebracket externs     >=> checkFixityExports-    >=> (\m ->-      -- We need to collect type synonym information, since synonyms will not be-      -- removed until later, during type checking.-      let syns = findTypeSynonyms externs (getModuleName m) $ getModuleDeclarations m-      -- We cannot prevent ill-kinded expansions of type synonyms without-      -- knowing their kinds but they're not available yet.-          kinds = mempty-       in deriveInstances externs syns kinds m)+    >=> deriveInstances     >=> desugarTypeClasses externs     >=> createBindingGroupsModule--findTypeSynonyms :: [ExternsFile] -> ModuleName -> [Declaration] -> SynonymMap-findTypeSynonyms externs mn decls =-    M.fromList $ (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)-              ++ mapMaybe fromLocalDecl decls-  where-    fromExternsDecl mn' (EDTypeSynonym name args ty) = Just (Qualified (Just mn') name, (args, ty))-    fromExternsDecl _ _ = Nothing--    fromLocalDecl (TypeSynonymDeclaration _ name args ty) =-      Just (Qualified (Just mn) name, (args, ty))-    fromLocalDecl _ = Nothing
src/Language/PureScript/Sugar/TypeClasses.hs view
@@ -206,22 +206,27 @@   go d@(TypeClassDeclaration sa name args implies deps members) = do     modify (M.insert (mn, name) (makeTypeClassData args (map memberToNameAndType members) implies deps False))     return (Nothing, d : typeClassDictionaryDeclaration sa name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)-  go (TypeInstanceDeclaration _ _ _ _ _ _ _ DerivedInstance) = internalError "Derived instanced should have been desugared"-  go (TypeInstanceDeclaration sa chainId idx name deps className tys (ExplicitInstance members))-    | className == C.Coercible-    = throwError . errorMessage' (fst sa) $ InvalidCoercibleInstanceDeclaration tys-    | otherwise = do-    desugared <- desugarCases members+  go (TypeInstanceDeclaration sa chainId idx name deps className tys body) = do     name' <- desugarInstName name-    dictDecl <- typeInstanceDictionaryDeclaration sa name' mn deps className tys desugared-    let d = TypeInstanceDeclaration sa chainId idx (Right name') deps className tys (ExplicitInstance members)+    let d = TypeInstanceDeclaration sa chainId idx (Right name') deps className tys body+    let explicitOrNot = case body of+          DerivedInstance -> Left $ DerivedInstancePlaceholder className KnownClassStrategy+          NewtypeInstance -> Left $ DerivedInstancePlaceholder className NewtypeStrategy+          ExplicitInstance members -> Right members+    dictDecl <- case explicitOrNot of+      Right members+        | className == C.Coercible ->+          throwError . errorMessage' (fst sa) $ InvalidCoercibleInstanceDeclaration tys+        | otherwise -> do+          desugared <- desugarCases members+          typeInstanceDictionaryDeclaration sa name' mn deps className tys desugared+      Left dict ->+        let+          dictTy = foldl srcTypeApp (srcTypeConstructor (fmap (coerceProperName . dictTypeName) className)) tys+          constrainedTy = quantify (foldr srcConstrainedType dictTy deps)+        in+          return $ ValueDecl sa name' Private [] [MkUnguarded (TypedValue True dict constrainedTy)]     return (expRef name' className tys, [d, dictDecl])-  go (TypeInstanceDeclaration sa chainId idx name deps className tys (NewtypeInstanceWithDictionary dict)) = do-    name' <- desugarInstName name-    let dictTy = foldl srcTypeApp (srcTypeConstructor (fmap (coerceProperName . dictTypeName) className)) tys-        constrainedTy = quantify (foldr srcConstrainedType dictTy deps)-        d = TypeInstanceDeclaration sa chainId idx (Right name') deps className tys (NewtypeInstanceWithDictionary dict)-    return (expRef name' className tys, [d, ValueDecl sa name' Private [] [MkUnguarded (TypedValue True dict constrainedTy)]])   go other = return (Nothing, [other])    -- |
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs view
@@ -2,297 +2,92 @@ module Language.PureScript.Sugar.TypeClasses.Deriving (deriveInstances) where  import           Prelude.Compat-import           Protolude (ordNub)+import           Protolude (note) -import           Control.Arrow (second)-import           Control.Monad (replicateM, zipWithM, unless, when) import           Control.Monad.Error.Class (MonadError(..))-import           Control.Monad.Writer.Class (MonadWriter(..)) import           Control.Monad.Supply.Class (MonadSupply)-import           Data.Foldable (for_)-import           Data.List (foldl', find, sortOn, unzip5)-import qualified Data.Map as M-import           Data.Maybe (fromMaybe)-import qualified Data.Set as S-import           Data.Text (Text)+import           Data.List (foldl', find, unzip5) import           Language.PureScript.AST+import           Language.PureScript.AST.Utils import qualified Language.PureScript.Constants.Data.Generic.Rep as DataGenericRep import qualified Language.PureScript.Constants.Data.Newtype as DataNewtype-import qualified Language.PureScript.Constants.Prelude as Prelude-import qualified Language.PureScript.Constants.Prim as Prim import           Language.PureScript.Crash import           Language.PureScript.Environment import           Language.PureScript.Errors-import           Language.PureScript.Externs import           Language.PureScript.Names-import           Language.PureScript.Label (Label(..)) import           Language.PureScript.PSString (mkString) import           Language.PureScript.Types import           Language.PureScript.TypeChecker (checkNewtype)-import           Language.PureScript.TypeChecker.Synonyms (SynonymMap, KindMap, replaceAllTypeSynonymsM) --- | When deriving an instance for a newtype, we must ensure that all superclass--- instances were derived in the same way. This data structure is used to ensure--- this property.-data NewtypeDerivedInstances = NewtypeDerivedInstances-  { ndiClasses :: M.Map (ModuleName, ProperName 'ClassName) ([Text], [SourceConstraint], [FunctionalDependency])-  -- ^ A list of superclass constraints for each type class. Since type classes-  -- have not been desugared here, we need to track this.-  , ndiDerivedInstances :: S.Set ((ModuleName, ProperName 'ClassName), (ModuleName, ProperName 'TypeName))-  -- ^ A list of newtype instances which were derived in this module.-  } deriving Show--instance 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.------ Note: since newtypes in newtype instances can only be applied to type arguments--- (no flexible instances allowed), we don't need to bother with unification when--- looking for matching superclass instances, which saves us a lot of work. Instead,--- we just match the newtype name.-extractNewtypeName :: ModuleName -> [SourceType] -> Maybe (ModuleName, ProperName 'TypeName)-extractNewtypeName _ [] = Nothing-extractNewtypeName mn xs = go (last xs) where-  go (TypeApp _ ty (TypeVar _ _)) = go ty-  go (TypeConstructor _ name) = Just (qualify mn name)-  go _ = Nothing- -- | Elaborates deriving instance declarations by code generation. deriveInstances   :: forall m-   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)-  => [ExternsFile]-  -> SynonymMap-  -> KindMap-  -> Module+   . (MonadError MultipleErrors m, MonadSupply m)+  => Module   -> m Module-deriveInstances externs syns kinds (Module ss coms mn ds exts) =-    Module ss coms mn <$> mapM (deriveInstance mn syns kinds instanceData ds) ds <*> pure exts-  where-    instanceData :: NewtypeDerivedInstances-    instanceData =-        foldMap (\ExternsFile{..} -> foldMap (fromExternsDecl efModuleName) efDeclarations) externs <> foldMap fromLocalDecl ds-      where-        fromExternsDecl mn' EDClass{..} =-          NewtypeDerivedInstances (M.singleton (mn', edClassName) (map fst edClassTypeArguments, edClassConstraints, edFunctionalDependencies)) mempty-        fromExternsDecl mn' EDInstance{..} =-          foldMap (\nm -> NewtypeDerivedInstances mempty (S.singleton (qualify mn' edInstanceClassName, nm))) (extractNewtypeName mn' edInstanceTypes)-        fromExternsDecl _ _ = mempty--        fromLocalDecl (TypeClassDeclaration _ cl args cons deps _) =-          NewtypeDerivedInstances (M.singleton (mn, cl) (map fst args, cons, deps)) mempty-        fromLocalDecl (TypeInstanceDeclaration _ _ _ _ _ cl tys _) =-          foldMap (\nm -> NewtypeDerivedInstances mempty (S.singleton (qualify mn cl, nm))) (extractNewtypeName mn tys)-        fromLocalDecl _ = mempty+deriveInstances (Module ss coms mn ds exts) =+    Module ss coms mn <$> mapM (deriveInstance mn ds) ds <*> pure exts  -- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration, -- elaborates that into an instance declaration via code generation.+--+-- More instance deriving happens during type checking. The instances+-- derived here are special for two reasons:+-- * they depend only on the structure of the data, not types; and+-- * they expect wildcard types from the user and generate type expressions+--   to replace them.+-- deriveInstance-  :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)+  :: forall m+   . (MonadError MultipleErrors m, MonadSupply m)   => ModuleName-  -> SynonymMap-  -> KindMap-  -> NewtypeDerivedInstances   -> [Declaration]   -> Declaration   -> m Declaration-deriveInstance mn syns kinds _ ds (TypeInstanceDeclaration sa@(ss, _) ch idx nm deps className tys DerivedInstance)-  | className == Qualified (Just dataEq) (ProperName "Eq")-  = case tys of-      [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty-           , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveEq ss mn syns kinds ds tyCon-           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1-  | className == Qualified (Just dataEq) (ProperName "Eq1")-  = case tys of-      [ty] | Just (Qualified mn' _, _) <- unwrapTypeConstructor ty-           , mn == fromMaybe mn mn'-           -> pure . TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance $ deriveEq1 ss-           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1-  | className == Qualified (Just dataOrd) (ProperName "Ord")-  = case tys of-      [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty-           , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveOrd ss mn syns kinds ds tyCon-           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1-  | className == Qualified (Just dataOrd) (ProperName "Ord1")-  = case tys of-      [ty] | Just (Qualified mn' _, _) <- unwrapTypeConstructor ty-           , mn == fromMaybe mn mn'-           -> pure . TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance $ deriveOrd1 ss-           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1-  | className == Qualified (Just dataFunctor) (ProperName "Functor")-  = case tys of-      [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty-           , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveFunctor ss mn syns kinds ds tyCon-           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty-      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1-  | className == DataNewtype.Newtype-  = case tys of-      [wrappedTy, unwrappedTy]-        | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy-        , mn == fromMaybe mn mn'-        -> do actualUnwrappedTy <- deriveNewtype ss syns kinds ds tyCon args unwrappedTy-              return $ TypeInstanceDeclaration sa ch idx nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance [])-        | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys wrappedTy-      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2-  | className == DataGenericRep.Generic-  = case tys of-      [actualTy, repTy]-        | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor actualTy-        , mn == fromMaybe mn mn'-        -> do (inst, inferredRepTy) <- deriveGenericRep ss mn syns kinds ds tyCon args repTy-              return $ TypeInstanceDeclaration sa ch idx nm deps className [actualTy, inferredRepTy] (ExplicitInstance inst)-        | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys actualTy-      _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2-  | otherwise = throwError . errorMessage' ss $ CannotDerive className tys-deriveInstance mn syns kinds ndis ds (TypeInstanceDeclaration sa@(ss, _) ch idx nm deps className tys NewtypeInstance) =-  case tys of-    _ : _ | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor (last tys)-          , mn == fromMaybe mn mn'-          -> TypeInstanceDeclaration sa ch idx nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance ss mn syns kinds ndis className ds tys tyCon args-          | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys (last tys)-    _ -> throwError . errorMessage' ss $ InvalidNewtypeInstance className tys-deriveInstance _ _ _ _ _ e = return e--unwrapTypeConstructor :: SourceType -> Maybe (Qualified (ProperName 'TypeName), [SourceType])-unwrapTypeConstructor = fmap (second reverse) . go-  where-  go (TypeConstructor _ tyCon) = Just (tyCon, [])-  go (TypeApp _ ty arg) = do-    (tyCon, args) <- go ty-    return (tyCon, arg : args)-  go _ = Nothing--deriveNewtypeInstance-  :: forall m-   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => SourceSpan-  -> ModuleName-  -> SynonymMap-  -> KindMap-  -> NewtypeDerivedInstances-  -> Qualified (ProperName 'ClassName)-  -> [Declaration]-  -> [SourceType]-  -> ProperName 'TypeName-  -> [SourceType]-  -> m Expr-deriveNewtypeInstance ss mn syns kinds ndis className ds tys tyConNm dargs = do-    verifySuperclasses-    tyCon <- findTypeDecl ss tyConNm ds-    go tyCon-  where-    go (DataDeclaration _ Newtype _ tyArgNames [DataConstructorDeclaration _ _ [(_, wrapped)]]) = do-      -- The newtype might not be applied to all type arguments.-      -- This is okay as long as the newtype wraps something which ends with-      -- sufficiently many type applications to variables.-      -- For example, we can derive Functor for-      ---      -- newtype MyArray a = MyArray (Array a)-      ---      -- since Array a is a type application which uses the last-      -- type argument-      wrapped' <- replaceAllTypeSynonymsM syns kinds wrapped-      case stripRight (takeReverse (length tyArgNames - length dargs) tyArgNames) wrapped' of-        Just wrapped'' -> do-          let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs-          wrapped''' <- replaceAllTypeSynonymsM syns kinds $ replaceAllTypeVars subst wrapped''-          tys' <- mapM (replaceAllTypeSynonymsM syns kinds) tys-          return (DeferredDictionary className (init tys' ++ [wrapped''']))-        Nothing -> throwError . errorMessage' ss $ InvalidNewtypeInstance className tys-    go _ = throwError . errorMessage' ss $ InvalidNewtypeInstance className tys--    takeReverse :: Int -> [a] -> [a]-    takeReverse n = take n . reverse--    stripRight :: [(Text, Maybe kind)] -> SourceType -> Maybe SourceType-    stripRight [] ty = Just ty-    stripRight ((arg, _) : args) (TypeApp _ t (TypeVar _ arg'))-      | arg == arg' = stripRight args t-    stripRight _ _ = Nothing--    verifySuperclasses :: m ()-    verifySuperclasses =-      for_ (M.lookup (qualify mn className) (ndiClasses ndis)) $ \(args, superclasses, _) ->-        for_ superclasses $ \Constraint{..} -> do-          let constraintClass' = qualify (error "verifySuperclasses: unknown class module") constraintClass-          for_ (M.lookup constraintClass' (ndiClasses ndis)) $ \(_, _, deps) ->-            -- We need to check whether the newtype is mentioned, because of classes like MonadWriter-            -- with its Monoid superclass constraint.-            when (not (null args) && any ((last args `elem`) . usedTypeVariables) constraintArgs) $ do-              -- For now, we only verify superclasses where the newtype is the only argument,-              -- or for which all other arguments are determined by functional dependencies.-              -- Everything else raises a UnverifiableSuperclassInstance warning.-              -- This covers pretty much all cases we're interested in, but later we might want to do-              -- more work to extend this to other superclass relationships.-              let determined = map (srcTypeVar . (args !!)) . ordNub . concatMap fdDetermined . filter ((== [length args - 1]) . fdDeterminers) $ deps-              if eqType (last constraintArgs) (srcTypeVar (last args)) && all (`elem` determined) (init constraintArgs)-                then do-                  -- Now make sure that a superclass instance was derived. Again, this is not a complete-                  -- check, since the superclass might have multiple type arguments, so overlaps might still-                  -- be possible, so we warn again.-                  for_ (extractNewtypeName mn tys) $ \nm ->-                    unless ((constraintClass', nm) `S.member` ndiDerivedInstances ndis) $-                      tell . errorMessage' ss $ MissingNewtypeSuperclassInstance constraintClass className tys-                else tell . errorMessage' ss $ UnverifiableSuperclassInstance constraintClass className tys--dataEq :: ModuleName-dataEq = ModuleName "Data.Eq"--dataOrd :: ModuleName-dataOrd = ModuleName "Data.Ord"--dataFunctor :: ModuleName-dataFunctor = ModuleName "Data.Functor"+deriveInstance mn ds decl =+  case decl of+    TypeInstanceDeclaration sa@(ss, _) ch idx nm deps className tys DerivedInstance -> let+      binaryWildcardClass :: (Declaration -> [SourceType] -> m ([Declaration], SourceType)) -> m Declaration+      binaryWildcardClass f = case tys of+        [ty1, ty2] -> case unwrapTypeConstructor ty1 of+          Just (Qualified (Just mn') tyCon, _, args) | mn == mn' -> do+            checkIsWildcard ss tyCon ty2+            tyConDecl <- findTypeDecl ss tyCon ds+            (members, ty2') <- f tyConDecl args+            pure $ TypeInstanceDeclaration sa ch idx nm deps className [ty1, ty2'] (ExplicitInstance members)+          _ -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty1+        _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2 -unguarded :: Expr -> [GuardedExpr]-unguarded e = [MkUnguarded e]+      in case className of+        DataNewtype.Newtype -> binaryWildcardClass deriveNewtype+        DataGenericRep.Generic -> binaryWildcardClass (deriveGenericRep ss mn)+        _ -> pure decl+    _ -> pure decl  deriveGenericRep   :: forall m    . (MonadError MultipleErrors m, MonadSupply m)   => SourceSpan   -> ModuleName-  -> SynonymMap-  -> KindMap-  -> [Declaration]-  -> ProperName 'TypeName+  -> Declaration   -> [SourceType]-  -> SourceType   -> m ([Declaration], SourceType)-deriveGenericRep ss mn syns kinds ds tyConNm tyConArgs repTy = do-    checkIsWildcard ss tyConNm repTy-    go =<< findTypeDecl ss tyConNm ds-  where-    go :: Declaration -> m ([Declaration], SourceType)-    go (DataDeclaration (ss', _) _ _ args dctors) = do+deriveGenericRep ss mn tyCon tyConArgs =+  case tyCon of+    DataDeclaration (ss', _) _ _ args dctors -> do       x <- freshIdent "x"       (reps, to, from) <- unzip3 <$> traverse makeInst dctors       let rep = toRepTy reps           inst | null reps =                    -- If there are no cases, spin                    [ ValueDecl (ss', []) (Ident "to") Public [] $ unguarded $-                      lamCase ss' x+                      lamCase x                         [ CaseAlternative                             [NullBinder]                             (unguarded (App (Var ss DataGenericRep.to) (Var ss' (Qualified Nothing x))))                         ]                    , ValueDecl (ss', []) (Ident "from") Public [] $ unguarded $-                      lamCase ss' x+                      lamCase x                         [ CaseAlternative                             [NullBinder]                             (unguarded (App (Var ss DataGenericRep.from) (Var ss' (Qualified Nothing x))))@@ -300,15 +95,17 @@                    ]                | otherwise =                    [ ValueDecl (ss', []) (Ident "to") Public [] $ unguarded $-                       lamCase ss' x (zipWith ($) (map underBinder (sumBinders (length dctors))) to)+                       lamCase x (zipWith ($) (map underBinder (sumBinders (length dctors))) to)                    , ValueDecl (ss', []) (Ident "from") Public [] $ unguarded $-                       lamCase ss' x (zipWith ($) (map underExpr (sumExprs (length dctors))) from)+                       lamCase x (zipWith ($) (map underExpr (sumExprs (length dctors))) from)                    ]            subst = zipWith ((,) . fst) args tyConArgs       return (inst, replaceAllTypeVars subst rep)-    go _ = internalError "deriveGenericRep go: expected DataDeclaration"+    _ -> internalError "deriveGenericRep: expected DataDeclaration" +    where+     select :: (a -> a) -> (a -> a) -> Int -> [a -> a]     select _ _ 0 = []     select _ _ 1 = [id]@@ -330,7 +127,7 @@       :: DataConstructorDeclaration       -> m (SourceType, CaseAlternative, CaseAlternative)     makeInst (DataConstructorDeclaration _ ctorName args) = do-        args' <- mapM (replaceAllTypeSynonymsM syns kinds . snd) args+        let args' = map snd args         (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args'         return ( srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Constructor)                                   (srcTypeLevelString $ mkString (runProperName ctorName)))@@ -382,202 +179,22 @@ checkIsWildcard ss tyConNm _ =   throwError . errorMessage' ss $ ExpectedWildcard tyConNm -deriveEq-  :: forall m-   . (MonadError MultipleErrors m, MonadSupply m)-  => SourceSpan-  -> ModuleName-  -> SynonymMap-  -> KindMap-  -> [Declaration]-  -> ProperName 'TypeName-  -> m [Declaration]-deriveEq ss mn syns kinds ds tyConNm = do-  tyCon <- findTypeDecl ss tyConNm ds-  eqFun <- mkEqFunction tyCon-  return [ ValueDecl (ss, []) (Ident Prelude.eq) Public [] (unguarded eqFun) ]-  where-    mkEqFunction :: Declaration -> m Expr-    mkEqFunction (DataDeclaration (ss', _) _ _ _ args) = do-      x <- freshIdent "x"-      y <- freshIdent "y"-      lamCase2 ss' x y <$> (addCatch <$> mapM mkCtorClause args)-    mkEqFunction _ = internalError "mkEqFunction: expected DataDeclaration"--    preludeConj :: Expr -> Expr -> Expr-    preludeConj = App . App (Var ss (Qualified (Just (ModuleName "Data.HeytingAlgebra")) (Ident Prelude.conj)))--    preludeEq :: Expr -> Expr -> Expr-    preludeEq = App . App (Var ss (Qualified (Just dataEq) (Ident Prelude.eq)))--    preludeEq1 :: Expr -> Expr -> Expr-    preludeEq1 = App . App (Var ss (Qualified (Just dataEq) (Ident Prelude.eq1)))--    addCatch :: [CaseAlternative] -> [CaseAlternative]-    addCatch xs-      | length xs /= 1 = xs ++ [catchAll]-      | otherwise = xs -- Avoid redundant case-      where-      catchAll = CaseAlternative [NullBinder, NullBinder] (unguarded (Literal ss (BooleanLiteral False)))--    mkCtorClause :: DataConstructorDeclaration -> m CaseAlternative-    mkCtorClause (DataConstructorDeclaration _ ctorName tys) = do-      identsL <- replicateM (length tys) (freshIdent "l")-      identsR <- replicateM (length tys) (freshIdent "r")-      tys' <- mapM (replaceAllTypeSynonymsM syns kinds . snd) tys-      let tests = zipWith3 toEqTest (map (Var ss . Qualified Nothing) identsL) (map (Var ss . Qualified Nothing) identsR) tys'-      return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (unguarded (conjAll tests))-      where-      caseBinder idents = ConstructorBinder ss (Qualified (Just mn) ctorName) (map (VarBinder ss) idents)--    conjAll :: [Expr] -> Expr-    conjAll [] = Literal ss (BooleanLiteral True)-    conjAll xs = foldl1 preludeConj xs--    toEqTest :: Expr -> Expr -> SourceType -> Expr-    toEqTest l r ty-      | Just rec <- objectType ty-      , Just fields <- decomposeRec rec =-          conjAll-          . map (\(Label str, typ) -> toEqTest (Accessor str l) (Accessor str r) typ)-          $ fields-      | isAppliedVar ty = preludeEq1 l r-      | otherwise = preludeEq l r--deriveEq1 :: SourceSpan -> [Declaration]-deriveEq1 ss =-  [ ValueDecl (ss, []) (Ident Prelude.eq1) Public [] (unguarded preludeEq)]-  where-    preludeEq :: Expr-    preludeEq = Var ss (Qualified (Just dataEq) (Ident Prelude.eq))--deriveOrd-  :: forall m-   . (MonadError MultipleErrors m, MonadSupply m)-  => SourceSpan-  -> ModuleName-  -> SynonymMap-  -> KindMap-  -> [Declaration]-  -> ProperName 'TypeName-  -> m [Declaration]-deriveOrd ss mn syns kinds ds tyConNm = do-  tyCon <- findTypeDecl ss tyConNm ds-  compareFun <- mkCompareFunction tyCon-  return [ ValueDecl (ss, []) (Ident Prelude.compare) Public [] (unguarded compareFun) ]-  where-    mkCompareFunction :: Declaration -> m Expr-    mkCompareFunction (DataDeclaration (ss', _) _ _ _ args) = do-      x <- freshIdent "x"-      y <- freshIdent "y"-      lamCase2 ss' x y <$> (addCatch . concat <$> mapM mkCtorClauses (splitLast args))-    mkCompareFunction _ = internalError "mkCompareFunction: expected DataDeclaration"--    splitLast :: [a] -> [(a, Bool)]-    splitLast [] = []-    splitLast [x] = [(x, True)]-    splitLast (x : xs) = (x, False) : splitLast xs--    addCatch :: [CaseAlternative] -> [CaseAlternative]-    addCatch xs-      | null xs = [catchAll] -- No type constructors-      | otherwise = xs-      where-      catchAll = CaseAlternative [NullBinder, NullBinder] (unguarded (orderingCtor "EQ"))--    orderingName :: Text -> Qualified (ProperName a)-    orderingName = Qualified (Just (ModuleName "Data.Ordering")) . ProperName--    orderingCtor :: Text -> Expr-    orderingCtor = Constructor ss . orderingName--    orderingBinder :: Text -> Binder-    orderingBinder name = ConstructorBinder ss (orderingName name) []--    ordCompare :: Expr -> Expr -> Expr-    ordCompare = App . App (Var ss (Qualified (Just dataOrd) (Ident Prelude.compare)))--    ordCompare1 :: Expr -> Expr -> Expr-    ordCompare1 = App . App (Var ss (Qualified (Just dataOrd) (Ident Prelude.compare1)))--    mkCtorClauses :: (DataConstructorDeclaration, Bool) -> m [CaseAlternative]-    mkCtorClauses (DataConstructorDeclaration _ ctorName tys, isLast) = do-      identsL <- replicateM (length tys) (freshIdent "l")-      identsR <- replicateM (length tys) (freshIdent "r")-      tys' <- mapM (replaceAllTypeSynonymsM syns kinds . snd) tys-      let tests = zipWith3 toOrdering (map (Var ss . Qualified Nothing) identsL) (map (Var ss . Qualified Nothing) identsR) tys'-          extras | not isLast = [ CaseAlternative [ ConstructorBinder ss (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)-                                                  , NullBinder-                                                  ]-                                                  (unguarded (orderingCtor "LT"))-                                , CaseAlternative [ NullBinder-                                                  , ConstructorBinder ss (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)-                                                  ]-                                                  (unguarded (orderingCtor "GT"))-                                ]-                 | otherwise = []-      return $ CaseAlternative [ caseBinder identsL-                               , caseBinder identsR-                               ]-                               (unguarded (appendAll tests))-             : extras--      where-      caseBinder idents = ConstructorBinder ss (Qualified (Just mn) ctorName) (map (VarBinder ss) idents)--    appendAll :: [Expr] -> Expr-    appendAll [] = orderingCtor "EQ"-    appendAll [x] = x-    appendAll (x : xs) = Case [x] [ CaseAlternative [orderingBinder "LT"]-                                                    (unguarded (orderingCtor "LT"))-                                  , CaseAlternative [orderingBinder "GT"]-                                                    (unguarded (orderingCtor "GT"))-                                  , CaseAlternative [ NullBinder ]-                                                    (unguarded (appendAll xs))-                                  ]--    toOrdering :: Expr -> Expr -> SourceType -> Expr-    toOrdering l r ty-      | Just rec <- objectType ty-      , Just fields <- decomposeRec rec =-          appendAll-          . map (\(Label str, typ) -> toOrdering (Accessor str l) (Accessor str r) typ)-          $ fields-      | isAppliedVar ty = ordCompare1 l r-      | otherwise = ordCompare l r--deriveOrd1 :: SourceSpan -> [Declaration]-deriveOrd1 ss =-  [ ValueDecl (ss, []) (Ident Prelude.compare1) Public [] (unguarded dataOrdCompare)]-  where-    dataOrdCompare :: Expr-    dataOrdCompare = Var ss (Qualified (Just dataOrd) (Ident Prelude.compare))- deriveNewtype   :: forall m-   . (MonadError MultipleErrors m, MonadSupply m)-  => SourceSpan-  -> SynonymMap-  -> KindMap-  -> [Declaration]-  -> ProperName 'TypeName+   . MonadError MultipleErrors m+  => Declaration   -> [SourceType]-  -> SourceType-  -> m SourceType-deriveNewtype ss syns kinds ds tyConNm tyConArgs unwrappedTy = do-    checkIsWildcard ss tyConNm unwrappedTy-    go =<< findTypeDecl ss tyConNm ds-  where-    go :: Declaration -> m SourceType-    go (DataDeclaration (ss', _) Data name _ _) =+  -> m ([Declaration], SourceType)+deriveNewtype tyCon tyConArgs =+  case tyCon of+    DataDeclaration (ss', _) Data name _ _ ->       throwError . errorMessage' ss' $ CannotDeriveNewtypeForData name-    go (DataDeclaration _ Newtype name args dctors) = do+    DataDeclaration _ Newtype name args dctors -> do       checkNewtype name dctors       let (DataConstructorDeclaration _ _ [(_, ty)]) = head dctors-      ty' <- replaceAllTypeSynonymsM syns kinds ty       let subst = zipWith ((,) . fst) args tyConArgs-      return $ replaceAllTypeVars subst ty'-    go _ = internalError "deriveNewtype go: expected DataDeclaration"+      return ([], replaceAllTypeVars subst ty)+    _ -> internalError "deriveNewtype: expected DataDeclaration"  findTypeDecl   :: (MonadError MultipleErrors m)@@ -585,117 +202,8 @@   -> ProperName 'TypeName   -> [Declaration]   -> m Declaration-findTypeDecl ss tyConNm = maybe (throwError . errorMessage' ss $ CannotFindDerivingType tyConNm) return . find isTypeDecl+findTypeDecl ss tyConNm = note (errorMessage' ss $ CannotFindDerivingType tyConNm) . find isTypeDecl   where   isTypeDecl :: Declaration -> Bool-  isTypeDecl (DataDeclaration _ _ nm _ _) | nm == tyConNm = True+  isTypeDecl (DataDeclaration _ _ nm _ _) = nm == tyConNm   isTypeDecl _ = False--lam :: SourceSpan -> Ident -> Expr -> Expr-lam ss = Abs . VarBinder ss--lamCase :: SourceSpan -> Ident -> [CaseAlternative] -> Expr-lamCase ss s = lam ss s . Case [mkVar ss s]--lamCase2 :: SourceSpan -> Ident -> Ident -> [CaseAlternative] -> Expr-lamCase2 ss s t = lam ss s . lam ss t . Case [mkVar ss s, mkVar ss t]--mkVarMn :: SourceSpan -> Maybe ModuleName -> Ident -> Expr-mkVarMn ss mn = Var ss . Qualified mn--mkVar :: SourceSpan -> Ident -> Expr-mkVar ss = mkVarMn ss Nothing--isAppliedVar :: Type a -> Bool-isAppliedVar (TypeApp _ (TypeVar _ _) _) = True-isAppliedVar _ = False--objectType :: Type a -> Maybe (Type a)-objectType (TypeApp _ (TypeConstructor _ Prim.Record) rec) = Just rec-objectType _ = Nothing--decomposeRec :: SourceType -> Maybe [(Label, SourceType)]-decomposeRec = fmap (sortOn fst) . go-  where go (RCons _ str typ typs) = fmap ((str, typ) :) (go typs)-        go (REmptyKinded _ _) = Just []-        go _ = Nothing--decomposeRec' :: SourceType -> [(Label, SourceType)]-decomposeRec' = sortOn fst . go-  where go (RCons _ str typ typs) = (str, typ) : go typs-        go _ = []--deriveFunctor-  :: forall m-   . (MonadError MultipleErrors m, MonadSupply m)-  => SourceSpan-  -> ModuleName-  -> SynonymMap-  -> KindMap-  -> [Declaration]-  -> ProperName 'TypeName-  -> m [Declaration]-deriveFunctor ss mn syns kinds ds tyConNm = do-  tyCon <- findTypeDecl ss tyConNm ds-  mapFun <- mkMapFunction tyCon-  return [ ValueDecl (ss, []) (Ident Prelude.map) Public [] (unguarded mapFun) ]-  where-    mkMapFunction :: Declaration -> m Expr-    mkMapFunction (DataDeclaration (ss', _) _ _ tys ctors) = case reverse tys of-      [] -> throwError . errorMessage' ss' $ KindsDoNotUnify (kindType -:> kindType) kindType-      ((iTy, _) : _) -> do-        f <- freshIdent "f"-        m <- freshIdent "m"-        lam ss' f . lamCase ss' m <$> mapM (mkCtorClause iTy f) ctors-    mkMapFunction _ = internalError "mkMapFunction: expected DataDeclaration"--    mkCtorClause :: Text -> Ident -> DataConstructorDeclaration -> m CaseAlternative-    mkCtorClause iTyName f (DataConstructorDeclaration _ ctorName ctorTys) = do-      idents <- replicateM (length ctorTys) (freshIdent "v")-      ctorTys' <- mapM (replaceAllTypeSynonymsM syns kinds . snd) ctorTys-      args <- zipWithM transformArg idents ctorTys'-      let ctor = Constructor ss (Qualified (Just mn) ctorName)-          rebuilt = foldl' App ctor args-          caseBinder = ConstructorBinder ss (Qualified (Just mn) ctorName) (VarBinder ss <$> idents)-      return $ CaseAlternative [caseBinder] (unguarded rebuilt)-      where-        fVar = mkVar ss f-        mapVar = mkVarMn ss (Just dataFunctor) (Ident Prelude.map)--        -- TODO: deal with type synonyms, ala https://github.com/purescript/purescript/pull/2516-        transformArg :: Ident -> SourceType -> m Expr-        transformArg ident = fmap (foldr App (mkVar ss ident)) . goType where--          goType :: SourceType -> m (Maybe Expr)-          -- argument matches the index type-          goType (TypeVar _ t) | t == iTyName = return (Just fVar)--          -- records-          goType recTy | Just row <- objectType recTy =-              traverse buildUpdate (decomposeRec' row) >>= (traverse buildRecord . justUpdates)-            where-              justUpdates :: [Maybe (Label, Expr)] -> Maybe [(Label, Expr)]-              justUpdates = foldMap (fmap return)--              buildUpdate :: (Label, SourceType) -> m (Maybe (Label, Expr))-              buildUpdate (lbl, ty) = do upd <- goType ty-                                         return ((lbl,) <$> upd)--              buildRecord :: [(Label, Expr)] -> m Expr-              buildRecord updates = do-                arg <- freshIdent "o"-                let argVar = mkVar ss arg-                    mkAssignment (Label l, x) = (l, App x (Accessor l argVar))-                return (lam ss arg (ObjectUpdate argVar (mkAssignment <$> updates)))--          -- quantifiers-          goType (ForAll _ scopedVar _ t _) | scopedVar /= iTyName = goType t--          -- constraints-          goType (ConstrainedType _ _ t) = goType t--          -- under a `* -> *`, just assume functor for now-          goType (TypeApp _ _ t) = fmap (App mapVar) <$> goType t--          -- otherwise do nothing - will fail type checking if type does actually contain index-          goType _ = return Nothing
src/Language/PureScript/TypeChecker.hs view
@@ -10,6 +10,7 @@ import Prelude.Compat import Protolude (headMay, maybeToLeft, ordNub) +import Control.Lens ((^..), _2) import Control.Monad (when, unless, void, forM, zipWithM_) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (MonadState(..), modify, gets)@@ -47,8 +48,6 @@ import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types -import Lens.Micro.Platform ((^..), _2)- addDataType   :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => ModuleName@@ -353,7 +352,8 @@     internalError "Type declarations should have been removed before typeCheckAlld"   go (ValueDecl sa@(ss, _) name nameKind [] [MkUnguarded val]) = do     env <- getEnv-    warnAndRethrow (addHint (ErrorInValueDeclaration name) . addHint (positionedError ss)) $ do+    let declHint = if isPlainIdent name then addHint (ErrorInValueDeclaration name) else id+    warnAndRethrow (declHint . addHint (positionedError ss)) $ do       val' <- checkExhaustiveExpr ss env moduleName val       valueIsNotDefined moduleName name       typesOf NonRecursiveBindingGroup moduleName [((sa, name), val')] >>= \case
+ src/Language/PureScript/TypeChecker/Deriving.hs view
@@ -0,0 +1,431 @@+module Language.PureScript.TypeChecker.Deriving (deriveInstance) where++import Protolude hiding (Type)++import Control.Monad.Writer.Class (MonadWriter(..))+import Data.Foldable (foldl1)+import Data.List (init, last, zipWith3, (!!))+import qualified Data.Map as M++import Control.Monad.Supply.Class+import Language.PureScript.AST+import Language.PureScript.AST.Utils+import qualified Language.PureScript.Constants.Prelude as Prelude+import qualified Language.PureScript.Constants.Prim as Prim+import Language.PureScript.Crash+import Language.PureScript.Environment+import Language.PureScript.Errors+import Language.PureScript.Label (Label(..))+import Language.PureScript.Names+import Language.PureScript.PSString+import Language.PureScript.Sugar.TypeClasses+import Language.PureScript.TypeChecker.Monad+import Language.PureScript.TypeChecker.Synonyms+import Language.PureScript.TypeClassDictionaries+import Language.PureScript.Types++-- | Extract the name of the newtype appearing in the last type argument of+-- a derived newtype instance.+--+-- Note: since newtypes in newtype instances can only be applied to type arguments+-- (no flexible instances allowed), we don't need to bother with unification when+-- looking for matching superclass instances, which saves us a lot of work. Instead,+-- we just match the newtype name.+extractNewtypeName :: ModuleName -> [SourceType] -> Maybe (ModuleName, ProperName 'TypeName)+extractNewtypeName mn+  = fmap (\(n, _, _) -> qualify mn n)+  . (unwrapTypeConstructor <=< lastMay)++deriveInstance+  :: forall m+   . MonadError MultipleErrors m+  => MonadState CheckState m+  => MonadSupply m+  => MonadWriter MultipleErrors m+  => SourceType+  -> Qualified (ProperName 'ClassName)+  -> InstanceDerivationStrategy+  -> m Expr+deriveInstance instType className strategy = do+  mn <- unsafeCheckCurrentModule+  env <- getEnv+  (fmap coerceProperName -> ctorName, _, tys) <- maybe (internalCompilerError "invalid instance type") pure $ unwrapTypeConstructor instType++  TypeClassData{..} <-+    note (errorMessage . UnknownName $ fmap TyClassName className) $+      className `M.lookup` typeClasses env++  case strategy of+    KnownClassStrategy -> let+      unaryClass :: (ModuleName -> ProperName 'TypeName -> m [(PSString, Expr)]) -> m Expr+      unaryClass f = case tys of+        [ty] -> case unwrapTypeConstructor ty of+          Just (Qualified (Just mn') tyCon, _, _) | mn == mn' -> do+            let superclassesDicts = flip map typeClassSuperclasses $ \(Constraint _ superclass _ suTyArgs _) ->+                  let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs+                  in lam UnusedIdent (DeferredDictionary superclass tyArgs)+            let superclasses = map mkString (superClassDictionaryNames typeClassSuperclasses) `zip` superclassesDicts+            App (Constructor nullSourceSpan ctorName) . mkLit . ObjectLiteral . (++ superclasses) <$> f mn tyCon+          _ -> throwError . errorMessage $ ExpectedTypeConstructor className tys ty+        _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 1++      in case className of+        Prelude.Eq -> unaryClass deriveEq+        Prelude.Eq1 -> unaryClass $ \_ _ -> deriveEq1+        Prelude.Functor -> unaryClass deriveFunctor+        Prelude.Ord -> unaryClass deriveOrd+        Prelude.Ord1 -> unaryClass $ \_ _ -> deriveOrd1+        -- See L.P.Sugar.TypeClasses.Deriving for the classes that can be+        -- derived prior to type checking.+        _ -> throwError . errorMessage $ CannotDerive className tys++    NewtypeStrategy ->+      case tys of+        _ : _ | Just (Qualified (Just mn') tyCon, kargs, args) <- unwrapTypeConstructor (last tys)+              , mn == mn'+              -> deriveNewtypeInstance mn className tys tyCon kargs args+              | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys (last tys)+        _ -> throwError . errorMessage $ InvalidNewtypeInstance className tys++deriveNewtypeInstance+  :: forall m+   . MonadError MultipleErrors m+  => MonadState CheckState m+  => MonadSupply m+  => MonadWriter MultipleErrors m+  => ModuleName+  -> Qualified (ProperName 'ClassName)+  -> [SourceType]+  -> ProperName 'TypeName+  -> [SourceType]+  -> [SourceType]+  -> m Expr+deriveNewtypeInstance mn className tys tyConNm dkargs dargs = do+    verifySuperclasses+    (dtype, tyKindNames, tyArgNames, ctors) <- lookupTypeDecl mn tyConNm+    go dtype tyKindNames tyArgNames ctors+  where+    go (Just Newtype) tyKindNames tyArgNames [(_, [wrapped])] = do+      -- The newtype might not be applied to all type arguments.+      -- This is okay as long as the newtype wraps something which ends with+      -- sufficiently many type applications to variables.+      -- For example, we can derive Functor for+      --+      -- newtype MyArray a = MyArray (Array a)+      --+      -- since Array a is a type application which uses the last+      -- type argument+      wrapped' <- replaceAllTypeSynonyms wrapped+      case stripRight (takeReverse (length tyArgNames - length dargs) tyArgNames) wrapped' of+        Just wrapped'' -> do+          let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs <> zip tyKindNames dkargs+          wrapped''' <- replaceAllTypeSynonyms $ replaceAllTypeVars subst wrapped''+          tys' <- mapM replaceAllTypeSynonyms tys+          return (DeferredDictionary className (init tys' ++ [wrapped''']))+        Nothing -> throwError . errorMessage $ InvalidNewtypeInstance className tys+    go _ _ _ _ = throwError . errorMessage $ InvalidNewtypeInstance className tys++    takeReverse :: Int -> [a] -> [a]+    takeReverse n = take n . reverse++    stripRight :: [(Text, Maybe kind)] -> SourceType -> Maybe SourceType+    stripRight [] ty = Just ty+    stripRight ((arg, _) : args) (TypeApp _ t (TypeVar _ arg'))+      | arg == arg' = stripRight args t+    stripRight _ _ = Nothing++    verifySuperclasses :: m ()+    verifySuperclasses = do+      env <- getEnv+      for_ (M.lookup className (typeClasses env)) $ \TypeClassData{ typeClassArguments = args, typeClassSuperclasses = superclasses } ->+        for_ superclasses $ \Constraint{..} -> do+          let constraintClass' = qualify (internalError "verifySuperclasses: unknown class module") constraintClass+          for_ (M.lookup constraintClass (typeClasses env)) $ \TypeClassData{ typeClassDependencies = deps } ->+            -- We need to check whether the newtype is mentioned, because of classes like MonadWriter+            -- with its Monoid superclass constraint.+            when (not (null args) && any ((fst (last args) `elem`) . usedTypeVariables) constraintArgs) $ do+              -- For now, we only verify superclasses where the newtype is the only argument,+              -- or for which all other arguments are determined by functional dependencies.+              -- Everything else raises a UnverifiableSuperclassInstance warning.+              -- This covers pretty much all cases we're interested in, but later we might want to do+              -- more work to extend this to other superclass relationships.+              let determined = map (srcTypeVar . fst . (args !!)) . ordNub . concatMap fdDetermined . filter ((== [length args - 1]) . fdDeterminers) $ deps+              if eqType (last constraintArgs) (srcTypeVar . fst $ last args) && all (`elem` determined) (init constraintArgs)+                then do+                  -- Now make sure that a superclass instance was derived. Again, this is not a complete+                  -- check, since the superclass might have multiple type arguments, so overlaps might still+                  -- be possible, so we warn again.+                  for_ (extractNewtypeName mn tys) $ \nm -> do+                    unless (hasNewtypeSuperclassInstance constraintClass' nm (typeClassDictionaries env)) $+                      tell . errorMessage $ MissingNewtypeSuperclassInstance constraintClass className tys+                else tell . errorMessage $ UnverifiableSuperclassInstance constraintClass className tys++    -- Note that this check doesn't actually verify that the superclass is+    -- newtype-derived; see #3168. The whole verifySuperclasses feature+    -- is pretty sketchy, and could use a thorough review and probably rewrite.+    hasNewtypeSuperclassInstance (suModule, suClass) nt@(newtypeModule, _) dicts =+      let su = Qualified (Just suModule) suClass+          lookIn mn'+            = elem nt+            . (toList . extractNewtypeName mn' . tcdInstanceTypes+                <=< foldMap toList . M.elems+                <=< toList . (M.lookup su <=< M.lookup (Just mn')))+            $ dicts+      in lookIn suModule || lookIn newtypeModule++deriveEq+  :: forall m+   . MonadError MultipleErrors m+  => MonadState CheckState m+  => MonadSupply m+  => ModuleName+  -> ProperName 'TypeName+  -> m [(PSString, Expr)]+deriveEq mn tyConNm = do+  (_, _, _, ctors) <- lookupTypeDecl mn tyConNm+  eqFun <- mkEqFunction ctors+  pure [(Prelude.eq, eqFun)]+  where+    mkEqFunction :: [(ProperName 'ConstructorName, [SourceType])] -> m Expr+    mkEqFunction ctors = do+      x <- freshIdent "x"+      y <- freshIdent "y"+      lamCase2 x y . addCatch <$> mapM mkCtorClause ctors++    preludeConj :: Expr -> Expr -> Expr+    preludeConj = App . App (mkVarMn (Just (ModuleName "Data.HeytingAlgebra")) (Ident Prelude.conj))++    preludeEq :: Expr -> Expr -> Expr+    preludeEq = App . App (mkRef Prelude.identEq)++    preludeEq1 :: Expr -> Expr -> Expr+    preludeEq1 = App . App (mkRef Prelude.identEq1)++    addCatch :: [CaseAlternative] -> [CaseAlternative]+    addCatch xs+      | length xs /= 1 = xs ++ [catchAll]+      | otherwise = xs -- Avoid redundant case+      where+      catchAll = CaseAlternative [NullBinder, NullBinder] (unguarded (mkLit (BooleanLiteral False)))++    mkCtorClause :: (ProperName 'ConstructorName, [SourceType]) -> m CaseAlternative+    mkCtorClause (ctorName, tys) = do+      identsL <- replicateM (length tys) (freshIdent "l")+      identsR <- replicateM (length tys) (freshIdent "r")+      tys' <- mapM replaceAllTypeSynonyms tys+      let tests = zipWith3 toEqTest (map mkVar identsL) (map mkVar identsR) tys'+      return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (unguarded (conjAll tests))+      where+      caseBinder idents = mkCtorBinder mn ctorName $ map mkBinder idents++    conjAll :: [Expr] -> Expr+    conjAll = \case+      [] -> mkLit (BooleanLiteral True)+      xs -> foldl1 preludeConj xs++    toEqTest :: Expr -> Expr -> SourceType -> Expr+    toEqTest l r ty+      | Just fields <- decomposeRec <=< objectType $ ty+        = conjAll+        . map (\(Label str, typ) -> toEqTest (Accessor str l) (Accessor str r) typ)+        $ fields+      | isAppliedVar ty = preludeEq1 l r+      | otherwise = preludeEq l r++deriveEq1 :: forall m. Applicative m => m [(PSString, Expr)]+deriveEq1 = pure [(Prelude.eq1, mkRef Prelude.identEq)]++deriveOrd+  :: forall m+   . MonadError MultipleErrors m+  => MonadState CheckState m+  => MonadSupply m+  => ModuleName+  -> ProperName 'TypeName+  -> m [(PSString, Expr)]+deriveOrd mn tyConNm = do+  (_, _, _, ctors) <- lookupTypeDecl mn tyConNm+  compareFun <- mkCompareFunction ctors+  pure [(Prelude.compare, compareFun)]+  where+    mkCompareFunction :: [(ProperName 'ConstructorName, [SourceType])] -> m Expr+    mkCompareFunction ctors = do+      x <- freshIdent "x"+      y <- freshIdent "y"+      lamCase2 x y <$> (addCatch . concat <$> mapM mkCtorClauses (splitLast ctors))++    splitLast :: [a] -> [(a, Bool)]+    splitLast [] = []+    splitLast [x] = [(x, True)]+    splitLast (x : xs) = (x, False) : splitLast xs++    addCatch :: [CaseAlternative] -> [CaseAlternative]+    addCatch xs+      | null xs = [catchAll] -- No type constructors+      | otherwise = xs+      where+      catchAll = CaseAlternative [NullBinder, NullBinder] (unguarded (orderingCtor "EQ"))++    orderingMod :: ModuleName+    orderingMod = ModuleName "Data.Ordering"++    orderingCtor :: Text -> Expr+    orderingCtor = mkCtor orderingMod . ProperName++    orderingBinder :: Text -> Binder+    orderingBinder name = mkCtorBinder orderingMod (ProperName name) []++    ordCompare :: Expr -> Expr -> Expr+    ordCompare = App . App (mkRef Prelude.identCompare)++    ordCompare1 :: Expr -> Expr -> Expr+    ordCompare1 = App . App (mkRef Prelude.identCompare1)++    mkCtorClauses :: ((ProperName 'ConstructorName, [SourceType]), Bool) -> m [CaseAlternative]+    mkCtorClauses ((ctorName, tys), isLast) = do+      identsL <- replicateM (length tys) (freshIdent "l")+      identsR <- replicateM (length tys) (freshIdent "r")+      tys' <- mapM replaceAllTypeSynonyms tys+      let tests = zipWith3 toOrdering (map mkVar identsL) (map mkVar identsR) tys'+          extras | not isLast = [ CaseAlternative [nullCaseBinder, NullBinder] (unguarded (orderingCtor "LT"))+                                , CaseAlternative [NullBinder, nullCaseBinder] (unguarded (orderingCtor "GT"))+                                ]+                 | otherwise = []+      return $ CaseAlternative [ caseBinder identsL+                               , caseBinder identsR+                               ]+                               (unguarded (appendAll tests))+             : extras++      where+      caseBinder idents = mkCtorBinder mn ctorName $ map mkBinder idents+      nullCaseBinder = mkCtorBinder mn ctorName $ replicate (length tys) NullBinder++    appendAll :: [Expr] -> Expr+    appendAll = \case+      [] -> orderingCtor "EQ"+      [x] -> x+      (x : xs) -> Case [x] [ CaseAlternative [orderingBinder "LT"] (unguarded (orderingCtor "LT"))+                           , CaseAlternative [orderingBinder "GT"] (unguarded (orderingCtor "GT"))+                           , CaseAlternative [NullBinder] (unguarded (appendAll xs))+                           ]++    toOrdering :: Expr -> Expr -> SourceType -> Expr+    toOrdering l r ty+      | Just fields <- decomposeRec <=< objectType $ ty+        = appendAll+        . map (\(Label str, typ) -> toOrdering (Accessor str l) (Accessor str r) typ)+        $ fields+      | isAppliedVar ty = ordCompare1 l r+      | otherwise = ordCompare l r++deriveOrd1 :: forall m. Applicative m => m [(PSString, Expr)]+deriveOrd1 = pure [(Prelude.compare1, mkRef Prelude.identCompare)]++lookupTypeDecl+  :: forall m+   . MonadError MultipleErrors m+  => MonadState CheckState m+  => ModuleName+  -> ProperName 'TypeName+  -> m (Maybe DataDeclType, [Text], [(Text, Maybe SourceType)], [(ProperName 'ConstructorName, [SourceType])])+lookupTypeDecl mn typeName = do+  env <- getEnv+  note (errorMessage $ CannotFindDerivingType typeName) $ do+    (kind, DataType _ args dctors) <- Qualified (Just mn) typeName `M.lookup` types env+    (kargs, _) <- completeBinderList kind+    let dtype = do+          (ctorName, _) <- headMay dctors+          (a, _, _, _) <- Qualified (Just mn) ctorName `M.lookup` dataConstructors env+          pure a+    pure (dtype, fst . snd <$> kargs, map (\(v, k, _) -> (v, k)) args, dctors)++isAppliedVar :: Type a -> Bool+isAppliedVar (TypeApp _ (TypeVar _ _) _) = True+isAppliedVar _ = False++objectType :: Type a -> Maybe (Type a)+objectType (TypeApp _ (TypeConstructor _ Prim.Record) rec) = Just rec+objectType _ = Nothing++decomposeRec :: SourceType -> Maybe [(Label, SourceType)]+decomposeRec = fmap (sortOn fst) . go+  where go (RCons _ str typ typs) = fmap ((str, typ) :) (go typs)+        go (REmptyKinded _ _) = Just []+        go _ = Nothing++decomposeRec' :: SourceType -> [(Label, SourceType)]+decomposeRec' = sortOn fst . go+  where go (RCons _ str typ typs) = (str, typ) : go typs+        go _ = []++deriveFunctor+  :: forall m+   . MonadError MultipleErrors m+  => MonadState CheckState m+  => MonadSupply m+  => ModuleName+  -> ProperName 'TypeName+  -> m [(PSString, Expr)]+deriveFunctor mn tyConNm = do+  (_, _, tys, ctors) <- lookupTypeDecl mn tyConNm+  mapFun <- mkMapFunction tys ctors+  pure [(Prelude.map, mapFun)]+  where+    mkMapFunction :: [(Text, Maybe SourceType)] -> [(ProperName 'ConstructorName, [SourceType])] -> m Expr+    mkMapFunction tys ctors = case reverse tys of+      [] -> throwError . errorMessage $ KindsDoNotUnify (kindType -:> kindType) kindType+      ((iTy, _) : _) -> do+        f <- freshIdent "f"+        m <- freshIdent "m"+        lam f . lamCase m <$> mapM (mkCtorClause iTy f) ctors++    mkCtorClause :: Text -> Ident -> (ProperName 'ConstructorName, [SourceType]) -> m CaseAlternative+    mkCtorClause iTyName f (ctorName, ctorTys) = do+      idents <- replicateM (length ctorTys) (freshIdent "v")+      ctorTys' <- mapM replaceAllTypeSynonyms ctorTys+      args <- zipWithM transformArg idents ctorTys'+      let ctor = mkCtor mn ctorName+          rebuilt = foldl' App ctor args+          caseBinder = mkCtorBinder mn ctorName $ map mkBinder idents+      return $ CaseAlternative [caseBinder] (unguarded rebuilt)+      where+        fVar = mkVar f+        mapVar = mkRef Prelude.identMap++        transformArg :: Ident -> SourceType -> m Expr+        transformArg ident = fmap (foldr App (mkVar ident)) . goType where++          goType :: SourceType -> m (Maybe Expr)+          -- argument matches the index type+          goType (TypeVar _ t) | t == iTyName = return (Just fVar)++          -- records+          goType recTy | Just row <- objectType recTy =+              traverse buildUpdate (decomposeRec' row) >>= (traverse buildRecord . justUpdates)+            where+              justUpdates :: [Maybe (Label, Expr)] -> Maybe [(Label, Expr)]+              justUpdates = foldMap (fmap return)++              buildUpdate :: (Label, SourceType) -> m (Maybe (Label, Expr))+              buildUpdate (lbl, ty) = do upd <- goType ty+                                         return ((lbl,) <$> upd)++              buildRecord :: [(Label, Expr)] -> m Expr+              buildRecord updates = do+                arg <- freshIdent "o"+                let argVar = mkVar arg+                    mkAssignment (Label l, x) = (l, App x (Accessor l argVar))+                return (lam arg (ObjectUpdate argVar (mkAssignment <$> updates)))++          -- quantifiers+          goType (ForAll _ scopedVar _ t _) | scopedVar /= iTyName = goType t++          -- constraints+          goType (ConstrainedType _ _ t) = goType t++          -- under a `* -> *`, just assume functor for now+          goType (TypeApp _ _ t) = fmap (App mapVar) <$> goType t++          -- otherwise do nothing - will fail type checking if type does actually contain index+          goType _ = return Nothing
src/Language/PureScript/TypeChecker/Entailment/Coercible.hs view
@@ -527,6 +527,10 @@   -> SourceType   -> MultipleErrors insoluble k a b =+  -- We can erase kind applications when determining whether to show the+  -- "Consider adding a type annotation" hint, because annotating kinds to+  -- instantiate unknowns in Coercible constraints should never resolve+  -- NoInstanceFound errors.   errorMessage $ NoInstanceFound (srcConstraint Prim.Coercible [k] [a, b] Nothing) [] (any containsUnknowns [a, b])  -- | Constraints of the form @Coercible a b@ can be solved if the two arguments
src/Language/PureScript/TypeChecker/Kinds.hs view
@@ -28,6 +28,7 @@ import Prelude.Compat  import Control.Arrow ((***))+import Control.Lens ((^.), _1, _2, _3) import Control.Monad import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State@@ -55,7 +56,6 @@ import Language.PureScript.TypeChecker.Synonyms import Language.PureScript.Types import Language.PureScript.Pretty.Types-import Lens.Micro.Platform ((^.), _1, _2, _3)  generalizeUnknowns :: [(Unknown, SourceType)] -> SourceType -> SourceType generalizeUnknowns unks ty =@@ -180,7 +180,7 @@           throwError . errorMessage' (fst ann) . UnknownName . fmap TyClassName $ v         Just _ ->           checkConstraint con-      ty' <- checkKind ty E.kindType+      ty' <- checkIsSaturatedType ty       con'' <- applyConstraint con'       pure (ConstrainedType ann' con'' ty', E.kindType $> ann')     ty@(TypeLevelString ann _) ->@@ -228,10 +228,10 @@     ForAll ann arg mbKind ty sc -> do       moduleName <- unsafeCheckCurrentModule       kind <- case mbKind of-        Just k -> replaceAllTypeSynonyms =<< checkKind k E.kindType+        Just k -> replaceAllTypeSynonyms =<< checkIsSaturatedType k         Nothing -> freshKind (fst ann)       (ty', unks) <- bindLocalTypeVariables moduleName [(ProperName arg, kind)] $ do-        ty' <- apply =<< checkKind ty E.kindType+        ty' <- apply =<< checkIsSaturatedType ty         unks <- unknownsWithKinds . IS.toList $ unknowns ty'         pure (ty', unks)       for_ unks . uncurry $ addUnsolved Nothing@@ -249,7 +249,8 @@   -> m (SourceType, SourceType) inferAppKind ann (fn, fnKind) arg = case fnKind of   TypeApp _ (TypeApp _ arrKind argKind) resKind | eqType arrKind E.tyFunction -> do-    arg' <- checkKind arg argKind+    expandSynonyms <- requiresSynonymsToExpand fn+    arg' <- checkKind' expandSynonyms arg argKind     (TypeApp ann fn arg',) <$> apply resKind   TUnknown _ u -> do     (lvl, _) <- lookupUnsolved u@@ -266,6 +267,12 @@     inferAppKind ann (KindApp ann fn (TUnknown ann u), replaceTypeVars a (TUnknown ann u) ty) arg   _ ->     cannotApplyTypeToType fn arg+  where+  requiresSynonymsToExpand = \case+    TypeConstructor _ v -> M.notMember v . E.typeSynonyms <$> getEnv+    TypeApp _ l _ -> requiresSynonymsToExpand l+    KindApp _ l _ -> requiresSynonymsToExpand l+    _ -> pure True  cannotApplyTypeToType   :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)@@ -293,12 +300,34 @@   => SourceType   -> SourceType   -> m SourceType-checkKind ty kind2 =+checkKind = checkKind' False++-- | `checkIsSaturatedType t` is identical to `checkKind t E.kindType` except+-- that the former checks that the type synonyms in `t` expand completely. This+-- is the appropriate function to use when expanding the types of type+-- parameter kinds, arguments to data constructors, etc., in order for the+-- PartiallyAppliedSynonym error to take precedence over the KindsDoNotUnify+-- error.+--+checkIsSaturatedType+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> m SourceType+checkIsSaturatedType ty = checkKind' True ty E.kindType++checkKind'+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => Bool+  -> SourceType+  -> SourceType+  -> m SourceType+checkKind' requireSynonymsToExpand ty kind2 = do   withErrorMessageHint (ErrorCheckingKind ty kind2)     . rethrowWithPosition (fst $ getAnnForType ty) $ do         (ty', kind1) <- inferKind ty         kind1' <- apply kind1         kind2' <- apply kind2+        when requireSynonymsToExpand $ void $ replaceAllTypeSynonyms ty'         instantiateKind (ty', kind1') kind2'  instantiateKind@@ -614,7 +643,7 @@   tyKind <- apply =<< lookupTypeVariable moduleName (Qualified Nothing tyName)   let (sigBinders, tyKind') = fromJust . completeBinderList $ tyKind   bindLocalTypeVariables moduleName (first ProperName . snd <$> sigBinders) $ do-    tyArgs' <- for tyArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< flip checkKind E.kindType+    tyArgs' <- for tyArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< checkIsSaturatedType     subsumesKind (foldr ((E.-:>) . snd) E.kindType tyArgs') tyKind'     bindLocalTypeVariables moduleName (first ProperName <$> tyArgs') $ do       let tyCtorName = srcTypeConstructor $ mkQualified tyName moduleName@@ -630,7 +659,7 @@   -> DataConstructorDeclaration   -> m (DataConstructorDeclaration, SourceType) inferDataConstructor tyCtor DataConstructorDeclaration{..} = do-  dataCtorFields' <- traverse (traverse (flip checkKind E.kindType)) dataCtorFields+  dataCtorFields' <- traverse (traverse checkIsSaturatedType) dataCtorFields   dataCtor <- flip (foldr ((E.-:>) . snd)) dataCtorFields' <$> checkKind tyCtor E.kindType   pure ( DataConstructorDeclaration { dataCtorFields = dataCtorFields', .. }, dataCtor ) @@ -666,7 +695,7 @@   let (sigBinders, tyKind') = fromJust . completeBinderList $ tyKind   bindLocalTypeVariables moduleName (first ProperName . snd <$> sigBinders) $ do     kindRes <- freshKind (fst ann)-    tyArgs' <- for tyArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< flip checkKind E.kindType+    tyArgs' <- for tyArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< checkIsSaturatedType     unifyKinds tyKind' $ foldr ((E.-:>) . snd) kindRes tyArgs'     bindLocalTypeVariables moduleName (first ProperName <$> tyArgs') $ do       tyBodyAndKind <- traverse apply =<< inferKind tyBody@@ -782,7 +811,7 @@   clsKind <- apply =<< lookupTypeVariable moduleName (Qualified Nothing $ coerceProperName clsName)   let (sigBinders, clsKind') = fromJust . completeBinderList $ clsKind   bindLocalTypeVariables moduleName (first ProperName . snd <$> sigBinders) $ do-    clsArgs' <- for clsArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< flip checkKind E.kindType+    clsArgs' <- for clsArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< checkIsSaturatedType     unifyKinds clsKind' $ foldr ((E.-:>) . snd) E.kindConstraint clsArgs'     bindLocalTypeVariables moduleName (first ProperName <$> clsArgs') $ do       (clsArgs',,)@@ -860,7 +889,7 @@     ty' <- checkKind ty E.kindConstraint     constraints' <- for constraints checkConstraint     allTy <- apply $ foldr srcConstrainedType ty' constraints'-    allUnknowns <- unknownsWithKinds . IS.toList $ unknowns allTy+    allUnknowns <- unknownsWithKinds . IS.toList . foldMap unknowns . (allTy :) =<< traverse (apply . snd) freeVarsDict     let unknownVars = unknownVarNames (usedTypeVariables allTy) allUnknowns     let allWithVars = replaceUnknownsWithVars unknownVars allTy     let (allConstraints, (_, allKinds, allArgs)) = unapplyTypes <$> unapplyConstraints allWithVars
src/Language/PureScript/TypeChecker/Types.hs view
@@ -51,6 +51,7 @@ import Language.PureScript.Errors import Language.PureScript.Names import Language.PureScript.Traversals+import Language.PureScript.TypeChecker.Deriving import Language.PureScript.TypeChecker.Entailment import Language.PureScript.TypeChecker.Kinds import Language.PureScript.TypeChecker.Monad@@ -656,7 +657,7 @@   => Expr   -> SourceType   -> m TypedValue'-check val ty = withErrorMessageHint (ErrorCheckingType val ty) $ check' val ty+check val ty = withErrorMessageHint' val (ErrorCheckingType val ty) $ check' val ty  -- | -- Check the type of a value@@ -770,6 +771,10 @@   ensureNoDuplicateProperties ps   ps' <- checkProperties e ps row False   return $ TypedValue' True (Literal ss (ObjectLiteral ps')) t+check' (DerivedInstancePlaceholder name strategy) t = do+  d <- deriveInstance t name strategy+  d' <- tvToExpr <$> check' d t+  return $ TypedValue' True d' t check' e@(ObjectUpdate obj ps) t@(TypeApp _ o row) | o == tyRecord = do   ensureNoDuplicateProperties ps   -- We need to be careful to avoid duplicate labels here.@@ -923,6 +928,7 @@   PositionedValue _ _ v -> isInternal v   TypedValue _ v _ -> isInternal v   Constructor _ (Qualified _ name) -> isDictTypeName name+  DerivedInstancePlaceholder{} -> True   _ -> False  -- | Introduce a hint only if the given expression is not internal
src/Language/PureScript/Types.hs view
@@ -10,6 +10,7 @@ import Control.Applicative ((<|>)) import Control.Arrow (first, second) import Control.DeepSeq (NFData)+import Control.Lens (Lens', (^.), set) import Control.Monad ((<=<), (>=>)) import Data.Aeson ((.:), (.:?), (.!=), (.=)) import qualified Data.Aeson as A@@ -28,8 +29,6 @@ import Language.PureScript.Label (Label) import Language.PureScript.PSString (PSString) -import Lens.Micro (Lens', (^.), set)- type SourceType = Type SourceAnn type SourceConstraint = Constraint SourceAnn @@ -559,8 +558,10 @@   go (TUnknown _ u) = IS.singleton u   go _ = mempty +-- | Check if a type contains unknowns in a position that is relevant to+-- constraint solving. (Kinds are not.) containsUnknowns :: Type a -> Bool-containsUnknowns = everythingOnTypes (||) go where+containsUnknowns = everythingOnTypes (||) go . eraseKindApps where   go :: Type a -> Bool   go TUnknown{} = True   go _ = False@@ -570,6 +571,8 @@   KindApp _ ty _ -> ty   ConstrainedType ann con ty ->     ConstrainedType ann (con { constraintKindArgs = [] }) ty+  Skolem ann name _ i sc ->+    Skolem ann name Nothing i sc   other -> other  eraseForAllKindAnnotations :: Type a -> Type a@@ -621,6 +624,7 @@   go (KindApp ann t1 t2) = f (KindApp ann (go t1) (go t2))   go (ForAll ann arg mbK ty sco) = f (ForAll ann arg (go <$> mbK) (go ty) sco)   go (ConstrainedType ann c ty) = f (ConstrainedType ann (mapConstraintArgsAll (map go) c) (go ty))+  go (Skolem ann name mbK i sc) = f (Skolem ann name (go <$> mbK) i sc)   go (RCons ann name ty rest) = f (RCons ann name (go ty) (go rest))   go (KindedType ann ty k) = f (KindedType ann (go ty) (go k))   go (BinaryNoParensType ann t1 t2 t3) = f (BinaryNoParensType ann (go t1) (go t2) (go t3))@@ -633,6 +637,7 @@   go (KindApp ann t1 t2) = (KindApp ann <$> go t1 <*> go t2) >>= f   go (ForAll ann arg mbK ty sco) = (ForAll ann arg <$> traverse go mbK <*> go ty <*> pure sco) >>= f   go (ConstrainedType ann c ty) = (ConstrainedType ann <$> overConstraintArgsAll (mapM go) c <*> go ty) >>= f+  go (Skolem ann name mbK i sc) = (Skolem ann name <$> traverse go mbK <*> pure i <*> pure sc) >>= f   go (RCons ann name ty rest) = (RCons ann name <$> go ty <*> go rest) >>= f   go (KindedType ann ty k) = (KindedType ann <$> go ty <*> go k) >>= f   go (BinaryNoParensType ann t1 t2 t3) = (BinaryNoParensType ann <$> go t1 <*> go t2 <*> go t3) >>= f@@ -645,11 +650,12 @@   go (KindApp ann t1 t2) = KindApp ann <$> (f t1 >>= go) <*> (f t2 >>= go)   go (ForAll ann arg mbK ty sco) = ForAll ann arg <$> traverse (f >=> go) mbK <*> (f ty >>= go) <*> pure sco   go (ConstrainedType ann c ty) = ConstrainedType ann <$> overConstraintArgsAll (mapM (go <=< f)) c <*> (f ty >>= go)+  go (Skolem ann name mbK i sc) = Skolem ann name <$> traverse (f >=> go) mbK <*> pure i <*> pure sc   go (RCons ann name ty rest) = RCons ann name <$> (f ty >>= go) <*> (f rest >>= go)   go (KindedType ann ty k) = KindedType ann <$> (f ty >>= go) <*> (f k >>= go)   go (BinaryNoParensType ann t1 t2 t3) = BinaryNoParensType ann <$> (f t1 >>= go) <*> (f t2 >>= go) <*> (f t3 >>= go)   go (ParensInType ann t) = ParensInType ann <$> (f t >>= go)-  go other = f other+  go other = pure other  everythingOnTypes :: (r -> r -> r) -> (Type a -> r) -> Type a -> r everythingOnTypes (<+>) f = go where@@ -658,6 +664,7 @@   go t@(ForAll _ _ (Just k) ty _) = f t <+> go k <+> go ty   go t@(ForAll _ _ _ ty _) = f t <+> go ty   go t@(ConstrainedType _ c ty) = foldl (<+>) (f t) (map go (constraintKindArgs c) ++ map go (constraintArgs c)) <+> go ty+  go t@(Skolem _ _ (Just k) _ _) = f t <+> go k   go t@(RCons _ _ ty rest) = f t <+> go ty <+> go rest   go t@(KindedType _ ty k) = f t <+> go ty <+> go k   go t@(BinaryNoParensType _ t1 t2 t3) = f t <+> go t1 <+> go t2 <+> go t3@@ -672,6 +679,7 @@   go s (ForAll _ _ (Just k) ty _) = go' s k <+> go' s ty   go s (ForAll _ _ _ ty _) = go' s ty   go s (ConstrainedType _ c ty) = foldl (<+>) r0 (map (go' s) (constraintKindArgs c) ++ map (go' s) (constraintArgs c)) <+> go' s ty+  go s (Skolem _ _ (Just k) _ _) = go' s k   go s (RCons _ _ ty rest) = go' s ty <+> go' s rest   go s (KindedType _ ty k) = go' s ty <+> go' s k   go s (BinaryNoParensType _ t1 t2 t3) = go' s t1 <+> go' s t2 <+> go' s t3
tests/Language/PureScript/Ide/StateSpec.hs view
@@ -1,11 +1,11 @@ module Language.PureScript.Ide.StateSpec where  import           Protolude+import           Control.Lens hiding (anyOf, (&)) 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
tests/Main.hs view
@@ -7,6 +7,7 @@  import Test.Hspec +import qualified TestAst import qualified TestCompiler import qualified TestCoreFn import qualified TestCst@@ -32,6 +33,7 @@    hspec $ do     describe "cst" TestCst.spec+    describe "ast" TestAst.spec     describe "ide" TestIde.spec     beforeAll TestUtils.setupSupportModules $ do       describe "compiler" TestCompiler.spec
+ tests/TestAst.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE TypeApplications #-}+module TestAst where++import Protolude hiding (Constraint, Type, (:+))++import Control.Lens ((+~))+import Control.Newtype (ala')+import Generic.Random+import Test.Hspec+import Test.QuickCheck++import Language.PureScript.Label+import Language.PureScript.Names+import Language.PureScript.PSString+import Language.PureScript.Types++spec :: Spec+spec = do+  describe "Language.PureScript.Types" $ do+    describe "everywhereOnTypes" $ do+      everywhereOnTypesSpec everywhereOnTypes+    describe "everywhereOnTypesM" $ do+      everywhereOnTypesSpec $ ala' Identity everywhereOnTypesM+    describe "everywhereOnTypesTopDownM" $ do+      everywhereOnTypesSpec $ ala' Identity everywhereOnTypesTopDownM+    describe "everythingOnTypes" $ do+      everythingOnTypesSpec everythingOnTypes+    describe "everythingWithContextOnTypes" $ do+      everythingOnTypesSpec $ \f g -> everythingWithContextOnTypes () [] f $ \s -> (s, ) . g++everywhereOnTypesSpec :: ((Type Int -> Type Int) -> Type Int -> Type Int) -> Spec+everywhereOnTypesSpec everywhereOnTypesUnderTest = do+  it "should visit each type once" $+    forAllShrink (genTypeAnnotatedWith (pure 0) (pure 1)) subterms $ \t ->+      all (== 1) `isSatisfiedBy` everywhereOnTypesUnderTest (annForType +~ 1) t++everythingOnTypesSpec :: (([Int] -> [Int] -> [Int]) -> (Type Int -> [Int]) -> Type Int -> [Int]) -> Spec+everythingOnTypesSpec everythingOnTypesUnderTest = do+  it "should visit each type once" $+    forAllShrink (genTypeAnnotatedWith (pure 1) (pure 0)) subterms $ \t ->+      everythingOnTypesUnderTest (++) (pure . getAnnForType) t ===+        filter (== 1) (toList t)+++infixr 0 `isSatisfiedBy`+isSatisfiedBy :: forall a p. Show a => Testable p => (a -> p) -> a -> Property+isSatisfiedBy = liftA2 counterexample show++genTypeAnnotatedWith :: forall a. Gen a -> Gen a -> Gen (Type a)+genTypeAnnotatedWith genTypeAnn genConstraintAnn = genType where+  generatorEnvironment+    =  genConstraint+    :+ maybeOf genConstraintData+    :+ Label <$> genPSString+    :+ genPSString+    :+ genQualified (OpName @'TypeOpName)+    :+ genQualified (ProperName @'ClassName)+    :+ genQualified (ProperName @'TypeName)+    :+ genSkolemScope+    :+ maybeOf genSkolemScope+    :+ genText+    :+ listOf' (listOf' genText)+    :+ maybeOf genText+    :+ genType+    :+ listOf' genType+    :+ maybeOf genType+    :+ genWildcardData++  genConstraint :: Gen (Constraint a)+  genConstraint = genericArbitraryUG (genConstraintAnn :+ generatorEnvironment)++  genConstraintData :: Gen ConstraintData+  genConstraintData = genericArbitraryUG generatorEnvironment++  genQualified :: forall b. (Text -> b) -> Gen (Qualified b)+  genQualified ctor = Qualified Nothing . ctor <$> genText++  genSkolemScope :: Gen SkolemScope+  genSkolemScope = SkolemScope <$> arbitrary++  genType :: Gen (Type a)+  genType = genericArbitraryRecG (genTypeAnn :+ generatorEnvironment) uniform `withBaseCase` (TypeVar <$> genTypeAnn <*> genText)++  genWildcardData :: Gen WildcardData+  genWildcardData = genericArbitraryUG genText++  maybeOf :: forall b. Gen b -> Gen (Maybe b)+  maybeOf = genericArbitraryUG++  genText :: Gen Text+  genText = pure "x" -- Feel free to make this random if it matters at some point.++  genPSString :: Gen PSString+  genPSString = pure "x" -- Ditto.
tests/purs/docs/output/Prim.Int/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim.Int","comments":"The Prim.Int module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with type-level intural numbers.","declarations":[{"kind":null,"children":[],"comments":"Compiler solved type class for adding type-level `Int`s.\n","title":"Add","info":{"fundeps":[[["left","right"],["sum"]],[["left","sum"],["right"]],[["right","sum"],["left"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["sum",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for comparing two type-level `Int`s.\nProduces an `Ordering`.\n","title":"Compare","info":{"fundeps":[[["left","right"],["ordering"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["ordering",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for multiplying type-level `Int`s.\n","title":"Mul","info":{"fundeps":[[["left","right"],["product"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["product",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for converting a type-level `Int` into a type-level `String` (i.e. `Symbol`).\n","title":"ToString","info":{"fundeps":[[["int"],["string"]]],"arguments":[["int",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["string",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}+{"reExports":[],"name":"Prim.Int","comments":"The Prim.Int module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with type-level intural numbers.","declarations":[{"kind":null,"children":[],"comments":"Compiler solved type class for adding type-level `Int`s.\n","title":"Add","info":{"fundeps":[[["left","right"],["sum"]],[["left","sum"],["right"]],[["right","sum"],["left"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["sum",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for comparing two type-level `Int`s.\nProduces an `Ordering`.\n","title":"Compare","info":{"fundeps":[[["left","right"],["ordering"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["ordering",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"Ordering"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for multiplying type-level `Int`s.\n","title":"Mul","info":{"fundeps":[[["left","right"],["product"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["product",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for converting a type-level `Int` into a type-level `String` (i.e. `Symbol`).\n","title":"ToString","info":{"fundeps":[[["int"],["string"]]],"arguments":[["int",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["string",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}
tests/purs/docs/output/Prim/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim","comments":"The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types &mdash; for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import.\n\n`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler such as Type wildcards (e.g. `f :: _ -> Int`) and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md).\n","declarations":[{"kind":null,"children":[],"comments":"A function, which takes values of the type specified by the first type\nparameter, and returns values of the type specified by the second.\nIn the JavaScript backend, this is a standard JavaScript Function.\n\nThe type constructor `(->)` is syntactic sugar for this type constructor.\nIt is recommended to use `(->)` rather than `Function`, where possible.\n\nThat is, prefer this:\n\n    f :: Number -> Number\n\nto either of these:\n\n    f :: Function Number Number\n    f :: (->) Number Number\n","title":"Function","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"An Array: a data structure supporting efficient random access. In\nthe JavaScript backend, values of this type are represented as JavaScript\nArrays at runtime.\n\nConstruct values using literals:\n\n    x = [1,2,3,4,5] :: Array Int\n","title":"Array","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"The type of records whose fields are known at compile time. In the\nJavaScript backend, values of this type are represented as JavaScript\nObjects at runtime.\n\nThe type signature here means that the `Record` type constructor takes\na row of concrete types. For example:\n\n    type Person = Record (name :: String, age :: Number)\n\nThe syntactic sugar with curly braces `{ }` is generally preferred, though:\n\n    type Person = { name :: String, age :: Number }\n\nThe row associates a type to each label which appears in the record.\n\n_Technical note_: PureScript allows duplicate labels in rows, and the\nmeaning of `Record r` is based on the _first_ occurrence of each label in\nthe row `r`.\n","title":"Record","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A double precision floating point number (IEEE 754).\n\nConstruct values of this type with literals:\n\n    y = 35.23 :: Number\n    z = 1.224e6 :: Number\n","title":"Number","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A 32-bit signed integer. See the purescript-integers package for details\nof how this is accomplished when compiling to JavaScript.\n\nConstruct values of this type with literals:\n\n    x = 23 :: Int\n","title":"Int","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A String. As in JavaScript, String values represent sequences of UTF-16\ncode units, which are not required to form a valid encoding of Unicode\ntext (for example, lone surrogates are permitted).\n\nConstruct values of this type with literals, using double quotes `\"`:\n\n    x = \"hello, world\" :: String\n\nMulti-line string literals are also supported with triple quotes (`\"\"\"`).\n","title":"String","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A single character (UTF-16 code unit). The JavaScript representation is a\nnormal String, which is guaranteed to contain one code unit. This means\nthat astral plane characters (i.e. those with code point values greater\nthan 0xFFFF) cannot be represented as Char values.\n\nConstruct values of this type with literals, using single quotes `'`:\n\n    x = 'a' :: Char\n","title":"Char","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A JavaScript Boolean value.\n\nConstruct values of this type with the literals `true` and `false`.\n","title":"Boolean","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"The Partial type class is used to indicate that a function is *partial,*\nthat is, it is not defined for all inputs. In practice, attempting to use\na partial function with a bad input will usually cause an error to be\nthrown, although it is not safe to assume that this will happen in all\ncases. For more information, see\n[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/).\n","title":"Partial","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Type` is the kind of all proper types: those that classify value-level terms.\nFor example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`.\n","title":"Type","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Constraint` is the kind of type class constraints.\nFor example, a type class declaration like this:\n\n    class Semigroup a where\n      append :: a -> a -> a\n\nhas the kind signature:\n\n    class Semigroup :: Type -> Constraint\n","title":"Constraint","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Symbol` is the kind of type-level strings.\n\nConstruct types of this kind using the same literal syntax as documented\nfor strings.\n","title":"Symbol","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Row` is the kind constructor of label-indexed types which map type-level strings to other types.\nFor example, the kind of `Record` is `Row Type -> Type`, mapping field names to values.\n","title":"Row","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null}]}+{"reExports":[],"name":"Prim","comments":"The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types &mdash; for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import.\n\n`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler such as Type wildcards (e.g. `f :: _ -> Int`) and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md).\n","declarations":[{"kind":null,"children":[],"comments":"A function, which takes values of the type specified by the first type\nparameter, and returns values of the type specified by the second.\nIn the JavaScript backend, this is a standard JavaScript Function.\n\nThe type constructor `(->)` is syntactic sugar for this type constructor.\nIt is recommended to use `(->)` rather than `Function`, where possible.\n\nThat is, prefer this:\n\n    f :: Number -> Number\n\nto either of these:\n\n    f :: Function Number Number\n    f :: (->) Number Number\n","title":"Function","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"An Array: a data structure supporting efficient random access. In\nthe JavaScript backend, values of this type are represented as JavaScript\nArrays at runtime.\n\nConstruct values using literals:\n\n    x = [1,2,3,4,5] :: Array Int\n","title":"Array","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"The type of records whose fields are known at compile time. In the\nJavaScript backend, values of this type are represented as JavaScript\nObjects at runtime.\n\nThe type signature here means that the `Record` type constructor takes\na row of concrete types. For example:\n\n    type Person = Record (name :: String, age :: Number)\n\nThe syntactic sugar with curly braces `{ }` is generally preferred, though:\n\n    type Person = { name :: String, age :: Number }\n\nThe row associates a type to each label which appears in the record.\n\n_Technical note_: PureScript allows duplicate labels in rows, and the\nmeaning of `Record r` is based on the _first_ occurrence of each label in\nthe row `r`.\n","title":"Record","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A double precision floating point number (IEEE 754).\n\nConstruct values of this type with literals.\nNegative literals must be wrapped in parentheses if the negation sign could be mistaken\nfor an infix operator:\n\n    x = 35.23 :: Number\n    y = -1.224e6 :: Number\n    z = exp (-1.0) :: Number\n","title":"Number","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A 32-bit signed integer. See the `purescript-integers` package for details\nof how this is accomplished when compiling to JavaScript.\n\nConstruct values of this type with literals. Hexadecimal syntax is supported.\nNegative literals must be wrapped in parentheses if the negation sign could be mistaken\nfor an infix operator:\n\n    x = -23 :: Int\n    y = 0x17 :: Int\n    z = complement (-24) :: Int\n\nIntegers used as types are considered to have kind `Int`.\nUnlike value-level `Int`s, which must be representable as a 32-bit signed integer,\ntype-level `Int`s are unbounded. Hexadecimal support is also supported at the type level.\n\n    type One :: Int\n    type One = 1\n    \n    type Beyond32BitSignedInt :: Int\n    type Beyond32BitSignedInt = 2147483648\n    \n    type HexInt :: Int\n    type HexInt = 0x17\n\nNegative integer literals at the type level must be\nwrapped in parentheses if the negation sign could be mistaken for an infix operator.\n\n    type NegativeOne = -1\n    foo :: Proxy (-1) -> ...\n","title":"Int","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A String. As in JavaScript, String values represent sequences of UTF-16\ncode units, which are not required to form a valid encoding of Unicode\ntext (for example, lone surrogates are permitted).\n\nConstruct values of this type with literals, using double quotes `\"`:\n\n    x = \"hello, world\" :: String\n\nMulti-line string literals are also supported with triple quotes (`\"\"\"`):\n\n    x = \"\"\"multi\n       line\"\"\"\n\nAt the type level, string literals represent types with kind `Symbol`.\nThese types will have kind `String` in a future release:\n\n    type Hello :: Symbol\n    type Hello = \"Hello, world\"\n","title":"String","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A single character (UTF-16 code unit). The JavaScript representation is a\nnormal `String`, which is guaranteed to contain one code unit. This means\nthat astral plane characters (i.e. those with code point values greater\nthan `0xFFFF`) cannot be represented as `Char` values.\n\nConstruct values of this type with literals, using single quotes `'`:\n\n    x = 'a' :: Char\n","title":"Char","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A JavaScript Boolean value.\n\nConstruct values of this type with the literals `true` and `false`.\n\nThe `True` and `False` types defined in `Prim.Boolean` have this type as their kind.\n","title":"Boolean","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"The Partial type class is used to indicate that a function is *partial,*\nthat is, it is not defined for all inputs. In practice, attempting to use\na partial function with a bad input will usually cause an error to be\nthrown, although it is not safe to assume that this will happen in all\ncases. For more information, see\n[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/).\n","title":"Partial","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Type` is the kind of all proper types: those that classify value-level terms.\nFor example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`.\n","title":"Type","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Constraint` is the kind of type class constraints.\nFor example, a type class declaration like this:\n\n    class Semigroup a where\n      append :: a -> a -> a\n\nhas the kind signature:\n\n    class Semigroup :: Type -> Constraint\n","title":"Constraint","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Symbol` is the kind of type-level strings.\n\nConstruct types of this kind using the same literal syntax as documented\nfor strings.\n\n    type Hello :: Symbol\n    type Hello = \"Hello, world\"\n\n","title":"Symbol","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Row` is the kind constructor of label-indexed types which map type-level strings to other types.\nThe most common use of `Row` is `Row Type`, a row mapping labels to basic (of kind `Type`) types:\n\n    type ExampleRow :: Row Type\n    type ExampleRow = ( name :: String, values :: Array Int )\n\nThis is the kind of `Row` expected by the `Record` type constructor.\nMore advanced row kinds like `Row (Type -> Type)` are used much less frequently.\n","title":"Row","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null}]}
tests/purs/failing/2616.out view
@@ -14,8 +14,8 @@ [33m                          [0m while applying a function [33mcompare[0m   of type [33mOrd t0 => t0 -> t0 -> Ordering[0m-  to argument [33m$l6[0m-while inferring the type of [33mcompare $l6[0m+  to argument [33m$l2[0m+while inferring the type of [33mcompare $l2[0m in value declaration [33mordFoo[0m  where [33mr1[0m is a rigid type variable
tests/purs/failing/3405.out view
@@ -1,9 +1,18 @@ Error found:+in module [33mMain[0m at tests/purs/failing/3405.purs:8:1 - 8:43 (line 8, column 1 - line 8, column 43) -  Cannot derive a type class instance, because the type declaration for [33mSomething[0m could not be found.+  Orphan instance [33meqSomething[0m found for+  [33m                [0m+  [33m  Data.Eq.Eq Int[0m+  [33m                [0m+  This problem can be resolved by declaring the instance in [33mData.Eq[0m, or by defining the instance on a newtype wrapper. +in type class instance+[33m                      [0m+[33m  Data.Eq.Eq Something[0m+[33m                      [0m -See https://github.com/purescript/documentation/blob/master/errors/CannotFindDerivingType.md for more information,+See https://github.com/purescript/documentation/blob/master/errors/OrphanInstance.md for more information, or to contribute content related to this error.
tests/purs/failing/3405.purs view
@@ -1,4 +1,4 @@--- @shouldFailWith CannotFindDerivingType+-- @shouldFailWith OrphanInstance module Main where  import Prelude
+ tests/purs/failing/3453.out view
@@ -0,0 +1,11 @@+Error found:+at tests/purs/failing/3453.purs:6:1 - 6:11 (line 6, column 1 - line 6, column 11)++  A cycle appears in the definition of type synonym [33mS[0m+  Cycles are disallowed because they can lead to loops in the type checker.+  Consider using a 'newtype' instead.+++See https://github.com/purescript/documentation/blob/master/errors/CycleInTypeSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3453.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith CycleInTypeSynonym+module Main where++import Data.Newtype (class Newtype)++type S = S+newtype Z = Z S+derive instance newtypeZ :: Newtype Z _
+ tests/purs/failing/3510.out view
@@ -0,0 +1,18 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/3510.purs:7:1 - 7:28 (line 7, column 1 - line 7, column 28)++  Type class instance head is invalid due to use of type+  [33m    [0m+  [33m  ()[0m+  [33m    [0m+  All types appearing in instance declarations must be of the form T a_1 .. a_n, where each type a_i is of the same form, unless the type is fully determined by other type class arguments via functional dependencies.++in type class instance+[33m              [0m+[33m  Data.Eq.Eq T[0m+[33m              [0m++See https://github.com/purescript/documentation/blob/master/errors/InvalidInstanceHead.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3510.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith InvalidInstanceHead+module Main where++import Prelude (class Eq)++type T = {}+derive instance eqT :: Eq T
tests/purs/failing/InvalidDerivedInstance.out view
@@ -1,14 +1,16 @@ Error found:+in module [33mMain[0m at tests/purs/failing/InvalidDerivedInstance.purs:8:1 - 8:30 (line 8, column 1 - line 8, column 30) -  Cannot derive the type class instance-  [33m              [0m-  [33m  Data.Eq.Eq X[0m-  [33m             X[0m-  [33m              [0m-  because the [33mData.Eq.Eq[0m type class has 1 type argument, but the declaration specifies 2.+  The type class [33mData.Eq.Eq[0m expects 1 argument.+  But the instance [33meqX[0m provided 2. +in type class instance+[33m              [0m+[33m  Data.Eq.Eq X[0m+[33m             X[0m+[33m              [0m -See https://github.com/purescript/documentation/blob/master/errors/InvalidDerivedInstance.md for more information,+See https://github.com/purescript/documentation/blob/master/errors/ClassInstanceArityMismatch.md for more information, or to contribute content related to this error.
tests/purs/failing/InvalidDerivedInstance.purs view
@@ -1,4 +1,4 @@--- @shouldFailWith InvalidDerivedInstance+-- @shouldFailWith ClassInstanceArityMismatch module Main where  import Prelude
tests/purs/failing/InvalidDerivedInstance2.out view
@@ -1,17 +1,18 @@ Error found:+in module [33mMain[0m at tests/purs/failing/InvalidDerivedInstance2.purs:6:1 - 6:34 (line 6, column 1 - line 6, column 34) -  Cannot derive the type class instance-  [33m                        [0m-  [33m  Data.Eq.Eq (Record ())[0m-  [33m                        [0m-  because the type-  [33m           [0m-  [33m  Record ()[0m-  [33m           [0m-  is not of the required form T a_1 ... a_n, where T is a type constructor defined in the same module.+  Type class instance head is invalid due to use of type+  [33m    [0m+  [33m  ()[0m+  [33m    [0m+  All types appearing in instance declarations must be of the form T a_1 .. a_n, where each type a_i is of the same form, unless the type is fully determined by other type class arguments via functional dependencies. +in type class instance+[33m                        [0m+[33m  Data.Eq.Eq (Record ())[0m+[33m                        [0m -See https://github.com/purescript/documentation/blob/master/errors/ExpectedTypeConstructor.md for more information,+See https://github.com/purescript/documentation/blob/master/errors/InvalidInstanceHead.md for more information, or to contribute content related to this error.
tests/purs/failing/InvalidDerivedInstance2.purs view
@@ -1,4 +1,4 @@--- @shouldFailWith ExpectedTypeConstructor+-- @shouldFailWith InvalidInstanceHead module Main where  import Prelude
tests/purs/failing/InvalidDerivedInstance3.out view
@@ -1,9 +1,13 @@ Error found:+in module [33mMain[0m at tests/purs/failing/InvalidDerivedInstance3.purs:8:15 - 8:16 (line 8, column 15 - line 8, column 16)    Type synonym [33mMain.S[0m is partially applied.   Type synonyms must be applied to all of their type arguments. +while checking that type [33mS[0m+  has kind [33mType[0m+in type constructor [33mN[0m  See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information, or to contribute content related to this error.
tests/purs/failing/NewtypeInstance.out view
@@ -1,4 +1,5 @@ Error found:+in module [33mMain[0m at tests/purs/failing/NewtypeInstance.purs:8:1 - 8:40 (line 8, column 1 - line 8, column 40)    Cannot derive newtype instance for@@ -7,6 +8,7 @@   [33m                  [0m   Make sure this is a newtype. +in value declaration [33mshowX[0m  See https://github.com/purescript/documentation/blob/master/errors/InvalidNewtypeInstance.md for more information, or to contribute content related to this error.
tests/purs/failing/NewtypeInstance2.out view
@@ -1,12 +1,17 @@ Error found:+in module [33mMain[0m at tests/purs/failing/NewtypeInstance2.purs:8:1 - 8:54 (line 8, column 1 - line 8, column 54)    Cannot derive newtype instance for-  [33m                      [0m-  [33m  Data.Show.Show (X a)[0m-  [33m                      [0m+  [33m                       [0m+  [33m  Data.Show.Show (X a0)[0m+  [33m                       [0m   Make sure this is a newtype. +in value declaration [33mshowX[0m++where [33ma0[0m is a rigid type variable+        bound at (line 0, column 0 - line 0, column 0)  See https://github.com/purescript/documentation/blob/master/errors/InvalidNewtypeInstance.md for more information, or to contribute content related to this error.
tests/purs/failing/NewtypeInstance3.out view
@@ -1,4 +1,5 @@ Error found:+in module [33mMain[0m at tests/purs/failing/NewtypeInstance3.purs:8:1 - 8:43 (line 8, column 1 - line 8, column 43)    Cannot derive newtype instance for@@ -7,6 +8,7 @@   [33m               [0m   Make sure this is a newtype. +in value declaration [33mnullary[0m  See https://github.com/purescript/documentation/blob/master/errors/InvalidNewtypeInstance.md for more information, or to contribute content related to this error.
tests/purs/failing/NewtypeInstance4.out view
@@ -1,4 +1,5 @@ Error found:+in module [33mMain[0m at tests/purs/failing/NewtypeInstance4.purs:8:1 - 8:40 (line 8, column 1 - line 8, column 40)    Cannot derive newtype instance for@@ -7,6 +8,7 @@   [33m                  [0m   Make sure this is a newtype. +in value declaration [33mshowX[0m  See https://github.com/purescript/documentation/blob/master/errors/InvalidNewtypeInstance.md for more information, or to contribute content related to this error.
tests/purs/failing/NewtypeInstance5.out view
@@ -1,4 +1,5 @@ Error found:+in module [33mMain[0m at tests/purs/failing/NewtypeInstance5.purs:8:1 - 8:46 (line 8, column 1 - line 8, column 46)    Cannot derive newtype instance for@@ -7,6 +8,7 @@   [33m                        [0m   Make sure this is a newtype. +in value declaration [33mfunctorX[0m  See https://github.com/purescript/documentation/blob/master/errors/InvalidNewtypeInstance.md for more information, or to contribute content related to this error.
tests/purs/failing/NewtypeInstance6.out view
@@ -1,13 +1,24 @@ Error found:-at tests/purs/failing/NewtypeInstance6.purs:8:1 - 8:46 (line 8, column 1 - line 8, column 46)+in module [33mMain[0m+at tests/purs/failing/NewtypeInstance6.purs:8:45 - 8:46 (line 8, column 45 - line 8, column 46) -  Cannot derive newtype instance for-  [33m                        [0m-  [33m  Data.Functor.Functor X[0m-  [33m                        [0m-  Make sure this is a newtype.+  Could not match kind+  [33m              [0m+  [33m  Type -> Type[0m+  [33m              [0m+  with kind+  [33m      [0m+  [33m  Type[0m+  [33m      [0m +while checking that type [33mX[0m+  has kind [33mType -> Type[0m+while inferring the kind of [33mFunctor X[0m+in type class instance+[33m                        [0m+[33m  Data.Functor.Functor X[0m+[33m                        [0m -See https://github.com/purescript/documentation/blob/master/errors/InvalidNewtypeInstance.md for more information,+See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information, or to contribute content related to this error.
tests/purs/failing/NewtypeInstance6.purs view
@@ -1,4 +1,4 @@--- @shouldFailWith InvalidNewtypeInstance+-- @shouldFailWith KindsDoNotUnify module Main where  import Prelude
+ tests/purs/failing/NewtypeUnnamedInstance.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/NewtypeUnnamedInstance.purs:8:1 - 8:31 (line 8, column 1 - line 8, column 31)++  Cannot derive newtype instance for+  [33m                  [0m+  [33m  Data.Show.Show X[0m+  [33m                  [0m+  Make sure this is a newtype.+++See https://github.com/purescript/documentation/blob/master/errors/InvalidNewtypeInstance.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/NewtypeUnnamedInstance.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith InvalidNewtypeInstance+module Main where++import Prelude++data X = X++derive newtype instance Show X
+ tests/purs/failing/PASTrumpsKDNU1.out view
@@ -0,0 +1,17 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/PASTrumpsKDNU1.purs:14:33 - 14:43 (line 14, column 33 - line 14, column 43)++  Type synonym [33mData.NaturalTransformation.NaturalTransformation[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mNaturalTransformation Array[0m+  has kind [33mType[0m+while inferring the kind of [33mShow a => NaturalTransformation Array[0m+while inferring the kind of [33mProxy (Show a => NaturalTransformation Array)[0m+while inferring the kind of [33mforall a. Proxy (Show a => NaturalTransformation Array)[0m+in value declaration [33mf[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/PASTrumpsKDNU1.purs view
@@ -0,0 +1,15 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++import Prelude++-- The PASTrumpsKDNU series of tests check a number of situations in which+-- both PartiallyAppliedSynonym and KindsDoNotUnify would be reasonable+-- errors to show; in these situtations, PartiallyAppliedSynonym is likely to+-- be the more useful error.++data Proxy :: forall k. k -> Type+data Proxy a = Proxy++f :: forall a. Proxy (Show a => (~>) Array)+f = Proxy
+ tests/purs/failing/PASTrumpsKDNU2.out view
@@ -0,0 +1,15 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/PASTrumpsKDNU2.purs:9:19 - 9:29 (line 9, column 19 - line 9, column 29)++  Type synonym [33mData.NaturalTransformation.NaturalTransformation[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mNaturalTransformation Array[0m+  has kind [33mType[0m+while inferring the kind of [33mforall (a :: NaturalTransformation Array). Proxy a -> Proxy a[0m+in value declaration [33mf[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/PASTrumpsKDNU2.purs view
@@ -0,0 +1,10 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++import Prelude++data Proxy :: forall k. k -> Type+data Proxy a = Proxy++f :: forall (a :: (~>) Array). Proxy a -> Proxy a+f x = x
+ tests/purs/failing/PASTrumpsKDNU3.out view
@@ -0,0 +1,16 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/PASTrumpsKDNU3.purs:9:23 - 9:33 (line 9, column 23 - line 9, column 33)++  Type synonym [33mData.NaturalTransformation.NaturalTransformation[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mNaturalTransformation Array[0m+  has kind [33mType[0m+while inferring the kind of [33mforall a. NaturalTransformation Array[0m+while inferring the kind of [33mProxy (forall a. NaturalTransformation Array)[0m+in value declaration [33mp[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/PASTrumpsKDNU3.purs view
@@ -0,0 +1,10 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++import Prelude++data Proxy :: forall k. k -> Type+data Proxy a = Proxy++p :: Proxy (forall a. (~>) Array)+p = Proxy
+ tests/purs/failing/PASTrumpsKDNU4.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/PASTrumpsKDNU4.purs:6:14 - 6:24 (line 6, column 14 - line 6, column 24)++  Type synonym [33mData.NaturalTransformation.NaturalTransformation[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mNaturalTransformation Array[0m+  has kind [33mType[0m+in type constructor [33mD[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/PASTrumpsKDNU4.purs view
@@ -0,0 +1,6 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++import Prelude++data D (a :: (~>) Array) = D
+ tests/purs/failing/PASTrumpsKDNU5.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/PASTrumpsKDNU5.purs:6:16 - 6:26 (line 6, column 16 - line 6, column 26)++  Type synonym [33mData.NaturalTransformation.NaturalTransformation[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mNaturalTransformation Array[0m+  has kind [33mType[0m+in type constructor [33mN[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/PASTrumpsKDNU5.purs view
@@ -0,0 +1,6 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++import Prelude++newtype N = N ((~>) Array)
+ tests/purs/failing/PASTrumpsKDNU6.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/PASTrumpsKDNU6.purs:6:14 - 6:24 (line 6, column 14 - line 6, column 24)++  Type synonym [33mData.NaturalTransformation.NaturalTransformation[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mNaturalTransformation Array[0m+  has kind [33mType[0m+in type synonym [33mT[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/PASTrumpsKDNU6.purs view
@@ -0,0 +1,6 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++import Prelude++type T (a :: (~>) Array) = Int
+ tests/purs/failing/PASTrumpsKDNU7.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/PASTrumpsKDNU7.purs:6:15 - 6:25 (line 6, column 15 - line 6, column 25)++  Type synonym [33mData.NaturalTransformation.NaturalTransformation[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mNaturalTransformation Array[0m+  has kind [33mType[0m+in type constructor [33mC$Dict[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/PASTrumpsKDNU7.purs view
@@ -0,0 +1,6 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++import Prelude++class C (a :: (~>) Array)
tests/purs/failing/RowConstructors2.out view
@@ -2,20 +2,14 @@ in module [33mMain[0m at tests/purs/failing/RowConstructors2.purs:7:16 - 7:19 (line 7, column 16 - line 7, column 19) -  Could not match kind-  [33m                     [0m-  [33m  Function (Row Type)[0m-  [33m                     [0m-  with kind-  [33m     [0m-  [33m  Row[0m-  [33m     [0m+  Type synonym [33mMain.Foo[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.  while checking that type [33mFoo[0m   has kind [33mRow Type[0m while inferring the kind of [33mRecord Foo[0m in type synonym [33mBar[0m -See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information, or to contribute content related to this error.
tests/purs/failing/RowConstructors2.purs view
@@ -1,4 +1,4 @@--- @shouldFailWith KindsDoNotUnify+-- @shouldFailWith PartiallyAppliedSynonym module Main where  import Effect.Console (log)
+ tests/purs/failing/TypeSynonyms10.out view
@@ -0,0 +1,21 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/TypeSynonyms10.purs:8:19 - 8:23 (line 8, column 19 - line 8, column 23)++  Could not match kind+  [33m                        [0m+  [33m  (Type -> Type) -> Type[0m+  [33m                        [0m+  with kind+  [33m      [0m+  [33m  Type[0m+  [33m      [0m++while checking that type [33mNaturalTransformation Array[0m+  has kind [33mType[0m+while inferring the kind of [33mF (NaturalTransformation Array)[0m+in type constructor [33mN[0m++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/TypeSynonyms10.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith KindsDoNotUnify+module Main where++import Prelude++type F (a :: Type) = a++newtype N = N (F ((~>) Array))
+ tests/purs/failing/TypeSynonyms8.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/TypeSynonyms8.purs:6:15 - 6:16 (line 6, column 15 - line 6, column 16)++  Type synonym [33mMain.S[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mS[0m+  has kind [33mType[0m+in type constructor [33mN[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/TypeSynonyms8.purs view
@@ -0,0 +1,6 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++data D a+type S a = D a+newtype N = N S
+ tests/purs/failing/TypeSynonyms9.out view
@@ -0,0 +1,15 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/TypeSynonyms9.purs:7:19 - 7:29 (line 7, column 19 - line 7, column 29)++  Type synonym [33mData.NaturalTransformation.NaturalTransformation[0m is partially applied.+  Type synonyms must be applied to all of their type arguments.++while checking that type [33mNaturalTransformation Array[0m+  has kind [33m(Type -> Type) -> Type -> Type[0m+while inferring the kind of [33mA (NaturalTransformation Array)[0m+in type constructor [33mB[0m++See https://github.com/purescript/documentation/blob/master/errors/PartiallyAppliedSynonym.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/TypeSynonyms9.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith PartiallyAppliedSynonym+module Main where++import Prelude++newtype A (a :: (Type -> Type) -> Type -> Type) = A String+newtype B = B (A ((~>) Array))
+ tests/purs/optimize/4229.out.js view
@@ -0,0 +1,17 @@+import * as Data_Unit from "../Data.Unit/index.js";+import * as Effect_Console from "../Effect.Console/index.js";+var Control_Bind = /* #__PURE__ */ (function () {+    function Control_Bind() {++    };+    Control_Bind.value = new Control_Bind();+    return Control_Bind;+})();+var main = function __do() {+    Data_Unit.unit;+    return Effect_Console.log("Done")();+};+export {+    Control_Bind,+    main+};
+ tests/purs/optimize/4229.purs view
@@ -0,0 +1,13 @@+module Main where++import Prelude++import Effect (Effect)+import Effect.Console (log)++data X = Control_Bind++main :: Effect Unit+main = do+  pure unit+  log "Done"
+ tests/purs/optimize/Foreign.js view
@@ -0,0 +1,1 @@+export const foo = 42;
+ tests/purs/optimize/Foreign.out.js view
@@ -0,0 +1,5 @@+import * as $foreign from "./foreign.js";+var bar = $foreign.foo;+export {+    bar+};
+ tests/purs/optimize/Foreign.purs view
@@ -0,0 +1,5 @@+module Main (bar) where++foreign import foo :: Int++bar = foo
+ tests/purs/passing/3510.purs view
@@ -0,0 +1,11 @@+module Main where++import Prelude (class Eq)+import Effect.Console (log)++data Maybe a = Just a | Nothing++type T = Maybe Int+derive instance eqT :: Eq T++main = log "Done"
+ tests/purs/passing/4105.purs view
@@ -0,0 +1,12 @@+module Main where++import Prelude++import Effect.Console (log)++import Lib (Patch)++newtype UpdateDto = UpdateDto Patch+derive instance eqUpdateDto :: Eq UpdateDto++main = log "Done"
+ tests/purs/passing/4105/Lib.purs view
@@ -0,0 +1,5 @@+module Lib where++type Template col = { bio :: col String }+type Identity a = a+type Patch = Template Identity
+ tests/purs/passing/4180.purs view
@@ -0,0 +1,14 @@+module Main where++import Effect.Console (log)++class C (t :: Type)+instance C (f a)++f :: C (Array String) => Int+f = 0++v :: Int+v = f++main = log "Done"
+ tests/purs/passing/4200.purs view
@@ -0,0 +1,11 @@+module Main where++import Data.Newtype (class Newtype)+import Effect.Console (log)+import Lib (TAlias)++newtype NewA a = NewA (TAlias Int)++derive instance Newtype (NewA a) _++main = log "Done"
+ tests/purs/passing/4200/Lib.purs view
@@ -0,0 +1,7 @@+module Lib where++data T :: forall m. m -> Type+data T msg = E++type TAlias :: forall k. k -> Type+type TAlias msg = T msg
+ tests/purs/passing/4229.purs view
@@ -0,0 +1,13 @@+module Main where++import Effect.Console (log)+import Partial.Unsafe (unsafePartial)++data X = Prim++f :: Partial => Int -> Int+f 0 = 0++f' = unsafePartial f++main = log "Done"
+ tests/purs/passing/4310.purs view
@@ -0,0 +1,8 @@+module Main where++import Effect.Console (log)+import Lib++main = do+  let q = runTest (4 /\ 4)+  log "Done"
+ tests/purs/passing/4310/Lib.purs view
@@ -0,0 +1,17 @@+module Lib where++import Prelude++data Tuple a b = Tuple a b++infixr 6 Tuple as /\+infixr 6 type Tuple as /\++class Test a where+  runTest :: a -> String++instance Test Int where+  runTest _ = "4"++instance (Test a, Test b) => Test (a /\ b) where+  runTest (a /\ b) = runTest a <> runTest b
tests/purs/passing/NewtypeInstance.purs view
@@ -54,6 +54,13 @@ newtype Syn a = Syn (Syn' (MyArray Int) a) derive newtype instance functorSyn :: Functor Syn +data Proxy2 a b = Proxy2+derive instance Functor (Proxy2 x)++newtype Foo :: forall k. k -> Type+newtype Foo a = Foo (Proxy2 k a)+derive newtype instance Functor Foo+ main = do   logShow (X "test")   logShow (singleton "test" :: Y String)
tests/purs/passing/TypeSynonyms.purs view
@@ -25,4 +25,6 @@ test1 :: forall a b c. Lens (Pair (Pair a b) c) a test1 = composeLenses fst fst +newtype N = N (Array ~> Array)+ main = log "Done"
tests/purs/publish/basic-example/output/Prim.Int/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim.Int","comments":"The Prim.Int module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with type-level intural numbers.","declarations":[{"kind":null,"children":[],"comments":"Compiler solved type class for adding type-level `Int`s.\n","title":"Add","info":{"fundeps":[[["left","right"],["sum"]],[["left","sum"],["right"]],[["right","sum"],["left"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["sum",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for comparing two type-level `Int`s.\nProduces an `Ordering`.\n","title":"Compare","info":{"fundeps":[[["left","right"],["ordering"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["ordering",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for multiplying type-level `Int`s.\n","title":"Mul","info":{"fundeps":[[["left","right"],["product"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["product",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for converting a type-level `Int` into a type-level `String` (i.e. `Symbol`).\n","title":"ToString","info":{"fundeps":[[["int"],["string"]]],"arguments":[["int",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["string",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}+{"reExports":[],"name":"Prim.Int","comments":"The Prim.Int module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with type-level intural numbers.","declarations":[{"kind":null,"children":[],"comments":"Compiler solved type class for adding type-level `Int`s.\n","title":"Add","info":{"fundeps":[[["left","right"],["sum"]],[["left","sum"],["right"]],[["right","sum"],["left"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["sum",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for comparing two type-level `Int`s.\nProduces an `Ordering`.\n","title":"Compare","info":{"fundeps":[[["left","right"],["ordering"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["ordering",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"Ordering"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for multiplying type-level `Int`s.\n","title":"Mul","info":{"fundeps":[[["left","right"],["product"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["product",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"Compiler solved type class for converting a type-level `Int` into a type-level `String` (i.e. `Symbol`).\n","title":"ToString","info":{"fundeps":[[["int"],["string"]]],"arguments":[["int",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],["string",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}
tests/purs/publish/basic-example/output/Prim/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim","comments":"The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types &mdash; for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import.\n\n`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler such as Type wildcards (e.g. `f :: _ -> Int`) and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md).\n","declarations":[{"kind":null,"children":[],"comments":"A function, which takes values of the type specified by the first type\nparameter, and returns values of the type specified by the second.\nIn the JavaScript backend, this is a standard JavaScript Function.\n\nThe type constructor `(->)` is syntactic sugar for this type constructor.\nIt is recommended to use `(->)` rather than `Function`, where possible.\n\nThat is, prefer this:\n\n    f :: Number -> Number\n\nto either of these:\n\n    f :: Function Number Number\n    f :: (->) Number Number\n","title":"Function","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"An Array: a data structure supporting efficient random access. In\nthe JavaScript backend, values of this type are represented as JavaScript\nArrays at runtime.\n\nConstruct values using literals:\n\n    x = [1,2,3,4,5] :: Array Int\n","title":"Array","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"The type of records whose fields are known at compile time. In the\nJavaScript backend, values of this type are represented as JavaScript\nObjects at runtime.\n\nThe type signature here means that the `Record` type constructor takes\na row of concrete types. For example:\n\n    type Person = Record (name :: String, age :: Number)\n\nThe syntactic sugar with curly braces `{ }` is generally preferred, though:\n\n    type Person = { name :: String, age :: Number }\n\nThe row associates a type to each label which appears in the record.\n\n_Technical note_: PureScript allows duplicate labels in rows, and the\nmeaning of `Record r` is based on the _first_ occurrence of each label in\nthe row `r`.\n","title":"Record","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A double precision floating point number (IEEE 754).\n\nConstruct values of this type with literals:\n\n    y = 35.23 :: Number\n    z = 1.224e6 :: Number\n","title":"Number","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A 32-bit signed integer. See the purescript-integers package for details\nof how this is accomplished when compiling to JavaScript.\n\nConstruct values of this type with literals:\n\n    x = 23 :: Int\n","title":"Int","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A String. As in JavaScript, String values represent sequences of UTF-16\ncode units, which are not required to form a valid encoding of Unicode\ntext (for example, lone surrogates are permitted).\n\nConstruct values of this type with literals, using double quotes `\"`:\n\n    x = \"hello, world\" :: String\n\nMulti-line string literals are also supported with triple quotes (`\"\"\"`).\n","title":"String","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A single character (UTF-16 code unit). The JavaScript representation is a\nnormal String, which is guaranteed to contain one code unit. This means\nthat astral plane characters (i.e. those with code point values greater\nthan 0xFFFF) cannot be represented as Char values.\n\nConstruct values of this type with literals, using single quotes `'`:\n\n    x = 'a' :: Char\n","title":"Char","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A JavaScript Boolean value.\n\nConstruct values of this type with the literals `true` and `false`.\n","title":"Boolean","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"The Partial type class is used to indicate that a function is *partial,*\nthat is, it is not defined for all inputs. In practice, attempting to use\na partial function with a bad input will usually cause an error to be\nthrown, although it is not safe to assume that this will happen in all\ncases. For more information, see\n[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/).\n","title":"Partial","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Type` is the kind of all proper types: those that classify value-level terms.\nFor example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`.\n","title":"Type","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Constraint` is the kind of type class constraints.\nFor example, a type class declaration like this:\n\n    class Semigroup a where\n      append :: a -> a -> a\n\nhas the kind signature:\n\n    class Semigroup :: Type -> Constraint\n","title":"Constraint","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Symbol` is the kind of type-level strings.\n\nConstruct types of this kind using the same literal syntax as documented\nfor strings.\n","title":"Symbol","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Row` is the kind constructor of label-indexed types which map type-level strings to other types.\nFor example, the kind of `Record` is `Row Type -> Type`, mapping field names to values.\n","title":"Row","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null}]}+{"reExports":[],"name":"Prim","comments":"The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types &mdash; for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import.\n\n`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler such as Type wildcards (e.g. `f :: _ -> Int`) and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md).\n","declarations":[{"kind":null,"children":[],"comments":"A function, which takes values of the type specified by the first type\nparameter, and returns values of the type specified by the second.\nIn the JavaScript backend, this is a standard JavaScript Function.\n\nThe type constructor `(->)` is syntactic sugar for this type constructor.\nIt is recommended to use `(->)` rather than `Function`, where possible.\n\nThat is, prefer this:\n\n    f :: Number -> Number\n\nto either of these:\n\n    f :: Function Number Number\n    f :: (->) Number Number\n","title":"Function","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"An Array: a data structure supporting efficient random access. In\nthe JavaScript backend, values of this type are represented as JavaScript\nArrays at runtime.\n\nConstruct values using literals:\n\n    x = [1,2,3,4,5] :: Array Int\n","title":"Array","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"The type of records whose fields are known at compile time. In the\nJavaScript backend, values of this type are represented as JavaScript\nObjects at runtime.\n\nThe type signature here means that the `Record` type constructor takes\na row of concrete types. For example:\n\n    type Person = Record (name :: String, age :: Number)\n\nThe syntactic sugar with curly braces `{ }` is generally preferred, though:\n\n    type Person = { name :: String, age :: Number }\n\nThe row associates a type to each label which appears in the record.\n\n_Technical note_: PureScript allows duplicate labels in rows, and the\nmeaning of `Record r` is based on the _first_ occurrence of each label in\nthe row `r`.\n","title":"Record","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A double precision floating point number (IEEE 754).\n\nConstruct values of this type with literals.\nNegative literals must be wrapped in parentheses if the negation sign could be mistaken\nfor an infix operator:\n\n    x = 35.23 :: Number\n    y = -1.224e6 :: Number\n    z = exp (-1.0) :: Number\n","title":"Number","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A 32-bit signed integer. See the `purescript-integers` package for details\nof how this is accomplished when compiling to JavaScript.\n\nConstruct values of this type with literals. Hexadecimal syntax is supported.\nNegative literals must be wrapped in parentheses if the negation sign could be mistaken\nfor an infix operator:\n\n    x = -23 :: Int\n    y = 0x17 :: Int\n    z = complement (-24) :: Int\n\nIntegers used as types are considered to have kind `Int`.\nUnlike value-level `Int`s, which must be representable as a 32-bit signed integer,\ntype-level `Int`s are unbounded. Hexadecimal support is also supported at the type level.\n\n    type One :: Int\n    type One = 1\n    \n    type Beyond32BitSignedInt :: Int\n    type Beyond32BitSignedInt = 2147483648\n    \n    type HexInt :: Int\n    type HexInt = 0x17\n\nNegative integer literals at the type level must be\nwrapped in parentheses if the negation sign could be mistaken for an infix operator.\n\n    type NegativeOne = -1\n    foo :: Proxy (-1) -> ...\n","title":"Int","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A String. As in JavaScript, String values represent sequences of UTF-16\ncode units, which are not required to form a valid encoding of Unicode\ntext (for example, lone surrogates are permitted).\n\nConstruct values of this type with literals, using double quotes `\"`:\n\n    x = \"hello, world\" :: String\n\nMulti-line string literals are also supported with triple quotes (`\"\"\"`):\n\n    x = \"\"\"multi\n       line\"\"\"\n\nAt the type level, string literals represent types with kind `Symbol`.\nThese types will have kind `String` in a future release:\n\n    type Hello :: Symbol\n    type Hello = \"Hello, world\"\n","title":"String","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A single character (UTF-16 code unit). The JavaScript representation is a\nnormal `String`, which is guaranteed to contain one code unit. This means\nthat astral plane characters (i.e. those with code point values greater\nthan `0xFFFF`) cannot be represented as `Char` values.\n\nConstruct values of this type with literals, using single quotes `'`:\n\n    x = 'a' :: Char\n","title":"Char","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"A JavaScript Boolean value.\n\nConstruct values of this type with the literals `true` and `false`.\n\nThe `True` and `False` types defined in `Prim.Boolean` have this type as their kind.\n","title":"Boolean","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"The Partial type class is used to indicate that a function is *partial,*\nthat is, it is not defined for all inputs. In practice, attempting to use\na partial function with a bad input will usually cause an error to be\nthrown, although it is not safe to assume that this will happen in all\ncases. For more information, see\n[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/).\n","title":"Partial","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Type` is the kind of all proper types: those that classify value-level terms.\nFor example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`.\n","title":"Type","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Constraint` is the kind of type class constraints.\nFor example, a type class declaration like this:\n\n    class Semigroup a where\n      append :: a -> a -> a\n\nhas the kind signature:\n\n    class Semigroup :: Type -> Constraint\n","title":"Constraint","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Symbol` is the kind of type-level strings.\n\nConstruct types of this kind using the same literal syntax as documented\nfor strings.\n\n    type Hello :: Symbol\n    type Hello = \"Hello, world\"\n\n","title":"Symbol","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"kind":null,"children":[],"comments":"`Row` is the kind constructor of label-indexed types which map type-level strings to other types.\nThe most common use of `Row` is `Row Type`, a row mapping labels to basic (of kind `Type`) types:\n\n    type ExampleRow :: Row Type\n    type ExampleRow = ( name :: String, values :: Array Int )\n\nThis is the kind of `Row` expected by the `Record` type constructor.\nMore advanced row kinds like `Row (Type -> Type)` are used much less frequently.\n","title":"Row","info":{"roles":[],"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null}]}
+ tests/purs/warning/4308.out view
@@ -0,0 +1,49 @@+Warning 1 of 3:++  in module [33mMain[0m+  at tests/purs/warning/4308.purs:13:6 - 13:7 (line 13, column 6 - line 13, column 7)++    Wildcard type definition has the inferred type+    [33m     [0m+    [33m  Int[0m+    [33m     [0m++  in value declaration [33mg[0m++  See https://github.com/purescript/documentation/blob/master/errors/WildcardInferredType.md for more information,+  or to contribute content related to this warning.++Warning 2 of 3:++  in module [33mMain[0m+  at tests/purs/warning/4308.purs:14:13 - 14:14 (line 14, column 13 - line 14, column 14)++    Wildcard type definition has the inferred type+    [33m     [0m+    [33m  Int[0m+    [33m     [0m++  in value declaration [33mg[0m++  See https://github.com/purescript/documentation/blob/master/errors/WildcardInferredType.md for more information,+  or to contribute content related to this warning.++Warning 3 of 3:++  in module [33mMain[0m+  at tests/purs/warning/4308.purs:14:25 - 14:26 (line 14, column 25 - line 14, column 26)++    Wildcard type definition has the inferred type+    [33m     [0m+    [33m  Int[0m+    [33m     [0m+    in the following context:++      y :: [33mInt[0m+++  in value declaration [33mg[0m++  See https://github.com/purescript/documentation/blob/master/errors/WildcardInferredType.md for more information,+  or to contribute content related to this warning.+
+ tests/purs/warning/4308.purs view
@@ -0,0 +1,14 @@+-- @shouldWarnWith WildcardInferredType+-- @shouldWarnWith WildcardInferredType+-- @shouldWarnWith WildcardInferredType+module Main where++-- No warnings expected here because `f` has full type signature+f :: Int+f = (\(y :: _) -> (y :: _)) 42++-- All three warnings expected here because the type signature of `g` has a+-- wildcard in it. One warning for the top-level signature wildcard, one for the+-- wildcard in the lambda parameter pattern, and one in the lambda body.+g :: _+g = (\(y :: _) -> (y :: _)) 42
tests/purs/warning/ImplicitQualifiedImportReExport.out view
@@ -21,7 +21,7 @@     Module [33mData.Either[0m was imported as [33mY[0m with unspecified imports.     As this module is being re-exported, consider using the explicit form: -      [33mimport Data.Either (Either(..), choose, either, fromLeft, fromLeft', fromRight, fromRight', hush, isLeft, isRight, note, note') as Y[0m+      [33mimport Data.Either (Either(..), blush, choose, either, fromLeft, fromLeft', fromRight, fromRight', hush, isLeft, isRight, note, note') as Y[0m
tests/purs/warning/NewtypeInstance.out view
@@ -1,4 +1,5 @@ Warning found:+in module [33mMain[0m at tests/purs/warning/NewtypeInstance.purs:8:1 - 8:38 (line 8, column 1 - line 8, column 38)    The derived newtype instance for@@ -7,6 +8,7 @@   [33m                [0m   does not include a derived superclass instance for [33mData.Eq.Eq[0m. +in value declaration [33mordX[0m  See https://github.com/purescript/documentation/blob/master/errors/MissingNewtypeSuperclassInstance.md for more information, or to contribute content related to this warning.
tests/purs/warning/NewtypeInstance2.out view
@@ -1,13 +1,18 @@ Warning found:+in module [33mMain[0m at tests/purs/warning/NewtypeInstance2.purs:15:1 - 15:86 (line 15, column 1 - line 15, column 86)    The derived newtype instance for-  [33m                               [0m-  [33m  Main.MonadWriter w           [0m-  [33m                   (MyWriter w)[0m-  [33m                               [0m+  [33m                                [0m+  [33m  Main.MonadWriter w0           [0m+  [33m                   (MyWriter w0)[0m+  [33m                                [0m   does not include a derived superclass instance for [33mControl.Monad.Monad[0m. +in value declaration [33mmonadWriterMyWriter[0m++where [33mw0[0m is a rigid type variable+        bound at (line 0, column 0 - line 0, column 0)  See https://github.com/purescript/documentation/blob/master/errors/MissingNewtypeSuperclassInstance.md for more information, or to contribute content related to this warning.
tests/purs/warning/NewtypeInstance3.out view
@@ -1,13 +1,18 @@ Warning found:+in module [33mMain[0m at tests/purs/warning/NewtypeInstance3.purs:21:1 - 21:86 (line 21, column 1 - line 21, column 86)    The derived newtype instance for-  [33m                               [0m-  [33m  Main.MonadWriter w           [0m-  [33m                   (MyWriter w)[0m-  [33m                               [0m+  [33m                                [0m+  [33m  Main.MonadWriter w0           [0m+  [33m                   (MyWriter w0)[0m+  [33m                                [0m   does not include a derived superclass instance for [33mMain.MonadTell[0m. +in value declaration [33mmonadWriterMyWriter[0m++where [33mw0[0m is a rigid type variable+        bound at (line 0, column 0 - line 0, column 0)  See https://github.com/purescript/documentation/blob/master/errors/MissingNewtypeSuperclassInstance.md for more information, or to contribute content related to this warning.
tests/purs/warning/NewtypeInstance4.out view
@@ -1,13 +1,18 @@ Warning found:+in module [33mMain[0m at tests/purs/warning/NewtypeInstance4.purs:23:1 - 23:86 (line 23, column 1 - line 23, column 86)    The derived newtype instance for-  [33m                               [0m-  [33m  Main.MonadWriter w           [0m-  [33m                   (MyWriter w)[0m-  [33m                               [0m+  [33m                                [0m+  [33m  Main.MonadWriter w0           [0m+  [33m                   (MyWriter w0)[0m+  [33m                                [0m   implies an superclass instance for [33mMain.MonadTell[0m which could not be verified. +in value declaration [33mmonadWriterMyWriter[0m++where [33mw0[0m is a rigid type variable+        bound at (line 0, column 0 - line 0, column 0)  See https://github.com/purescript/documentation/blob/master/errors/UnverifiableSuperclassInstance.md for more information, or to contribute content related to this warning.
tests/support/bower.json view
@@ -8,7 +8,7 @@     "purescript-control": "^6.0.0",     "purescript-distributive": "^6.0.0",     "purescript-effect": "^4.0.0",-    "purescript-either": "^6.0.0",+    "purescript-either": "^6.1.0",     "purescript-enums": "^6.0.0",     "purescript-foldable-traversable": "^6.0.0",     "purescript-functions": "^6.0.0",@@ -29,7 +29,7 @@     "purescript-safe-coerce": "^2.0.0",     "purescript-st": "^6.0.0",     "purescript-strings": "^6.0.0",-    "purescript-tailrec": "^6.0.0",+    "purescript-tailrec": "^6.1.0",     "purescript-tuples": "^7.0.0",     "purescript-type-equality": "^4.0.1",     "purescript-typelevel-prelude": "^7.0.0",