From b7e05967ecec890c1d45d266e221bc877a87f184 Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Sun, 30 Oct 2022 04:54:49 +0100 Subject: [PATCH 01/68] Allow IDE module rebuilds without touching filesystem output/cache-db (#4399) Co-authored-by: wclr --- .../feature_ide-rebuild-without-filesystem.md | 4 ++ CONTRIBUTORS.md | 1 + psc-ide/PROTOCOL.md | 7 +-- src/Language/PureScript/Ide/Rebuild.hs | 29 +++++++++-- src/Language/PureScript/Make/Actions.hs | 51 ++++++++++++------- 5 files changed, 67 insertions(+), 25 deletions(-) create mode 100644 CHANGELOG.d/feature_ide-rebuild-without-filesystem.md diff --git a/CHANGELOG.d/feature_ide-rebuild-without-filesystem.md b/CHANGELOG.d/feature_ide-rebuild-without-filesystem.md new file mode 100644 index 0000000000..7bb4b533d6 --- /dev/null +++ b/CHANGELOG.d/feature_ide-rebuild-without-filesystem.md @@ -0,0 +1,4 @@ +* Allow IDE module rebuilds eschewing the filesystem + + This allows IDE clients to typecheck the module the user is currently typing in without modifying the output. + This allows for faster feedback cycles in editors and avoids producing a broken `/output` before the user actually saves the file. diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 60e0b6fb31..a891e1211b 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -160,6 +160,7 @@ If you would prefer to use different terms, please use the section below instead | [@sd-yip](https://github.com/sd-yip) | Nicholas Yip | [MIT license](http://opensource.org/licenses/MIT) | | [@j-nava](https://github.com/j-nava) | Jesse Nava | [MIT license](http://opensource.org/licenses/MIT) | | [@imcotton](https://github.com/imcotton) | Cotton Hou | [MIT license](http://opensource.org/licenses/MIT) | +| [@wclr](https://github.com/wclr) | Alex Osh | [MIT license](http://opensource.org/licenses/MIT) | ### Contributors using Modified Terms diff --git a/psc-ide/PROTOCOL.md b/psc-ide/PROTOCOL.md index fba93d39f7..d42185483b 100644 --- a/psc-ide/PROTOCOL.md +++ b/psc-ide/PROTOCOL.md @@ -2,7 +2,7 @@ Communication with `purs ide server` is via a JSON protocol over a TCP connection: the server listens on a particular (configurable) port, and will accept a single line -of JSON input in the format described below, terminated by a newline, before giving +of JSON input in the format described below, terminated by a newline, before giving a JSON response and closing the connection. The `purs ide client` command can be used as a wrapper for the TCP connection, but @@ -80,7 +80,7 @@ The `complete` command looks up possible completions/corrections. If no matcher is given every candidate, that passes the filters, is returned in no particular order. - - `currentModule :: (optional) String`: The current modules name. Allows you + - `currentModule :: (optional) String`: The current modules name. Allows you to see module-private functions after a successful rebuild. If it matches with the rebuild cache non-exported modules will also be completed. You can fill the rebuild cache by using the "Rebuild" command. @@ -371,7 +371,8 @@ loaded. A successful rebuild will be stored to allow for completions of private identifiers. Arguments: - - `file :: String` the path to the module to rebuild + - `file :: String` the path to the module to rebuild **or** the complete + source code of the module to be compiled prefixed with `data:` - `actualFile :: Maybe String` Specifies the path to be used for location information and parse errors. This is useful in case a temp file is used as the source for a rebuild. diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs index 52a74a4d01..51d9dd996e 100644 --- a/src/Language/PureScript/Ide/Rebuild.hs +++ b/src/Language/PureScript/Ide/Rebuild.hs @@ -14,9 +14,12 @@ import qualified Data.Map.Lazy as M import Data.Maybe (fromJust) import qualified Data.Set as S import qualified Data.Time as Time +import qualified Data.Text as Text import qualified Language.PureScript as P +import Language.PureScript.Make (ffiCodegen') import Language.PureScript.Make.Cache (CacheInfo(..), normaliseForCache) import qualified Language.PureScript.CST as CST + import Language.PureScript.Ide.Error import Language.PureScript.Ide.Logging import Language.PureScript.Ide.State @@ -51,7 +54,10 @@ rebuildFile -- ^ A runner for the second build with open exports -> m Success rebuildFile file actualFile codegenTargets runOpenBuild = do - (fp, input) <- ideReadFile file + (fp, input) <- + case List.stripPrefix "data:" file of + Just source -> pure ("", Text.pack source) + _ -> ideReadFile file let fp' = fromMaybe fp actualFile (pwarnings, m) <- case sequence $ CST.parseFromFile fp' input of Left parseError -> @@ -65,13 +71,18 @@ rebuildFile file actualFile codegenTargets runOpenBuild = do -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign -- modules using their file paths, we need to specify the path in the 'Map'. let filePathMap = M.singleton moduleName (Left P.RebuildAlways) - foreigns <- P.inferForeignModules (M.singleton moduleName (Right file)) + let pureRebuild = fp == "" + let modulePath = if pureRebuild then fp' else file + foreigns <- P.inferForeignModules (M.singleton moduleName (Right modulePath)) let makeEnv = P.buildMakeActions outputDirectory filePathMap foreigns False + & (if pureRebuild then enableForeignCheck foreigns codegenTargets . shushCodegen else identity) + & shushProgress -- Rebuild the single module using the cached externs (result, warnings) <- logPerf (labelTimespec "Rebuilding Module") $ liftIO $ P.runMake (P.defaultOptions { P.optionsCodegenTargets = codegenTargets }) do - newExterns <- P.rebuildModule (shushProgress makeEnv) externs m - updateCacheDb codegenTargets outputDirectory file actualFile moduleName + newExterns <- P.rebuildModule makeEnv externs m + unless pureRebuild + $ updateCacheDb codegenTargets outputDirectory file actualFile moduleName pure newExterns case result of Left errors -> @@ -176,6 +187,16 @@ shushCodegen ma = , P.ffiCodegen = \_ -> pure () } +-- | Enables foreign module check without actual codegen. +enableForeignCheck + :: M.Map P.ModuleName FilePath + -> S.Set P.CodegenTarget + -> P.MakeActions P.Make + -> P.MakeActions P.Make +enableForeignCheck foreigns codegenTargets ma = + ma { P.ffiCodegen = ffiCodegen' foreigns codegenTargets Nothing + } + -- | Returns a topologically sorted list of dependent ExternsFiles for the given -- module. Throws an error if there is a cyclic dependency within the -- ExternsFiles diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index ff50ba1d0c..27a173e754 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -8,6 +8,7 @@ module Language.PureScript.Make.Actions , cacheDbFile , readCacheDb' , writeCacheDb' + , ffiCodegen' ) where import Prelude @@ -280,23 +281,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = ffiCodegen :: CF.Module CF.Ann -> Make () ffiCodegen m = do codegenTargets <- asks optionsCodegenTargets - when (S.member JS codegenTargets) $ do - let mn = CF.moduleName m - case mn `M.lookup` foreigns of - Just path - | not $ requiresForeign m -> - tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path - | otherwise -> do - checkResult <- checkForeignDecls m path - case checkResult of - Left _ -> copyFile path (outputFilename mn "foreign.js") - Right (ESModule, _) -> copyFile path (outputFilename mn "foreign.js") - Right (CJSModule, _) -> do - throwError $ errorMessage' (CF.moduleSourceSpan m) $ DeprecatedFFICommonJSModule mn path - - Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn - | otherwise -> return () - + ffiCodegen' foreigns codegenTargets (Just outputFilename) m genSourceMap :: String -> String -> Int -> [SMap] -> Make () genSourceMap dir mapFile extraLines mappings = do @@ -358,7 +343,7 @@ checkForeignDecls m path = do modSS = CF.moduleSourceSpan m checkFFI :: JS.JSAST -> Make (ForeignModuleType, S.Set Ident) - checkFFI js = do + checkFFI js = do (foreignModuleType, foreignIdentsStrs) <- case (,) <$> getForeignModuleExports js <*> getForeignModuleImports js of Left reason -> throwError $ errorParsingModule reason @@ -438,3 +423,33 @@ checkForeignDecls m path = do . CST.runTokenParser CST.parseIdent . CST.lex $ T.pack str + +-- | FFI check and codegen action. +-- If path maker is supplied copies foreign module to the output. +ffiCodegen' + :: M.Map ModuleName FilePath + -> S.Set CodegenTarget + -> Maybe (ModuleName -> String -> FilePath) + -> CF.Module CF.Ann + -> Make () +ffiCodegen' foreigns codegenTargets makeOutputPath m = do + when (S.member JS codegenTargets) $ do + let mn = CF.moduleName m + case mn `M.lookup` foreigns of + Just path + | not $ requiresForeign m -> + tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path + | otherwise -> do + checkResult <- checkForeignDecls m path + case checkResult of + Left _ -> copyForeign path mn + Right (ESModule, _) -> copyForeign path mn + Right (CJSModule, _) -> do + throwError $ errorMessage' (CF.moduleSourceSpan m) $ DeprecatedFFICommonJSModule mn path + Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn + | otherwise -> return () + where + requiresForeign = not . null . CF.moduleForeign + + copyForeign path mn = + for_ makeOutputPath (\outputFilename -> copyFile path (outputFilename mn "foreign.js")) From 3b6630592e82ca039d8adec3ad4c8e1dbf0f53e3 Mon Sep 17 00:00:00 2001 From: Nicholas Wolverson Date: Wed, 2 Nov 2022 14:48:00 +0000 Subject: [PATCH 02/68] IDE dependencies filter - filter by import list (#4412) - Given a list of import lines, typically the import section of a module being edited, filter to the declarations brought into scope by those imports plus specified qualifier. --- CHANGELOG.d/feature_ide-dependency-filter.md | 6 + psc-ide/PROTOCOL.md | 14 +- purescript.cabal | 2 + src/Language/PureScript/Ide.hs | 3 +- src/Language/PureScript/Ide/Filter.hs | 32 ++- src/Language/PureScript/Ide/Filter/Imports.hs | 31 +++ src/Language/PureScript/Ide/Imports.hs | 241 +---------------- .../PureScript/Ide/Imports/Actions.hs | 251 ++++++++++++++++++ tests/Language/PureScript/Ide/FilterSpec.hs | 63 ++++- tests/Language/PureScript/Ide/ImportsSpec.hs | 1 + 10 files changed, 399 insertions(+), 245 deletions(-) create mode 100644 CHANGELOG.d/feature_ide-dependency-filter.md create mode 100644 src/Language/PureScript/Ide/Filter/Imports.hs create mode 100644 src/Language/PureScript/Ide/Imports/Actions.hs diff --git a/CHANGELOG.d/feature_ide-dependency-filter.md b/CHANGELOG.d/feature_ide-dependency-filter.md new file mode 100644 index 0000000000..66d9b6b1a4 --- /dev/null +++ b/CHANGELOG.d/feature_ide-dependency-filter.md @@ -0,0 +1,6 @@ +```markdown +* Add `purs ide` dependency/imports filter (#4412 by @nwolverson) + + This allows IDE tooling to filter type searches according to the imports of a given module, + restricting to identifiers in scope. +``` diff --git a/psc-ide/PROTOCOL.md b/psc-ide/PROTOCOL.md index d42185483b..e6cb5d1115 100644 --- a/psc-ide/PROTOCOL.md +++ b/psc-ide/PROTOCOL.md @@ -577,14 +577,22 @@ The Module filter only keeps identifiers that appear in the listed modules. ``` ### Dependency filter -The Dependency filter only keeps identifiers that appear in the listed modules -and in any of their dependencies/imports. +The Dependency filter only keeps identifiers that appear in the listed module or +are brought into scope by any of its imports. + +The module text is provided, though only the portion up until the end of the import section +need be provided. + +Parameters: +- `moduleText :: String` +- `qualifier :: String` (optional) ```json { "filter": "dependencies", "params": { - "modules": ["My.Module"] + "moduleText": "module My.Module where\nimport Foo as F\n", + "qualifier": "F" } } ``` diff --git a/purescript.cabal b/purescript.cabal index 84458234c4..4766e6ec50 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -286,7 +286,9 @@ library Language.PureScript.Ide.Externs Language.PureScript.Ide.Filter Language.PureScript.Ide.Filter.Declaration + Language.PureScript.Ide.Filter.Imports Language.PureScript.Ide.Imports + Language.PureScript.Ide.Imports.Actions Language.PureScript.Ide.Logging Language.PureScript.Ide.Matcher Language.PureScript.Ide.Prim diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs index cf56b4d8b4..fdee5c6f4a 100644 --- a/src/Language/PureScript/Ide.hs +++ b/src/Language/PureScript/Ide.hs @@ -30,7 +30,8 @@ import Language.PureScript.Ide.Completion import Language.PureScript.Ide.Error import Language.PureScript.Ide.Externs import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Imports hiding (Import) +import Language.PureScript.Ide.Imports hiding (Import) +import Language.PureScript.Ide.Imports.Actions import Language.PureScript.Ide.Matcher import Language.PureScript.Ide.Prim import Language.PureScript.Ide.Rebuild diff --git a/src/Language/PureScript/Ide/Filter.hs b/src/Language/PureScript/Ide/Filter.hs index 4bca2e1275..a3086c9e0a 100644 --- a/src/Language/PureScript/Ide/Filter.hs +++ b/src/Language/PureScript/Ide/Filter.hs @@ -19,6 +19,7 @@ module Language.PureScript.Ide.Filter , exactFilter , prefixFilter , declarationTypeFilter + , dependencyFilter , applyFilters ) where @@ -31,8 +32,13 @@ import qualified Data.Set as Set import qualified Data.Map as Map import Language.PureScript.Ide.Filter.Declaration (DeclarationType) import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Imports import Language.PureScript.Ide.Util + import qualified Language.PureScript as P +import qualified Data.Text as T + +import Language.PureScript.Ide.Filter.Imports newtype Filter = Filter (Either (Set P.ModuleName) DeclarationFilter) deriving Show @@ -45,6 +51,7 @@ data DeclarationFilter | Exact Text | Namespace (Set IdeNamespace) | DeclType (Set DeclarationType) + | Dependencies { qualifier :: Maybe P.ModuleName, currentModuleName :: P.ModuleName, dependencyImports :: [Import] } deriving Show -- | Only keeps Declarations in the given modules @@ -67,6 +74,9 @@ prefixFilter t = Filter (Right (Prefix t)) declarationTypeFilter :: Set DeclarationType -> Filter declarationTypeFilter dts = Filter (Right (DeclType dts)) +dependencyFilter :: Maybe P.ModuleName -> P.ModuleName -> [Import] -> Filter +dependencyFilter q m f = Filter (Right (Dependencies q m f)) + optimizeFilters :: [Filter] -> (Maybe (Set P.ModuleName), [DeclarationFilter]) optimizeFilters = first smashModuleFilters . partitionEithers . map unFilter where @@ -88,17 +98,19 @@ applyDeclarationFilters -> ModuleMap [IdeDeclarationAnn] applyDeclarationFilters fs = Map.filter (not . null) - . Map.map (foldr (.) identity (map applyDeclarationFilter fs)) + . Map.mapWithKey (\modl decls -> foldr (.) identity (map (applyDeclarationFilter modl) fs) decls) applyDeclarationFilter - :: DeclarationFilter + :: P.ModuleName + -> DeclarationFilter -> [IdeDeclarationAnn] -> [IdeDeclarationAnn] -applyDeclarationFilter f = case f of +applyDeclarationFilter modl f = case f of Prefix prefix -> prefixFilter' prefix Exact t -> exactFilter' t Namespace namespaces -> namespaceFilter' namespaces DeclType dts -> declarationTypeFilter' dts + Dependencies qual currentModuleName imps -> dependencyFilter' modl qual currentModuleName imps namespaceFilter' :: Set IdeNamespace -> [IdeDeclarationAnn] -> [IdeDeclarationAnn] namespaceFilter' namespaces = @@ -116,6 +128,13 @@ declarationTypeFilter' :: Set DeclarationType -> [IdeDeclarationAnn] -> [IdeDecl declarationTypeFilter' declTypes = filter (\decl -> declarationType (discardAnn decl) `Set.member` declTypes) +dependencyFilter' :: P.ModuleName -> Maybe P.ModuleName -> P.ModuleName -> [Import] -> [IdeDeclarationAnn] -> [IdeDeclarationAnn] +dependencyFilter' modl qual currentModuleName imports = + if modl == currentModuleName && isNothing qual then + identity + else + filter (\decl -> any (matchImport qual modl decl) imports) + instance FromJSON Filter where parseJSON = withObject "filter" $ \o -> do (filter' :: Text) <- o .: "filter" @@ -139,4 +158,11 @@ instance FromJSON Filter where "declarations" -> do declarations <- o.: "params" pure (declarationTypeFilter (Set.fromList declarations)) + "dependencies" -> do + params <- o.: "params" + moduleText <- params .: "moduleText" + qualifier <- fmap P.moduleNameFromString <$> params .:? "qualifier" + case sliceImportSection (T.lines moduleText) of + Left err -> fail ("Couldn't parse module imports: " <> T.unpack err) + Right (currentModuleName, _, imports, _ ) -> pure (dependencyFilter qualifier currentModuleName imports) s -> fail ("Unknown filter: " <> show s) diff --git a/src/Language/PureScript/Ide/Filter/Imports.hs b/src/Language/PureScript/Ide/Filter/Imports.hs new file mode 100644 index 0000000000..f1870b4d09 --- /dev/null +++ b/src/Language/PureScript/Ide/Filter/Imports.hs @@ -0,0 +1,31 @@ +module Language.PureScript.Ide.Filter.Imports where + + +import Protolude hiding (isPrefixOf) + +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Imports + +import qualified Language.PureScript as P + +matchImport :: Maybe P.ModuleName -> P.ModuleName -> IdeDeclarationAnn -> Import -> Bool +matchImport matchQualifier declMod (IdeDeclarationAnn _ decl) (Import importMod declTy qualifier) | declMod == importMod && matchQualifier == qualifier = + case declTy of + P.Implicit -> True + P.Explicit refs -> any (matchRef decl) refs + P.Hiding refs -> not $ any (matchRef decl) refs + where + matchRef (IdeDeclValue (IdeValue ident _)) (P.ValueRef _ ident') = ident == ident' + matchRef (IdeDeclType (IdeType tname _kind _dctors)) (P.TypeRef _ tname' _dctors') = tname == tname' + matchRef (IdeDeclTypeSynonym (IdeTypeSynonym tname _type _kind)) (P.TypeRef _ tname' _dctors) = tname == tname' -- Can this occur? + + matchRef (IdeDeclDataConstructor (IdeDataConstructor dcname tname _type)) (P.TypeRef _ tname' dctors) = + tname == tname' + && maybe True (dcname `elem`) dctors -- (..) or explicitly lists constructor + + matchRef (IdeDeclTypeClass (IdeTypeClass tcname _kind _instances)) (P.TypeClassRef _ tcname') = tcname == tcname' + matchRef (IdeDeclValueOperator (IdeValueOperator{ _ideValueOpName })) (P.ValueOpRef _ opname) = _ideValueOpName == opname + matchRef (IdeDeclTypeOperator (IdeTypeOperator{ _ideTypeOpName })) (P.TypeOpRef _ opname) = _ideTypeOpName == opname + matchRef _ _ = False + +matchImport _ _ _ _ = False diff --git a/src/Language/PureScript/Ide/Imports.hs b/src/Language/PureScript/Ide/Imports.hs index 95fb37e383..94e6d78fd7 100644 --- a/src/Language/PureScript/Ide/Imports.hs +++ b/src/Language/PureScript/Ide/Imports.hs @@ -13,17 +13,11 @@ ----------------------------------------------------------------------------- module Language.PureScript.Ide.Imports - ( addImplicitImport - , addQualifiedImport - , addImportForIdentifier - , answerRequest - , parseImportsFromFile + ( parseImportsFromFile + , parseImportsFromFile' -- for tests , parseImport , prettyPrintImportSection - , addImplicitImport' - , addQualifiedImport' - , addExplicitImport' , sliceImportSection , prettyPrintImport' , Import(Import) @@ -32,22 +26,14 @@ module Language.PureScript.Ide.Imports import Protolude hiding (moduleName) -import Control.Lens ((^.), (%~), ix, has) -import Data.List (nubBy, partition) +import Control.Lens ((^.), (%~), ix) +import Data.List (partition) import qualified Data.List.NonEmpty as NE -import qualified Data.Map as Map import qualified Data.Text as T import qualified Language.PureScript as P -import qualified Language.PureScript.Constants.Prim as C import qualified Language.PureScript.CST as CST -import Language.PureScript.Ide.Completion import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Prim -import Language.PureScript.Ide.Types import Language.PureScript.Ide.Util -import System.IO.UTF8 (writeUTF8FileT) data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName) deriving (Eq, Show) @@ -136,201 +122,6 @@ sliceImportSection fileLines = first (toS . CST.prettyPrintError . NE.head) $ do & ix 0 %~ T.drop (c1 - 1) & ix (l2 - l1) %~ T.take c2 --- | Adds an implicit import like @import Prelude@ to a Sourcefile. -addImplicitImport - :: (MonadIO m, MonadError IdeError m) - => FilePath -- ^ The source file read from - -> P.ModuleName -- ^ The module to import - -> m [Text] -addImplicitImport fp mn = do - (_, pre, imports, post) <- parseImportsFromFile' fp - let newImportSection = addImplicitImport' imports mn - pure $ joinSections (pre, newImportSection, post) - -addImplicitImport' :: [Import] -> P.ModuleName -> [Text] -addImplicitImport' imports mn = - prettyPrintImportSection (Import mn P.Implicit Nothing : imports) - --- | Adds a qualified import like @import Data.Map as Map@ to a source file. -addQualifiedImport - :: (MonadIO m, MonadError IdeError m) - => FilePath - -- ^ The sourcefile read from - -> P.ModuleName - -- ^ The module to import - -> P.ModuleName - -- ^ The qualifier under which to import - -> m [Text] -addQualifiedImport fp mn qualifier = do - (_, pre, imports, post) <- parseImportsFromFile' fp - let newImportSection = addQualifiedImport' imports mn qualifier - pure $ joinSections (pre, newImportSection, post) - -addQualifiedImport' :: [Import] -> P.ModuleName -> P.ModuleName -> [Text] -addQualifiedImport' imports mn qualifier = - prettyPrintImportSection (Import mn P.Implicit (Just qualifier) : imports) - --- | Adds an explicit import like @import Prelude (unit)@ to a Sourcefile. If an --- explicit import already exists for the given module, it adds the identifier --- to that imports list. --- --- So @addExplicitImport "/File.purs" "bind" "Prelude"@ with an already existing --- @import Prelude (bind)@ in the file File.purs returns @["import Prelude --- (bind, unit)"]@ -addExplicitImport :: (MonadIO m, MonadError IdeError m) => - FilePath -> IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> m [Text] -addExplicitImport fp decl moduleName qualifier = do - (mn, pre, imports, post) <- parseImportsFromFile' fp - let newImportSection = - -- TODO: Open an issue when this PR is merged, we should optimise this - -- so that this case does not write to disc - if mn == moduleName - then imports - else addExplicitImport' decl moduleName qualifier imports - pure $ joinSections (pre, prettyPrintImportSection newImportSection, post) - -addExplicitImport' :: IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> [Import] -> [Import] -addExplicitImport' decl moduleName qualifier imports = - let - isImplicitlyImported = - any (\case - Import mn P.Implicit qualifier' -> mn == moduleName && qualifier == qualifier' - _ -> False) imports - isNotExplicitlyImportedFromPrim = - moduleName == C.Prim && - not (any (\case - Import C.Prim (P.Explicit _) Nothing -> True - _ -> False) imports) - -- We can't import Modules from other modules - isModule = has _IdeDeclModule decl - - matches (Import mn (P.Explicit _) qualifier') = mn == moduleName && qualifier == qualifier' - matches _ = False - freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) qualifier - in - if isImplicitlyImported || isNotExplicitlyImportedFromPrim || isModule - then imports - else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports - where - refFromDeclaration (IdeDeclTypeClass tc) = - P.TypeClassRef ideSpan (tc ^. ideTCName) - refFromDeclaration (IdeDeclDataConstructor dtor) = - P.TypeRef ideSpan (dtor ^. ideDtorTypeName) Nothing - refFromDeclaration (IdeDeclType t) = - P.TypeRef ideSpan (t ^. ideTypeName) (Just []) - refFromDeclaration (IdeDeclValueOperator op) = - P.ValueOpRef ideSpan (op ^. ideValueOpName) - refFromDeclaration (IdeDeclTypeOperator op) = - P.TypeOpRef ideSpan (op ^. ideTypeOpName) - refFromDeclaration d = - P.ValueRef ideSpan (P.Ident (identifierFromIdeDeclaration d)) - - -- | Adds a declaration to an import: - -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe) - insertDeclIntoImport :: IdeDeclaration -> Import -> Import - insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) = - Import mn (P.Explicit (sort (insertDeclIntoRefs decl' refs))) qual - insertDeclIntoImport _ is = is - - insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef] - insertDeclIntoRefs d@(IdeDeclDataConstructor dtor) refs = - updateAtFirstOrPrepend - (matchType (dtor ^. ideDtorTypeName)) - (insertDtor (dtor ^. ideDtorName)) - (refFromDeclaration d) - refs - insertDeclIntoRefs (IdeDeclType t) refs - | any matches refs = refs - where - matches (P.TypeRef _ typeName _) = _ideTypeName t == typeName - matches _ = False - insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs) - - insertDtor _ (P.TypeRef ss tn' _) = P.TypeRef ss tn' Nothing - insertDtor _ refs = refs - - matchType :: P.ProperName 'P.TypeName -> P.DeclarationRef -> Bool - matchType tn (P.TypeRef _ n _) = tn == n - matchType _ _ = False - -ideSpan :: P.SourceSpan -ideSpan = P.internalModuleSourceSpan "" - --- | If none of the elements of the list satisfy the given predicate 'predicate', then prepend the default value 'def' --- to the given list. Otherwise, update the first element of the list that satisfies 'predicate' with the updating --- function 'update'. -updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a] -updateAtFirstOrPrepend predicate update def xs = - case break predicate xs of - (before, []) -> def : before - (before, x : after) -> before ++ [update x] ++ after - --- | Looks up the given identifier in the currently loaded modules. --- --- * Throws an error if the identifier cannot be found. --- --- * If exactly one match is found, adds an explicit import to the importsection --- --- * If more than one possible imports are found, reports the possibilities as a --- list of completions. -addImportForIdentifier - :: (Ide m, MonadError IdeError m) - => FilePath -- ^ The Sourcefile to read from - -> Text -- ^ The identifier to import - -> Maybe P.ModuleName -- ^ The optional qualifier under which to import - -> [Filter] -- ^ Filters to apply before searching for the identifier - -> m (Either [Match IdeDeclaration] [Text]) -addImportForIdentifier fp ident qual filters = do - let addPrim = Map.union idePrimDeclarations - modules <- getAllModules Nothing - let - matches = - getExactMatches ident filters (addPrim modules) - & map (fmap discardAnn) - & filter (\(Match (_, d)) -> not (has _IdeDeclModule d)) - - case matches of - [] -> - throwError (NotFound "Couldn't find the given identifier. \ - \Have you loaded the corresponding module?") - - -- Only one match was found for the given identifier, so we can insert it - -- right away - [Match (m, decl)] -> - Right <$> addExplicitImport fp decl m qual - - -- This case comes up for newtypes and dataconstructors. Because values and - -- types don't share a namespace we can get multiple matches from the same - -- module. This also happens for parameterized types, as these generate both - -- a type as well as a type synonym. - - ms@[Match (m1, d1), Match (m2, d2)] -> - if m1 /= m2 - -- If the modules don't line up we just ask the user to specify the - -- module - then pure (Left ms) - else case decideRedundantCase d1 d2 <|> decideRedundantCase d2 d1 of - -- If dataconstructor and type line up we just import the - -- dataconstructor as that will give us an unnecessary import warning at - -- worst - Just decl -> - Right <$> addExplicitImport fp decl m1 qual - -- Here we need the user to specify whether they wanted a - -- dataconstructor or a type - Nothing -> - throwError (GeneralError "Undecidable between type and dataconstructor") - - -- Multiple matches were found so we need to ask the user to clarify which - -- module they meant - xs -> - pure (Left xs) - where - decideRedundantCase d@(IdeDeclDataConstructor dtor) (IdeDeclType t) = - if dtor ^. ideDtorTypeName == t ^. ideTypeName then Just d else Nothing - decideRedundantCase IdeDeclType{} ts@IdeDeclTypeSynonym{} = - Just ts - decideRedundantCase _ _ = Nothing - prettyPrintImport' :: Import -> Text prettyPrintImport' (Import mn idt qual) = "import " <> P.prettyPrintImport mn idt qual @@ -352,18 +143,6 @@ prettyPrintImportSection imports = Import _ (P.Hiding _) Nothing -> True _ -> False - --- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@, --- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the --- first argument. -answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success -answerRequest outfp rs = - case outfp of - Nothing -> pure (MultilineTextResult rs) - Just outfp' -> do - liftIO (writeUTF8FileT outfp' (T.unlines rs)) - pure (TextResult ("Written to " <> T.pack outfp')) - -- | Test and ghci helper parseImport :: Text -> Maybe Import parseImport t = @@ -373,15 +152,3 @@ parseImport t = Right (_, mn, idt, mmn) -> Just (Import mn idt mmn) _ -> Nothing - -joinSections :: ([Text], [Text], [Text]) -> [Text] -joinSections (pre, decls, post) = pre `joinLine` (decls `joinLine` post) - where - isBlank = T.all (== ' ') - joinLine as bs - | Just ln1 <- lastMay as - , Just ln2 <- head bs - , not (isBlank ln1) && not (isBlank ln2) = - as ++ [""] ++ bs - | otherwise = - as ++ bs diff --git a/src/Language/PureScript/Ide/Imports/Actions.hs b/src/Language/PureScript/Ide/Imports/Actions.hs new file mode 100644 index 0000000000..9465d68033 --- /dev/null +++ b/src/Language/PureScript/Ide/Imports/Actions.hs @@ -0,0 +1,251 @@ +module Language.PureScript.Ide.Imports.Actions + ( addImplicitImport + , addQualifiedImport + , addImportForIdentifier + , answerRequest + + -- for tests + , addImplicitImport' + , addQualifiedImport' + , addExplicitImport' + ) +where + +import Protolude hiding (moduleName) + +import Control.Lens ((^.), has) +import Data.List (nubBy) +import qualified Data.Map as Map +import qualified Data.Text as T +import qualified Language.PureScript as P +import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Ide.Completion +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.Filter +import Language.PureScript.Ide.Imports +import Language.PureScript.Ide.State +import Language.PureScript.Ide.Prim +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util +import System.IO.UTF8 (writeUTF8FileT) + +-- | Adds an implicit import like @import Prelude@ to a Sourcefile. +addImplicitImport + :: (MonadIO m, MonadError IdeError m) + => FilePath -- ^ The source file read from + -> P.ModuleName -- ^ The module to import + -> m [Text] +addImplicitImport fp mn = do + (_, pre, imports, post) <- parseImportsFromFile' fp + let newImportSection = addImplicitImport' imports mn + pure $ joinSections (pre, newImportSection, post) + +addImplicitImport' :: [Import] -> P.ModuleName -> [Text] +addImplicitImport' imports mn = + prettyPrintImportSection (Import mn P.Implicit Nothing : imports) + +-- | Adds a qualified import like @import Data.Map as Map@ to a source file. +addQualifiedImport + :: (MonadIO m, MonadError IdeError m) + => FilePath + -- ^ The sourcefile read from + -> P.ModuleName + -- ^ The module to import + -> P.ModuleName + -- ^ The qualifier under which to import + -> m [Text] +addQualifiedImport fp mn qualifier = do + (_, pre, imports, post) <- parseImportsFromFile' fp + let newImportSection = addQualifiedImport' imports mn qualifier + pure $ joinSections (pre, newImportSection, post) + +addQualifiedImport' :: [Import] -> P.ModuleName -> P.ModuleName -> [Text] +addQualifiedImport' imports mn qualifier = + prettyPrintImportSection (Import mn P.Implicit (Just qualifier) : imports) + +-- | Adds an explicit import like @import Prelude (unit)@ to a Sourcefile. If an +-- explicit import already exists for the given module, it adds the identifier +-- to that imports list. +-- +-- So @addExplicitImport "/File.purs" "bind" "Prelude"@ with an already existing +-- @import Prelude (bind)@ in the file File.purs returns @["import Prelude +-- (bind, unit)"]@ +addExplicitImport :: (MonadIO m, MonadError IdeError m) => + FilePath -> IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> m [Text] +addExplicitImport fp decl moduleName qualifier = do + (mn, pre, imports, post) <- parseImportsFromFile' fp + let newImportSection = + -- TODO: Open an issue when this PR is merged, we should optimise this + -- so that this case does not write to disc + if mn == moduleName + then imports + else addExplicitImport' decl moduleName qualifier imports + pure $ joinSections (pre, prettyPrintImportSection newImportSection, post) + +addExplicitImport' :: IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> [Import] -> [Import] +addExplicitImport' decl moduleName qualifier imports = + let + isImplicitlyImported = + any (\case + Import mn P.Implicit qualifier' -> mn == moduleName && qualifier == qualifier' + _ -> False) imports + isNotExplicitlyImportedFromPrim = + moduleName == C.Prim && + not (any (\case + Import C.Prim (P.Explicit _) Nothing -> True + _ -> False) imports) + -- We can't import Modules from other modules + isModule = has _IdeDeclModule decl + + matches (Import mn (P.Explicit _) qualifier') = mn == moduleName && qualifier == qualifier' + matches _ = False + freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) qualifier + in + if isImplicitlyImported || isNotExplicitlyImportedFromPrim || isModule + then imports + else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports + where + refFromDeclaration (IdeDeclTypeClass tc) = + P.TypeClassRef ideSpan (tc ^. ideTCName) + refFromDeclaration (IdeDeclDataConstructor dtor) = + P.TypeRef ideSpan (dtor ^. ideDtorTypeName) Nothing + refFromDeclaration (IdeDeclType t) = + P.TypeRef ideSpan (t ^. ideTypeName) (Just []) + refFromDeclaration (IdeDeclValueOperator op) = + P.ValueOpRef ideSpan (op ^. ideValueOpName) + refFromDeclaration (IdeDeclTypeOperator op) = + P.TypeOpRef ideSpan (op ^. ideTypeOpName) + refFromDeclaration d = + P.ValueRef ideSpan (P.Ident (identifierFromIdeDeclaration d)) + + -- | Adds a declaration to an import: + -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe) + insertDeclIntoImport :: IdeDeclaration -> Import -> Import + insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) = + Import mn (P.Explicit (sort (insertDeclIntoRefs decl' refs))) qual + insertDeclIntoImport _ is = is + + insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef] + insertDeclIntoRefs d@(IdeDeclDataConstructor dtor) refs = + updateAtFirstOrPrepend + (matchType (dtor ^. ideDtorTypeName)) + (insertDtor (dtor ^. ideDtorName)) + (refFromDeclaration d) + refs + insertDeclIntoRefs (IdeDeclType t) refs + | any matches refs = refs + where + matches (P.TypeRef _ typeName _) = _ideTypeName t == typeName + matches _ = False + insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs) + + insertDtor _ (P.TypeRef ss tn' _) = P.TypeRef ss tn' Nothing + insertDtor _ refs = refs + + matchType :: P.ProperName 'P.TypeName -> P.DeclarationRef -> Bool + matchType tn (P.TypeRef _ n _) = tn == n + matchType _ _ = False + + +-- | Looks up the given identifier in the currently loaded modules. +-- +-- * Throws an error if the identifier cannot be found. +-- +-- * If exactly one match is found, adds an explicit import to the importsection +-- +-- * If more than one possible imports are found, reports the possibilities as a +-- list of completions. +addImportForIdentifier + :: (Ide m, MonadError IdeError m) + => FilePath -- ^ The Sourcefile to read from + -> Text -- ^ The identifier to import + -> Maybe P.ModuleName -- ^ The optional qualifier under which to import + -> [Filter] -- ^ Filters to apply before searching for the identifier + -> m (Either [Match IdeDeclaration] [Text]) +addImportForIdentifier fp ident qual filters = do + let addPrim = Map.union idePrimDeclarations + modules <- getAllModules Nothing + let + matches = + getExactMatches ident filters (addPrim modules) + & map (fmap discardAnn) + & filter (\(Match (_, d)) -> not (has _IdeDeclModule d)) + + case matches of + [] -> + throwError (NotFound "Couldn't find the given identifier. \ + \Have you loaded the corresponding module?") + + -- Only one match was found for the given identifier, so we can insert it + -- right away + [Match (m, decl)] -> + Right <$> addExplicitImport fp decl m qual + + -- This case comes up for newtypes and dataconstructors. Because values and + -- types don't share a namespace we can get multiple matches from the same + -- module. This also happens for parameterized types, as these generate both + -- a type as well as a type synonym. + + ms@[Match (m1, d1), Match (m2, d2)] -> + if m1 /= m2 + -- If the modules don't line up we just ask the user to specify the + -- module + then pure (Left ms) + else case decideRedundantCase d1 d2 <|> decideRedundantCase d2 d1 of + -- If dataconstructor and type line up we just import the + -- dataconstructor as that will give us an unnecessary import warning at + -- worst + Just decl -> + Right <$> addExplicitImport fp decl m1 qual + -- Here we need the user to specify whether they wanted a + -- dataconstructor or a type + Nothing -> + throwError (GeneralError "Undecidable between type and dataconstructor") + + -- Multiple matches were found so we need to ask the user to clarify which + -- module they meant + xs -> + pure (Left xs) + where + decideRedundantCase d@(IdeDeclDataConstructor dtor) (IdeDeclType t) = + if dtor ^. ideDtorTypeName == t ^. ideTypeName then Just d else Nothing + decideRedundantCase IdeDeclType{} ts@IdeDeclTypeSynonym{} = + Just ts + decideRedundantCase _ _ = Nothing + +-- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@, +-- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the +-- first argument. +answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success +answerRequest outfp rs = + case outfp of + Nothing -> pure (MultilineTextResult rs) + Just outfp' -> do + liftIO (writeUTF8FileT outfp' (T.unlines rs)) + pure (TextResult ("Written to " <> T.pack outfp')) + + +-- | If none of the elements of the list satisfy the given predicate 'predicate', then prepend the default value 'def' +-- to the given list. Otherwise, update the first element of the list that satisfies 'predicate' with the updating +-- function 'update'. +updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a] +updateAtFirstOrPrepend predicate update def xs = + case break predicate xs of + (before, []) -> def : before + (before, x : after) -> before ++ [update x] ++ after + + +ideSpan :: P.SourceSpan +ideSpan = P.internalModuleSourceSpan "" + +joinSections :: ([Text], [Text], [Text]) -> [Text] +joinSections (pre, decls, post) = pre `joinLine` (decls `joinLine` post) + where + isBlank = T.all (== ' ') + joinLine as bs + | Just ln1 <- lastMay as + , Just ln2 <- head bs + , not (isBlank ln1) && not (isBlank ln2) = + as ++ [""] ++ bs + | otherwise = + as ++ bs diff --git a/tests/Language/PureScript/Ide/FilterSpec.hs b/tests/Language/PureScript/Ide/FilterSpec.hs index ea397c5bbf..2e4eb1f698 100644 --- a/tests/Language/PureScript/Ide/FilterSpec.hs +++ b/tests/Language/PureScript/Ide/FilterSpec.hs @@ -6,13 +6,14 @@ import qualified Data.Set as Set import Language.PureScript.Ide.Filter import Language.PureScript.Ide.Filter.Declaration as D import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Imports import Language.PureScript.Ide.Test as T import qualified Language.PureScript as P import Test.Hspec type Module = (P.ModuleName, [IdeDeclarationAnn]) -moduleA, moduleB, moduleC, moduleD, moduleE, moduleF, moduleG, moduleH, moduleI :: Module +moduleA, moduleB, moduleC, moduleD, moduleE, moduleF, moduleG, moduleH, moduleI, moduleDCtors :: Module moduleA = (P.moduleNameFromString "Module.A", [T.ideValue "function1" Nothing]) moduleB = (P.moduleNameFromString "Module.B", [T.ideValue "data1" Nothing]) moduleC = (P.moduleNameFromString "Module.C", [T.ideType "List" Nothing []]) @@ -22,10 +23,14 @@ moduleF = (P.moduleNameFromString "Module.F", [T.ideDtor "DtorA" "TypeA" Nothing moduleG = (P.moduleNameFromString "Module.G", [T.ideTypeClass "MyClass" P.kindType []]) moduleH = (P.moduleNameFromString "Module.H", [T.ideValueOp "<$>" (P.Qualified P.ByNullSourcePos (Left "")) 0 Nothing Nothing]) moduleI = (P.moduleNameFromString "Module.I", [T.ideTypeOp "~>" (P.Qualified P.ByNullSourcePos "") 0 Nothing Nothing]) +moduleDCtors = (P.moduleNameFromString "Module.WithDC", [T.ideType "Foo" Nothing [(P.ProperName "A", P.tyString), (P.ProperName "B", P.tyString)] ]) modules :: ModuleMap [IdeDeclarationAnn] modules = Map.fromList [moduleA, moduleB] +allModules :: ModuleMap [IdeDeclarationAnn] +allModules = Map.fromList [moduleA, moduleB,moduleC,moduleD,moduleE,moduleF,moduleG,moduleH,moduleI,moduleDCtors] + runEq :: Text -> [Module] runEq s = Map.toList (applyFilters [exactFilter s] modules) @@ -41,6 +46,20 @@ runNamespace namespaces = Map.toList . applyFilters [namespaceFilter namespaces] runDeclaration :: [D.DeclarationType] -> [Module] -> [Module] runDeclaration decls = Map.toList . applyFilters [declarationTypeFilter (Set.fromList decls)] . Map.fromList +runDependency :: [Text] -> [Module] +runDependency = runDependency' "Whatever" + +runDependency' :: Text -> [Text] -> [Module] +runDependency' currentModuleName imports = Map.toList $ applyFilters [dependencyFilter Nothing (P.ModuleName currentModuleName) (testParseImports currentModuleName imports)] allModules + +runDependencyQualified :: Text -> [Text] -> [Module] +runDependencyQualified qualifier imports = Map.toList $ applyFilters [dependencyFilter (Just $ P.ModuleName qualifier) (P.ModuleName "Whatever") (testParseImports "Whatever" imports)] allModules + +testParseImports :: Text -> [Text] -> [Import] +testParseImports currentModuleName imports = either (const []) (\(_, _, x, _) -> x) $ sliceImportSection moduleLines + where + moduleLines = "module " <> currentModuleName <> " where" : (imports <> [ "", "blah = 42" ]) + spec :: Spec spec = do describe "equality Filter" $ do @@ -130,3 +149,45 @@ spec = do it "extracts modules by filtering `value`, and `valueoperator` declarations" $ runDeclaration [D.Value, D.ValueOperator] [moduleA, moduleB, moduleD, moduleG, moduleE, moduleH] `shouldBe` [moduleA, moduleB, moduleH] + describe "dependencyFilter" $ do + describe "import types" $ do + it "filters by implicit imports" $ do + runDependency ["import Module.A", "import Module.C"] `shouldBe` [moduleA, moduleC] + it "filters by matching explicit value import" $ do + runDependency ["import Module.A (function1)"] `shouldBe` [moduleA] + it "filters by matching explicit value import from correct module" $ do + runDependency ["import Module.B (function1)"] `shouldBe` [] + it "filters not matching explicit value import" $ do + runDependency ["import Module.A (function2)"] `shouldBe` [] + it "filters out names in hiding import" $ do + runDependency ["import Module.A hiding (function1)"] `shouldBe` [] + it "doesn't filter out not matching names in hiding import" $ do + runDependency ["import Module.A hiding (nonsense)"] `shouldBe` [moduleA] + it "filters by containing module" $ do + runDependency' "Module.A" ["import Module.Blah"] `shouldBe` [moduleA] + describe "declaration types" $ do + it "matches type" $ do + runDependency ["import Module.C (List)"] `shouldBe` [moduleC] + it "includes data constructor with (..)" $ do + runDependency ["import Module.F (TypeA(..))"] `shouldBe` [moduleF] + it "includes data constructor explicitly listed" $ do + runDependency ["import Module.F (TypeA(DtorA))"] `shouldBe` [moduleF] + it "does not include data constructor not explicitly listed" $ do + runDependency ["import Module.F (TypeA(BogusOtherConstructor))"] `shouldBe` [] + it "does not include data constructor when only the type is imported" $ do + runDependency ["import Module.F (TypeA)"] `shouldBe` [] + it "includes synonym" $ do + runDependency ["import Module.E (SFType)"] `shouldBe` [moduleE] + it "includes typeclass" $ do + runDependency ["import Module.G (class MyClass)"] `shouldBe` [moduleG] + it "includes value op" $ do + runDependency ["import Module.H ((<$>))"] `shouldBe` [moduleH] + it "includes type op" $ do + runDependency ["import Module.I (type (~>))"] `shouldBe` [moduleI] + describe "qualifiers" $ do + it "includes single qualified import and not unqualified things" $ do + runDependencyQualified "AA" [ "import Module.A as AA", "import Module.C"] `shouldBe` [moduleA] + it "includes multiple qualified imports" $ do + runDependencyQualified "Combined.Thing" [ "import Module.A as Combined.Thing", "import Module.C as Combined.Thing", "import Module.F"] `shouldBe` [moduleA, moduleC] + it "doesn't include qualified import when qualifier not specified" $ do + runDependency [ "import Module.AA as A"] `shouldBe` [] diff --git a/tests/Language/PureScript/Ide/ImportsSpec.hs b/tests/Language/PureScript/Ide/ImportsSpec.hs index e56f23a857..91c51c7045 100644 --- a/tests/Language/PureScript/Ide/ImportsSpec.hs +++ b/tests/Language/PureScript/Ide/ImportsSpec.hs @@ -8,6 +8,7 @@ import qualified Language.PureScript as P import Language.PureScript.Ide.Command as Command import Language.PureScript.Ide.Error import Language.PureScript.Ide.Imports +import Language.PureScript.Ide.Imports.Actions import Language.PureScript.Ide.Filter (moduleFilter) import qualified Language.PureScript.Ide.Test as Test import Language.PureScript.Ide.Types From 45cb5d55f08e45c2ac66dc9cd6f9c898a6c3da2e Mon Sep 17 00:00:00 2001 From: Verity Scheel Date: Wed, 2 Nov 2022 20:17:13 -0500 Subject: [PATCH 03/68] Add variable name, spans to DuplicateDeclarationsInLet error (#4405) Shows the last of the duplicate variable declarations first, since that seems to be preferred in psa and IDEs --- CHANGELOG.d/misc_overlapping-let.md | 1 + src/Language/PureScript/Errors.hs | 8 +++---- src/Language/PureScript/Sugar/Names.hs | 21 ++++++++++++------ .../failing/DuplicateDeclarationsInLet.out | 4 ++-- .../failing/DuplicateDeclarationsInLet.purs | 2 -- .../failing/DuplicateDeclarationsInLet2.out | 10 +++++++++ .../failing/DuplicateDeclarationsInLet2.purs | 10 +++++++++ .../failing/DuplicateDeclarationsInLet3.out | 22 +++++++++++++++++++ .../failing/DuplicateDeclarationsInLet3.purs | 16 ++++++++++++++ 9 files changed, 79 insertions(+), 15 deletions(-) create mode 100644 CHANGELOG.d/misc_overlapping-let.md create mode 100644 tests/purs/failing/DuplicateDeclarationsInLet2.out create mode 100644 tests/purs/failing/DuplicateDeclarationsInLet2.purs create mode 100644 tests/purs/failing/DuplicateDeclarationsInLet3.out create mode 100644 tests/purs/failing/DuplicateDeclarationsInLet3.purs diff --git a/CHANGELOG.d/misc_overlapping-let.md b/CHANGELOG.d/misc_overlapping-let.md new file mode 100644 index 0000000000..0100fe2e42 --- /dev/null +++ b/CHANGELOG.d/misc_overlapping-let.md @@ -0,0 +1 @@ +* Improve `DuplicateDeclarationsInLet` error so that it mentions what variable names were duplicated, reporting several in separate errors as necessary. diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index eecbfc3ce3..872022d065 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -79,7 +79,7 @@ data SimpleErrorMessage | OrphanKindDeclaration (ProperName 'TypeName) | OrphanRoleDeclaration (ProperName 'TypeName) | RedefinedIdent Ident - | OverlappingNamesInLet + | OverlappingNamesInLet Ident | UnknownName (Qualified Name) | UnknownImport ModuleName Name | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName) @@ -258,7 +258,7 @@ errorCode em = case unwrapErrorMessage em of OrphanKindDeclaration{} -> "OrphanKindDeclaration" OrphanRoleDeclaration{} -> "OrphanRoleDeclaration" RedefinedIdent{} -> "RedefinedIdent" - OverlappingNamesInLet -> "OverlappingNamesInLet" + OverlappingNamesInLet{} -> "OverlappingNamesInLet" UnknownName{} -> "UnknownName" UnknownImport{} -> "UnknownImport" UnknownImportDataConstructor{} -> "UnknownImportDataConstructor" @@ -731,8 +731,8 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon line "The last statement in a 'do' block must be an expression, but this block ends with a binder." renderSimpleErrorMessage InvalidDoLet = line "The last statement in a 'do' block must be an expression, but this block ends with a let binding." - renderSimpleErrorMessage OverlappingNamesInLet = - line "The same name was used more than once in a let binding." + renderSimpleErrorMessage (OverlappingNamesInLet name) = + line $ "The name " <> markCode (showIdent name) <> " was defined multiple times in a binding group" renderSimpleErrorMessage (InfiniteType ty) = paras [ line "An infinite type was inferred for an expression: " , markCodeBox $ indent $ prettyType ty diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs index 03968af376..7c09126af8 100644 --- a/src/Language/PureScript/Sugar/Names.hs +++ b/src/Language/PureScript/Sugar/Names.hs @@ -10,14 +10,15 @@ module Language.PureScript.Sugar.Names ) where import Prelude -import Protolude (ordNub, sortOn, swap, foldl') +import Protolude (sortOn, swap, foldl') -import Control.Arrow (first, second) +import Control.Arrow (first, second, (&&&)) import Control.Monad import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Lazy import Control.Monad.Writer (MonadWriter(..)) +import qualified Data.List.NonEmpty as NEL import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Map as M import qualified Data.Set as S @@ -253,9 +254,15 @@ renameInModule imports (Module modSS coms mn decls exps) = updateValue (pos, bound) (Abs (VarBinder ss arg) val') = return ((pos, M.insert arg (spanStart ss) bound), Abs (VarBinder ss arg) val') updateValue (pos, bound) (Let w ds val') = do - let args = mapMaybe letBoundVariable ds - unless (length (ordNub args) == length args) . - throwError . errorMessage' pos $ OverlappingNamesInLet + let + args = mapMaybe letBoundVariable ds + groupByFst = map (\ts -> (fst (NEL.head ts), snd <$> ts)) . NEL.groupAllWith fst + duplicateArgsErrs = foldMap mkArgError $ groupByFst args + mkArgError (ident, poses) + | NEL.length poses < 2 = mempty + | otherwise = errorMessage'' (NEL.reverse poses) (OverlappingNamesInLet ident) + when (nonEmpty duplicateArgsErrs) $ + throwError duplicateArgsErrs return ((pos, declarationsToMap ds `M.union` bound), Let w ds val') updateValue (_, bound) (Var ss name'@(Qualified qualifiedBy ident)) = ((ss, bound), ) <$> case (M.lookup ident bound, qualifiedBy) of @@ -324,8 +331,8 @@ renameInModule imports (Module modSS coms mn decls exps) = . fmap (second spanStart . swap) . binderNamesWithSpans - letBoundVariable :: Declaration -> Maybe Ident - letBoundVariable = fmap valdeclIdent . getValueDeclaration + letBoundVariable :: Declaration -> Maybe (Ident, SourceSpan) + letBoundVariable = fmap (valdeclIdent &&& (fst . valdeclSourceAnn)) . getValueDeclaration declarationsToMap :: [Declaration] -> M.Map Ident SourcePos declarationsToMap = foldl goDTM M.empty diff --git a/tests/purs/failing/DuplicateDeclarationsInLet.out b/tests/purs/failing/DuplicateDeclarationsInLet.out index 831dad6fc2..038e5e23c9 100644 --- a/tests/purs/failing/DuplicateDeclarationsInLet.out +++ b/tests/purs/failing/DuplicateDeclarationsInLet.out @@ -1,8 +1,8 @@ Error found: in module Main -at tests/purs/failing/DuplicateDeclarationsInLet.purs:6:7 - 6:8 (line 6, column 7 - line 6, column 8) +at tests/purs/failing/DuplicateDeclarationsInLet.purs:9:3 - 9:14 (line 9, column 3 - line 9, column 14) - The same name was used more than once in a let binding. + The name a was defined multiple times in a binding group See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information, diff --git a/tests/purs/failing/DuplicateDeclarationsInLet.purs b/tests/purs/failing/DuplicateDeclarationsInLet.purs index fed163d7aa..861a607d42 100644 --- a/tests/purs/failing/DuplicateDeclarationsInLet.purs +++ b/tests/purs/failing/DuplicateDeclarationsInLet.purs @@ -1,8 +1,6 @@ -- @shouldFailWith OverlappingNamesInLet module Main where -import Prelude - foo = a where a :: Number diff --git a/tests/purs/failing/DuplicateDeclarationsInLet2.out b/tests/purs/failing/DuplicateDeclarationsInLet2.out new file mode 100644 index 0000000000..25957ecbc8 --- /dev/null +++ b/tests/purs/failing/DuplicateDeclarationsInLet2.out @@ -0,0 +1,10 @@ +Error found: +in module Main +at tests/purs/failing/DuplicateDeclarationsInLet2.purs:10:3 - 10:24 (line 10, column 3 - line 10, column 24) + + The name interrupted was defined multiple times in a binding group + + +See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/DuplicateDeclarationsInLet2.purs b/tests/purs/failing/DuplicateDeclarationsInLet2.purs new file mode 100644 index 0000000000..98549b3b1f --- /dev/null +++ b/tests/purs/failing/DuplicateDeclarationsInLet2.purs @@ -0,0 +1,10 @@ +-- @shouldFailWith OverlappingNamesInLet +module Main where + +foo = interrupted + where + interrupted true = 1 + + interrupter = 2 + + interrupted false = 3 diff --git a/tests/purs/failing/DuplicateDeclarationsInLet3.out b/tests/purs/failing/DuplicateDeclarationsInLet3.out new file mode 100644 index 0000000000..33d911057f --- /dev/null +++ b/tests/purs/failing/DuplicateDeclarationsInLet3.out @@ -0,0 +1,22 @@ +Error 1 of 2: + + in module Main + at tests/purs/failing/DuplicateDeclarationsInLet3.purs:9:3 - 9:11 (line 9, column 3 - line 9, column 11) + + The name a was defined multiple times in a binding group + + + See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information, + or to contribute content related to this error. + +Error 2 of 2: + + in module Main + at tests/purs/failing/DuplicateDeclarationsInLet3.purs:16:3 - 16:24 (line 16, column 3 - line 16, column 24) + + The name interrupted was defined multiple times in a binding group + + + See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information, + or to contribute content related to this error. + diff --git a/tests/purs/failing/DuplicateDeclarationsInLet3.purs b/tests/purs/failing/DuplicateDeclarationsInLet3.purs new file mode 100644 index 0000000000..9ca900ea58 --- /dev/null +++ b/tests/purs/failing/DuplicateDeclarationsInLet3.purs @@ -0,0 +1,16 @@ +-- @shouldFailWith OverlappingNamesInLet +-- @shouldFailWith OverlappingNamesInLet +module Main where + +-- Should see separate errors for `a` and `interrupted` +foo = interrupter + a + where + a = 0 + a :: Int + a = 0 + + interrupted true = 1 + + interrupter = 2 + + interrupted false = 3 From 10609242a269b4409fb7d4571fc905cd9fc999cb Mon Sep 17 00:00:00 2001 From: Ruslan Gadeev Date: Fri, 11 Nov 2022 03:08:56 +0300 Subject: [PATCH 04/68] Fix typos (#4415) --- CHANGELOG.d/misc_fix-typos.md | 1 + CONTRIBUTORS.md | 1 + psc-ide/DESIGN.org | 2 +- src/Language/PureScript/CST/Layout.hs | 2 +- src/Language/PureScript/Ide/Matcher.hs | 2 +- src/Language/PureScript/Sugar/Operators.hs | 4 ++-- .../TypeChecker/Entailment/Coercible.hs | 16 ++++++++-------- src/Language/PureScript/TypeChecker/Kinds.hs | 2 +- src/Language/PureScript/Types.hs | 2 +- 9 files changed, 17 insertions(+), 15 deletions(-) create mode 100644 CHANGELOG.d/misc_fix-typos.md diff --git a/CHANGELOG.d/misc_fix-typos.md b/CHANGELOG.d/misc_fix-typos.md new file mode 100644 index 0000000000..6daaeb3cc1 --- /dev/null +++ b/CHANGELOG.d/misc_fix-typos.md @@ -0,0 +1 @@ +* Fix various typos in documentation and source comments. \ No newline at end of file diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index a891e1211b..9c62eee433 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -161,6 +161,7 @@ If you would prefer to use different terms, please use the section below instead | [@j-nava](https://github.com/j-nava) | Jesse Nava | [MIT license](http://opensource.org/licenses/MIT) | | [@imcotton](https://github.com/imcotton) | Cotton Hou | [MIT license](http://opensource.org/licenses/MIT) | | [@wclr](https://github.com/wclr) | Alex Osh | [MIT license](http://opensource.org/licenses/MIT) | +| [@Deltaspace0](https://github.com/Deltaspace0) | Ruslan Gadeev | [MIT license](http://opensource.org/licenses/MIT) | ### Contributors using Modified Terms diff --git a/psc-ide/DESIGN.org b/psc-ide/DESIGN.org index 432d40bcad..45b77f22a3 100644 --- a/psc-ide/DESIGN.org +++ b/psc-ide/DESIGN.org @@ -122,7 +122,7 @@ =ide= makes sure to not run into deadlocks or data races. However the current implementation of =purs ide server= runs all the commands - sequentially, because the commmands run fast enough at this point, and a + sequentially, because the commands run fast enough at this point, and a users interaction with his editor are mostly sequential anyway. * Commands The three most involved commands are completion, adding imports and rebuilding. diff --git a/src/Language/PureScript/CST/Layout.hs b/src/Language/PureScript/CST/Layout.hs index 2b32704373..ea2dbfa769 100644 --- a/src/Language/PureScript/CST/Layout.hs +++ b/src/Language/PureScript/CST/Layout.hs @@ -82,7 +82,7 @@ -- ] of -- @ -- --- Which of the above 13 commas function as the separaters between the +-- Which of the above 13 commas function as the separators between the -- case binders (e.g. @one@) in the outermost @case ... of@ context? -- -- ### The Solution diff --git a/src/Language/PureScript/Ide/Matcher.hs b/src/Language/PureScript/Ide/Matcher.hs index 40b8283a02..9263abdb5e 100644 --- a/src/Language/PureScript/Ide/Matcher.hs +++ b/src/Language/PureScript/Ide/Matcher.hs @@ -94,7 +94,7 @@ flexRate p c = do -- Borrowed from: http://cdewaka.com/2013/06/fuzzy-pattern-matching-in-haskell/ -- -- By string =~ pattern we'll get the start of the match and the length of --- the matchas a (start, length) tuple if there's a match. +-- the matches a (start, length) tuple if there's a match. -- If match fails then it would be (-1,0) flexScore :: Text -> Text -> Maybe Double flexScore pat str = diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs index ca3c282d3a..f830a31c09 100644 --- a/src/Language/PureScript/Sugar/Operators.hs +++ b/src/Language/PureScript/Sugar/Operators.hs @@ -184,7 +184,7 @@ rebracketFiltered !caller pred_ externs m = do -- | Indicates whether the `rebracketModule` -- is being called with the full desugar pass -- run via `purs compile` or whether --- only the partial desguar pass is run +-- only the partial desugar pass is run -- via `purs docs`. -- This indication is needed to prevent -- a `purs docs` error when using @@ -216,7 +216,7 @@ rebracketModule !caller pred_ valueOpTable typeOpTable (Module ss coms mn ds ext -- and only some of the desugar passes when generating docs. -- When generating docs, `case _ of` syntax used in an instance declaration -- can trigger the `IncorrectAnonymousArgument` error because it does not - -- run the same passes that the compile desguaring does. Since `purs docs` + -- run the same passes that the compile desugaring does. Since `purs docs` -- will only succeed once `purs compile` succeeds, we can ignore this check -- when running `purs docs`. -- See https://github.com/purescript/purescript/issues/4274#issuecomment-1087730651= diff --git a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs index ab6a2338a2..666fc398c6 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs @@ -373,8 +373,8 @@ interactDiffTyVar env (_, tv1, ty1) (tv2, ty2) -- | A canonical constraint of the form @Coercible tv1 ty1@ can rewrite the -- right hand side of an irreducible constraint of the form @Coercible tv2 ty2@ --- by substituting @ty1@ for every occurence of @tv1@ at representational and --- phantom role in @ty2@. Nominal occurences are left untouched. +-- by substituting @ty1@ for every occurrence of @tv1@ at representational and +-- phantom role in @ty2@. Nominal occurrences are left untouched. rewrite :: Environment -> (SourceType, SourceType) -> SourceType -> Writer Any SourceType rewrite env (Skolem _ _ _ s1 _, ty1) | not $ occurs s1 ty1 = go where go (Skolem _ _ _ s2 _) | s1 == s2 = tell (Any True) $> ty1 @@ -506,7 +506,7 @@ canon env givens k a b = -- -- yield the wanted @Coercible (N Maybe a) (N Maybe b)@ which we cannot -- decompose because the second parameter of @N@ is nominal. On the other - -- hand, unwraping on both sides yields @Coercible (Maybe a) (Maybe b)@ + -- hand, unwrapping on both sides yields @Coercible (Maybe a) (Maybe b)@ -- which we can then decompose to @Coercible a b@ and discharge with the -- given. <|> canonNewtypeLeft env a b @@ -601,7 +601,7 @@ canonRow a b throwError . errorMessage $ TypesDoNotUnify (rowFromList rl1) (rowFromList rl2) | otherwise = empty --- | Unwraping a newtype can fails in two ways: +-- | Unwrapping a newtype can fails in two ways: data UnwrapNewtypeError = CannotUnwrapInfiniteNewtypeChain -- ^ The newtype might wrap an infinite newtype chain. We may think that this @@ -620,7 +620,7 @@ data UnwrapNewtypeError -- -- yield a wanted @Coercible (N a) (N b)@ that we can decompose to -- @Coercible a b@ then discharge with the given if the newtype - -- unwraping rules do not apply. + -- unwrapping rules do not apply. | CannotUnwrapConstructor -- ^ The constructor may not be in scope or may not belong to a newtype. @@ -709,7 +709,7 @@ lookupNewtypeConstructorInScope env currentModuleName currentModuleImports quali _ -> False -- | Constraints of the form @Coercible (N a_0 .. a_n) b@ yield a constraint --- @Coercible a b@ if unwraping the newtype yields @a@. +-- @Coercible a b@ if unwrapping the newtype yields @a@. canonNewtypeLeft :: MonadState CheckState m => MonadWriter [ErrorMessageHint] m @@ -724,7 +724,7 @@ canonNewtypeLeft env a b = Right a' -> pure . Canonicalized $ S.singleton (a', b) -- | Constraints of the form @Coercible a (N b_0 .. b_n)@ yield a constraint --- @Coercible a b@ if unwraping the newtype yields @b@. +-- @Coercible a b@ if unwrapping the newtype yields @b@. canonNewtypeRight :: MonadState CheckState m => MonadWriter [ErrorMessageHint] m @@ -829,7 +829,7 @@ canonDecompositionFailure env k a b -- Decomposing a given @Coercible (Const a a) (Const a b)@ constraint to -- @Coercible a b@ when @MkConst@ is out of scope would let us coerce arbitrary -- types in modules where @MkConst@ is imported, because the given is easily --- satisfied with the newtype unwraping rules. +-- satisfied with the newtype unwrapping rules. -- -- Moreover we do not decompose wanted constraints if they could be discharged -- by a given constraint. diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs index 4c9e8555a1..e9ddf6cd31 100644 --- a/src/Language/PureScript/TypeChecker/Kinds.hs +++ b/src/Language/PureScript/TypeChecker/Kinds.hs @@ -910,7 +910,7 @@ checkKindDeclaration _ ty = do checkQuantification finalTy checkValidKind finalTy where - -- When expanding type synoyms and generalizing, we need to generate more + -- When expanding type synonyms and generalizing, we need to generate more -- unique names so that they don't clash or shadow other names, or can -- be referenced (easily). freshVar arg = (arg <>) . T.pack . show <$> fresh diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs index c98f94459b..6e394cd980 100644 --- a/src/Language/PureScript/Types.hs +++ b/src/Language/PureScript/Types.hs @@ -365,7 +365,7 @@ typeFromJSON defaultAnn annFromJSON = A.withObject "Type" $ \o -> do "ParensInType" -> do b <- contents ParensInType a <$> go b - -- Backwards compatability for kinds + -- Backwards compatibility for kinds "KUnknown" -> TUnknown a <$> contents "Row" -> From 7f72c6939d564c24c2a0c075401af65748a93e17 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Thu, 10 Nov 2022 19:15:58 -0500 Subject: [PATCH 05/68] Document our evolving changelog principles (#4288) --- CHANGELOG.d/README.md | 35 +++++++++++++++++++++++++++-------- 1 file changed, 27 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.d/README.md b/CHANGELOG.d/README.md index 2d9698909c..7fa2fa83e1 100644 --- a/CHANGELOG.d/README.md +++ b/CHANGELOG.d/README.md @@ -6,13 +6,32 @@ Maintainers: see update-changelog.hs for details of this process. Contributors: read on! -When you are preparing a new PR, add a new file to this directory. The file -should be named `{PREFIX}_{SLUG}.md`, where `{PREFIX}` is one of the following: -* `breaking`: for breaking changes -* `feature`: for new features -* `fix`: for bug fixes -* `internal`: for work that will not directly affect users of PureScript -* `misc`: for anything else that needs to be logged +Our guiding principle is that the changelog is a tool for users—people who +depend on PureScript as a compiler or as a library—who are considering +upgrading, or have recently upgraded, their PureScript compiler version. We ask +that when making changes that such users might need to know about, you help +them out by adding to our changelog. + +Work that doesn't change the compiler (such as updates to README.md) doesn't +need a changelog entry. But keep in mind that even parts of the project like +our CI workflow can introduce changes to the compiler we release. + +When you are preparing a new PR that does change the compiler, add a new file +to this directory. The file should be named `{PREFIX}_{SLUG}.md`, where +`{PREFIX}` is one of the following: +* `breaking`: for breaking changes to the compiler, for which a user may need to do + work to their project before or immediately upon upgrading +* `feature`: for new features, which might prevent a user from downgrading to an + earlier version +* `fix`: for bug fixes, which might motivate a user to upgrade +* `internal`: for work that is not expected to directly affect users; these + entries should usually be brief, but may serve as useful starting points for + investigations if a change ends up having unintended consequences + +(There is also a fifth prefix, `misc`. This is an escape hatch in case we have +something that somehow doesn't fit in the above categories but that we want to +include in the changelog, which frankly seems unlikely given how much of a +catch-all `internal` is. We'll tell you if you should use this one.) `{SLUG}` should be a short description of the work you've done. The name has no impact on the final CHANGELOG.md. @@ -20,7 +39,7 @@ impact on the final CHANGELOG.md. Some example names: * `fix_issue-9876.md` * `breaking_deprecate-classes.md` -* `misc_add-forum-to-readme.md` +* `internal_use-ubuntu-38.04-in-ci.md` The contents of the file can be as brief as: From 5f6a6659391563cdec3c41ac6a4b2ff5263d0f68 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Tue, 15 Nov 2022 22:32:07 -0500 Subject: [PATCH 06/68] Organize the compiler's internal constants files (#4406) --- CHANGELOG.d/internal_organize-constants.md | 1 + purescript.cabal | 8 +- src/Language/PureScript/AST/Declarations.hs | 2 +- src/Language/PureScript/CodeGen/JS.hs | 2 +- .../PureScript/Constants/Data/Foldable.hs | 28 -- .../PureScript/Constants/Data/Generic/Rep.hs | 39 -- .../PureScript/Constants/Data/Newtype.hs | 6 - .../PureScript/Constants/Data/Traversable.hs | 19 - src/Language/PureScript/Constants/Libs.hs | 235 +++++++++ src/Language/PureScript/Constants/Prelude.hs | 455 ------------------ src/Language/PureScript/Constants/Prim.hs | 240 ++------- src/Language/PureScript/Constants/TH.hs | 224 +++++++++ src/Language/PureScript/CoreFn/CSE.hs | 2 +- src/Language/PureScript/CoreFn/Desugar.hs | 2 +- src/Language/PureScript/CoreFn/Laziness.hs | 7 +- src/Language/PureScript/CoreFn/Optimizer.hs | 9 +- .../PureScript/CoreImp/Optimizer/Common.hs | 15 +- .../PureScript/CoreImp/Optimizer/Inliner.hs | 357 +++++--------- .../PureScript/CoreImp/Optimizer/MagicDo.hs | 50 +- .../PureScript/CoreImp/Optimizer/Unused.hs | 2 +- src/Language/PureScript/Docs/Prim.hs | 135 +++--- src/Language/PureScript/Environment.hs | 178 +++---- src/Language/PureScript/Errors.hs | 33 +- .../PureScript/Ide/Imports/Actions.hs | 4 +- src/Language/PureScript/Ide/Prim.hs | 16 +- src/Language/PureScript/Linter.hs | 4 +- src/Language/PureScript/Linter/Imports.hs | 2 +- src/Language/PureScript/Sugar/AdoNotation.hs | 8 +- src/Language/PureScript/Sugar/DoNotation.hs | 10 +- src/Language/PureScript/Sugar/Names/Env.hs | 18 +- src/Language/PureScript/Sugar/Operators.hs | 4 +- src/Language/PureScript/Sugar/TypeClasses.hs | 14 +- .../PureScript/Sugar/TypeClasses/Deriving.hs | 43 +- src/Language/PureScript/TypeChecker.hs | 7 +- .../PureScript/TypeChecker/Deriving.hs | 66 ++- .../PureScript/TypeChecker/Entailment.hs | 32 +- .../TypeChecker/Entailment/IntCompare.hs | 14 +- weeder.dhall | 7 + 38 files changed, 949 insertions(+), 1349 deletions(-) create mode 100644 CHANGELOG.d/internal_organize-constants.md delete mode 100644 src/Language/PureScript/Constants/Data/Foldable.hs delete mode 100644 src/Language/PureScript/Constants/Data/Generic/Rep.hs delete mode 100644 src/Language/PureScript/Constants/Data/Newtype.hs delete mode 100644 src/Language/PureScript/Constants/Data/Traversable.hs create mode 100644 src/Language/PureScript/Constants/Libs.hs delete mode 100644 src/Language/PureScript/Constants/Prelude.hs create mode 100644 src/Language/PureScript/Constants/TH.hs diff --git a/CHANGELOG.d/internal_organize-constants.md b/CHANGELOG.d/internal_organize-constants.md new file mode 100644 index 0000000000..1d0f0103d5 --- /dev/null +++ b/CHANGELOG.d/internal_organize-constants.md @@ -0,0 +1 @@ +* Organize the compiler's internal constants files diff --git a/purescript.cabal b/purescript.cabal index 4766e6ec50..57da11080e 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -176,6 +176,7 @@ common defaults stm >=2.5.0.2 && <2.6, stringsearch >=0.3.6.6 && <0.4, syb >=0.7.2.1 && <0.8, + template-haskell >=2.18.0.0 && <2.19, text >=1.2.5.0 && <1.3, these >=1.1.1.1 && <1.2, time >=1.11.1.1 && <1.12, @@ -211,11 +212,7 @@ library Language.PureScript.CodeGen.JS Language.PureScript.CodeGen.JS.Common Language.PureScript.CodeGen.JS.Printer - Language.PureScript.Constants.Prelude - Language.PureScript.Constants.Data.Foldable - Language.PureScript.Constants.Data.Generic.Rep - Language.PureScript.Constants.Data.Newtype - Language.PureScript.Constants.Data.Traversable + Language.PureScript.Constants.Libs Language.PureScript.CoreFn Language.PureScript.CoreFn.Ann Language.PureScript.CoreFn.Binders @@ -373,6 +370,7 @@ library System.IO.UTF8 other-modules: Data.Text.PureScript + Language.PureScript.Constants.TH Paths_purescript autogen-modules: Paths_purescript diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs index 5d97ed8b83..2ac1ee1ded 100644 --- a/src/Language/PureScript/AST/Declarations.hs +++ b/src/Language/PureScript/AST/Declarations.hs @@ -147,7 +147,7 @@ addDefaultImport (Qualified toImportAs toImport) m@(Module ss coms mn decls exps importPrim :: Module -> Module importPrim = let - primModName = C.Prim + primModName = C.M_Prim in addDefaultImport (Qualified (ByModuleName primModName) primModName) . addDefaultImport (Qualified ByNullSourcePos primModName) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index b1f87ad4cc..f5a02fe8e3 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -393,7 +393,7 @@ moduleBindToJs mn = bindToJs -- | Generate code in the simplified JavaScript intermediate representation for a reference to a -- variable that may have a qualified name. qualifiedToJS :: (a -> Ident) -> Qualified a -> AST - qualifiedToJS f (Qualified (ByModuleName C.Prim) a) = AST.Var Nothing . runIdent $ f a + qualifiedToJS f (Qualified (ByModuleName C.M_Prim) a) = AST.Var Nothing . runIdent $ f a qualifiedToJS f (Qualified (ByModuleName 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) diff --git a/src/Language/PureScript/Constants/Data/Foldable.hs b/src/Language/PureScript/Constants/Data/Foldable.hs deleted file mode 100644 index f0692cd9f1..0000000000 --- a/src/Language/PureScript/Constants/Data/Foldable.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Language.PureScript.Constants.Data.Foldable where - -import Data.String (IsString) -import Language.PureScript.Names - -foldl :: forall a. (IsString a) => a -foldl = "foldl" - -foldr :: forall a. (IsString a) => a -foldr = "foldr" - -foldMap :: forall a. (IsString a) => a -foldMap = "foldMap" - -pattern DataFoldable :: ModuleName -pattern DataFoldable = ModuleName "Data.Foldable" - -pattern Foldable :: Qualified (ProperName 'ClassName) -pattern Foldable = Qualified (ByModuleName DataFoldable) (ProperName "Foldable") - -identFoldl :: Qualified Ident -identFoldl = Qualified (ByModuleName DataFoldable) (Ident foldl) - -identFoldr :: Qualified Ident -identFoldr = Qualified (ByModuleName DataFoldable) (Ident foldr) - -identFoldMap :: Qualified Ident -identFoldMap = Qualified (ByModuleName DataFoldable) (Ident foldMap) diff --git a/src/Language/PureScript/Constants/Data/Generic/Rep.hs b/src/Language/PureScript/Constants/Data/Generic/Rep.hs deleted file mode 100644 index 9d0b493f32..0000000000 --- a/src/Language/PureScript/Constants/Data/Generic/Rep.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Language.PureScript.Constants.Data.Generic.Rep where - -import Language.PureScript.Names - -pattern DataGenericRep :: ModuleName -pattern DataGenericRep = ModuleName "Data.Generic.Rep" - -pattern Generic :: Qualified (ProperName 'ClassName) -pattern Generic = Qualified (ByModuleName DataGenericRep) (ProperName "Generic") - -to :: Qualified Ident -to = Qualified (ByModuleName DataGenericRep) (Ident "to") - -from :: Qualified Ident -from = Qualified (ByModuleName DataGenericRep) (Ident "from") - -pattern NoConstructors :: Qualified (ProperName a) -pattern NoConstructors = Qualified (ByModuleName DataGenericRep) (ProperName "NoConstructors") - -pattern NoArguments :: Qualified (ProperName a) -pattern NoArguments = Qualified (ByModuleName DataGenericRep) (ProperName "NoArguments") - -pattern Sum :: Qualified (ProperName a) -pattern Sum = Qualified (ByModuleName DataGenericRep) (ProperName "Sum") - -pattern Inl :: Qualified (ProperName a) -pattern Inl = Qualified (ByModuleName DataGenericRep) (ProperName "Inl") - -pattern Inr :: Qualified (ProperName a) -pattern Inr = Qualified (ByModuleName DataGenericRep) (ProperName "Inr") - -pattern Product :: Qualified (ProperName a) -pattern Product = Qualified (ByModuleName DataGenericRep) (ProperName "Product") - -pattern Constructor :: Qualified (ProperName a) -pattern Constructor = Qualified (ByModuleName DataGenericRep) (ProperName "Constructor") - -pattern Argument :: Qualified (ProperName a) -pattern Argument = Qualified (ByModuleName DataGenericRep) (ProperName "Argument") diff --git a/src/Language/PureScript/Constants/Data/Newtype.hs b/src/Language/PureScript/Constants/Data/Newtype.hs deleted file mode 100644 index 620f305de0..0000000000 --- a/src/Language/PureScript/Constants/Data/Newtype.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Language.PureScript.Constants.Data.Newtype where - -import Language.PureScript.Names - -pattern Newtype :: Qualified (ProperName 'ClassName) -pattern Newtype = Qualified (ByModuleName (ModuleName "Data.Newtype")) (ProperName "Newtype") diff --git a/src/Language/PureScript/Constants/Data/Traversable.hs b/src/Language/PureScript/Constants/Data/Traversable.hs deleted file mode 100644 index 668ab43890..0000000000 --- a/src/Language/PureScript/Constants/Data/Traversable.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Language.PureScript.Constants.Data.Traversable where - -import Data.String (IsString) -import Language.PureScript.Names - -traverse :: forall a. (IsString a) => a -traverse = "traverse" - -sequence :: forall a. (IsString a) => a -sequence = "sequence" - -pattern DataTraversable :: ModuleName -pattern DataTraversable = ModuleName "Data.Traversable" - -pattern Traversable :: Qualified (ProperName 'ClassName) -pattern Traversable = Qualified (ByModuleName DataTraversable) (ProperName "Traversable") - -identTraverse :: Qualified Ident -identTraverse = Qualified (ByModuleName DataTraversable) (Ident traverse) diff --git a/src/Language/PureScript/Constants/Libs.hs b/src/Language/PureScript/Constants/Libs.hs new file mode 100644 index 0000000000..112a75ccb8 --- /dev/null +++ b/src/Language/PureScript/Constants/Libs.hs @@ -0,0 +1,235 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TemplateHaskell #-} +-- | Various constants which refer to things in the Prelude and other core libraries +module Language.PureScript.Constants.Libs where + +import qualified Protolude as P + +import Data.String (IsString) +import Language.PureScript.PSString (PSString) +import qualified Language.PureScript.Constants.TH as TH + +-- Core lib values + +stRefValue :: forall a. IsString a => a +stRefValue = "value" + +-- Type Class Dictionary Names + +data EffectDictionaries = EffectDictionaries + { edApplicativeDict :: PSString + , edBindDict :: PSString + , edMonadDict :: PSString + , edWhile :: PSString + , edUntil :: PSString + } + +effDictionaries :: EffectDictionaries +effDictionaries = EffectDictionaries + { edApplicativeDict = "applicativeEff" + , edBindDict = "bindEff" + , edMonadDict = "monadEff" + , edWhile = "whileE" + , edUntil = "untilE" + } + +effectDictionaries :: EffectDictionaries +effectDictionaries = EffectDictionaries + { edApplicativeDict = "applicativeEffect" + , edBindDict = "bindEffect" + , edMonadDict = "monadEffect" + , edWhile = "whileE" + , edUntil = "untilE" + } + +stDictionaries :: EffectDictionaries +stDictionaries = EffectDictionaries + { edApplicativeDict = "applicativeST" + , edBindDict = "bindST" + , edMonadDict = "monadST" + , edWhile = "while" + , edUntil = "until" + } + +$(TH.declare do + + -- purescript-prelude + + TH.mod "Control.Apply" do + TH.asIdent do TH.asString do TH.var "apply" + + TH.mod "Control.Applicative" do + TH.asIdent do TH.asPair do TH.asString do TH.var "pure" + + TH.mod "Control.Bind" do + TH.asPair do + TH.asString do + TH.var "bind" + TH.cls "Discard" ; TH.var "discard" + + TH.var "discardUnit" + + TH.mod "Control.Category" do + TH.asPair do + TH.asIdent do TH.var "identity" + + TH.var "categoryFn" + + TH.mod "Control.Semigroupoid" do + TH.asPair do + TH.vars ["compose", "composeFlipped"] + TH.var "semigroupoidFn" + + TH.mod "Data.Bounded" do + TH.asPair do + TH.vars ["bottom", "top"] + TH.var "boundedBoolean" + + TH.mod "Data.Eq" do + TH.cls "Eq" ; TH.asIdent do TH.asPair do TH.asString do TH.var "eq" + TH.cls "Eq1" ; TH.asIdent do TH.asString do TH.var "eq1" + TH.asPair do + TH.var "notEq" + + TH.var "eqBoolean" + TH.var "eqChar" + TH.var "eqInt" + TH.var "eqNumber" + TH.var "eqString" + + TH.mod "Data.EuclideanRing" do + TH.asPair do + TH.var "div" + + TH.var "euclideanRingNumber" + + TH.mod "Data.Function" do + TH.prefixWith "function" do TH.asIdent do TH.vars ["apply", "applyFlipped"] + TH.asIdent do TH.var "flip" + + TH.mod "Data.Functor" do + TH.cls "Functor" ; TH.asIdent do TH.asString do TH.var "map" + + TH.mod "Data.Generic.Rep" do + TH.cls "Generic" ; TH.asIdent do TH.vars ["from", "to"] + TH.ntys ["Argument", "Constructor", "NoArguments", "NoConstructors", "Product"] + TH.dty "Sum" ["Inl", "Inr"] + + TH.mod "Data.HeytingAlgebra" do + TH.asPair do + TH.asIdent do TH.vars ["conj", "disj", "not"] + + TH.var "heytingAlgebraBoolean" + + TH.mod "Data.Monoid" do + TH.asIdent do TH.var "mempty" + + TH.mod "Data.Ord" do + TH.cls "Ord" ; TH.asIdent do TH.asString do TH.var "compare" + TH.cls "Ord1" ; TH.asIdent do TH.asString do TH.var "compare1" + TH.asPair do + TH.vars ["greaterThan", "greaterThanOrEq", "lessThan", "lessThanOrEq"] + + TH.var "ordBoolean" + TH.var "ordChar" + TH.var "ordInt" + TH.var "ordNumber" + TH.var "ordString" + + TH.mod "Data.Ordering" do + TH.dty "Ordering" ["EQ", "GT", "LT"] + + TH.mod "Data.Reflectable" do + TH.cls "Reflectable" + + TH.mod "Data.Ring" do + TH.asPair do + TH.asString do TH.vars ["negate", "sub"] + + TH.var "ringInt" + TH.var "ringNumber" + + TH.mod "Data.Semigroup" do + TH.asPair do + TH.asIdent do TH.var "append" + + TH.var "semigroupString" + + TH.mod "Data.Semiring" do + TH.asPair do + TH.vars ["add", "mul", "one", "zero"] + + TH.var "semiringInt" + TH.var "semiringNumber" + + TH.mod "Data.Symbol" do + TH.cls "IsSymbol" + + -- purescript-arrays + + TH.mod "Data.Array" do + TH.asPair do TH.var "unsafeIndex" + + -- purescript-eff + + TH.mod "Control.Monad.Eff" (P.pure ()) + + TH.mod "Control.Monad.Eff.Uncurried" do + TH.asPair do TH.vars ["mkEffFn", "runEffFn"] + + -- purescript-effect + + TH.mod "Effect" (P.pure ()) + + TH.mod "Effect.Uncurried" do + TH.asPair do TH.vars ["mkEffectFn", "runEffectFn"] + + -- purescript-foldable-traversable + + TH.mod "Data.Foldable" do + TH.cls "Foldable" ; TH.asIdent do TH.asString do TH.vars ["foldMap", "foldl", "foldr"] + + TH.mod "Data.Traversable" do + TH.cls "Traversable" ; TH.asString do TH.asIdent (TH.var "traverse") ; TH.var "sequence" + + -- purescript-functions + + TH.mod "Data.Function.Uncurried" do + TH.asPair do TH.asString do TH.vars ["mkFn", "runFn"] + + -- purescript-integers + + TH.mod "Data.Int.Bits" do + TH.asPair do + TH.var "and" + TH.var "complement" + TH.var "or" + TH.var "shl" + TH.var "shr" + TH.var "xor" + TH.var "zshr" + + -- purescript-newtype + + TH.mod "Data.Newtype" do + TH.cls "Newtype" + + -- purescript-partial + + TH.mod "Partial.Unsafe" do + TH.asIdent do TH.asPair do TH.var "unsafePartial" + + -- purescript-st + + TH.mod "Control.Monad.ST.Internal" do + TH.asPair do TH.vars ["modify", "new", "read", "run", "write"] + + TH.mod "Control.Monad.ST.Uncurried" do + TH.asPair do TH.vars ["mkSTFn", "runSTFn"] + + -- purescript-unsafe-coerce + + TH.mod "Unsafe.Coerce" do + TH.asPair do TH.var "unsafeCoerce" + + ) diff --git a/src/Language/PureScript/Constants/Prelude.hs b/src/Language/PureScript/Constants/Prelude.hs deleted file mode 100644 index 2ae16c2e87..0000000000 --- a/src/Language/PureScript/Constants/Prelude.hs +++ /dev/null @@ -1,455 +0,0 @@ --- | Various constants which refer to things in the Prelude -module Language.PureScript.Constants.Prelude where - -import Data.String (IsString) -import Language.PureScript.PSString (PSString) -import Language.PureScript.Names - --- Operators - -apply :: forall a. (IsString a) => a -apply = "apply" - -applyFlipped :: forall a. (IsString a) => a -applyFlipped = "applyFlipped" - -append :: forall a. (IsString a) => a -append = "append" - -mempty :: forall a. (IsString a) => a -mempty = "mempty" - -bind :: forall a. (IsString a) => a -bind = "bind" - -discard :: forall a. (IsString a) => a -discard = "discard" - -pattern Discard :: Qualified (ProperName 'ClassName) -pattern Discard = Qualified (ByModuleName ControlBind) (ProperName "Discard") - -add :: forall a. (IsString a) => a -add = "add" - -sub :: forall a. (IsString a) => a -sub = "sub" - -mul :: forall a. (IsString a) => a -mul = "mul" - -div :: forall a. (IsString a) => a -div = "div" - -lessThan :: forall a. (IsString a) => a -lessThan = "lessThan" - -greaterThan :: forall a. (IsString a) => a -greaterThan = "greaterThan" - -lessThanOrEq :: forall a. (IsString a) => a -lessThanOrEq = "lessThanOrEq" - -greaterThanOrEq :: forall a. (IsString a) => a -greaterThanOrEq = "greaterThanOrEq" - -eq :: forall a. (IsString a) => a -eq = "eq" - -eq1 :: forall a. (IsString a) => a -eq1 = "eq1" - -notEq :: forall a. (IsString a) => a -notEq = "notEq" - -compare :: forall a. (IsString a) => a -compare = "compare" - -compare1 :: forall a. (IsString a) => a -compare1 = "compare1" - -conj :: forall a. (IsString a) => a -conj = "conj" - -disj :: forall a. (IsString a) => a -disj = "disj" - -unsafeIndex :: forall a. (IsString a) => a -unsafeIndex = "unsafeIndex" - -or :: forall a. (IsString a) => a -or = "or" - -and :: forall a. (IsString a) => a -and = "and" - -xor :: forall a. (IsString a) => a -xor = "xor" - -compose :: forall a. (IsString a) => a -compose = "compose" - -composeFlipped :: forall a. (IsString a) => a -composeFlipped = "composeFlipped" - -map :: forall a. (IsString a) => a -map = "map" - --- Functions - -negate :: forall a. (IsString a) => a -negate = "negate" - -not :: forall a. (IsString a) => a -not = "not" - -shl :: forall a. (IsString a) => a -shl = "shl" - -shr :: forall a. (IsString a) => a -shr = "shr" - -zshr :: forall a. (IsString a) => a -zshr = "zshr" - -complement :: forall a. (IsString a) => a -complement = "complement" - -identity :: forall a. (IsString a) => a -identity = "identity" - --- Prelude Values - -zero :: forall a. (IsString a) => a -zero = "zero" - -one :: forall a. (IsString a) => a -one = "one" - -bottom :: forall a. (IsString a) => a -bottom = "bottom" - -top :: forall a. (IsString a) => a -top = "top" - -pure' :: forall a. (IsString a) => a -pure' = "pure" - --- Core lib values - -runST :: forall a. (IsString a) => a -runST = "run" - -stRefValue :: forall a. (IsString a) => a -stRefValue = "value" - -newSTRef :: forall a. (IsString a) => a -newSTRef = "new" - -readSTRef :: forall a. (IsString a) => a -readSTRef = "read" - -writeSTRef :: forall a. (IsString a) => a -writeSTRef = "write" - -modifySTRef :: forall a. (IsString a) => a -modifySTRef = "modify" - -mkFn :: forall a. (IsString a) => a -mkFn = "mkFn" - -runFn :: forall a. (IsString a) => a -runFn = "runFn" - -mkEffFn :: forall a. (IsString a) => a -mkEffFn = "mkEffFn" - -runEffFn :: forall a. (IsString a) => a -runEffFn = "runEffFn" - -mkEffectFn :: forall a. (IsString a) => a -mkEffectFn = "mkEffectFn" - -runEffectFn :: forall a. (IsString a) => a -runEffectFn = "runEffectFn" - -mkSTFn :: forall a. (IsString a) => a -mkSTFn = "mkSTFn" - -runSTFn :: forall a. (IsString a) => a -runSTFn = "runSTFn" - --- Type Class Dictionary Names - -data EffectDictionaries = EffectDictionaries - { edApplicativeDict :: PSString - , edBindDict :: PSString - , edMonadDict :: PSString - , edWhile :: PSString - , edUntil :: PSString - } - -effDictionaries :: EffectDictionaries -effDictionaries = EffectDictionaries - { edApplicativeDict = "applicativeEff" - , edBindDict = "bindEff" - , edMonadDict = "monadEff" - , edWhile = "whileE" - , edUntil = "untilE" - } - -effectDictionaries :: EffectDictionaries -effectDictionaries = EffectDictionaries - { edApplicativeDict = "applicativeEffect" - , edBindDict = "bindEffect" - , edMonadDict = "monadEffect" - , edWhile = "whileE" - , edUntil = "untilE" - } - -stDictionaries :: EffectDictionaries -stDictionaries = EffectDictionaries - { edApplicativeDict = "applicativeST" - , edBindDict = "bindST" - , edMonadDict = "monadST" - , edWhile = "while" - , edUntil = "until" - } - -discardUnitDictionary :: forall a. (IsString a) => a -discardUnitDictionary = "discardUnit" - -semiringNumber :: forall a. (IsString a) => a -semiringNumber = "semiringNumber" - -semiringInt :: forall a. (IsString a) => a -semiringInt = "semiringInt" - -ringNumber :: forall a. (IsString a) => a -ringNumber = "ringNumber" - -ringInt :: forall a. (IsString a) => a -ringInt = "ringInt" - -euclideanRingNumber :: forall a. (IsString a) => a -euclideanRingNumber = "euclideanRingNumber" - -ordBoolean :: forall a. (IsString a) => a -ordBoolean = "ordBoolean" - -ordNumber :: forall a. (IsString a) => a -ordNumber = "ordNumber" - -ordInt :: forall a. (IsString a) => a -ordInt = "ordInt" - -ordString :: forall a. (IsString a) => a -ordString = "ordString" - -ordChar :: forall a. (IsString a) => a -ordChar = "ordChar" - -eqNumber :: forall a. (IsString a) => a -eqNumber = "eqNumber" - -eqInt :: forall a. (IsString a) => a -eqInt = "eqInt" - -eqString :: forall a. (IsString a) => a -eqString = "eqString" - -eqChar :: forall a. (IsString a) => a -eqChar = "eqChar" - -eqBoolean :: forall a. (IsString a) => a -eqBoolean = "eqBoolean" - -boundedBoolean :: forall a. (IsString a) => a -boundedBoolean = "boundedBoolean" - -heytingAlgebraBoolean :: forall a. (IsString a) => a -heytingAlgebraBoolean = "heytingAlgebraBoolean" - -semigroupString :: forall a. (IsString a) => a -semigroupString = "semigroupString" - -semigroupoidFn :: forall a. (IsString a) => a -semigroupoidFn = "semigroupoidFn" - -categoryFn :: forall a. (IsString a) => a -categoryFn = "categoryFn" - --- Data.Symbol - -pattern DataSymbol :: ModuleName -pattern DataSymbol = ModuleName "Data.Symbol" - -pattern IsSymbol :: Qualified (ProperName 'ClassName) -pattern IsSymbol = Qualified (ByModuleName DataSymbol) (ProperName "IsSymbol") - -pattern DataReflectable :: ModuleName -pattern DataReflectable = ModuleName "Data.Reflectable" - -pattern Reflectable :: Qualified (ProperName 'ClassName) -pattern Reflectable = Qualified (ByModuleName DataReflectable) (ProperName "Reflectable") - -pattern DataOrdering :: ModuleName -pattern DataOrdering = ModuleName "Data.Ordering" - -pattern DataFunctionUncurried :: ModuleName -pattern DataFunctionUncurried = ModuleName "Data.Function.Uncurried" - -pattern PartialUnsafe :: ModuleName -pattern PartialUnsafe = ModuleName "Partial.Unsafe" - -pattern Ordering :: Qualified (ProperName 'TypeName) -pattern Ordering = Qualified (ByModuleName DataOrdering) (ProperName "Ordering") - -pattern LT :: Qualified (ProperName 'ConstructorName) -pattern LT = Qualified (ByModuleName DataOrdering) (ProperName "LT") - -pattern EQ :: Qualified (ProperName 'ConstructorName) -pattern EQ = Qualified (ByModuleName DataOrdering) (ProperName "EQ") - -pattern GT :: Qualified (ProperName 'ConstructorName) -pattern GT = Qualified (ByModuleName DataOrdering) (ProperName "GT") - -pattern DataArray :: ModuleName -pattern DataArray = ModuleName "Data.Array" - -pattern Eff :: ModuleName -pattern Eff = ModuleName "Control.Monad.Eff" - -pattern Effect :: ModuleName -pattern Effect = ModuleName "Effect" - -pattern ST :: ModuleName -pattern ST = ModuleName "Control.Monad.ST.Internal" - -pattern ControlApply :: ModuleName -pattern ControlApply = ModuleName "Control.Apply" - -pattern Apply :: Qualified (ProperName 'ClassName) -pattern Apply = Qualified (ByModuleName ControlApply) (ProperName "Apply") - -identApply :: Qualified Ident -identApply = Qualified (ByModuleName ControlApply) (Ident apply) - -pattern ControlApplicative :: ModuleName -pattern ControlApplicative = ModuleName "Control.Applicative" - -pattern Applicative :: Qualified (ProperName 'ClassName) -pattern Applicative = Qualified (ByModuleName ControlApplicative) (ProperName "Applicative") - -identPure :: Qualified Ident -identPure = Qualified (ByModuleName ControlApplicative) (Ident pure') - -pattern ControlSemigroupoid :: ModuleName -pattern ControlSemigroupoid = ModuleName "Control.Semigroupoid" - -pattern ControlBind :: ModuleName -pattern ControlBind = ModuleName "Control.Bind" - -pattern ControlCategory :: ModuleName -pattern ControlCategory = ModuleName "Control.Category" - -pattern Category :: Qualified (ProperName 'ClassName) -pattern Category = Qualified (ByModuleName ControlCategory) (ProperName "Category") - -identIdentity :: Qualified Ident -identIdentity = Qualified (ByModuleName ControlCategory) (Ident identity) - -pattern ControlMonadEffUncurried :: ModuleName -pattern ControlMonadEffUncurried = ModuleName "Control.Monad.Eff.Uncurried" - -pattern EffectUncurried :: ModuleName -pattern EffectUncurried = ModuleName "Effect.Uncurried" - -pattern ControlMonadSTUncurried :: ModuleName -pattern ControlMonadSTUncurried = ModuleName "Control.Monad.ST.Uncurried" - -pattern DataBounded :: ModuleName -pattern DataBounded = ModuleName "Data.Bounded" - -pattern DataSemigroup :: ModuleName -pattern DataSemigroup = ModuleName "Data.Semigroup" - -identAppend :: Qualified Ident -identAppend = Qualified (ByModuleName DataSemigroup) (Ident append) - -pattern DataMonoid :: ModuleName -pattern DataMonoid = ModuleName "Data.Monoid" - -identMempty :: Qualified Ident -identMempty = Qualified (ByModuleName DataMonoid) (Ident mempty) - -pattern DataHeytingAlgebra :: ModuleName -pattern DataHeytingAlgebra = ModuleName "Data.HeytingAlgebra" - -pattern DataEq :: ModuleName -pattern DataEq = ModuleName "Data.Eq" - -pattern Eq :: Qualified (ProperName 'ClassName) -pattern Eq = Qualified (ByModuleName DataEq) (ProperName "Eq") - -pattern Eq1 :: Qualified (ProperName 'ClassName) -pattern Eq1 = Qualified (ByModuleName DataEq) (ProperName "Eq1") - -identEq :: Qualified Ident -identEq = Qualified (ByModuleName DataEq) (Ident eq) - -identEq1 :: Qualified Ident -identEq1 = Qualified (ByModuleName DataEq) (Ident eq1) - -pattern DataOrd :: ModuleName -pattern DataOrd = ModuleName "Data.Ord" - -pattern Ord :: Qualified (ProperName 'ClassName) -pattern Ord = Qualified (ByModuleName DataOrd) (ProperName "Ord") - -pattern Ord1 :: Qualified (ProperName 'ClassName) -pattern Ord1 = Qualified (ByModuleName DataOrd) (ProperName "Ord1") - -identCompare :: Qualified Ident -identCompare = Qualified (ByModuleName DataOrd) (Ident compare) - -identCompare1 :: Qualified Ident -identCompare1 = Qualified (ByModuleName DataOrd) (Ident compare1) - -pattern DataFunctor :: ModuleName -pattern DataFunctor = ModuleName "Data.Functor" - -pattern Functor :: Qualified (ProperName 'ClassName) -pattern Functor = Qualified (ByModuleName DataFunctor) (ProperName "Functor") - -identMap :: Qualified Ident -identMap = Qualified (ByModuleName 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" - -identFlip :: Qualified Ident -identFlip = Qualified (ByModuleName DataFunction) (Ident flip) - -flip :: forall a. (IsString a) => a -flip = "flip" - -pattern DataIntBits :: ModuleName -pattern DataIntBits = ModuleName "Data.Int.Bits" - -unsafePartial :: forall a. (IsString a) => a -unsafePartial = "unsafePartial" - -pattern UnsafeCoerce :: ModuleName -pattern UnsafeCoerce = ModuleName "Unsafe.Coerce" - -unsafeCoerceFn :: forall a. (IsString a) => a -unsafeCoerceFn = "unsafeCoerce" diff --git a/src/Language/PureScript/Constants/Prim.hs b/src/Language/PureScript/Constants/Prim.hs index aa2d468022..795dbffdd9 100644 --- a/src/Language/PureScript/Constants/Prim.hs +++ b/src/Language/PureScript/Constants/Prim.hs @@ -1,195 +1,57 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TemplateHaskell #-} -- | Various constants which refer to things in Prim module Language.PureScript.Constants.Prim where -import Data.String (IsString) import Language.PureScript.Names - --- Prim values - -undefined :: forall a. (IsString a) => a -undefined = "undefined" - --- Prim - -pattern Prim :: ModuleName -pattern Prim = ModuleName "Prim" - -pattern Partial :: Qualified (ProperName 'ClassName) -pattern Partial = Qualified (ByModuleName Prim) (ProperName "Partial") - -pattern Record :: Qualified (ProperName 'TypeName) -pattern Record = Qualified (ByModuleName Prim) (ProperName "Record") - -pattern Type :: Qualified (ProperName 'TypeName) -pattern Type = Qualified (ByModuleName Prim) (ProperName "Type") - -pattern Constraint :: Qualified (ProperName 'TypeName) -pattern Constraint = Qualified (ByModuleName Prim) (ProperName "Constraint") - -pattern Function :: Qualified (ProperName 'TypeName) -pattern Function = Qualified (ByModuleName Prim) (ProperName "Function") - -pattern Array :: Qualified (ProperName 'TypeName) -pattern Array = Qualified (ByModuleName Prim) (ProperName "Array") - -pattern Row :: Qualified (ProperName 'TypeName) -pattern Row = Qualified (ByModuleName Prim) (ProperName "Row") - --- Prim.Boolean - -pattern PrimBoolean :: ModuleName -pattern PrimBoolean = ModuleName "Prim.Boolean" - -booleanTrue :: Qualified (ProperName 'TypeName) -booleanTrue = Qualified (ByModuleName PrimBoolean) (ProperName "True") - -booleanFalse :: Qualified (ProperName 'TypeName) -booleanFalse = Qualified (ByModuleName PrimBoolean) (ProperName "False") - --- Prim.Coerce - -pattern PrimCoerce :: ModuleName -pattern PrimCoerce = ModuleName "Prim.Coerce" - -pattern Coercible :: Qualified (ProperName 'ClassName) -pattern Coercible = Qualified (ByModuleName PrimCoerce) (ProperName "Coercible") - --- Prim.Ordering - -pattern PrimOrdering :: ModuleName -pattern PrimOrdering = ModuleName "Prim.Ordering" - -orderingLT :: Qualified (ProperName 'TypeName) -orderingLT = Qualified (ByModuleName PrimOrdering) (ProperName "LT") - -orderingEQ :: Qualified (ProperName 'TypeName) -orderingEQ = Qualified (ByModuleName PrimOrdering) (ProperName "EQ") - -orderingGT :: Qualified (ProperName 'TypeName) -orderingGT = Qualified (ByModuleName PrimOrdering) (ProperName "GT") - --- Prim.Row - -pattern PrimRow :: ModuleName -pattern PrimRow = ModuleName "Prim.Row" - -pattern RowUnion :: Qualified (ProperName 'ClassName) -pattern RowUnion = Qualified (ByModuleName PrimRow) (ProperName "Union") - -pattern RowNub :: Qualified (ProperName 'ClassName) -pattern RowNub = Qualified (ByModuleName PrimRow) (ProperName "Nub") - -pattern RowCons :: Qualified (ProperName 'ClassName) -pattern RowCons = Qualified (ByModuleName PrimRow) (ProperName "Cons") - -pattern RowLacks :: Qualified (ProperName 'ClassName) -pattern RowLacks = Qualified (ByModuleName PrimRow) (ProperName "Lacks") - --- Prim.RowList - -pattern PrimRowList :: ModuleName -pattern PrimRowList = ModuleName "Prim.RowList" - -pattern RowToList :: Qualified (ProperName 'ClassName) -pattern RowToList = Qualified (ByModuleName PrimRowList) (ProperName "RowToList") - -pattern RowListNil :: Qualified (ProperName 'TypeName) -pattern RowListNil = Qualified (ByModuleName PrimRowList) (ProperName "Nil") - -pattern RowListCons :: Qualified (ProperName 'TypeName) -pattern RowListCons = Qualified (ByModuleName PrimRowList) (ProperName "Cons") - --- Prim.Int - -pattern PrimInt :: ModuleName -pattern PrimInt = ModuleName "Prim.Int" - -pattern IntAdd :: Qualified (ProperName 'ClassName) -pattern IntAdd = Qualified (ByModuleName PrimInt) (ProperName "Add") - -pattern IntCompare :: Qualified (ProperName 'ClassName) -pattern IntCompare = Qualified (ByModuleName PrimInt) (ProperName "Compare") - -pattern IntMul :: Qualified (ProperName 'ClassName) -pattern IntMul = Qualified (ByModuleName PrimInt) (ProperName "Mul") - -pattern IntToString :: Qualified (ProperName 'ClassName) -pattern IntToString = Qualified (ByModuleName PrimInt) (ProperName "ToString") - --- Prim.Symbol - -pattern PrimSymbol :: ModuleName -pattern PrimSymbol = ModuleName "Prim.Symbol" - -pattern SymbolCompare :: Qualified (ProperName 'ClassName) -pattern SymbolCompare = Qualified (ByModuleName PrimSymbol) (ProperName "Compare") - -pattern SymbolAppend :: Qualified (ProperName 'ClassName) -pattern SymbolAppend = Qualified (ByModuleName PrimSymbol) (ProperName "Append") - -pattern SymbolCons :: Qualified (ProperName 'ClassName) -pattern SymbolCons = Qualified (ByModuleName PrimSymbol) (ProperName "Cons") - --- Prim.TypeError - -pattern PrimTypeError :: ModuleName -pattern PrimTypeError = ModuleName "Prim.TypeError" - -pattern Fail :: Qualified (ProperName 'ClassName) -pattern Fail = Qualified (ByModuleName PrimTypeError) (ProperName "Fail") - -pattern Warn :: Qualified (ProperName 'ClassName) -pattern Warn = Qualified (ByModuleName PrimTypeError) (ProperName "Warn") +import qualified Language.PureScript.Constants.TH as TH + +$(TH.declare do + TH.mod "Prim" do + TH.cls "Partial" + TH.ty "Array" + TH.ty "Boolean" + TH.ty "Char" + TH.ty "Constraint" + TH.ty "Function" + TH.ty "Int" + TH.ty "Number" + TH.ty "Record" + TH.ty "Row" + TH.ty "String" + TH.ty "Symbol" + TH.ty "Type" + TH.asIdent do TH.asString do TH.var "undefined" + + TH.mod "Prim.Boolean" do + TH.tys ["False", "True"] + + TH.mod "Prim.Coerce" do + TH.cls "Coercible" + + TH.mod "Prim.Int" do + TH.prefixWith "Int" do TH.clss ["Add", "Compare", "Mul", "ToString"] + + TH.mod "Prim.Ordering" do + TH.prefixWith "Type" do TH.ty "Ordering" + TH.tys ["EQ", "GT", "LT"] + + TH.mod "Prim.Row" do + TH.prefixWith "Row" do TH.clss ["Cons", "Lacks", "Nub", "Union"] + + TH.mod "Prim.RowList" do + TH.ty "RowList" + TH.cls "RowToList" + TH.prefixWith "RowList" do TH.tys ["Cons", "Nil"] + + TH.mod "Prim.Symbol" do + TH.prefixWith "Symbol" do TH.clss ["Append", "Compare", "Cons"] + + TH.mod "Prim.TypeError" do + TH.clss ["Fail", "Warn"] + TH.tys ["Above", "Beside", "Doc", "Quote", "QuoteLabel", "Text"] + + ) primModules :: [ModuleName] -primModules = [Prim, PrimBoolean, PrimCoerce, PrimOrdering, PrimRow, PrimRowList, PrimSymbol, PrimInt, PrimTypeError] - -typ :: forall a. (IsString a) => a -typ = "Type" - -kindOrdering :: forall a. (IsString a) => a -kindOrdering = "Ordering" - -kindRowList :: forall a. (IsString a) => a -kindRowList = "RowList" - -symbol :: forall a. (IsString a) => a -symbol = "Symbol" - -doc :: forall a. (IsString a) => a -doc = "Doc" - -row :: forall a. (IsString a) => a -row = "Row" - -constraint :: forall a. (IsString a) => a -constraint = "Constraint" - --- Modules - -prim :: forall a. (IsString a) => a -prim = "Prim" - -moduleBoolean :: forall a. (IsString a) => a -moduleBoolean = "Boolean" - -moduleCoerce :: forall a. (IsString a) => a -moduleCoerce = "Coerce" - -moduleOrdering :: forall a. (IsString a) => a -moduleOrdering = "Ordering" - -moduleRow :: forall a. (IsString a) => a -moduleRow = "Row" - -moduleRowList :: forall a. (IsString a) => a -moduleRowList = "RowList" - -moduleSymbol :: forall a. (IsString a) => a -moduleSymbol = "Symbol" - -moduleInt :: forall a. (IsString a) => a -moduleInt = "Int" - -typeError :: forall a. (IsString a) => a -typeError = "TypeError" +primModules = [M_Prim, M_Prim_Boolean, M_Prim_Coerce, M_Prim_Ordering, M_Prim_Row, M_Prim_RowList, M_Prim_Symbol, M_Prim_Int, M_Prim_TypeError] diff --git a/src/Language/PureScript/Constants/TH.hs b/src/Language/PureScript/Constants/TH.hs new file mode 100644 index 0000000000..10ded13093 --- /dev/null +++ b/src/Language/PureScript/Constants/TH.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE TemplateHaskell #-} +-- | This module implements an eDSL for compactly declaring pattern synonyms +-- representing known PureScript modules and their members. +-- +-- The following example assumes this module is imported qualified as TH and +-- the BlockArguments extension is used, both of which I recommend. +-- +-- > $(TH.declare do +-- > TH.mod "Data.Foo" do +-- > TH.ty "SomeType" +-- > TH.asIdent do +-- > TH.var "someVariable" +-- > ) +-- +-- will become: +-- +-- > pattern M_Data_Foo :: ModuleName +-- > pattern M_Data_Foo = ModuleName "Data.Foo" +-- > +-- > pattern SomeType :: Qualified (ProperName 'TypeName) +-- > pattern SomeType = Qualified (ByModuleName M_Data_Foo) (ProperName "SomeType") +-- > +-- > pattern I_someVariable :: Qualified Ident +-- > pattern I_someVariable = Qualified (ByModuleName M_Data_Foo) (Ident "someVariable") +-- +-- All pattern synonyms must start with an uppercase letter. To prevent +-- namespace collisions, different types of pattern are distinguished by a sort +-- of Hungarian notation convention: +-- +-- @ +-- SomeType -- a type or class name +-- C_Ctor -- a constructor name +-- I_name -- a Qualified Ident +-- M_Data_Foo -- a module name +-- P_name -- a (module name, polymorphic string) pair +-- S_name -- a lone polymorphic string (this doesn't contain any module information) +-- @ +-- +-- I_, P_, and S_ patterns are all optional and have to be enabled with +-- `asIdent`, `asPair`, and `asString` modifiers respectively. +-- +-- Finally, to disambiguate between identifiers with the same name (such as +-- Data.Function.apply and Data.Apply.apply), the `prefixWith` modifier will +-- modify the names of the patterns created within it. +-- +-- > TH.mod "Data.Function" do +-- > TH.prefixWith "function" do +-- > TH.asIdent do +-- > TH.var "apply" +-- +-- results in: +-- +-- > pattern I_functionApply :: Qualified Ident +-- > pattern I_functionApply = Qualified (ByModuleName (M_Data_Function) (Ident "apply") +-- +module Language.PureScript.Constants.TH + ( declare + , mod + , cls, clss + , dty + , nty, ntys + , ty, tys + , var, vars + , prefixWith + , asIdent + , asPair + , asString + ) where + +import Protolude hiding (Type, mod) + +import Control.Lens (over, _head) +import Control.Monad.Trans.RWS (RWS, execRWS) +import Control.Monad.Trans.Writer (Writer, execWriter) +import Control.Monad.Writer.Class (tell) +import Data.String (String) +import Language.Haskell.TH +import Language.PureScript.Names hiding (Name) + +-- | Generate pattern synonyms corresponding to the provided PureScript +-- declarations. +declare :: Writer (Q [Dec]) () -> Q [Dec] +declare = execWriter + +-- | Declare a module. +mod :: String -> ModDecs -> Writer (Q [Dec]) () +mod mnStr inner = do + -- pattern M_Data_Foo :: ModuleName + -- pattern M_Data_Foo = ModuleName "Data.Foo" + let mn = mkModuleName mnStr + tell $ typedPatSyn mn [t| ModuleName |] [p| ModuleName $(litP $ stringL mnStr) |] + tell $ snd $ execRWS inner (mn, "", []) () + +-- | Declare a type class. The resulting pattern will use the name of the class +-- and have type `Qualified (ProperName 'ClassName)`. +cls :: String -> ModDecs +cls cn = ask >>= \(mn, prefix, _) -> tell $ mkPnPat [t| 'ClassName |] mn prefix cn + +-- | Declare a list of type classes; shorthand for repeatedly calling `cls`. +clss :: [String] -> ModDecs +clss = traverse_ cls + +-- | Declare a data type, given the name of the type and a list of constructor +-- names. A pattern will be created using the name of the type and have type +-- `Qualified (ProperName 'TypeName)`. A pattern will also be created for each +-- constructor prefixed with "C_", having type `Qualified (ProperName +-- 'ConstructorName)`. +dty :: String -> [String] -> ModDecs +dty dn ctors = ask >>= \(mn, prefix, _) -> do + tell $ mkPnPat [t| 'TypeName |] mn prefix dn + tell $ map fold $ traverse (mkPnPat [t| 'ConstructorName |] mn $ "C_" <> prefix) ctors + +-- | Declare a data type with a singular constructor named the same as the +-- type, as is commonly the case with newtypes (but this does not require the +-- type to be a newtype in reality). Shorthand for calling `dty`. +nty :: String -> ModDecs +nty tn = dty tn [tn] + +-- | Declare a list of data types with singular constructors; shorthand for +-- repeatedly calling `nty`, which itself is shorthand for `dty`. +ntys :: [String] -> ModDecs +ntys = traverse_ nty + +-- | Declare a type. The resulting pattern will use the name of the type and have +-- type `Qualified (ProperName 'TypeName)`. +ty :: String -> ModDecs +ty tn = ask >>= \(mn, prefix, _) -> tell $ mkPnPat [t| 'TypeName |] mn prefix tn + +-- | Declare a list of types; shorthand for repeatedly calling `ty`. +tys :: [String] -> ModDecs +tys = traverse_ ty + +-- | Declare a variable, function, named instance, or generally a lower-case +-- value member of a module. The patterns created depend on which of `asPair`, +-- `asIdent`, or `asString` are used in the enclosing context. +var :: String -> ModDecs +var nm = ask >>= \(mn, prefix, vtds) -> tell $ foldMap (\f -> f mn prefix nm) vtds + +-- | Declare a list of variables; shorthand for repeatedly calling `var`. +vars :: [String] -> ModDecs +vars = traverse_ var + +-- | For every variable declared within, create a pattern synonym prefixed +-- with "P_" having type `forall a. (Eq a, IsString a) => (ModuleName, a)`. +asPair :: ModDecs -> ModDecs +asPair = local $ addToVars mkPairDec + +-- | For every variable declared within, cerate a pattern synonym prefixed +-- with "I_" having type `Qualified Ident`. +asIdent :: ModDecs -> ModDecs +asIdent = local $ addToVars mkIdentDec + +-- | For every variable declared within, cerate a pattern synonym prefixed +-- with "S_" having type `forall a. (Eq a, IsString a) => a`. +asString :: ModDecs -> ModDecs +asString = local $ addToVars mkStringDec + +-- | Prefix the names of all enclosed declarations with the provided string, to +-- prevent collisions with other identifiers. For example, +-- `prefixWith "function"` would turn `I_apply` into `I_functionApply`, and +-- `C_Example` into `C_FunctionExample`. +prefixWith :: String -> ModDecs -> ModDecs +prefixWith = local . applyPrefix + +-- Internals start here + +type ModDecs = RWS (Name, String, [VarToDec]) (Q [Dec]) () () +type VarToDec = Name -> String -> String -> Q [Dec] + +addToVars :: VarToDec -> (a, b, [VarToDec]) -> (a, b, [VarToDec]) +addToVars f (a, b, fs) = (a, b, f : fs) + +applyPrefix :: String -> (a, String, c) -> (a, String, c) +applyPrefix prefix (a, prefix', c) = (a, camelAppend prefix' prefix, c) + +cap :: String -> String +cap = over _head toUpper + +camelAppend :: String -> String -> String +camelAppend l r = if null l then r else l <> cap r + +-- "Data.Foo" -> M_Data_Foo +mkModuleName :: String -> Name +mkModuleName = mkName . ("M_" <>) . map (\case '.' -> '_'; other -> other) + +-- "I_" -> "fn" -> "foo" -> I_fnFoo +-- "I_" -> "" -> "foo" -> I_foo +mkPrefixedName :: String -> String -> String -> Name +mkPrefixedName tag prefix = mkName . (tag <>) . camelAppend prefix + +-- 'TypeName -> M_Data_Foo -> "Function" -> "Foo" -> +-- pattern FunctionFoo :: Qualified (ProperName 'TypeName) +-- pattern FunctionFoo = Qualified (ByModuleName M_Data_Foo) (ProperName "Foo") +mkPnPat :: Q Type -> VarToDec +mkPnPat pnType mn prefix str = typedPatSyn (mkName $ cap prefix <> str) + [t| Qualified (ProperName $pnType) |] + [p| Qualified (ByModuleName $(conP mn [])) (ProperName $(litP $ stringL str)) |] + +-- M_Data_Foo -> "function" -> "foo" -> +-- pattern I_functionFoo :: Qualified Ident +-- pattern I_functionFoo = Qualified (ByModuleName M_Data_Foo) (Ident "foo") +mkIdentDec :: VarToDec +mkIdentDec mn prefix str = typedPatSyn (mkPrefixedName "I_" prefix str) + [t| Qualified Ident |] + [p| Qualified (ByModuleName $(conP mn [])) (Ident $(litP $ stringL str)) |] + +-- M_Data_Foo -> "function" -> "foo" -> +-- pattern P_functionFoo :: forall a. (Eq a, IsString a) => (ModuleName, a) +-- pattern P_functionFoo = (M_Data_Foo, "foo") +mkPairDec :: VarToDec +mkPairDec mn prefix str = typedPatSyn (mkPrefixedName "P_" prefix str) + [t| forall a. (Eq a, IsString a) => (ModuleName, a) |] + [p| ($(conP mn []), $(litP $ stringL str)) |] + +-- _ -> "function" -> "foo" -> +-- pattern S_functionFoo :: forall a. (Eq a, IsString a) => a +-- pattern S_functionFoo = "foo" +mkStringDec :: VarToDec +mkStringDec _ prefix str = typedPatSyn (mkPrefixedName "S_" prefix str) + [t| forall a. (Eq a, IsString a) => a |] + (litP $ stringL str) + +typedPatSyn :: Name -> Q Type -> Q Pat -> Q [Dec] +typedPatSyn nm t p = sequence [patSynSigD nm t, patSynD nm (prefixPatSyn []) implBidir p] diff --git a/src/Language/PureScript/CoreFn/CSE.hs b/src/Language/PureScript/CoreFn/CSE.hs index 9109a4f233..0ea811a980 100644 --- a/src/Language/PureScript/CoreFn/CSE.hs +++ b/src/Language/PureScript/CoreFn/CSE.hs @@ -19,7 +19,7 @@ import Data.Semigroup.Generic (GenericSemigroupMonoid(..)) import Language.PureScript.AST.Literals import Language.PureScript.AST.SourcePos (nullSourceSpan) -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C import Language.PureScript.CoreFn.Ann (Ann) import Language.PureScript.CoreFn.Binders import Language.PureScript.CoreFn.Expr diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs index 1326504e72..1cf6d5efe0 100644 --- a/src/Language/PureScript/CoreFn/Desugar.hs +++ b/src/Language/PureScript/CoreFn/Desugar.hs @@ -109,7 +109,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = A.Unused{} -> True _ -> False exprToCoreFn ss com ty (A.Unused _) = - Var (ss, com, ty, Nothing) (Qualified (ByModuleName C.Prim) (Ident C.undefined)) + Var (ss, com, ty, Nothing) C.I_undefined exprToCoreFn _ com ty (A.Var ss ident) = Var (ss, com, ty, getValueMeta ident) ident exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) = diff --git a/src/Language/PureScript/CoreFn/Laziness.hs b/src/Language/PureScript/CoreFn/Laziness.hs index 600fce7316..5055151596 100644 --- a/src/Language/PureScript/CoreFn/Laziness.hs +++ b/src/Language/PureScript/CoreFn/Laziness.hs @@ -17,7 +17,7 @@ import Data.Semigroup (Max(..)) import qualified Data.Set as S import Language.PureScript.AST.SourcePos -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C import Language.PureScript.CoreFn import Language.PureScript.Crash import Language.PureScript.Names @@ -128,8 +128,7 @@ onVarsWithDelayAndForce f = snd . go 0 $ Just 0 Var a i -> f delay force a i Abs a i e -> Abs a i <$> snd (if force == Just 0 then go (succ delay) force else go delay $ fmap pred force) e -- A clumsy hack to preserve TCO in a particular idiom of unsafePartial once seen in Data.Map.Internal, possibly still used elsewhere. - App a1 e1@(Var _ (Qualified (ByModuleName C.PartialUnsafe) (Ident up))) (Abs a2 i e2) | up == C.unsafePartial - -> App a1 e1 . Abs a2 i <$> handleExpr' e2 + App a1 e1@(Var _ C.I_unsafePartial) (Abs a2 i e2) -> App a1 e1 . Abs a2 i <$> handleExpr' e2 App a e1 e2 -> -- `handleApp` is just to handle the constructor application exception -- somewhat gracefully (i.e., without requiring a deep inspection of @@ -533,7 +532,7 @@ applyLazinessTransform mn rawItems = let nullAnn = ssAnn nullSourceSpan runtimeLazy = Var nullAnn . Qualified ByNullSourcePos $ InternalIdent RuntimeLazyFactory - runFn3 = Var nullAnn . Qualified (ByModuleName C.DataFunctionUncurried) . Ident $ C.runFn <> "3" + runFn3 = Var nullAnn . Qualified (ByModuleName C.M_Data_Function_Uncurried) . Ident $ C.S_runFn <> "3" strLit = Literal nullAnn . StringLiteral . mkString lazifyIdent = \case diff --git a/src/Language/PureScript/CoreFn/Optimizer.hs b/src/Language/PureScript/CoreFn/Optimizer.hs index e74feb2eaa..94d7b77a5a 100644 --- a/src/Language/PureScript/CoreFn/Optimizer.hs +++ b/src/Language/PureScript/CoreFn/Optimizer.hs @@ -11,10 +11,9 @@ import Language.PureScript.CoreFn.CSE import Language.PureScript.CoreFn.Expr import Language.PureScript.CoreFn.Module import Language.PureScript.CoreFn.Traversals -import Language.PureScript.Names (Ident(..), QualifiedBy(..), Qualified(..)) import Language.PureScript.Label import Language.PureScript.Types -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C import qualified Language.PureScript.Constants.Prim as C -- | @@ -54,7 +53,7 @@ closedRecordFields _ = Nothing optimizeDataFunctionApply :: Expr a -> Expr a optimizeDataFunctionApply e = case e of - (App a (App _ (Var _ (Qualified (ByModuleName C.DataFunction) (Ident fn))) x) y) - | fn == C.apply -> App a x y - | fn == C.applyFlipped -> App a y x + (App a (App _ (Var _ fn) x) y) + | C.I_functionApply <- fn -> App a x y + | C.I_functionApplyFlipped <- fn -> App a y x _ -> e diff --git a/src/Language/PureScript/CoreImp/Optimizer/Common.hs b/src/Language/PureScript/CoreImp/Optimizer/Common.hs index 6c4834c36b..b984fcf0a5 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Common.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Common.hs @@ -60,10 +60,13 @@ removeFromBlock :: ([AST] -> [AST]) -> AST -> AST removeFromBlock go (Block ss sts) = Block ss (go sts) removeFromBlock _ js = js -isDict :: (ModuleName, PSString) -> AST -> Bool -isDict (moduleName, dictName) (ModuleAccessor _ x y) = - x == moduleName && y == dictName -isDict _ _ = False +pattern Ref :: (ModuleName, PSString) -> AST +pattern Ref pair <- (refPatternHelper -> Just pair) +-- ideally: pattern Ref (moduleName, refName) <- ModuleAccessor _ moduleName refName +-- but: https://gitlab.haskell.org/ghc/ghc/-/issues/12203 +-- https://github.com/ghc-proposals/ghc-proposals/pull/138 -isDict' :: [(ModuleName, PSString)] -> AST -> Bool -isDict' xs js = any (`isDict` js) xs +refPatternHelper :: AST -> Maybe (ModuleName, PSString) +refPatternHelper = \case + ModuleAccessor _ moduleName refName -> Just (moduleName, refName) + _ -> Nothing diff --git a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs index da9f29383a..77e5ea4c77 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs @@ -18,16 +18,15 @@ import Control.Monad.Supply.Class (MonadSupply, freshName) import Data.Either (rights) import Data.Maybe (fromMaybe) -import Data.String (IsString, fromString) import Data.Text (Text) import qualified Data.Text as T import Language.PureScript.Names (ModuleName) -import Language.PureScript.PSString (PSString) +import Language.PureScript.PSString (PSString, mkString) import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common import Language.PureScript.AST (SourceSpan(..)) -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C import qualified Language.PureScript.Constants.Prim as C -- TODO: Potential bug: @@ -72,7 +71,7 @@ evaluateIifes = everywhere convert convert :: AST -> AST convert (App _ (Function _ Nothing [] (Block _ [Return _ ret])) []) = ret convert (App _ (Function _ Nothing idents (Block _ [Return ss ret])) []) - | not (any (`isReassigned` ret) idents) = replaceIdents (map (, Var ss C.undefined) idents) ret + | not (any (`isReassigned` ret) idents) = replaceIdents (map (, Var ss C.S_undefined) idents) ret convert js = js inlineVariables :: AST -> AST @@ -89,129 +88,121 @@ inlineCommonValues :: (AST -> AST) -> AST -> AST inlineCommonValues expander = everywhere convert where convert :: AST -> AST - convert (expander -> App ss fn [dict]) - | isDict' [semiringNumber, semiringInt] dict && isDict fnZero fn = NumericLiteral ss (Left 0) - | isDict' [semiringNumber, semiringInt] dict && isDict fnOne fn = NumericLiteral ss (Left 1) - | isDict boundedBoolean dict && isDict fnBottom fn = BooleanLiteral ss False - | isDict boundedBoolean dict && isDict fnTop fn = BooleanLiteral ss True - convert (App ss (expander -> App _ fn [dict]) [x]) - | isDict ringInt dict && isDict fnNegate fn = Binary ss BitwiseOr (Unary ss Negate x) (NumericLiteral ss (Left 0)) - convert (App ss (App _ (expander -> App _ fn [dict]) [x]) [y]) - | isDict semiringInt dict && isDict fnAdd fn = intOp ss Add x y - | isDict semiringInt dict && isDict fnMultiply fn = intOp ss Multiply x y - | isDict ringInt dict && isDict fnSubtract fn = intOp ss Subtract x y + convert (expander -> App ss (Ref fn) [Ref dict]) + | dict `elem` [C.P_semiringNumber, C.P_semiringInt], C.P_zero <- fn = NumericLiteral ss (Left 0) + | dict `elem` [C.P_semiringNumber, C.P_semiringInt], C.P_one <- fn = NumericLiteral ss (Left 1) + | C.P_boundedBoolean <- dict, C.P_bottom <- fn = BooleanLiteral ss False + | C.P_boundedBoolean <- dict, C.P_top <- fn = BooleanLiteral ss True + convert (App ss (expander -> App _ (Ref C.P_negate) [Ref C.P_ringInt]) [x]) + = Binary ss BitwiseOr (Unary ss Negate x) (NumericLiteral ss (Left 0)) + convert (App ss (App _ (expander -> App _ (Ref fn) [Ref dict]) [x]) [y]) + | C.P_semiringInt <- dict, C.P_add <- fn = intOp ss Add x y + | C.P_semiringInt <- dict, C.P_mul <- fn = intOp ss Multiply x y + | C.P_ringInt <- dict, C.P_sub <- 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) intOp ss op x y = Binary ss BitwiseOr (Binary ss op x y) (NumericLiteral ss (Left 0)) inlineCommonOperators :: (AST -> AST) -> AST -> AST inlineCommonOperators expander = everywhereTopDown $ applyAll $ - [ binary semiringNumber opAdd Add - , binary semiringNumber opMul Multiply - - , binary ringNumber opSub Subtract - , unary ringNumber opNegate Negate - - , binary euclideanRingNumber opDiv Divide - - , binary eqNumber opEq EqualTo - , binary eqNumber opNotEq NotEqualTo - , binary eqInt opEq EqualTo - , binary eqInt opNotEq NotEqualTo - , binary eqString opEq EqualTo - , binary eqString opNotEq NotEqualTo - , binary eqChar opEq EqualTo - , binary eqChar opNotEq NotEqualTo - , binary eqBoolean opEq EqualTo - , binary eqBoolean opNotEq NotEqualTo - - , binary ordBoolean opLessThan LessThan - , binary ordBoolean opLessThanOrEq LessThanOrEqualTo - , binary ordBoolean opGreaterThan GreaterThan - , binary ordBoolean opGreaterThanOrEq GreaterThanOrEqualTo - , binary ordChar opLessThan LessThan - , binary ordChar opLessThanOrEq LessThanOrEqualTo - , binary ordChar opGreaterThan GreaterThan - , binary ordChar opGreaterThanOrEq GreaterThanOrEqualTo - , binary ordInt opLessThan LessThan - , binary ordInt opLessThanOrEq LessThanOrEqualTo - , binary ordInt opGreaterThan GreaterThan - , binary ordInt opGreaterThanOrEq GreaterThanOrEqualTo - , binary ordNumber opLessThan LessThan - , binary ordNumber opLessThanOrEq LessThanOrEqualTo - , binary ordNumber opGreaterThan GreaterThan - , binary ordNumber opGreaterThanOrEq GreaterThanOrEqualTo - , binary ordString opLessThan LessThan - , binary ordString opLessThanOrEq LessThanOrEqualTo - , binary ordString opGreaterThan GreaterThan - , binary ordString opGreaterThanOrEq GreaterThanOrEqualTo - - , binary semigroupString opAppend Add - - , binary heytingAlgebraBoolean opConj And - , 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 - - , inlineNonClassFunction (isModFnWithDict (C.DataArray, C.unsafeIndex)) $ flip (Indexer Nothing) + [ binary C.P_semiringNumber C.P_add Add + , binary C.P_semiringNumber C.P_mul Multiply + + , binary C.P_ringNumber C.P_sub Subtract + , unary C.P_ringNumber C.P_negate Negate + + , binary C.P_euclideanRingNumber C.P_div Divide + + , binary C.P_eqNumber C.P_eq EqualTo + , binary C.P_eqNumber C.P_notEq NotEqualTo + , binary C.P_eqInt C.P_eq EqualTo + , binary C.P_eqInt C.P_notEq NotEqualTo + , binary C.P_eqString C.P_eq EqualTo + , binary C.P_eqString C.P_notEq NotEqualTo + , binary C.P_eqChar C.P_eq EqualTo + , binary C.P_eqChar C.P_notEq NotEqualTo + , binary C.P_eqBoolean C.P_eq EqualTo + , binary C.P_eqBoolean C.P_notEq NotEqualTo + + , binary C.P_ordBoolean C.P_lessThan LessThan + , binary C.P_ordBoolean C.P_lessThanOrEq LessThanOrEqualTo + , binary C.P_ordBoolean C.P_greaterThan GreaterThan + , binary C.P_ordBoolean C.P_greaterThanOrEq GreaterThanOrEqualTo + , binary C.P_ordChar C.P_lessThan LessThan + , binary C.P_ordChar C.P_lessThanOrEq LessThanOrEqualTo + , binary C.P_ordChar C.P_greaterThan GreaterThan + , binary C.P_ordChar C.P_greaterThanOrEq GreaterThanOrEqualTo + , binary C.P_ordInt C.P_lessThan LessThan + , binary C.P_ordInt C.P_lessThanOrEq LessThanOrEqualTo + , binary C.P_ordInt C.P_greaterThan GreaterThan + , binary C.P_ordInt C.P_greaterThanOrEq GreaterThanOrEqualTo + , binary C.P_ordNumber C.P_lessThan LessThan + , binary C.P_ordNumber C.P_lessThanOrEq LessThanOrEqualTo + , binary C.P_ordNumber C.P_greaterThan GreaterThan + , binary C.P_ordNumber C.P_greaterThanOrEq GreaterThanOrEqualTo + , binary C.P_ordString C.P_lessThan LessThan + , binary C.P_ordString C.P_lessThanOrEq LessThanOrEqualTo + , binary C.P_ordString C.P_greaterThan GreaterThan + , binary C.P_ordString C.P_greaterThanOrEq GreaterThanOrEqualTo + + , binary C.P_semigroupString C.P_append Add + + , binary C.P_heytingAlgebraBoolean C.P_conj And + , binary C.P_heytingAlgebraBoolean C.P_disj Or + , unary C.P_heytingAlgebraBoolean C.P_not Not + + , binary' C.P_or BitwiseOr + , binary' C.P_and BitwiseAnd + , binary' C.P_xor BitwiseXor + , binary' C.P_shl ShiftLeft + , binary' C.P_shr ShiftRight + , binary' C.P_zshr ZeroFillShiftRight + , unary' C.P_complement BitwiseNot + + , inlineNonClassFunction (isModFnWithDict C.P_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.ControlMonadSTUncurried C.mkSTFn i, runEffFn C.ControlMonadSTUncurried C.runSTFn i ] ] + [ fn | i <- [0..10], fn <- [ mkEffFn C.P_mkEffFn i, runEffFn C.P_runEffFn i ] ] ++ + [ fn | i <- [0..10], fn <- [ mkEffFn C.P_mkEffectFn i, runEffFn C.P_runEffectFn i ] ] ++ + [ fn | i <- [0..10], fn <- [ mkEffFn C.P_mkSTFn i, runEffFn C.P_runSTFn i ] ] where binary :: (ModuleName, PSString) -> (ModuleName, PSString) -> BinaryOperator -> AST -> AST - binary dict fns op = convert where + binary dict fn op = convert where convert :: AST -> AST - convert (App ss (App _ (expander -> App _ fn [dict']) [x]) [y]) | isDict dict dict' && isDict fns fn = Binary ss op x y + convert (App ss (App _ (expander -> App _ (Ref fn') [Ref dict']) [x]) [y]) | dict == dict', fn == fn' = Binary ss op x y convert other = other - binary' :: ModuleName -> PSString -> BinaryOperator -> AST -> AST - binary' moduleName opString op = convert where + binary' :: (ModuleName, PSString) -> BinaryOperator -> AST -> AST + binary' fn op = convert where convert :: AST -> AST - convert (App ss (App _ fn [x]) [y]) | isDict (moduleName, opString) fn = Binary ss op x y + convert (App ss (App _ (Ref fn') [x]) [y]) | fn == fn' = Binary ss op x y convert other = other unary :: (ModuleName, PSString) -> (ModuleName, PSString) -> UnaryOperator -> AST -> AST - unary dicts fns op = convert where + unary dict fn op = convert where convert :: AST -> AST - convert (App ss (expander -> App _ fn [dict']) [x]) | isDict dicts dict' && isDict fns fn = Unary ss op x + convert (App ss (expander -> App _ (Ref fn') [Ref dict']) [x]) | dict == dict', fn == fn' = Unary ss op x convert other = other - unary' :: ModuleName -> PSString -> UnaryOperator -> AST -> AST - unary' moduleName fnName op = convert where + unary' :: (ModuleName, PSString) -> UnaryOperator -> AST -> AST + unary' fn op = convert where convert :: AST -> AST - convert (App ss fn [x]) | isDict (moduleName, fnName) fn = Unary ss op x + convert (App ss (Ref fn') [x]) | fn == 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.P_mkFn $ \ss1 ss2 ss3 args js -> Function ss1 Nothing args (Block ss2 [Return ss3 js]) - mkEffFn :: ModuleName -> Text -> Int -> AST -> AST - mkEffFn modName fnName = mkFn' modName fnName $ \ss1 ss2 ss3 args js -> + mkEffFn :: (ModuleName, PSString) -> Int -> AST -> AST + mkEffFn mkFn_ = mkFn' mkFn_ $ \ss1 ss2 ss3 args js -> Function ss1 Nothing args (Block ss2 [Return ss3 (App ss3 js [])]) - mkFn' :: ModuleName -> Text -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST - mkFn' modName fnName res 0 = convert where + mkFn' :: (ModuleName, PSString) -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST + mkFn' mkFn_ res 0 = convert where convert :: AST -> AST - convert (App _ mkFnN [Function s1 Nothing [_] (Block s2 [Return s3 js])]) | isNFn modName fnName 0 mkFnN = + convert (App _ (Ref mkFnN) [Function s1 Nothing [_] (Block s2 [Return s3 js])]) | isNFn mkFn_ 0 mkFnN = res s1 s2 s3 [] js convert other = other - mkFn' modName fnName res n = convert where + mkFn' mkFn_ res n = convert where convert :: AST -> AST - convert orig@(App ss mkFnN [fn]) | isNFn modName fnName n mkFnN = + convert orig@(App ss (Ref mkFnN) [fn]) | isNFn mkFn_ n mkFnN = case collectArgs n [] fn of Just (args, [Return ss' ret]) -> res ss ss ss' args ret _ -> orig @@ -221,25 +212,23 @@ inlineCommonOperators expander = everywhereTopDown $ applyAll $ collectArgs m acc (Function _ Nothing [oneArg] (Block _ [Return _ ret])) = collectArgs (m - 1) (oneArg : acc) ret collectArgs _ _ _ = Nothing - isNFn :: ModuleName -> Text -> Int -> AST -> Bool - isNFn expectMod prefix n (ModuleAccessor _ modName name) | modName == expectMod = - name == fromString (T.unpack prefix <> show n) - isNFn _ _ _ _ = False + isNFn :: (ModuleName, PSString) -> Int -> (ModuleName, PSString) -> Bool + isNFn prefix n fn = fmap (<> mkString (T.pack $ show n)) prefix == fn runFn :: Int -> AST -> AST - runFn = runFn' C.DataFunctionUncurried C.runFn App + runFn = runFn' C.P_runFn App - runEffFn :: ModuleName -> Text -> Int -> AST -> AST - runEffFn modName fnName = runFn' modName fnName $ \ss fn acc -> + runEffFn :: (ModuleName, PSString) -> Int -> AST -> AST + runEffFn runFn_ = runFn' runFn_ $ \ss fn acc -> Function ss Nothing [] (Block ss [Return ss (App ss fn acc)]) - runFn' :: ModuleName -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST - runFn' modName runFnName res n = convert where + runFn' :: (ModuleName, PSString) -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST + runFn' runFn_ res n = convert where convert :: AST -> AST convert js = fromMaybe js $ go n [] js go :: Int -> [AST] -> AST -> Maybe AST - go 0 acc (App ss runFnN [fn]) | isNFn modName runFnName n runFnN && length acc == n = + go 0 acc (App ss (Ref runFnN) [fn]) | isNFn runFn_ n runFnN && length acc == n = Just $ res ss fn acc go m acc (App _ lhs [arg]) = go (m - 1) (arg : acc) lhs go _ _ _ = Nothing @@ -251,8 +240,7 @@ inlineCommonOperators expander = everywhereTopDown $ applyAll $ convert other = other isModFnWithDict :: (ModuleName, PSString) -> AST -> Bool - isModFnWithDict (m, op) (App _ (ModuleAccessor _ m' op') [Var _ _]) = - m == m' && op == op' + isModFnWithDict fn (App _ (Ref fn') [Var _ _]) = fn == fn' isModFnWithDict _ _ = False -- (f <<< g $ x) = f (g x) @@ -261,11 +249,11 @@ inlineFnComposition :: forall m. MonadSupply m => (AST -> AST) -> AST -> m AST inlineFnComposition expander = everywhereTopDownM convert where convert :: AST -> m AST - convert (App s1 (App s2 (App _ (expander -> App _ fn [dict']) [x]) [y]) [z]) - | isFnCompose dict' fn = return $ App s1 x [App s2 y [z]] - | isFnComposeFlipped dict' fn = return $ App s2 y [App s1 x [z]] - convert app@(App ss (App _ (expander -> App _ fn [dict']) _) _) - | isFnCompose dict' fn || isFnComposeFlipped dict' fn = mkApps ss <$> goApps app <*> freshName + convert (App s1 (App s2 (App _ (expander -> App _ (Ref fn) [Ref C.P_semigroupoidFn]) [x]) [y]) [z]) + | C.P_compose <- fn = return $ App s1 x [App s2 y [z]] + | C.P_composeFlipped <- fn = return $ App s2 y [App s1 x [z]] + convert app@(App ss (App _ (expander -> App _ (Ref fn) [Ref C.P_semigroupoidFn]) _) _) + | fn `elem` [C.P_compose, C.P_composeFlipped] = mkApps ss <$> goApps app <*> freshName convert other = return other mkApps :: Maybe SourceSpan -> [Either AST (Text, AST)] -> Text -> AST @@ -279,151 +267,28 @@ inlineFnComposition expander = everywhereTopDownM convert mkApp = either id $ \(name, arg) -> Var (getSourceSpan arg) name goApps :: AST -> m [Either AST (Text, AST)] - goApps (App _ (App _ (expander -> App _ fn [dict']) [x]) [y]) - | isFnCompose dict' fn = mappend <$> goApps x <*> goApps y - | isFnComposeFlipped dict' fn = mappend <$> goApps y <*> goApps x + goApps (App _ (App _ (expander -> App _ (Ref fn) [Ref C.P_semigroupoidFn]) [x]) [y]) + | C.P_compose <- fn = mappend <$> goApps x <*> goApps y + | C.P_composeFlipped <- fn = mappend <$> goApps y <*> goApps x goApps app@App {} = pure . Right . (,app) <$> freshName goApps other = pure [Left other] - isFnCompose :: AST -> AST -> Bool - isFnCompose dict' fn = isDict semigroupoidFn dict' && isDict fnCompose fn - - isFnComposeFlipped :: AST -> AST -> Bool - isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isDict fnComposeFlipped fn - - fnCompose :: forall a. IsString a => (ModuleName, a) - fnCompose = (C.ControlSemigroupoid, C.compose) - - fnComposeFlipped :: forall a. IsString a => (ModuleName, a) - fnComposeFlipped = (C.ControlSemigroupoid, C.composeFlipped) - inlineFnIdentity :: (AST -> AST) -> AST -> AST inlineFnIdentity expander = everywhereTopDown convert where convert :: AST -> AST - convert (App _ (expander -> App _ fn [dict]) [x]) | isDict categoryFn dict && isDict fnIdentity fn = x + convert (App _ (expander -> App _ (Ref C.P_identity) [Ref C.P_categoryFn]) [x]) = x convert other = other - fnIdentity :: forall a. IsString a => (ModuleName, a) - fnIdentity = (C.ControlCategory, C.identity) - inlineUnsafeCoerce :: AST -> AST inlineUnsafeCoerce = everywhereTopDown convert where - convert (App _ (ModuleAccessor _ C.UnsafeCoerce unsafeCoerceFn) [ comp ]) - | unsafeCoerceFn == C.unsafeCoerceFn - = comp + convert (App _ (Ref C.P_unsafeCoerce) [ comp ]) = comp convert other = other inlineUnsafePartial :: AST -> AST inlineUnsafePartial = everywhereTopDown convert where - convert (App ss (ModuleAccessor _ C.PartialUnsafe unsafePartial) [ comp ]) - | unsafePartial == C.unsafePartial + convert (App ss (Ref C.P_unsafePartial) [ comp ]) -- Apply to undefined here, the application should be optimized away -- if it is safe to do so - = App ss comp [ Var ss C.undefined ] + = App ss comp [ Var ss C.S_undefined ] convert other = other - -semiringNumber :: forall a. IsString a => (ModuleName, a) -semiringNumber = (C.DataSemiring, C.semiringNumber) - -semiringInt :: forall a. IsString a => (ModuleName, a) -semiringInt = (C.DataSemiring, C.semiringInt) - -ringNumber :: forall a. IsString a => (ModuleName, a) -ringNumber = (C.DataRing, C.ringNumber) - -ringInt :: forall a. IsString a => (ModuleName, a) -ringInt = (C.DataRing, C.ringInt) - -euclideanRingNumber :: forall a. IsString a => (ModuleName, a) -euclideanRingNumber = (C.DataEuclideanRing, C.euclideanRingNumber) - -eqNumber :: forall a. IsString a => (ModuleName, a) -eqNumber = (C.DataEq, C.eqNumber) - -eqInt :: forall a. IsString a => (ModuleName, a) -eqInt = (C.DataEq, C.eqInt) - -eqString :: forall a. IsString a => (ModuleName, a) -eqString = (C.DataEq, C.eqString) - -eqChar :: forall a. IsString a => (ModuleName, a) -eqChar = (C.DataEq, C.eqChar) - -eqBoolean :: forall a. IsString a => (ModuleName, a) -eqBoolean = (C.DataEq, C.eqBoolean) - -ordBoolean :: forall a. IsString a => (ModuleName, a) -ordBoolean = (C.DataOrd, C.ordBoolean) - -ordNumber :: forall a. IsString a => (ModuleName, a) -ordNumber = (C.DataOrd, C.ordNumber) - -ordInt :: forall a. IsString a => (ModuleName, a) -ordInt = (C.DataOrd, C.ordInt) - -ordString :: forall a. IsString a => (ModuleName, a) -ordString = (C.DataOrd, C.ordString) - -ordChar :: forall a. IsString a => (ModuleName, a) -ordChar = (C.DataOrd, C.ordChar) - -semigroupString :: forall a. IsString a => (ModuleName, a) -semigroupString = (C.DataSemigroup, C.semigroupString) - -boundedBoolean :: forall a. IsString a => (ModuleName, a) -boundedBoolean = (C.DataBounded, C.boundedBoolean) - -heytingAlgebraBoolean :: forall a. IsString a => (ModuleName, a) -heytingAlgebraBoolean = (C.DataHeytingAlgebra, C.heytingAlgebraBoolean) - -semigroupoidFn :: forall a. IsString a => (ModuleName, a) -semigroupoidFn = (C.ControlSemigroupoid, C.semigroupoidFn) - -categoryFn :: forall a. IsString a => (ModuleName, a) -categoryFn = (C.ControlCategory, C.categoryFn) - -opAdd :: forall a. IsString a => (ModuleName, a) -opAdd = (C.DataSemiring, C.add) - -opMul :: forall a. IsString a => (ModuleName, a) -opMul = (C.DataSemiring, C.mul) - -opEq :: forall a. IsString a => (ModuleName, a) -opEq = (C.DataEq, C.eq) - -opNotEq :: forall a. IsString a => (ModuleName, a) -opNotEq = (C.DataEq, C.notEq) - -opLessThan :: forall a. IsString a => (ModuleName, a) -opLessThan = (C.DataOrd, C.lessThan) - -opLessThanOrEq :: forall a. IsString a => (ModuleName, a) -opLessThanOrEq = (C.DataOrd, C.lessThanOrEq) - -opGreaterThan :: forall a. IsString a => (ModuleName, a) -opGreaterThan = (C.DataOrd, C.greaterThan) - -opGreaterThanOrEq :: forall a. IsString a => (ModuleName, a) -opGreaterThanOrEq = (C.DataOrd, C.greaterThanOrEq) - -opAppend :: forall a. IsString a => (ModuleName, a) -opAppend = (C.DataSemigroup, C.append) - -opSub :: forall a. IsString a => (ModuleName, a) -opSub = (C.DataRing, C.sub) - -opNegate :: forall a. IsString a => (ModuleName, a) -opNegate = (C.DataRing, C.negate) - -opDiv :: forall a. IsString a => (ModuleName, a) -opDiv = (C.DataEuclideanRing, C.div) - -opConj :: forall a. IsString a => (ModuleName, a) -opConj = (C.DataHeytingAlgebra, C.conj) - -opDisj :: forall a. IsString a => (ModuleName, a) -opDisj = (C.DataHeytingAlgebra, C.disj) - -opNot :: forall a. IsString a => (ModuleName, a) -opNot = (C.DataHeytingAlgebra, C.not) diff --git a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs index 449c2be79c..fb9ed17ad5 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs @@ -11,7 +11,7 @@ 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 +import qualified Language.PureScript.Constants.Libs as C -- | Inline type class dictionaries for >>= and return for the Eff monad -- @@ -28,13 +28,13 @@ import qualified Language.PureScript.Constants.Prelude as C -- ... -- } magicDoEff :: (AST -> AST) -> AST -> AST -magicDoEff = magicDo C.Eff C.effDictionaries +magicDoEff = magicDo C.M_Control_Monad_Eff C.effDictionaries magicDoEffect :: (AST -> AST) -> AST -> AST -magicDoEffect = magicDo C.Effect C.effectDictionaries +magicDoEffect = magicDo C.M_Effect C.effectDictionaries magicDoST :: (AST -> AST) -> AST -> AST -magicDoST = magicDo C.ST C.stDictionaries +magicDoST = magicDo C.M_Control_Monad_ST_Internal C.stDictionaries magicDo :: ModuleName -> C.EffectDictionaries -> (AST -> AST) -> AST -> AST magicDo effectModule C.EffectDictionaries{..} expander = everywhereTopDown convert @@ -68,25 +68,16 @@ magicDo effectModule C.EffectDictionaries{..} expander = everywhereTopDown conve App s1 (Function s2 Nothing [] (Block ss (applyReturns `fmap` body))) [] convert other = other -- Check if an expression represents a monomorphic call to >>= for the Eff monad - isBind (expander -> App _ fn [dict]) | isDict (effectModule, edBindDict) dict && isBindPoly fn = True + isBind (expander -> App _ (Ref C.P_bind) [Ref dict]) = (effectModule, edBindDict) == dict isBind _ = False -- Check if an expression represents a call to @discard@ - isDiscard (expander -> App _ (expander -> App _ fn [dict1]) [dict2]) - | isDict (C.ControlBind, C.discardUnitDictionary) dict1 && - isDict (effectModule, edBindDict) dict2 && - isDiscardPoly fn = True + isDiscard (expander -> App _ (expander -> App _ (Ref C.P_discard) [Ref C.P_discardUnit]) [Ref dict]) = (effectModule, edBindDict) == dict isDiscard _ = False -- Check if an expression represents a monomorphic call to pure or return for the Eff applicative - isPure (expander -> App _ fn [dict]) | isDict (effectModule, edApplicativeDict) dict && isPurePoly fn = True + isPure (expander -> App _ (Ref C.P_pure) [Ref dict]) = (effectModule, edApplicativeDict) == dict isPure _ = False - -- Check if an expression represents the polymorphic >>= function - isBindPoly = isDict (C.ControlBind, C.bind) - -- Check if an expression represents the polymorphic pure function - isPurePoly = isDict (C.ControlApplicative, C.pure') - -- Check if an expression represents the polymorphic discard function - isDiscardPoly = isDict (C.ControlBind, C.discard) -- Check if an expression represents a function in the Effect module - isEffFunc name (ModuleAccessor _ eff name') = eff == effectModule && name == name' + isEffFunc name (Ref fn) = (effectModule, name) == fn isEffFunc _ _ = False applyReturns :: AST -> AST @@ -102,10 +93,10 @@ magicDo effectModule C.EffectDictionaries{..} expander = everywhereTopDown conve inlineST :: AST -> AST inlineST = everywhere convertBlock where - -- Look for runST blocks and inline the STRefs there. - -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then + -- Look for run blocks and inline the STRefs there. + -- If all STRefs are used in the scope of the same run, only using { read, write, modify } then -- we can be more aggressive about inlining, and actually turn STRefs into local variables. - convertBlock (App s1 f [arg]) | isSTFunc C.runST f = + convertBlock (App s1 (Ref C.P_run) [arg]) = let refs = ordNub . findSTRefsIn $ arg usages = findAllSTUsagesIn arg allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages @@ -115,28 +106,25 @@ inlineST = everywhere convertBlock -- Convert a block in a safe way, preserving object wrappers of references, -- or in a more aggressive way, turning wrappers into local variables depending on the -- agg(ressive) parameter. - convert agg (App s1 f [arg]) | isSTFunc C.newSTRef f = + convert agg (App s1 (Ref C.P_new) [arg]) = Function s1 Nothing [] (Block s1 [Return s1 $ if agg then arg else ObjectLiteral s1 [(mkString C.stRefValue, arg)]]) - convert agg (App _ (App s1 f [ref]) []) | isSTFunc C.readSTRef f = + convert agg (App _ (App s1 (Ref C.P_read) [ref]) []) = if agg then ref else Indexer s1 (StringLiteral s1 C.stRefValue) ref - convert agg (App _ (App _ (App s1 f [arg]) [ref]) []) | isSTFunc C.writeSTRef f = + convert agg (App _ (App _ (App s1 (Ref C.P_write) [arg]) [ref]) []) = if agg then Assignment s1 ref arg else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) arg - convert agg (App _ (App _ (App s1 f [func]) [ref]) []) | isSTFunc C.modifySTRef f = + convert agg (App _ (App _ (App s1 (Ref C.P_modify) [func]) [ref]) []) = 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 (ModuleAccessor _ C.ST name') = name == name' - isSTFunc _ _ = False -- Find all ST Refs initialized in this block findSTRefsIn = everything (++) isSTRef where - isSTRef (VariableIntroduction _ ident (Just (_, App _ (App _ f [_]) []))) | isSTFunc C.newSTRef f = [ident] + isSTRef (VariableIntroduction _ ident (Just (_, App _ (App _ (Ref C.P_new) [_]) []))) = [ident] isSTRef _ = [] - -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef + -- Find all STRefs used as arguments to read, write, modify findAllSTUsagesIn = everything (++) isSTUsage where - isSTUsage (App _ (App _ f [ref]) []) | isSTFunc C.readSTRef f = [ref] - isSTUsage (App _ (App _ (App _ f [_]) [ref]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref] + isSTUsage (App _ (App _ (Ref C.P_read) [ref]) []) = [ref] + isSTUsage (App _ (App _ (App _ (Ref f) [_]) [ref]) []) | f `elem` [C.P_write, C.P_modify] = [ref] isSTUsage _ = [] -- Find all uses of a variable appearingIn ref = everything (++) isVar diff --git a/src/Language/PureScript/CoreImp/Optimizer/Unused.hs b/src/Language/PureScript/CoreImp/Optimizer/Unused.hs index cd11de4eca..f920d79af0 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Unused.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Unused.hs @@ -32,7 +32,7 @@ removeCodeAfterReturnStatements = everywhere (removeFromBlock go) removeUndefinedApp :: AST -> AST removeUndefinedApp = everywhere convert where - convert (App ss fn [Var _ arg]) | arg == C.undefined = App ss fn [] + convert (App ss fn [Var _ C.S_undefined]) = App ss fn [] convert js = js removeUnusedEffectFreeVars :: [Text] -> [[AST]] -> [[AST]] diff --git a/src/Language/PureScript/Docs/Prim.hs b/src/Language/PureScript/Docs/Prim.hs index a8021c9ddc..cd8a4697cd 100644 --- a/src/Language/PureScript/Docs/Prim.hs +++ b/src/Language/PureScript/Docs/Prim.hs @@ -13,6 +13,7 @@ import qualified Data.Text as T import qualified Data.Map as Map import Language.PureScript.Docs.Types +import qualified Language.PureScript.Constants.Prim as P import qualified Language.PureScript.Crash as P import qualified Language.PureScript.Environment as P import qualified Language.PureScript.Names as P @@ -158,27 +159,23 @@ primTypeErrorDocsModule = Module , modReExports = [] } -type NameGen a = Text -> P.Qualified (P.ProperName a) - -unsafeLookupOf +unsafeLookup :: forall v (a :: P.ProperNameType) - . NameGen a - -> Map.Map (P.Qualified (P.ProperName a)) v + . Map.Map (P.Qualified (P.ProperName a)) v -> String - -> Text + -> P.Qualified (P.ProperName a) -> v -unsafeLookupOf k m errorMsg name = go name +unsafeLookup m errorMsg name = go name where - go = fromJust' . flip Map.lookup m . k + go = fromJust' . flip Map.lookup m fromJust' (Just x) = x - fromJust' _ = P.internalError $ errorMsg ++ show name + fromJust' _ = P.internalError $ errorMsg ++ show (P.runProperName $ P.disqualify name) -lookupPrimTypeKindOf - :: NameGen 'P.TypeName - -> Text +lookupPrimTypeKind + :: P.Qualified (P.ProperName 'P.TypeName) -> Type' -lookupPrimTypeKindOf k = ($> ()) . fst . unsafeLookupOf k +lookupPrimTypeKind = ($> ()) . fst . unsafeLookup ( P.primTypes <> P.primBooleanTypes <> P.primOrderingTypes <> @@ -187,23 +184,20 @@ lookupPrimTypeKindOf k = ($> ()) . fst . unsafeLookupOf k P.primTypeErrorTypes ) "Docs.Prim: No such Prim type: " -primType :: Text -> Text -> Declaration -primType = primTypeOf P.primName - -primTypeOf :: NameGen 'P.TypeName -> Text -> Text -> Declaration -primTypeOf gen title comments = Declaration - { declTitle = title +primType :: P.Qualified (P.ProperName 'P.TypeName) -> Text -> Declaration +primType tn comments = Declaration + { declTitle = P.runProperName $ P.disqualify tn , declComments = Just comments , declSourceSpan = Nothing , declChildren = [] - , declInfo = ExternDataDeclaration (lookupPrimTypeKindOf gen title) [] + , declInfo = ExternDataDeclaration (lookupPrimTypeKind tn) [] , declKind = Nothing } -- | Lookup the TypeClassData of a Prim class. This function is specifically -- not exported because it is partial. -lookupPrimClassOf :: NameGen 'P.ClassName -> Text -> P.TypeClassData -lookupPrimClassOf g = unsafeLookupOf g +lookupPrimClass :: P.Qualified (P.ProperName 'P.ClassName) -> P.TypeClassData +lookupPrimClass = unsafeLookup ( P.primClasses <> P.primCoerceClasses <> P.primRowClasses <> @@ -213,18 +207,15 @@ lookupPrimClassOf g = unsafeLookupOf g P.primTypeErrorClasses ) "Docs.Prim: No such Prim class: " -primClass :: Text -> Text -> Declaration -primClass = primClassOf P.primName - -primClassOf :: NameGen 'P.ClassName -> Text -> Text -> Declaration -primClassOf gen title comments = Declaration - { declTitle = title +primClass :: P.Qualified (P.ProperName 'P.ClassName) -> Text -> Declaration +primClass cn comments = Declaration + { declTitle = P.runProperName $ P.disqualify cn , declComments = Just comments , declSourceSpan = Nothing , declChildren = [] , declInfo = let - tcd = lookupPrimClassOf gen title + tcd = lookupPrimClass cn args = fmap (fmap ($> ())) <$> P.typeClassArguments tcd superclasses = ($> ()) <$> P.typeClassSuperclasses tcd fundeps = convertFundepsToStrings args (P.typeClassDependencies tcd) @@ -234,13 +225,13 @@ primClassOf gen title comments = Declaration } kindType :: Declaration -kindType = primType "Type" $ T.unlines +kindType = primType P.Type $ T.unlines [ "`Type` is the kind of all proper types: those that classify value-level terms." , "For example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`." ] kindConstraint :: Declaration -kindConstraint = primType "Constraint" $ T.unlines +kindConstraint = primType P.Constraint $ T.unlines [ "`Constraint` is the kind of type class constraints." , "For example, a type class declaration like this:" , "" @@ -253,7 +244,7 @@ kindConstraint = primType "Constraint" $ T.unlines ] kindSymbol :: Declaration -kindSymbol = primType "Symbol" $ T.unlines +kindSymbol = primType P.Symbol $ T.unlines [ "`Symbol` is the kind of type-level strings." , "" , "Construct types of this kind using the same literal syntax as documented" @@ -265,7 +256,7 @@ kindSymbol = primType "Symbol" $ T.unlines ] kindRow :: Declaration -kindRow = primType "Row" $ T.unlines +kindRow = primType P.Row $ T.unlines [ "`Row` is the kind constructor of label-indexed types which map type-level strings to other types." , "The most common use of `Row` is `Row Type`, a row mapping labels to basic (of kind `Type`) types:" , "" @@ -277,7 +268,7 @@ kindRow = primType "Row" $ T.unlines ] function :: Declaration -function = primType "Function" $ T.unlines +function = primType P.Function $ T.unlines [ "A function, which takes values of the type specified by the first type" , "parameter, and returns values of the type specified by the second." , "In the JavaScript backend, this is a standard JavaScript Function." @@ -296,7 +287,7 @@ function = primType "Function" $ T.unlines ] array :: Declaration -array = primType "Array" $ T.unlines +array = primType P.Array $ T.unlines [ "An Array: a data structure supporting efficient random access. In" , "the JavaScript backend, values of this type are represented as JavaScript" , "Arrays at runtime." @@ -307,7 +298,7 @@ array = primType "Array" $ T.unlines ] record :: Declaration -record = primType "Record" $ T.unlines +record = primType P.Record $ T.unlines [ "The type of records whose fields are known at compile time. In the" , "JavaScript backend, values of this type are represented as JavaScript" , "Objects at runtime." @@ -329,7 +320,7 @@ record = primType "Record" $ T.unlines ] number :: Declaration -number = primType "Number" $ T.unlines +number = primType P.Number $ T.unlines [ "A double precision floating point number (IEEE 754)." , "" , "Construct values of this type with literals." @@ -342,7 +333,7 @@ number = primType "Number" $ T.unlines ] int :: Declaration -int = primType "Int" $ T.unlines +int = primType P.Int $ T.unlines [ "A 32-bit signed integer. See the `purescript-integers` package for details" , "of how this is accomplished when compiling to JavaScript." , "" @@ -375,7 +366,7 @@ int = primType "Int" $ T.unlines ] string :: Declaration -string = primType "String" $ T.unlines +string = primType P.String $ T.unlines [ "A String. As in JavaScript, String values represent sequences of UTF-16" , "code units, which are not required to form a valid encoding of Unicode" , "text (for example, lone surrogates are permitted)." @@ -397,7 +388,7 @@ string = primType "String" $ T.unlines ] char :: Declaration -char = primType "Char" $ T.unlines +char = primType P.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" @@ -409,7 +400,7 @@ char = primType "Char" $ T.unlines ] boolean :: Declaration -boolean = primType "Boolean" $ T.unlines +boolean = primType P.Boolean $ T.unlines [ "A JavaScript Boolean value." , "" , "Construct values of this type with the literals `true` and `false`." @@ -418,7 +409,7 @@ boolean = primType "Boolean" $ T.unlines ] partial :: Declaration -partial = primClass "Partial" $ T.unlines +partial = primClass P.Partial $ T.unlines [ "The Partial type class is used to indicate that a function is *partial,*" , "that is, it is not defined for all inputs. In practice, attempting to use" , "a partial function with a bad input will usually cause an error to be" @@ -428,17 +419,17 @@ partial = primClass "Partial" $ T.unlines ] booleanTrue :: Declaration -booleanTrue = primTypeOf (P.primSubName "Boolean") "True" $ T.unlines +booleanTrue = primType P.True $ T.unlines [ "The 'True' boolean type." ] booleanFalse :: Declaration -booleanFalse = primTypeOf (P.primSubName "Boolean") "False" $ T.unlines +booleanFalse = primType P.False $ T.unlines [ "The 'False' boolean type." ] coercible :: Declaration -coercible = primClassOf (P.primSubName "Coerce") "Coercible" $ T.unlines +coercible = primClass P.Coercible $ T.unlines [ "Coercible is a two-parameter type class that has instances for types `a`" , "and `b` if the compiler can infer that they have the same representation." , "Coercible constraints are solved according to the following rules:" @@ -494,29 +485,29 @@ coercible = primClassOf (P.primSubName "Coerce") "Coercible" $ T.unlines ] kindOrdering :: Declaration -kindOrdering = primTypeOf (P.primSubName "Ordering") "Ordering" $ T.unlines +kindOrdering = primType P.TypeOrdering $ T.unlines [ "The `Ordering` kind represents the three possibilities of comparing two" , "types of the same kind: `LT` (less than), `EQ` (equal to), and" , "`GT` (greater than)." ] orderingLT :: Declaration -orderingLT = primTypeOf (P.primSubName "Ordering") "LT" $ T.unlines +orderingLT = primType P.LT $ T.unlines [ "The 'less than' ordering type." ] orderingEQ :: Declaration -orderingEQ = primTypeOf (P.primSubName "Ordering") "EQ" $ T.unlines +orderingEQ = primType P.EQ $ T.unlines [ "The 'equal to' ordering type." ] orderingGT :: Declaration -orderingGT = primTypeOf (P.primSubName "Ordering") "GT" $ T.unlines +orderingGT = primType P.GT $ T.unlines [ "The 'greater than' ordering type." ] union :: Declaration -union = primClassOf (P.primSubName "Row") "Union" $ T.unlines +union = primClass P.RowUnion $ T.unlines [ "The Union type class is used to compute the union of two rows of types" , "(left-biased, including duplicates)." , "" @@ -524,58 +515,58 @@ union = primClassOf (P.primSubName "Row") "Union" $ T.unlines ] nub :: Declaration -nub = primClassOf (P.primSubName "Row") "Nub" $ T.unlines +nub = primClass P.RowNub $ T.unlines [ "The Nub type class is used to remove duplicate labels from rows." ] lacks :: Declaration -lacks = primClassOf (P.primSubName "Row") "Lacks" $ T.unlines +lacks = primClass P.RowLacks $ T.unlines [ "The Lacks type class asserts that a label does not occur in a given row." ] rowCons :: Declaration -rowCons = primClassOf (P.primSubName "Row") "Cons" $ T.unlines +rowCons = primClass P.RowCons $ T.unlines [ "The Cons type class is a 4-way relation which asserts that one row of" , "types can be obtained from another by inserting a new label/type pair on" , "the left." ] kindRowList :: Declaration -kindRowList = primTypeOf (P.primSubName "RowList") "RowList" $ T.unlines +kindRowList = primType P.RowList $ T.unlines [ "A type level list representation of a row of types." ] rowListCons :: Declaration -rowListCons = primTypeOf (P.primSubName "RowList") "Cons" $ T.unlines +rowListCons = primType P.RowListCons $ T.unlines [ "Constructs a new `RowList` from a label, a type, and an existing tail" , "`RowList`. E.g: `Cons \"x\" Int (Cons \"y\" Int Nil)`." ] rowListNil :: Declaration -rowListNil = primTypeOf (P.primSubName "RowList") "Nil" $ T.unlines +rowListNil = primType P.RowListNil $ T.unlines [ "The empty `RowList`." ] rowToList :: Declaration -rowToList = primClassOf (P.primSubName "RowList") "RowToList" $ T.unlines +rowToList = primClass P.RowToList $ T.unlines [ "Compiler solved type class for generating a `RowList` from a closed row" , "of types. Entries are sorted by label and duplicates are preserved in" , "the order they appeared in the row." ] symbolAppend :: Declaration -symbolAppend = primClassOf (P.primSubName "Symbol") "Append" $ T.unlines +symbolAppend = primClass P.SymbolAppend $ T.unlines [ "Compiler solved type class for appending `Symbol`s together." ] symbolCompare :: Declaration -symbolCompare = primClassOf (P.primSubName "Symbol") "Compare" $ T.unlines +symbolCompare = primClass P.SymbolCompare $ T.unlines [ "Compiler solved type class for comparing two `Symbol`s." , "Produces an `Ordering`." ] symbolCons :: Declaration -symbolCons = primClassOf (P.primSubName "Symbol") "Cons" $ T.unlines +symbolCons = primClass P.SymbolCons $ T.unlines [ "Compiler solved type class for either splitting up a symbol into its" , "head and tail or for combining a head and tail into a new symbol." , "Requires the head to be a single character and the combined string" @@ -583,28 +574,28 @@ symbolCons = primClassOf (P.primSubName "Symbol") "Cons" $ T.unlines ] intAdd :: Declaration -intAdd = primClassOf (P.primSubName "Int") "Add" $ T.unlines +intAdd = primClass P.IntAdd $ T.unlines [ "Compiler solved type class for adding type-level `Int`s." ] intCompare :: Declaration -intCompare = primClassOf (P.primSubName "Int") "Compare" $ T.unlines +intCompare = primClass P.IntCompare $ T.unlines [ "Compiler solved type class for comparing two type-level `Int`s." , "Produces an `Ordering`." ] intMul :: Declaration -intMul = primClassOf (P.primSubName "Int") "Mul" $ T.unlines +intMul = primClass P.IntMul $ T.unlines [ "Compiler solved type class for multiplying type-level `Int`s." ] intToString :: Declaration -intToString = primClassOf (P.primSubName "Int") "ToString" $ T.unlines +intToString = primClass P.IntToString $ T.unlines [ "Compiler solved type class for converting a type-level `Int` into a type-level `String` (i.e. `Symbol`)." ] fail :: Declaration -fail = primClassOf (P.primSubName "TypeError") "Fail" $ T.unlines +fail = primClass P.Fail $ T.unlines [ "The Fail type class is part of the custom type errors feature. To provide" , "a custom type error when someone tries to use a particular instance," , "write that instance out with a Fail constraint." @@ -614,7 +605,7 @@ fail = primClassOf (P.primSubName "TypeError") "Fail" $ T.unlines ] warn :: Declaration -warn = primClassOf (P.primSubName "TypeError") "Warn" $ T.unlines +warn = primClass P.Warn $ T.unlines [ "The Warn type class allows a custom compiler warning to be displayed." , "" , "For more information, see" @@ -622,7 +613,7 @@ warn = primClassOf (P.primSubName "TypeError") "Warn" $ T.unlines ] kindDoc :: Declaration -kindDoc = primTypeOf (P.primSubName "TypeError") "Doc" $ T.unlines +kindDoc = primType P.Doc $ T.unlines [ "`Doc` is the kind of type-level documents." , "" , "This kind is used with the `Fail` and `Warn` type classes." @@ -630,7 +621,7 @@ kindDoc = primTypeOf (P.primSubName "TypeError") "Doc" $ T.unlines ] textDoc :: Declaration -textDoc = primTypeOf (P.primSubName "TypeError") "Text" $ T.unlines +textDoc = primType P.Text $ T.unlines [ "The Text type constructor makes a Doc from a Symbol" , "to be used in a custom type error." , "" @@ -639,7 +630,7 @@ textDoc = primTypeOf (P.primSubName "TypeError") "Text" $ T.unlines ] quoteDoc :: Declaration -quoteDoc = primTypeOf (P.primSubName "TypeError") "Quote" $ T.unlines +quoteDoc = primType P.Quote $ T.unlines [ "The Quote type constructor renders any concrete type as a Doc" , "to be used in a custom type error." , "" @@ -648,7 +639,7 @@ quoteDoc = primTypeOf (P.primSubName "TypeError") "Quote" $ T.unlines ] quoteLabelDoc :: Declaration -quoteLabelDoc = primTypeOf (P.primSubName "TypeError") "QuoteLabel" $ T.unlines +quoteLabelDoc = primType P.QuoteLabel $ T.unlines [ "The `QuoteLabel` type constructor will produce a `Doc` when given a `Symbol`. When the resulting `Doc` is rendered" , "for a `Warn` or `Fail` constraint, a syntactically valid label will be produced, escaping with quotes as needed." , "" @@ -657,7 +648,7 @@ quoteLabelDoc = primTypeOf (P.primSubName "TypeError") "QuoteLabel" $ T.unlines ] besideDoc :: Declaration -besideDoc = primTypeOf (P.primSubName "TypeError") "Beside" $ T.unlines +besideDoc = primType P.Beside $ T.unlines [ "The Beside type constructor combines two Docs horizontally" , "to be used in a custom type error." , "" @@ -666,7 +657,7 @@ besideDoc = primTypeOf (P.primSubName "TypeError") "Beside" $ T.unlines ] aboveDoc :: Declaration -aboveDoc = primTypeOf (P.primSubName "TypeError") "Above" $ T.unlines +aboveDoc = primType P.Above $ T.unlines [ "The Above type constructor combines two Docs vertically" , "in a custom type error." , "" diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs index fc32591eb7..96dd1d2215 100644 --- a/src/Language/PureScript/Environment.hs +++ b/src/Language/PureScript/Environment.hs @@ -9,6 +9,7 @@ import Codec.Serialise (Serialise) import Data.Aeson ((.=), (.:)) import qualified Data.Aeson as A import Data.Foldable (find, fold) +import Data.Functor ((<&>)) import qualified Data.IntMap as IM import qualified Data.IntSet as IS import qualified Data.Map as M @@ -279,81 +280,62 @@ instance A.FromJSON DataDeclType where "newtype" -> return Newtype other -> fail $ "invalid type: '" ++ T.unpack other ++ "'" --- | Construct a ProperName in the Prim module -primName :: Text -> Qualified (ProperName a) -primName = Qualified (ByModuleName C.Prim) . ProperName - --- | Construct a 'ProperName' in the @Prim.NAME@ module. -primSubName :: Text -> Text -> Qualified (ProperName a) -primSubName sub = - Qualified (ByModuleName $ ModuleName $ C.prim <> "." <> sub) . ProperName - -primKind :: Text -> SourceType -primKind = primTy - -primSubKind :: Text -> Text -> SourceType -primSubKind sub = TypeConstructor nullSourceAnn . primSubName sub - -- | Kind of ground types kindType :: SourceType -kindType = primKind C.typ +kindType = srcTypeConstructor C.Type kindConstraint :: SourceType -kindConstraint = primKind C.constraint +kindConstraint = srcTypeConstructor C.Constraint kindSymbol :: SourceType -kindSymbol = primKind C.symbol +kindSymbol = srcTypeConstructor C.Symbol kindDoc :: SourceType -kindDoc = primSubKind C.typeError C.doc +kindDoc = srcTypeConstructor C.Doc kindOrdering :: SourceType -kindOrdering = primSubKind C.moduleOrdering C.kindOrdering +kindOrdering = srcTypeConstructor C.TypeOrdering kindRowList :: SourceType -> SourceType -kindRowList = TypeApp nullSourceAnn (primSubKind C.moduleRowList C.kindRowList) +kindRowList = TypeApp nullSourceAnn (srcTypeConstructor C.RowList) kindRow :: SourceType -> SourceType -kindRow = TypeApp nullSourceAnn (primKind C.row) +kindRow = TypeApp nullSourceAnn (srcTypeConstructor C.Row) kindOfREmpty :: SourceType kindOfREmpty = tyForall "k" kindType (kindRow (tyVar "k")) --- | Construct a type in the Prim module -primTy :: Text -> SourceType -primTy = TypeConstructor nullSourceAnn . primName - -- | Type constructor for functions tyFunction :: SourceType -tyFunction = primTy "Function" +tyFunction = srcTypeConstructor C.Function -- | Type constructor for strings tyString :: SourceType -tyString = primTy "String" +tyString = srcTypeConstructor C.String -- | Type constructor for strings tyChar :: SourceType -tyChar = primTy "Char" +tyChar = srcTypeConstructor C.Char -- | Type constructor for numbers tyNumber :: SourceType -tyNumber = primTy "Number" +tyNumber = srcTypeConstructor C.Number -- | Type constructor for integers tyInt :: SourceType -tyInt = primTy "Int" +tyInt = srcTypeConstructor C.Int -- | Type constructor for booleans tyBoolean :: SourceType -tyBoolean = primTy "Boolean" +tyBoolean = srcTypeConstructor C.Boolean -- | Type constructor for arrays tyArray :: SourceType -tyArray = primTy "Array" +tyArray = srcTypeConstructor C.Array -- | Type constructor for records tyRecord :: SourceType -tyRecord = primTy "Record" +tyRecord = srcTypeConstructor C.Record tyVar :: Text -> SourceType tyVar = TypeVar nullSourceAnn @@ -370,12 +352,12 @@ function = TypeApp nullSourceAnn . TypeApp nullSourceAnn tyFunction (-:>) = function infixr 4 -:> -primClass :: Qualified (ProperName 'TypeName) -> (SourceType -> SourceType) -> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))] +primClass :: Qualified (ProperName 'ClassName) -> (SourceType -> SourceType) -> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))] primClass name mkKind = [ let k = mkKind kindConstraint - in (name, (k, ExternData (nominalRolesForKind k))) + in (coerceProperName <$> name, (k, ExternData (nominalRolesForKind k))) , let k = mkKind kindType - in (dictTypeName <$> name, (k, TypeSynonym)) + in (dictTypeName . coerceProperName <$> name, (k, TypeSynonym)) ] -- | The primitive types in the external environment with their @@ -384,19 +366,19 @@ primClass name mkKind = primTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primTypes = M.fromList - [ (primName "Type", (kindType, ExternData [])) - , (primName "Constraint", (kindType, ExternData [])) - , (primName "Symbol", (kindType, ExternData [])) - , (primName "Row", (kindType -:> kindType, ExternData [Phantom])) - , (primName "Function", (kindType -:> kindType -:> kindType, ExternData [Representational, Representational])) - , (primName "Array", (kindType -:> kindType, ExternData [Representational])) - , (primName "Record", (kindRow kindType -:> kindType, ExternData [Representational])) - , (primName "String", (kindType, ExternData [])) - , (primName "Char", (kindType, ExternData [])) - , (primName "Number", (kindType, ExternData [])) - , (primName "Int", (kindType, ExternData [])) - , (primName "Boolean", (kindType, ExternData [])) - , (primName "Partial", (kindConstraint, ExternData [])) + [ (C.Type, (kindType, ExternData [])) + , (C.Constraint, (kindType, ExternData [])) + , (C.Symbol, (kindType, ExternData [])) + , (C.Row, (kindType -:> kindType, ExternData [Phantom])) + , (C.Function, (kindType -:> kindType -:> kindType, ExternData [Representational, Representational])) + , (C.Array, (kindType -:> kindType, ExternData [Representational])) + , (C.Record, (kindRow kindType -:> kindType, ExternData [Representational])) + , (C.String, (kindType, ExternData [])) + , (C.Char, (kindType, ExternData [])) + , (C.Number, (kindType, ExternData [])) + , (C.Int, (kindType, ExternData [])) + , (C.Boolean, (kindType, ExternData [])) + , (C.Partial <&> coerceProperName, (kindConstraint, ExternData [])) ] -- | This 'Map' contains all of the prim types from all Prim modules. @@ -416,75 +398,75 @@ allPrimTypes = M.unions primBooleanTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primBooleanTypes = M.fromList - [ (primSubName C.moduleBoolean "True", (tyBoolean, ExternData [])) - , (primSubName C.moduleBoolean "False", (tyBoolean, ExternData [])) + [ (C.True, (tyBoolean, ExternData [])) + , (C.False, (tyBoolean, ExternData [])) ] primCoerceTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primCoerceTypes = M.fromList $ mconcat - [ primClass (primSubName C.moduleCoerce "Coercible") (\kind -> tyForall "k" kindType $ tyVar "k" -:> tyVar "k" -:> kind) + [ primClass C.Coercible (\kind -> tyForall "k" kindType $ tyVar "k" -:> tyVar "k" -:> kind) ] primOrderingTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primOrderingTypes = M.fromList - [ (primSubName C.moduleOrdering "Ordering", (kindType, ExternData [])) - , (primSubName C.moduleOrdering "LT", (kindOrdering, ExternData [])) - , (primSubName C.moduleOrdering "EQ", (kindOrdering, ExternData [])) - , (primSubName C.moduleOrdering "GT", (kindOrdering, ExternData [])) + [ (C.TypeOrdering, (kindType, ExternData [])) + , (C.LT, (kindOrdering, ExternData [])) + , (C.EQ, (kindOrdering, ExternData [])) + , (C.GT, (kindOrdering, ExternData [])) ] primRowTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primRowTypes = M.fromList $ mconcat - [ primClass (primSubName C.moduleRow "Union") (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind) - , primClass (primSubName C.moduleRow "Nub") (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind) - , primClass (primSubName C.moduleRow "Lacks") (\kind -> tyForall "k" kindType $ kindSymbol -:> kindRow (tyVar "k") -:> kind) - , primClass (primSubName C.moduleRow "Cons") (\kind -> tyForall "k" kindType $ kindSymbol -:> tyVar "k" -:> kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind) + [ primClass C.RowUnion (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind) + , primClass C.RowNub (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind) + , primClass C.RowLacks (\kind -> tyForall "k" kindType $ kindSymbol -:> kindRow (tyVar "k") -:> kind) + , primClass C.RowCons (\kind -> tyForall "k" kindType $ kindSymbol -:> tyVar "k" -:> kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind) ] primRowListTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primRowListTypes = M.fromList $ - [ (primSubName C.moduleRowList "RowList", (kindType -:> kindType, ExternData [Phantom])) - , (primSubName C.moduleRowList "Cons", (tyForall "k" kindType $ kindSymbol -:> tyVar "k" -:> kindRowList (tyVar "k") -:> kindRowList (tyVar "k"), ExternData [Phantom, Phantom, Phantom])) - , (primSubName C.moduleRowList "Nil", (tyForall "k" kindType $ kindRowList (tyVar "k"), ExternData [])) + [ (C.RowList, (kindType -:> kindType, ExternData [Phantom])) + , (C.RowListCons, (tyForall "k" kindType $ kindSymbol -:> tyVar "k" -:> kindRowList (tyVar "k") -:> kindRowList (tyVar "k"), ExternData [Phantom, Phantom, Phantom])) + , (C.RowListNil, (tyForall "k" kindType $ kindRowList (tyVar "k"), ExternData [])) ] <> mconcat - [ primClass (primSubName C.moduleRowList "RowToList") (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRowList (tyVar "k") -:> kind) + [ primClass C.RowToList (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRowList (tyVar "k") -:> kind) ] primSymbolTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primSymbolTypes = M.fromList $ mconcat - [ primClass (primSubName C.moduleSymbol "Append") (\kind -> kindSymbol -:> kindSymbol -:> kindSymbol -:> kind) - , primClass (primSubName C.moduleSymbol "Compare") (\kind -> kindSymbol -:> kindSymbol -:> kindOrdering -:> kind) - , primClass (primSubName C.moduleSymbol "Cons") (\kind -> kindSymbol -:> kindSymbol -:> kindSymbol -:> kind) + [ primClass C.SymbolAppend (\kind -> kindSymbol -:> kindSymbol -:> kindSymbol -:> kind) + , primClass C.SymbolCompare (\kind -> kindSymbol -:> kindSymbol -:> kindOrdering -:> kind) + , primClass C.SymbolCons (\kind -> kindSymbol -:> kindSymbol -:> kindSymbol -:> kind) ] primIntTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primIntTypes = M.fromList $ mconcat - [ primClass (primSubName C.moduleInt "Add") (\kind -> tyInt -:> tyInt -:> tyInt -:> kind) - , primClass (primSubName C.moduleInt "Compare") (\kind -> tyInt -:> tyInt -:> kindOrdering -:> kind) - , primClass (primSubName C.moduleInt "Mul") (\kind -> tyInt -:> tyInt -:> tyInt -:> kind) - , primClass (primSubName C.moduleInt "ToString") (\kind -> tyInt -:> kindSymbol -:> kind) + [ primClass C.IntAdd (\kind -> tyInt -:> tyInt -:> tyInt -:> kind) + , primClass C.IntCompare (\kind -> tyInt -:> tyInt -:> kindOrdering -:> kind) + , primClass C.IntMul (\kind -> tyInt -:> tyInt -:> tyInt -:> kind) + , primClass C.IntToString (\kind -> tyInt -:> kindSymbol -:> kind) ] primTypeErrorTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primTypeErrorTypes = M.fromList $ - [ (primSubName C.typeError "Doc", (kindType, ExternData [])) - , (primSubName C.typeError "Fail", (kindDoc -:> kindConstraint, ExternData [Nominal])) - , (primSubName C.typeError "Warn", (kindDoc -:> kindConstraint, ExternData [Nominal])) - , (primSubName C.typeError "Text", (kindSymbol -:> kindDoc, ExternData [Phantom])) - , (primSubName C.typeError "Quote", (tyForall "k" kindType $ tyVar "k" -:> kindDoc, ExternData [Phantom])) - , (primSubName C.typeError "QuoteLabel", (kindSymbol -:> kindDoc, ExternData [Phantom])) - , (primSubName C.typeError "Beside", (kindDoc -:> kindDoc -:> kindDoc, ExternData [Phantom, Phantom])) - , (primSubName C.typeError "Above", (kindDoc -:> kindDoc -:> kindDoc, ExternData [Phantom, Phantom])) + [ (C.Doc, (kindType, ExternData [])) + , (C.Fail <&> coerceProperName, (kindDoc -:> kindConstraint, ExternData [Nominal])) + , (C.Warn <&> coerceProperName, (kindDoc -:> kindConstraint, ExternData [Nominal])) + , (C.Text, (kindSymbol -:> kindDoc, ExternData [Phantom])) + , (C.Quote, (tyForall "k" kindType $ tyVar "k" -:> kindDoc, ExternData [Phantom])) + , (C.QuoteLabel, (kindSymbol -:> kindDoc, ExternData [Phantom])) + , (C.Beside, (kindDoc -:> kindDoc -:> kindDoc, ExternData [Phantom, Phantom])) + , (C.Above, (kindDoc -:> kindDoc -:> kindDoc, ExternData [Phantom, Phantom])) ] <> mconcat - [ primClass (primSubName C.typeError "Fail") (\kind -> kindDoc -:> kind) - , primClass (primSubName C.typeError "Warn") (\kind -> kindDoc -:> kind) + [ primClass C.Fail (\kind -> kindDoc -:> kind) + , primClass C.Warn (\kind -> kindDoc -:> kind) ] -- | The primitive class map. This just contains the `Partial` class. @@ -492,7 +474,7 @@ primTypeErrorTypes = primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primClasses = M.fromList - [ (primName "Partial", makeTypeClassData [] [] [] [] True) + [ (C.Partial, makeTypeClassData [] [] [] [] True) ] -- | This contains all of the type classes from all Prim modules. @@ -511,7 +493,7 @@ primCoerceClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primCoerceClasses = M.fromList -- class Coercible (a :: k) (b :: k) - [ (primSubName C.moduleCoerce "Coercible", makeTypeClassData + [ (C.Coercible, makeTypeClassData [ ("a", Just (tyVar "k")) , ("b", Just (tyVar "k")) ] [] [] [] True) @@ -521,7 +503,7 @@ primRowClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primRowClasses = M.fromList -- class Union (left :: Row k) (right :: Row k) (union :: Row k) | left right -> union, right union -> left, union left -> right - [ (primSubName C.moduleRow "Union", makeTypeClassData + [ (C.RowUnion, makeTypeClassData [ ("left", Just (kindRow (tyVar "k"))) , ("right", Just (kindRow (tyVar "k"))) , ("union", Just (kindRow (tyVar "k"))) @@ -532,7 +514,7 @@ primRowClasses = ] True) -- class Nub (original :: Row k) (nubbed :: Row k) | original -> nubbed - , (primSubName C.moduleRow "Nub", makeTypeClassData + , (C.RowNub, makeTypeClassData [ ("original", Just (kindRow (tyVar "k"))) , ("nubbed", Just (kindRow (tyVar "k"))) ] [] [] @@ -540,13 +522,13 @@ primRowClasses = ] True) -- class Lacks (label :: Symbol) (row :: Row k) - , (primSubName C.moduleRow "Lacks", makeTypeClassData + , (C.RowLacks, makeTypeClassData [ ("label", Just kindSymbol) , ("row", Just (kindRow (tyVar "k"))) ] [] [] [] True) -- class RowCons (label :: Symbol) (a :: k) (tail :: Row k) (row :: Row k) | label tail a -> row, label row -> tail a - , (primSubName C.moduleRow "Cons", makeTypeClassData + , (C.RowCons, makeTypeClassData [ ("label", Just kindSymbol) , ("a", Just (tyVar "k")) , ("tail", Just (kindRow (tyVar "k"))) @@ -561,7 +543,7 @@ primRowListClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primRowListClasses = M.fromList -- class RowToList (row :: Row k) (list :: RowList k) | row -> list - [ (primSubName C.moduleRowList "RowToList", makeTypeClassData + [ (C.RowToList, makeTypeClassData [ ("row", Just (kindRow (tyVar "k"))) , ("list", Just (kindRowList (tyVar "k"))) ] [] [] @@ -573,7 +555,7 @@ primSymbolClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primSymbolClasses = M.fromList -- class Append (left :: Symbol) (right :: Symbol) (appended :: Symbol) | left right -> appended, right appended -> left, appended left -> right - [ (primSubName C.moduleSymbol "Append", makeTypeClassData + [ (C.SymbolAppend, makeTypeClassData [ ("left", Just kindSymbol) , ("right", Just kindSymbol) , ("appended", Just kindSymbol) @@ -584,7 +566,7 @@ primSymbolClasses = ] True) -- class Compare (left :: Symbol) (right :: Symbol) (ordering :: Ordering) | left right -> ordering - , (primSubName C.moduleSymbol "Compare", makeTypeClassData + , (C.SymbolCompare, makeTypeClassData [ ("left", Just kindSymbol) , ("right", Just kindSymbol) , ("ordering", Just kindOrdering) @@ -593,7 +575,7 @@ primSymbolClasses = ] True) -- class Cons (head :: Symbol) (tail :: Symbol) (symbol :: Symbol) | head tail -> symbol, symbol -> head tail - , (primSubName C.moduleSymbol "Cons", makeTypeClassData + , (C.SymbolCons, makeTypeClassData [ ("head", Just kindSymbol) , ("tail", Just kindSymbol) , ("symbol", Just kindSymbol) @@ -607,7 +589,7 @@ primIntClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primIntClasses = M.fromList -- class Add (left :: Int) (right :: Int) (sum :: Int) | left right -> sum, left sum -> right, right sum -> left - [ (primSubName C.moduleInt "Add", makeTypeClassData + [ (C.IntAdd, makeTypeClassData [ ("left", Just tyInt) , ("right", Just tyInt) , ("sum", Just tyInt) @@ -618,7 +600,7 @@ primIntClasses = ] True) -- class Compare (left :: Int) (right :: Int) (ordering :: Ordering) | left right -> ordering - , (primSubName C.moduleInt "Compare", makeTypeClassData + , (C.IntCompare, makeTypeClassData [ ("left", Just tyInt) , ("right", Just tyInt) , ("ordering", Just kindOrdering) @@ -627,7 +609,7 @@ primIntClasses = ] True) -- class Mul (left :: Int) (right :: Int) (product :: Int) | left right -> product - , (primSubName C.moduleInt "Mul", makeTypeClassData + , (C.IntMul, makeTypeClassData [ ("left", Just tyInt) , ("right", Just tyInt) , ("product", Just tyInt) @@ -636,7 +618,7 @@ primIntClasses = ] True) -- class ToString (int :: Int) (string :: Symbol) | int -> string - , (primSubName C.moduleInt "ToString", makeTypeClassData + , (C.IntToString, makeTypeClassData [ ("int", Just tyInt) , ("string", Just kindSymbol) ] [] [] @@ -648,11 +630,11 @@ primTypeErrorClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primTypeErrorClasses = M.fromList -- class Fail (message :: Symbol) - [ (primSubName C.typeError "Fail", makeTypeClassData + [ (C.Fail, makeTypeClassData [("message", Just kindDoc)] [] [] [] True) -- class Warn (message :: Symbol) - , (primSubName C.typeError "Warn", makeTypeClassData + , (C.Warn, makeTypeClassData [("message", Just kindDoc)] [] [] [] True) ] diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 872022d065..60228d3aa5 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -34,12 +34,11 @@ import Data.Traversable (for) import qualified GHC.Stack import Language.PureScript.AST import qualified Language.PureScript.Bundle as Bundle -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C import qualified Language.PureScript.Constants.Prim as C import Language.PureScript.Crash import qualified Language.PureScript.CST.Errors as CST import qualified Language.PureScript.CST.Print as CST -import Language.PureScript.Environment import Language.PureScript.Label (Label(..)) import Language.PureScript.Names import Language.PureScript.Pretty @@ -753,10 +752,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon line $ "The role declaration for " <> markCode (runProperName nm) <> " should follow its definition." renderSimpleErrorMessage (RedefinedIdent name) = line $ "The value " <> markCode (showIdent name) <> " has been defined multiple times" - renderSimpleErrorMessage (UnknownName name@(Qualified (BySourcePos _) (IdentName (Ident i)))) | i `elem` [ C.bind, C.discard ] = + renderSimpleErrorMessage (UnknownName name@(Qualified (BySourcePos _) (IdentName (Ident i)))) | i `elem` [ C.S_bind, C.S_discard ] = line $ "Unknown " <> printName name <> ". You're probably using do-notation, which the compiler replaces with calls to the " <> markCode "bind" <> " and " <> markCode "discard" <> " functions. Please import " <> markCode i <> " from module " <> markCode "Prelude" - renderSimpleErrorMessage (UnknownName name@(Qualified (BySourcePos _) (IdentName (Ident i)))) | i == C.negate = - line $ "Unknown " <> printName name <> ". You're probably using numeric negation (the unary " <> markCode "-" <> " operator), which the compiler replaces with calls to the " <> markCode i <> " function. Please import " <> markCode i <> " from module " <> markCode "Prelude" + renderSimpleErrorMessage (UnknownName name@(Qualified (BySourcePos _) (IdentName (Ident C.S_negate)))) = + line $ "Unknown " <> printName name <> ". You're probably using numeric negation (the unary " <> markCode "-" <> " operator), which the compiler replaces with calls to the " <> markCode C.S_negate <> " function. Please import " <> markCode C.S_negate <> " from module " <> markCode "Prelude" renderSimpleErrorMessage (UnknownName name) = line $ "Unknown " <> printName name renderSimpleErrorMessage (UnknownImport mn name) = @@ -1026,7 +1025,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon renderSimpleErrorMessage (ExtraneousClassMember ident className) = line $ "" <> markCode (showIdent ident) <> " is not a member of type class " <> markCode (showQualified runProperName className) renderSimpleErrorMessage (ExpectedType ty kind) = - paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode C.typ <> "." + paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode (runProperName . disqualify $ C.Type) <> "." , line "The error arises from the type" , markCodeBox $ indent $ prettyType ty , line "having the kind" @@ -1941,18 +1940,16 @@ renderBox = unlines toTypelevelString :: Type a -> Maybe Box.Box toTypelevelString (TypeLevelString _ s) = Just . Box.text $ decodeStringWithReplacement s -toTypelevelString (TypeApp _ (TypeConstructor _ f) x) - | f == primSubName C.typeError "Text" = toTypelevelString x -toTypelevelString (TypeApp _ (KindApp _ (TypeConstructor _ f) _) x) - | f == primSubName C.typeError "Quote" = Just (typeAsBox maxBound x) -toTypelevelString (TypeApp _ (TypeConstructor _ f) (TypeLevelString _ x)) - | f == primSubName C.typeError "QuoteLabel" = Just . line . prettyPrintLabel . Label $ x -toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ f) x) ret) - | f == primSubName C.typeError "Beside" = - (Box.<>) <$> toTypelevelString x <*> toTypelevelString ret -toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ f) x) ret) - | f == primSubName C.typeError "Above" = - (Box.//) <$> toTypelevelString x <*> toTypelevelString ret +toTypelevelString (TypeApp _ (TypeConstructor _ C.Text) x) = + toTypelevelString x +toTypelevelString (TypeApp _ (KindApp _ (TypeConstructor _ C.Quote) _) x) = + Just (typeAsBox maxBound x) +toTypelevelString (TypeApp _ (TypeConstructor _ C.QuoteLabel) (TypeLevelString _ x)) = + Just . line . prettyPrintLabel . Label $ x +toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ C.Beside) x) ret) = + (Box.<>) <$> toTypelevelString x <*> toTypelevelString ret +toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ C.Above) x) ret) = + (Box.//) <$> toTypelevelString x <*> toTypelevelString ret toTypelevelString _ = Nothing -- | Rethrow an error with a more detailed error message in the case of failure diff --git a/src/Language/PureScript/Ide/Imports/Actions.hs b/src/Language/PureScript/Ide/Imports/Actions.hs index 9465d68033..6d69491587 100644 --- a/src/Language/PureScript/Ide/Imports/Actions.hs +++ b/src/Language/PureScript/Ide/Imports/Actions.hs @@ -90,9 +90,9 @@ addExplicitImport' decl moduleName qualifier imports = Import mn P.Implicit qualifier' -> mn == moduleName && qualifier == qualifier' _ -> False) imports isNotExplicitlyImportedFromPrim = - moduleName == C.Prim && + moduleName == C.M_Prim && not (any (\case - Import C.Prim (P.Explicit _) Nothing -> True + Import C.M_Prim (P.Explicit _) Nothing -> True _ -> False) imports) -- We can't import Modules from other modules isModule = has _IdeDeclModule decl diff --git a/src/Language/PureScript/Ide/Prim.hs b/src/Language/PureScript/Ide/Prim.hs index 1768b30784..c65e98447b 100644 --- a/src/Language/PureScript/Ide/Prim.hs +++ b/src/Language/PureScript/Ide/Prim.hs @@ -11,28 +11,28 @@ import Language.PureScript.Ide.Types idePrimDeclarations :: ModuleMap [IdeDeclarationAnn] idePrimDeclarations = Map.fromList - [ ( C.Prim + [ ( C.M_Prim , mconcat [primTypes, primClasses] ) - , ( C.PrimBoolean + , ( C.M_Prim_Boolean , mconcat [primBooleanTypes] ) - , ( C.PrimOrdering + , ( C.M_Prim_Ordering , mconcat [primOrderingTypes] ) - , ( C.PrimRow + , ( C.M_Prim_Row , mconcat [primRowTypes, primRowClasses] ) - , ( C.PrimRowList + , ( C.M_Prim_RowList , mconcat [primRowListTypes, primRowListClasses] ) - , ( C.PrimSymbol + , ( C.M_Prim_Symbol , mconcat [primSymbolTypes, primSymbolClasses] ) - , ( C.PrimInt + , ( C.M_Prim_Int , mconcat [primIntTypes, primIntClasses] ) - , ( C.PrimTypeError + , ( C.M_Prim_TypeError , mconcat [primTypeErrorTypes, primTypeErrorClasses] ) ] diff --git a/src/Language/PureScript/Linter.hs b/src/Language/PureScript/Linter.hs index 54571a6272..15265fbf84 100644 --- a/src/Language/PureScript/Linter.hs +++ b/src/Language/PureScript/Linter.hs @@ -19,7 +19,7 @@ import Language.PureScript.Linter.Exhaustive as L import Language.PureScript.Linter.Imports as L import Language.PureScript.Names import Language.PureScript.Types -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C -- | Lint the PureScript AST. -- | @@ -162,7 +162,7 @@ lintUnused (Module modSS _ mn modDecls exports) = thisModuleRef _ = False rebindable :: S.Set Ident - rebindable = S.fromList [ Ident C.bind, Ident C.discard ] + rebindable = S.fromList [ Ident C.S_bind, Ident C.S_discard ] getDeclIdent :: Declaration -> Maybe Ident getDeclIdent = getIdentName <=< declName diff --git a/src/Language/PureScript/Linter/Imports.hs b/src/Language/PureScript/Linter/Imports.hs index e79f942227..9b81691411 100644 --- a/src/Language/PureScript/Linter/Imports.hs +++ b/src/Language/PureScript/Linter/Imports.hs @@ -142,7 +142,7 @@ lintImports (Module _ _ mn mdecls (Just mexports)) env usedImps = do -- Checks whether a module is the Prim module - used to suppress any checks -- made, as Prim is always implicitly imported. isPrim :: ModuleName -> Bool - isPrim = (== C.Prim) + isPrim = (== C.M_Prim) -- Creates a map of virtual modules mapped to all the declarations that -- import to that module, with the corresponding source span, import type, diff --git a/src/Language/PureScript/Sugar/AdoNotation.hs b/src/Language/PureScript/Sugar/AdoNotation.hs index 8dfdf59301..4e138f2c98 100644 --- a/src/Language/PureScript/Sugar/AdoNotation.hs +++ b/src/Language/PureScript/Sugar/AdoNotation.hs @@ -12,7 +12,7 @@ import Data.List (foldl') import Language.PureScript.AST import Language.PureScript.Errors import Language.PureScript.Names -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C -- | Replace all @AdoNotationBind@ and @AdoNotationValue@ constructors with -- applications of the pure and apply functions in scope, and all @AdoNotationLet@ @@ -28,13 +28,13 @@ desugarAdo d = in rethrowWithPosition ss $ f d where pure' :: SourceSpan -> Maybe ModuleName -> Expr - pure' ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.pure')) + pure' ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_pure)) map' :: SourceSpan -> Maybe ModuleName -> Expr - map' ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.map)) + map' ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_map)) apply :: SourceSpan -> Maybe ModuleName -> Expr - apply ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.apply)) + apply ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_apply)) replace :: SourceSpan -> Expr -> m Expr replace pos (Ado m els yield) = do diff --git a/src/Language/PureScript/Sugar/DoNotation.hs b/src/Language/PureScript/Sugar/DoNotation.hs index 0f7c3457b5..008af901da 100644 --- a/src/Language/PureScript/Sugar/DoNotation.hs +++ b/src/Language/PureScript/Sugar/DoNotation.hs @@ -14,7 +14,7 @@ import Language.PureScript.AST import Language.PureScript.Crash import Language.PureScript.Errors import Language.PureScript.Names -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C -- | Replace all @DoNotationBind@ and @DoNotationValue@ constructors with -- applications of the bind function in scope, and all @DoNotationLet@ @@ -30,10 +30,10 @@ desugarDo d = in rethrowWithPosition ss $ f d where bind :: SourceSpan -> Maybe ModuleName -> Expr - bind ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.bind)) + bind ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_bind)) discard :: SourceSpan -> Maybe ModuleName -> Expr - discard ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.discard)) + discard ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_discard)) replace :: SourceSpan -> Expr -> m Expr replace pos (Do m els) = go pos m els @@ -57,7 +57,7 @@ desugarDo d = go _ _ (DoNotationBind b _ : _) | First (Just ident) <- foldMap fromIdent (binderNames b) = throwError . errorMessage $ CannotUseBindWithDo (Ident ident) where - fromIdent (Ident i) | i `elem` [ C.bind, C.discard ] = First (Just i) + fromIdent (Ident i) | i `elem` [ C.S_bind, C.S_discard ] = First (Just i) fromIdent _ = mempty go pos m (DoNotationBind binder val : rest) = do rest' <- go pos m rest @@ -75,7 +75,7 @@ desugarDo d = go pos m (DoNotationLet ds : rest) = do let checkBind :: Declaration -> m () checkBind (ValueDecl (ss, _) i@(Ident name) _ _ _) - | name `elem` [ C.bind, C.discard ] = throwError . errorMessage' ss $ CannotUseBindWithDo i + | name `elem` [ C.S_bind, C.S_discard ] = throwError . errorMessage' ss $ CannotUseBindWithDo i checkBind _ = pure () mapM_ checkBind ds rest' <- go pos m rest diff --git a/src/Language/PureScript/Sugar/Names/Env.hs b/src/Language/PureScript/Sugar/Names/Env.hs index 31543eba9a..5b3616fdad 100644 --- a/src/Language/PureScript/Sugar/Names/Env.hs +++ b/src/Language/PureScript/Sugar/Names/Env.hs @@ -246,31 +246,31 @@ mkPrimExports ts cs = -- | Environment which only contains the Prim modules. primEnv :: Env primEnv = M.fromList - [ ( C.Prim + [ ( C.M_Prim , (internalModuleSourceSpan "", nullImports, primExports) ) - , ( C.PrimBoolean + , ( C.M_Prim_Boolean , (internalModuleSourceSpan "", nullImports, primBooleanExports) ) - , ( C.PrimCoerce + , ( C.M_Prim_Coerce , (internalModuleSourceSpan "", nullImports, primCoerceExports) ) - , ( C.PrimOrdering + , ( C.M_Prim_Ordering , (internalModuleSourceSpan "", nullImports, primOrderingExports) ) - , ( C.PrimRow + , ( C.M_Prim_Row , (internalModuleSourceSpan "", nullImports, primRowExports) ) - , ( C.PrimRowList + , ( C.M_Prim_RowList , (internalModuleSourceSpan "", nullImports, primRowListExports) ) - , ( C.PrimSymbol + , ( C.M_Prim_Symbol , (internalModuleSourceSpan "", nullImports, primSymbolExports) ) - , ( C.PrimInt + , ( C.M_Prim_Int , (internalModuleSourceSpan "", nullImports, primIntExports) ) - , ( C.PrimTypeError + , ( C.M_Prim_TypeError , (internalModuleSourceSpan "", nullImports, primTypeErrorExports) ) ] diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs index f830a31c09..1009ce3fbd 100644 --- a/src/Language/PureScript/Sugar/Operators.hs +++ b/src/Language/PureScript/Sugar/Operators.hs @@ -40,7 +40,7 @@ import Data.Maybe (mapMaybe, listToMaybe) import qualified Data.Map as M import Data.Ord (Down(..)) -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C -- | -- Removes unary negation operators and replaces them with calls to `negate`. @@ -50,7 +50,7 @@ desugarSignedLiterals (Module ss coms mn ds exts) = Module ss coms mn (map f' ds) exts where (f', _, _) = everywhereOnValues id go id - go (UnaryMinus ss' val) = App (Var ss' (Qualified ByNullSourcePos (Ident C.negate))) val + go (UnaryMinus ss' val) = App (Var ss' (Qualified ByNullSourcePos (Ident C.S_negate))) val go other = other -- | diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs index cd1dd4caae..28c633dfe5 100644 --- a/src/Language/PureScript/Sugar/TypeClasses.hs +++ b/src/Language/PureScript/Sugar/TypeClasses.hs @@ -53,13 +53,13 @@ desugarTypeClasses externs = flip evalStateT initialState . desugarModule initialState :: MemberMap initialState = mconcat - [ M.mapKeys (qualify C.Prim) primClasses - , M.mapKeys (qualify C.PrimCoerce) primCoerceClasses - , M.mapKeys (qualify C.PrimRow) primRowClasses - , M.mapKeys (qualify C.PrimRowList) primRowListClasses - , M.mapKeys (qualify C.PrimSymbol) primSymbolClasses - , M.mapKeys (qualify C.PrimInt) primIntClasses - , M.mapKeys (qualify C.PrimTypeError) primTypeErrorClasses + [ M.mapKeys (qualify C.M_Prim) primClasses + , M.mapKeys (qualify C.M_Prim_Coerce) primCoerceClasses + , M.mapKeys (qualify C.M_Prim_Row) primRowClasses + , M.mapKeys (qualify C.M_Prim_RowList) primRowListClasses + , M.mapKeys (qualify C.M_Prim_Symbol) primSymbolClasses + , M.mapKeys (qualify C.M_Prim_Int) primIntClasses + , M.mapKeys (qualify C.M_Prim_TypeError) primTypeErrorClasses , M.fromList (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations) ] diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs index 70db418116..bcd401a5bc 100755 --- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs @@ -9,8 +9,7 @@ import Control.Monad.Supply.Class (MonadSupply) 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.Libs as Libs import Language.PureScript.Crash import Language.PureScript.Environment import Language.PureScript.Errors @@ -59,8 +58,8 @@ deriveInstance mn ds decl = _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2 in case className of - DataNewtype.Newtype -> binaryWildcardClass deriveNewtype - DataGenericRep.Generic -> binaryWildcardClass (deriveGenericRep ss mn) + Libs.Generic -> binaryWildcardClass (deriveGenericRep ss mn) + Libs.Newtype -> binaryWildcardClass deriveNewtype _ -> pure decl _ -> pure decl @@ -84,13 +83,13 @@ deriveGenericRep ss mn tyCon tyConArgs = lamCase x [ CaseAlternative [NullBinder] - (unguarded (App (Var ss DataGenericRep.to) (Var ss' (Qualified ByNullSourcePos x)))) + (unguarded (App (Var ss Libs.I_to) (Var ss' (Qualified ByNullSourcePos x)))) ] , ValueDecl (ss', []) (Ident "from") Public [] $ unguarded $ lamCase x [ CaseAlternative [NullBinder] - (unguarded (App (Var ss DataGenericRep.from) (Var ss' (Qualified ByNullSourcePos x)))) + (unguarded (App (Var ss Libs.I_from) (Var ss' (Qualified ByNullSourcePos x)))) ] ] | otherwise = @@ -112,12 +111,12 @@ deriveGenericRep ss mn tyCon tyConArgs = select l r n = take (n - 1) (iterate (r .) l) ++ [compN (n - 1) r] sumBinders :: Int -> [Binder -> Binder] - sumBinders = select (ConstructorBinder ss DataGenericRep.Inl . pure) - (ConstructorBinder ss DataGenericRep.Inr . pure) + sumBinders = select (ConstructorBinder ss Libs.C_Inl . pure) + (ConstructorBinder ss Libs.C_Inr . pure) sumExprs :: Int -> [Expr -> Expr] - sumExprs = select (App (Constructor ss DataGenericRep.Inl)) - (App (Constructor ss DataGenericRep.Inr)) + sumExprs = select (App (Constructor ss Libs.C_Inl)) + (App (Constructor ss Libs.C_Inr)) compN :: Int -> (a -> a) -> a -> a compN 0 _ = id @@ -129,37 +128,37 @@ deriveGenericRep ss mn tyCon tyConArgs = makeInst (DataConstructorDeclaration _ ctorName args) = do let args' = map snd args (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args' - return ( srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Constructor) + return ( srcTypeApp (srcTypeApp (srcTypeConstructor Libs.Constructor) (srcTypeLevelString $ mkString (runProperName ctorName))) ctorTy - , CaseAlternative [ ConstructorBinder ss DataGenericRep.Constructor [matchProduct] ] + , CaseAlternative [ ConstructorBinder ss Libs.C_Constructor [matchProduct] ] (unguarded (foldl' App (Constructor ss (Qualified (ByModuleName mn) ctorName)) ctorArgs)) , CaseAlternative [ ConstructorBinder ss (Qualified (ByModuleName mn) ctorName) matchCtor ] - (unguarded (App (Constructor ss DataGenericRep.Constructor) mkProduct)) + (unguarded (App (Constructor ss Libs.C_Constructor) mkProduct)) ) makeProduct :: [SourceType] -> m (SourceType, Binder, [Expr], [Binder], Expr) makeProduct [] = - pure (srcTypeConstructor DataGenericRep.NoArguments, NullBinder, [], [], Constructor ss DataGenericRep.NoArguments) + pure (srcTypeConstructor Libs.NoArguments, NullBinder, [], [], Constructor ss Libs.C_NoArguments) makeProduct args = do (tys, bs1, es1, bs2, es2) <- unzip5 <$> traverse makeArg args - pure ( foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Product) f)) tys - , foldr1 (\b1 b2 -> ConstructorBinder ss DataGenericRep.Product [b1, b2]) bs1 + pure ( foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor Libs.Product) f)) tys + , foldr1 (\b1 b2 -> ConstructorBinder ss Libs.C_Product [b1, b2]) bs1 , es1 , bs2 - , foldr1 (\e1 -> App (App (Constructor ss DataGenericRep.Product) e1)) es2 + , foldr1 (\e1 -> App (App (Constructor ss Libs.C_Product) e1)) es2 ) makeArg :: SourceType -> m (SourceType, Binder, Expr, Binder, Expr) makeArg arg = do argName <- freshIdent "arg" - pure ( srcTypeApp (srcTypeConstructor DataGenericRep.Argument) arg - , ConstructorBinder ss DataGenericRep.Argument [ VarBinder ss argName ] + pure ( srcTypeApp (srcTypeConstructor Libs.Argument) arg + , ConstructorBinder ss Libs.C_Argument [ VarBinder ss argName ] , Var ss (Qualified (BySourcePos $ spanStart ss) argName) , VarBinder ss argName - , App (Constructor ss DataGenericRep.Argument) (Var ss (Qualified (BySourcePos $ spanStart ss) argName)) + , App (Constructor ss Libs.C_Argument) (Var ss (Qualified (BySourcePos $ spanStart ss) argName)) ) underBinder :: (Binder -> Binder) -> CaseAlternative -> CaseAlternative @@ -170,9 +169,9 @@ deriveGenericRep ss mn tyCon tyConArgs = underExpr _ _ = internalError "underExpr: expected unguarded alternative" toRepTy :: [SourceType] -> SourceType - toRepTy [] = srcTypeConstructor DataGenericRep.NoConstructors + toRepTy [] = srcTypeConstructor Libs.NoConstructors toRepTy [only] = only - toRepTy ctors = foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Sum) f)) ctors + toRepTy ctors = foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor Libs.Sum) f)) ctors checkIsWildcard :: MonadError MultipleErrors m => SourceSpan -> ProperName 'TypeName -> SourceType -> m () checkIsWildcard _ _ (TypeWildcard _ UnnamedWildcard) = return () diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index ba8cfd3543..e08be7b998 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -29,8 +29,7 @@ import qualified Data.Text as T import Language.PureScript.AST import Language.PureScript.AST.Declarations.ChainId (ChainId) -import qualified Language.PureScript.Constants.Data.Generic.Rep as DataGenericRep -import qualified Language.PureScript.Constants.Data.Newtype as DataNewtype +import qualified Language.PureScript.Constants.Libs as Libs import Language.PureScript.Crash import Language.PureScript.Environment import Language.PureScript.Errors @@ -789,8 +788,8 @@ typeCheckModule modulesExports (Module ss coms mn decls (Just exps)) = checkDataConstructorsAreExported :: DeclarationRef -> m () checkDataConstructorsAreExported dr@(TypeRef ss' name (fromMaybe [] -> exportedDataConstructorsNames)) | null exportedDataConstructorsNames = for_ - [ DataGenericRep.Generic - , DataNewtype.Newtype + [ Libs.Generic + , Libs.Newtype ] $ \className -> do env <- getEnv let dicts = foldMap (foldMap NEL.toList) $ diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index ca45877223..48d8566416 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -14,9 +14,7 @@ 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.Data.Foldable as Foldable -import qualified Language.PureScript.Constants.Data.Traversable as Traversable -import qualified Language.PureScript.Constants.Prelude as Prelude +import qualified Language.PureScript.Constants.Libs as Libs import qualified Language.PureScript.Constants.Prim as Prim import Language.PureScript.Crash import Language.PureScript.Environment @@ -78,13 +76,13 @@ deriveInstance instType className strategy = do unaryClass' f = unaryClass (f className) in case className of - Foldable.Foldable -> unaryClass' deriveFoldable - Prelude.Eq -> unaryClass deriveEq - Prelude.Eq1 -> unaryClass $ \_ _ -> deriveEq1 - Prelude.Functor -> unaryClass' deriveFunctor - Prelude.Ord -> unaryClass deriveOrd - Prelude.Ord1 -> unaryClass $ \_ _ -> deriveOrd1 - Traversable.Traversable -> unaryClass' deriveTraversable + Libs.Eq -> unaryClass deriveEq + Libs.Eq1 -> unaryClass $ \_ _ -> deriveEq1 + Libs.Foldable -> unaryClass' deriveFoldable + Libs.Functor -> unaryClass' deriveFunctor + Libs.Ord -> unaryClass deriveOrd + Libs.Ord1 -> unaryClass $ \_ _ -> deriveOrd1 + Libs.Traversable -> unaryClass' deriveTraversable -- See L.P.Sugar.TypeClasses.Deriving for the classes that can be -- derived prior to type checking. _ -> throwError . errorMessage $ CannotDerive className tys @@ -194,7 +192,7 @@ deriveEq deriveEq mn tyConNm = do (_, _, _, ctors) <- lookupTypeDecl mn tyConNm eqFun <- mkEqFunction ctors - pure [(Prelude.eq, eqFun)] + pure [(Libs.S_eq, eqFun)] where mkEqFunction :: [(ProperName 'ConstructorName, [SourceType])] -> m Expr mkEqFunction ctors = do @@ -203,13 +201,13 @@ deriveEq mn tyConNm = do lamCase2 x y . addCatch <$> mapM mkCtorClause ctors preludeConj :: Expr -> Expr -> Expr - preludeConj = App . App (mkVarMn (Just (ModuleName "Data.HeytingAlgebra")) (Ident Prelude.conj)) + preludeConj = App . App (mkRef Libs.I_conj) preludeEq :: Expr -> Expr -> Expr - preludeEq = App . App (mkRef Prelude.identEq) + preludeEq = App . App (mkRef Libs.I_eq) preludeEq1 :: Expr -> Expr -> Expr - preludeEq1 = App . App (mkRef Prelude.identEq1) + preludeEq1 = App . App (mkRef Libs.I_eq1) addCatch :: [CaseAlternative] -> [CaseAlternative] addCatch xs @@ -243,7 +241,7 @@ deriveEq mn tyConNm = do | otherwise = preludeEq l r deriveEq1 :: forall m. Applicative m => m [(PSString, Expr)] -deriveEq1 = pure [(Prelude.eq1, mkRef Prelude.identEq)] +deriveEq1 = pure [(Libs.S_eq1, mkRef Libs.I_eq)] deriveOrd :: forall m @@ -256,7 +254,7 @@ deriveOrd deriveOrd mn tyConNm = do (_, _, _, ctors) <- lookupTypeDecl mn tyConNm compareFun <- mkCompareFunction ctors - pure [(Prelude.compare, compareFun)] + pure [(Libs.S_compare, compareFun)] where mkCompareFunction :: [(ProperName 'ConstructorName, [SourceType])] -> m Expr mkCompareFunction ctors = do @@ -286,10 +284,10 @@ deriveOrd mn tyConNm = do orderingBinder name = mkCtorBinder orderingMod (ProperName name) [] ordCompare :: Expr -> Expr -> Expr - ordCompare = App . App (mkRef Prelude.identCompare) + ordCompare = App . App (mkRef Libs.I_compare) ordCompare1 :: Expr -> Expr -> Expr - ordCompare1 = App . App (mkRef Prelude.identCompare1) + ordCompare1 = App . App (mkRef Libs.I_compare1) mkCtorClauses :: ((ProperName 'ConstructorName, [SourceType]), Bool) -> m [CaseAlternative] mkCtorClauses ((ctorName, tys), isLast) = do @@ -330,7 +328,7 @@ deriveOrd mn tyConNm = do | otherwise = ordCompare l r deriveOrd1 :: forall m. Applicative m => m [(PSString, Expr)] -deriveOrd1 = pure [(Prelude.compare1, mkRef Prelude.identCompare)] +deriveOrd1 = pure [(Libs.S_compare1, mkRef Libs.I_compare)] lookupTypeDecl :: forall m @@ -493,9 +491,9 @@ deriveFunctor deriveFunctor nm mn tyConNm = do ctors <- validateParamsInTypeConstructors nm mn tyConNm mapFun <- mkTraversal mn mapVar (TraversalOps identity identity) ctors - pure [(Prelude.map, mapFun)] + pure [(Libs.S_map, mapFun)] where - mapVar = mkRef Prelude.identMap + mapVar = mkRef Libs.I_map toConst :: forall f a b. f a -> Const [f a] b toConst = Const . pure @@ -520,12 +518,12 @@ deriveFoldable nm mn tyConNm = do foldlFun <- mkAsymmetricFoldFunction False foldlVar ctors foldrFun <- mkAsymmetricFoldFunction True foldrVar ctors foldMapFun <- mkTraversal mn foldMapVar foldMapOps ctors - pure [(Foldable.foldl, foldlFun), (Foldable.foldr, foldrFun), (Foldable.foldMap, foldMapFun)] + pure [(Libs.S_foldl, foldlFun), (Libs.S_foldr, foldrFun), (Libs.S_foldMap, foldMapFun)] where - foldlVar = mkRef Foldable.identFoldl - foldrVar = mkRef Foldable.identFoldr - foldMapVar = mkRef Foldable.identFoldMap - flipVar = mkRef Prelude.identFlip + foldlVar = mkRef Libs.I_foldl + foldrVar = mkRef Libs.I_foldr + foldMapVar = mkRef Libs.I_foldMap + flipVar = mkRef Libs.I_flip mkAsymmetricFoldFunction :: Bool -> Expr -> [(ProperName 'ConstructorName, [Maybe ParamUsage])] -> m Expr mkAsymmetricFoldFunction isRightFold recurseVar ctors = do @@ -563,8 +561,8 @@ deriveFoldable nm mn tyConNm = do foldMapOps :: forall m. Applicative m => TraversalOps m foldMapOps = TraversalOps { visitExpr = toConst, .. } where - appendVar = mkRef Prelude.identAppend - memptyVar = mkRef Prelude.identMempty + appendVar = mkRef Libs.I_append + memptyVar = mkRef Libs.I_mempty extractExpr :: Const [m Expr] Expr -> m Expr extractExpr = consumeConst $ \case @@ -584,17 +582,17 @@ deriveTraversable nm mn tyConNm = do ctors <- validateParamsInTypeConstructors nm mn tyConNm traverseFun <- mkTraversal mn traverseVar traverseOps ctors sequenceFun <- usingLamIdent $ pure . App (App traverseVar identityVar) - pure [(Traversable.traverse, traverseFun), (Traversable.sequence, sequenceFun)] + pure [(Libs.S_traverse, traverseFun), (Libs.S_sequence, sequenceFun)] where - traverseVar = mkRef Traversable.identTraverse - identityVar = mkRef Prelude.identIdentity + traverseVar = mkRef Libs.I_traverse + identityVar = mkRef Libs.I_identity traverseOps :: forall m. MonadSupply m => TraversalOps m traverseOps = TraversalOps { .. } where - pureVar = mkRef Prelude.identPure - mapVar = mkRef Prelude.identMap - applyVar = mkRef Prelude.identApply + pureVar = mkRef Libs.I_pure + mapVar = mkRef Libs.I_map + applyVar = mkRef Libs.I_apply visitExpr :: m Expr -> WriterT [(Ident, m Expr)] m Expr visitExpr traversedExpr = do diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index b7d774d4ef..381f83fc0c 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -47,7 +47,7 @@ import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types import Language.PureScript.Label (Label(..)) import Language.PureScript.PSString (PSString, mkString, decodeString) -import qualified Language.PureScript.Constants.Prelude as C +import qualified Language.PureScript.Constants.Libs as C import qualified Language.PureScript.Constants.Prim as C -- | Describes what sort of dictionary to generate for type class instances @@ -77,9 +77,9 @@ asExpression = \case ReflectableString s -> Literal NullSourceSpan $ StringLiteral s ReflectableBoolean b -> Literal NullSourceSpan $ BooleanLiteral b ReflectableOrdering o -> Constructor NullSourceSpan $ case o of - LT -> C.LT - EQ -> C.EQ - GT -> C.GT + LT -> C.C_LT + EQ -> C.C_EQ + GT -> C.C_GT -- | Extract the identifier of a named instance namedInstanceIdentifier :: Evidence -> Maybe (Qualified Ident) @@ -228,7 +228,7 @@ entails SolverOptions{..} constraint context hints = findDicts ctx cn = fmap (fmap NamedInstance) . foldMap NEL.toList . foldMap M.elems . (M.lookup cn <=< flip M.lookup ctx) valUndefined :: Expr - valUndefined = Var nullSourceSpan (Qualified (ByModuleName C.Prim) (Ident C.undefined)) + valUndefined = Var nullSourceSpan C.I_undefined solve :: SourceConstraint -> WriterT (Any, [(Ident, InstanceContext, SourceConstraint)]) (StateT InstanceContext m) Expr solve = go 0 hints @@ -460,9 +460,9 @@ entails SolverOptions{..} constraint context hints = solveSymbolCompare :: [SourceType] -> Maybe [TypeClassDict] solveSymbolCompare [arg0@(TypeLevelString _ lhs), arg1@(TypeLevelString _ rhs), _] = let ordering = case compare lhs rhs of - LT -> C.orderingLT - EQ -> C.orderingEQ - GT -> C.orderingGT + LT -> C.LT + EQ -> C.EQ + GT -> C.GT args' = [arg0, arg1, srcTypeConstructor ordering] in Just [TypeClassDictionaryInScope Nothing 0 EmptyClassInstance [] C.SymbolCompare [] [] args' Nothing Nothing] solveSymbolCompare _ = Nothing @@ -526,11 +526,11 @@ entails SolverOptions{..} constraint context hints = TypeLevelInt _ i -> pure (ReflectableInt i, tyInt) TypeLevelString _ s -> pure (ReflectableString s, tyString) TypeConstructor _ n - | n == C.booleanTrue -> pure (ReflectableBoolean True, tyBoolean) - | n == C.booleanFalse -> pure (ReflectableBoolean False, tyBoolean) - | n == C.orderingLT -> pure (ReflectableOrdering LT, srcTypeConstructor C.Ordering) - | n == C.orderingEQ -> pure (ReflectableOrdering EQ, srcTypeConstructor C.Ordering) - | n == C.orderingGT -> pure (ReflectableOrdering GT, srcTypeConstructor C.Ordering) + | n == C.True -> pure (ReflectableBoolean True, tyBoolean) + | n == C.False -> pure (ReflectableBoolean False, tyBoolean) + | n == C.LT -> pure (ReflectableOrdering LT, srcTypeConstructor C.Ordering) + | n == C.EQ -> pure (ReflectableOrdering EQ, srcTypeConstructor C.Ordering) + | n == C.GT -> pure (ReflectableOrdering GT, srcTypeConstructor C.Ordering) _ -> Nothing pure [TypeClassDictionaryInScope Nothing 0 (ReflectableInstance ref) [] C.Reflectable [] [] [typeLevel, typ] Nothing Nothing] solveReflectable _ = Nothing @@ -554,9 +554,9 @@ entails SolverOptions{..} constraint context hints = solveIntCompare :: InstanceContext -> [SourceType] -> Maybe [TypeClassDict] solveIntCompare _ [arg0@(TypeLevelInt _ a), arg1@(TypeLevelInt _ b), _] = let ordering = case compare a b of - EQ -> C.orderingEQ - LT -> C.orderingLT - GT -> C.orderingGT + EQ -> C.EQ + LT -> C.LT + GT -> C.GT args' = [arg0, arg1, srcTypeConstructor ordering] in pure [TypeClassDictionaryInScope Nothing 0 EmptyClassInstance [] C.IntCompare [] [] args' Nothing Nothing] solveIntCompare ctx args@[a, b, _] = do diff --git a/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs b/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs index 50f2205ffb..fb21d989b4 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs @@ -46,18 +46,18 @@ type PSOrdering = P.Qualified (P.ProperName 'P.TypeName) solveRelation :: forall a. Ord a => Context a -> a -> a -> Maybe PSOrdering solveRelation context lhs rhs = if lhs == rhs then - pure P.orderingEQ + pure P.EQ else do let (graph, search) = inequalities lhs' <- search lhs rhs' <- search rhs case (G.path graph lhs' rhs', G.path graph rhs' lhs') of (True, True) -> - pure P.orderingEQ + pure P.EQ (True, False) -> - pure P.orderingLT + pure P.LT (False, True) -> - pure P.orderingGT + pure P.GT _ -> Nothing where @@ -79,9 +79,9 @@ solveRelation context lhs rhs = mkRelation :: P.Type a -> P.Type a -> P.Type a -> Maybe (Relation (P.Type a)) mkRelation lhs rhs rel = case rel of P.TypeConstructor _ ordering - | ordering == P.orderingEQ -> pure $ Equal lhs rhs - | ordering == P.orderingLT -> pure $ LessThan lhs rhs - | ordering == P.orderingGT -> pure $ LessThan rhs lhs + | ordering == P.EQ -> pure $ Equal lhs rhs + | ordering == P.LT -> pure $ LessThan lhs rhs + | ordering == P.GT -> pure $ LessThan rhs lhs _ -> Nothing diff --git a/weeder.dhall b/weeder.dhall index b681fde085..95686c45e8 100644 --- a/weeder.dhall +++ b/weeder.dhall @@ -21,6 +21,13 @@ , "^Language\\.PureScript\\.Ide\\.Imports\\.parseImport$" , "^Language\\.PureScript\\.TypeChecker\\.Monad\\.debug" + -- These declarations are used by Template Haskell code. + , "^Language\\.PureScript\\.Constants\\.TH\\." + + -- These declarations are produced by Template Haskell when generating + -- pattern synonyms; this confuses Weeder. + , "^Language\\.PureScript\\.Constants\\..*\\.\\$[bm]" + -- These declarations are unprincipled exceptions that we don't mind -- supporting just in case they're used now or in the future. , "^Language\\.PureScript\\.CST\\.Parser\\.parseExpr$" From ae25710acc27498d7382da675d17493e2250b2c9 Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Mon, 21 Nov 2022 02:45:32 +0100 Subject: [PATCH 07/68] Shorten error prefix of custom errors (#4418) --- CHANGELOG.d/feature_shorten-error-message.md | 3 +++ src/Language/PureScript/Errors.hs | 2 +- tests/purs/failing/2567.out | 2 +- .../failing/ProgrammablePolykindedTypeErrorsTypeString.out | 2 +- tests/purs/failing/ProgrammableTypeErrors.out | 2 +- tests/purs/failing/ProgrammableTypeErrorsTypeString.out | 2 +- 6 files changed, 8 insertions(+), 5 deletions(-) create mode 100644 CHANGELOG.d/feature_shorten-error-message.md diff --git a/CHANGELOG.d/feature_shorten-error-message.md b/CHANGELOG.d/feature_shorten-error-message.md new file mode 100644 index 0000000000..45697cdc2f --- /dev/null +++ b/CHANGELOG.d/feature_shorten-error-message.md @@ -0,0 +1,3 @@ +* Shorten the prefix for custom user defined error + messages to improve clarity and get to the relevant information + more quickly diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 60228d3aa5..283ac58910 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -883,7 +883,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon , line "because the class was not in scope. Perhaps it was not exported." ] renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Fail _ [ ty ] _) _ _) | Just box <- toTypelevelString ty = - paras [ line "A custom type error occurred while solving type class constraints:" + paras [ line "Custom error:" , indent box ] renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Partial diff --git a/tests/purs/failing/2567.out b/tests/purs/failing/2567.out index 04258502a7..76c6520f82 100644 --- a/tests/purs/failing/2567.out +++ b/tests/purs/failing/2567.out @@ -2,7 +2,7 @@ Error found: in module Main at tests/purs/failing/2567.purs:7:8 - 7:67 (line 7, column 8 - line 7, column 67) - A custom type error occurred while solving type class constraints: + Custom error: This constraint should be checked diff --git a/tests/purs/failing/ProgrammablePolykindedTypeErrorsTypeString.out b/tests/purs/failing/ProgrammablePolykindedTypeErrorsTypeString.out index 4968c73575..e938446ba6 100644 --- a/tests/purs/failing/ProgrammablePolykindedTypeErrorsTypeString.out +++ b/tests/purs/failing/ProgrammablePolykindedTypeErrorsTypeString.out @@ -2,7 +2,7 @@ Error found: in module Main at tests/purs/failing/ProgrammablePolykindedTypeErrorsTypeString.purs:23:7 - 23:17 (line 23, column 7 - line 23, column 17) - A custom type error occurred while solving type class constraints: + Custom error: Don't want to show Just @Type String because. diff --git a/tests/purs/failing/ProgrammableTypeErrors.out b/tests/purs/failing/ProgrammableTypeErrors.out index 7e0069e7cc..3c48205c4c 100644 --- a/tests/purs/failing/ProgrammableTypeErrors.out +++ b/tests/purs/failing/ProgrammableTypeErrors.out @@ -2,7 +2,7 @@ Error found: in module Main at tests/purs/failing/ProgrammableTypeErrors.purs:17:13 - 17:27 (line 17, column 13 - line 17, column 27) - A custom type error occurred while solving type class constraints: + Custom error: Cannot show functions diff --git a/tests/purs/failing/ProgrammableTypeErrorsTypeString.out b/tests/purs/failing/ProgrammableTypeErrorsTypeString.out index d9c33ca38c..bb5045ce43 100644 --- a/tests/purs/failing/ProgrammableTypeErrorsTypeString.out +++ b/tests/purs/failing/ProgrammableTypeErrorsTypeString.out @@ -2,7 +2,7 @@ Error found: in module Main at tests/purs/failing/ProgrammableTypeErrorsTypeString.purs:24:9 - 24:24 (line 24, column 9 - line 24, column 24) - A custom type error occurred while solving type class constraints: + Custom error: Don't want to show MyType Int because. From 3e19a7c2d12bcd6a455e43a9865d10e382274eb4 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Sun, 4 Dec 2022 21:20:21 -0500 Subject: [PATCH 08/68] Derive Bi*, Contravariant, and Profunctor (#4420) The compiler can now derive instances of `Bifunctor`, `Bifoldable`, `Bitraversable`, `Contravariant`, and `Profunctor`, as well as use those classes when deriving `Functor`, `Foldable`, and `Traversable`, enabling more instances to be derived. --- CHANGELOG.d/feature_derive-traversable-2.md | 4 + src/Language/PureScript/Constants/Libs.hs | 33 +- src/Language/PureScript/Errors.hs | 15 +- .../PureScript/TypeChecker/Deriving.hs | 345 ++++++++++++++---- .../PureScript/TypeChecker/Entailment.hs | 7 +- tests/purs/failing/BifunctorInstance1.out | 16 + tests/purs/failing/BifunctorInstance1.purs | 10 + tests/purs/failing/ContravariantInstance1.out | 16 + .../purs/failing/ContravariantInstance1.purs | 9 + tests/purs/failing/FoldableInstance10.out | 2 +- tests/purs/failing/FoldableInstance4.out | 21 +- tests/purs/failing/FoldableInstance4.purs | 2 +- tests/purs/failing/FoldableInstance5.out | 16 - tests/purs/failing/FoldableInstance5.purs | 9 - tests/purs/failing/FoldableInstance6.out | 2 +- tests/purs/failing/FoldableInstance7.out | 16 - tests/purs/failing/FoldableInstance7.purs | 9 - tests/purs/failing/FoldableInstance8.out | 4 +- tests/purs/failing/FoldableInstance9.out | 18 +- tests/purs/failing/FunctorInstance1.out | 16 + tests/purs/failing/FunctorInstance1.purs | 8 + tests/purs/passing/DerivingBifunctor.purs | 26 ++ tests/purs/passing/DerivingContravariant.purs | 20 + tests/purs/passing/DerivingFunctorFromBi.purs | 18 + .../passing/DerivingFunctorFromContra.purs | 13 + .../purs/passing/DerivingFunctorFromPro.purs | 16 + .../DerivingFunctorPrefersSimplerClasses.purs | 46 +++ tests/purs/passing/DerivingProfunctor.purs | 19 + 28 files changed, 586 insertions(+), 150 deletions(-) create mode 100644 CHANGELOG.d/feature_derive-traversable-2.md create mode 100644 tests/purs/failing/BifunctorInstance1.out create mode 100644 tests/purs/failing/BifunctorInstance1.purs create mode 100644 tests/purs/failing/ContravariantInstance1.out create mode 100644 tests/purs/failing/ContravariantInstance1.purs delete mode 100644 tests/purs/failing/FoldableInstance5.out delete mode 100644 tests/purs/failing/FoldableInstance5.purs delete mode 100644 tests/purs/failing/FoldableInstance7.out delete mode 100644 tests/purs/failing/FoldableInstance7.purs create mode 100644 tests/purs/failing/FunctorInstance1.out create mode 100644 tests/purs/failing/FunctorInstance1.purs create mode 100644 tests/purs/passing/DerivingBifunctor.purs create mode 100644 tests/purs/passing/DerivingContravariant.purs create mode 100644 tests/purs/passing/DerivingFunctorFromBi.purs create mode 100644 tests/purs/passing/DerivingFunctorFromContra.purs create mode 100644 tests/purs/passing/DerivingFunctorFromPro.purs create mode 100644 tests/purs/passing/DerivingFunctorPrefersSimplerClasses.purs create mode 100644 tests/purs/passing/DerivingProfunctor.purs diff --git a/CHANGELOG.d/feature_derive-traversable-2.md b/CHANGELOG.d/feature_derive-traversable-2.md new file mode 100644 index 0000000000..03d755aac2 --- /dev/null +++ b/CHANGELOG.d/feature_derive-traversable-2.md @@ -0,0 +1,4 @@ +* The compiler can now derive instances of `Bifunctor`, `Bifoldable`, + `Bitraversable`, `Contravariant`, and `Profunctor`, as well as use those + classes when deriving `Functor`, `Foldable`, and `Traversable`, enabling more + instances to be derived. diff --git a/src/Language/PureScript/Constants/Libs.hs b/src/Language/PureScript/Constants/Libs.hs index 112a75ccb8..3ec062a7d9 100644 --- a/src/Language/PureScript/Constants/Libs.hs +++ b/src/Language/PureScript/Constants/Libs.hs @@ -104,8 +104,10 @@ $(TH.declare do TH.var "euclideanRingNumber" TH.mod "Data.Function" do - TH.prefixWith "function" do TH.asIdent do TH.vars ["apply", "applyFlipped"] - TH.asIdent do TH.var "flip" + TH.asIdent do + TH.prefixWith "function" do TH.vars ["apply", "applyFlipped"] + TH.var "const" + TH.var "flip" TH.mod "Data.Functor" do TH.cls "Functor" ; TH.asIdent do TH.asString do TH.var "map" @@ -170,6 +172,17 @@ $(TH.declare do TH.mod "Data.Array" do TH.asPair do TH.var "unsafeIndex" + -- purescript-bifunctors + + TH.mod "Data.Bifunctor" do + TH.cls "Bifunctor" ; TH.asIdent do TH.asString do TH.var "bimap" + TH.asIdent do TH.vars ["lmap", "rmap"] + + -- purescript-contravariant + + TH.mod "Data.Functor.Contravariant" do + TH.cls "Contravariant" ; TH.asIdent do TH.asString do TH.var "cmap" + -- purescript-eff TH.mod "Control.Monad.Eff" (P.pure ()) @@ -186,6 +199,14 @@ $(TH.declare do -- purescript-foldable-traversable + TH.mod "Data.Bifoldable" do + TH.cls "Bifoldable" ; TH.asIdent do TH.asString do TH.vars ["bifoldMap", "bifoldl", "bifoldr"] + + TH.mod "Data.Bitraversable" do + TH.cls "Bitraversable" ; TH.asString do TH.asIdent (TH.var "bitraverse"); TH.var "bisequence" + TH.asIdent do + TH.vars ["ltraverse", "rtraverse"] + TH.mod "Data.Foldable" do TH.cls "Foldable" ; TH.asIdent do TH.asString do TH.vars ["foldMap", "foldl", "foldr"] @@ -219,6 +240,14 @@ $(TH.declare do TH.mod "Partial.Unsafe" do TH.asIdent do TH.asPair do TH.var "unsafePartial" + -- purescript-profunctor + + TH.mod "Data.Profunctor" do + TH.cls "Profunctor" ; TH.asIdent do TH.asString do TH.var "dimap" + TH.asIdent do + TH.var "lcmap" + TH.prefixWith "profunctor" do TH.var "rmap" + -- purescript-st TH.mod "Control.Monad.ST.Internal" do diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 283ac58910..3302625670 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -4,6 +4,7 @@ module Language.PureScript.Errors ) where import Prelude +import Protolude (unsnoc) import Control.Arrow ((&&&)) import Control.Exception (displayException) @@ -194,7 +195,7 @@ data SimpleErrorMessage | UnsupportedRoleDeclaration | RoleDeclarationArityMismatch (ProperName 'TypeName) Int Int | DuplicateRoleDeclaration (ProperName 'TypeName) - | CannotDeriveInvalidConstructorArg (Qualified (ProperName 'ClassName)) + | CannotDeriveInvalidConstructorArg (Qualified (ProperName 'ClassName)) [Qualified (ProperName 'ClassName)] Bool deriving (Show) data ErrorMessage = ErrorMessage @@ -587,6 +588,13 @@ colorCodeBox codeColor b = case codeColor of , Box.vcat Box.top $ replicate (Box.rows b) $ Box.text ansiColorReset ] +commasAndConjunction :: Text -> [Text] -> Text +commasAndConjunction conj = \case + [x] -> x + [x, y] -> x <> " " <> conj <> " " <> y + (unsnoc -> Just (rest, z)) -> foldMap (<> ", ") rest <> conj <> " " <> z + _ -> "" + -- | Default color intensity and color for code defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color) defaultCodeColor = (ANSI.Dull, ANSI.Yellow) @@ -1378,11 +1386,12 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon renderSimpleErrorMessage (DuplicateRoleDeclaration name) = line $ "Duplicate role declaration for " <> markCode (runProperName name) <> "." - renderSimpleErrorMessage (CannotDeriveInvalidConstructorArg className) = + renderSimpleErrorMessage (CannotDeriveInvalidConstructorArg className relatedClasses checkVariance) = paras [ line $ "One or more type variables are in positions that prevent " <> markCode (runProperName $ disqualify className) <> " from being derived." , line $ "To derive this class, make sure that these variables are only used as the final arguments to type constructors, " - <> "and that those type constructors themselves have instances of " <> markCode (runProperName $ disqualify className) <> "." + <> (if checkVariance then "that their variance matches the variance of " <> markCode (runProperName $ disqualify className) <> ", " else "") + <> "and that those type constructors themselves have instances of " <> commasAndConjunction "or" (markCode . showQualified runProperName <$> relatedClasses) <> "." ] renderHint :: ErrorMessageHint -> Box.Box -> Box.Box diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index 48d8566416..6c31cddcb6 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -5,11 +5,15 @@ module Language.PureScript.TypeChecker.Deriving (deriveInstance) where import Protolude hiding (Type) +import Control.Lens (both, over) +import Control.Monad.Error.Class (liftEither) import Control.Monad.Trans.Writer (Writer, WriterT, runWriter, runWriterT) import Control.Monad.Writer.Class (MonadWriter(..)) +import Data.Align (align, unalign) import Data.Foldable (foldl1, foldr1) import Data.List (init, last, zipWith3, (!!)) import qualified Data.Map as M +import Data.These (These(..), mergeTheseWith, these) import Control.Monad.Supply.Class import Language.PureScript.AST @@ -23,6 +27,7 @@ import Language.PureScript.Label (Label(..)) import Language.PureScript.Names import Language.PureScript.PSString import Language.PureScript.Sugar.TypeClasses +import Language.PureScript.TypeChecker.Entailment import Language.PureScript.TypeChecker.Monad import Language.PureScript.TypeChecker.Synonyms import Language.PureScript.TypeClassDictionaries @@ -76,13 +81,18 @@ deriveInstance instType className strategy = do unaryClass' f = unaryClass (f className) in case className of + Libs.Bifoldable -> unaryClass' $ deriveFoldable True + Libs.Bifunctor -> unaryClass' $ deriveFunctor (Just False) False Libs.S_bimap + Libs.Bitraversable -> unaryClass' $ deriveTraversable True + Libs.Contravariant -> unaryClass' $ deriveFunctor Nothing True Libs.S_cmap Libs.Eq -> unaryClass deriveEq Libs.Eq1 -> unaryClass $ \_ _ -> deriveEq1 - Libs.Foldable -> unaryClass' deriveFoldable - Libs.Functor -> unaryClass' deriveFunctor + Libs.Foldable -> unaryClass' $ deriveFoldable False + Libs.Functor -> unaryClass' $ deriveFunctor Nothing False Libs.S_map Libs.Ord -> unaryClass deriveOrd Libs.Ord1 -> unaryClass $ \_ _ -> deriveOrd1 - Libs.Traversable -> unaryClass' deriveTraversable + Libs.Profunctor -> unaryClass' $ deriveFunctor (Just True) False Libs.S_dimap + Libs.Traversable -> unaryClass' $ deriveTraversable False -- See L.P.Sugar.TypeClasses.Deriving for the classes that can be -- derived prior to type checking. _ -> throwError . errorMessage $ CannotDerive className tys @@ -367,78 +377,183 @@ decomposeRec' = sortOn fst . go where go (RCons _ str typ typs) = (str, typ) : go typs go _ = [] -data ParamUsage +-- | The parameter `c` is used to allow or forbid contravariance for different +-- type classes. When deriving a type class that is a variation on Functor, a +-- witness for `c` will be provided; when deriving a type class that is a +-- variation on Foldable or Traversable, `c` will be Void and the contravariant +-- ParamUsage constructor can be skipped in pattern matching. +data ParamUsage c = IsParam - | MentionsParam ParamUsage - | IsRecord (NonEmpty (PSString, ParamUsage)) + | IsLParam + -- ^ enables biparametric classes (of any variance) to be derived + | MentionsParam (ParamUsage c) + -- ^ enables monoparametric classes to be used in a derivation + | MentionsParamBi (These (ParamUsage c) (ParamUsage c)) + -- ^ enables biparametric classes to be used in a derivation + | MentionsParamContravariantly !c (ContravariantParamUsage c) + -- ^ enables contravariant classes (of either parametricity) to be used in a derivation + | IsRecord (NonEmpty (PSString, ParamUsage c)) + +data ContravariantParamUsage c + = MentionsParamContra (ParamUsage c) + -- ^ enables Contravariant to be used in a derivation + | MentionsParamPro (These (ParamUsage c) (ParamUsage c)) + -- ^ enables Profunctor to be used in a derivation + +data CovariantClasses = CovariantClasses + { monoClass :: Qualified (ProperName 'ClassName) + , biClass :: Qualified (ProperName 'ClassName) + } + +data ContravariantClasses = ContravariantClasses + { contraClass :: Qualified (ProperName 'ClassName) + , proClass :: Qualified (ProperName 'ClassName) + } + +data ContravarianceSupport c = ContravarianceSupport + { contravarianceWitness :: c + , paramIsContravariant :: Bool + , lparamIsContravariant :: Bool + , contravariantClasses :: ContravariantClasses + } + +-- | Return, if possible, a These the contents of which each satisfy the +-- predicate. +filterThese :: forall a. (a -> Bool) -> These a a -> Maybe (These a a) +filterThese p = uncurry align . over both (mfilter p) . unalign . Just validateParamsInTypeConstructors - :: forall m + :: forall c m . MonadError MultipleErrors m => MonadState CheckState m => Qualified (ProperName 'ClassName) -> ModuleName -> ProperName 'TypeName - -> m [(ProperName 'ConstructorName, [Maybe ParamUsage])] -validateParamsInTypeConstructors derivingClass mn tyConNm = do + -> Bool + -> CovariantClasses + -> Maybe (ContravarianceSupport c) + -> m [(ProperName 'ConstructorName, [Maybe (ParamUsage c)])] +validateParamsInTypeConstructors derivingClass mn tyConNm isBi CovariantClasses{..} contravarianceSupport = do (_, _, tyArgNames, ctors) <- lookupTypeDecl mn tyConNm - param <- note (errorMessage $ KindsDoNotUnify (kindType -:> kindType) kindType) . lastMay $ map fst tyArgNames + (mbLParam, param) <- liftEither . first (errorMessage . flip KindsDoNotUnify kindType . (kindType -:>)) $ + case (isBi, reverse $ map fst tyArgNames) of + (False, x : _) -> Right (Nothing, x) + (False, _) -> Left kindType + (True, y : x : _) -> Right (Just x, y) + (True, _ : _) -> Left kindType + (True, _) -> Left $ kindType -:> kindType ctors' <- traverse (traverse $ traverse replaceAllTypeSynonyms) ctors - let (ctorUsages, problemSpans) = runWriter $ traverse (traverse . traverse $ typeToUsageOf param) ctors' + tcds <- getTypeClassDictionaries + let (ctorUsages, problemSpans) = runWriter $ traverse (traverse . traverse $ typeToUsageOf tcds (maybe That These mbLParam param) False) ctors' + let relatedClasses = [monoClass, biClass] ++ ([contraClass, proClass] <*> (contravariantClasses <$> toList contravarianceSupport)) for_ (nonEmpty $ ordNub problemSpans) $ \sss -> - throwError . addHint (RelatedPositions sss) . errorMessage $ CannotDeriveInvalidConstructorArg derivingClass + throwError . addHint (RelatedPositions sss) . errorMessage $ CannotDeriveInvalidConstructorArg derivingClass relatedClasses (isJust contravarianceSupport) pure ctorUsages + where - typeToUsageOf :: Text -> SourceType -> Writer [SourceSpan] (Maybe ParamUsage) - typeToUsageOf param = go - where + typeToUsageOf :: InstanceContext -> These Text Text -> Bool -> SourceType -> Writer [SourceSpan] (Maybe (ParamUsage c)) + typeToUsageOf tcds = fix $ \go params isNegative -> let + goCo = go params isNegative + goContra = go params $ not isNegative + assertNoParamUsedIn :: SourceType -> Writer [SourceSpan] () - assertNoParamUsedIn = everythingOnTypes (*>) $ \case + assertNoParamUsedIn ty = void $ both (flip assertParamNotUsedIn ty) params + + assertParamNotUsedIn :: Text -> SourceType -> Writer [SourceSpan] () + assertParamNotUsedIn param = everythingOnTypes (*>) $ \case TypeVar (ss, _) name | name == param -> tell [ss] _ -> pure () - go = \case + tryBiClasses ht tyLArg tyArg + | hasInstance tcds ht biClass + = goCo tyLArg >>= preferMonoClass MentionsParamBi + | Just (ContravarianceSupport c _ _ ContravariantClasses{..}) <- contravarianceSupport, hasInstance tcds ht proClass + = goContra tyLArg >>= preferMonoClass (MentionsParamContravariantly c . MentionsParamPro) + | otherwise + = assertNoParamUsedIn tyLArg *> tryMonoClasses ht tyArg + where + preferMonoClass f lUsage = + (if isNothing lUsage && hasInstance tcds ht monoClass then fmap MentionsParam else fmap f . align lUsage) <$> goCo tyArg + + tryMonoClasses ht tyArg + | hasInstance tcds ht monoClass + = fmap MentionsParam <$> goCo tyArg + | Just (ContravarianceSupport c _ _ ContravariantClasses{..}) <- contravarianceSupport, hasInstance tcds ht contraClass + = fmap (MentionsParamContravariantly c . MentionsParamContra) <$> goContra tyArg + | otherwise + = assertNoParamUsedIn tyArg $> Nothing + + in \case ForAll _ name _ ty _ -> - if name == param then pure Nothing else go ty + fmap join . traverse (\params' -> go params' isNegative ty) $ filterThese (/= name) params ConstrainedType _ _ ty -> - go ty + goCo ty TypeApp _ (TypeConstructor _ Prim.Record) row -> fmap (fmap IsRecord . nonEmpty . catMaybes) . for (decomposeRec' row) $ \(Label lbl, ty) -> - fmap (lbl, ) <$> go ty + fmap (lbl, ) <$> goCo ty - TypeApp _ tyFn tyArg -> do - assertNoParamUsedIn tyFn - fmap MentionsParam <$> go tyArg + TypeApp _ (TypeApp _ tyFn tyLArg) tyArg -> + assertNoParamUsedIn tyFn *> tryBiClasses (headOfType tyFn) tyLArg tyArg - TypeVar _ name -> - pure $ (name == param) `orEmpty` IsParam + TypeApp _ tyFn tyArg -> + assertNoParamUsedIn tyFn *> tryMonoClasses (headOfType tyFn) tyArg + + TypeVar (ss, _) name -> mergeTheseWith (checkName lparamIsContra IsLParam) (checkName paramIsContra IsParam) (liftA2 (<|>)) params + where + checkName thisParamIsContra usage param + | name == param = when (thisParamIsContra /= isNegative) (tell [ss]) $> Just usage + | otherwise = pure Nothing ty -> assertNoParamUsedIn ty $> Nothing + paramIsContra = any paramIsContravariant contravarianceSupport + lparamIsContra = any lparamIsContravariant contravarianceSupport + + hasInstance :: InstanceContext -> Qualified (Either Text (ProperName 'TypeName)) -> Qualified (ProperName 'ClassName) -> Bool + hasInstance tcds ht@(Qualified qb _) cn@(Qualified cqb _) = + any tcdAppliesToType $ concatMap (findDicts tcds cn) (ordNub [ByNullSourcePos, cqb, qb]) + where + tcdAppliesToType tcd = case tcdInstanceTypes tcd of + [headOfType -> ht'] -> ht == ht' + -- ^ It's possible that, if ht and ht' are Lefts, this might require + -- verifying that the name isn't shadowed by something in tcdForAll. I + -- can't devise a legal program that causes this issue, but if in the + -- future it seems like a good idea, it probably is. + _ -> False + + headOfType :: SourceType -> Qualified (Either Text (ProperName 'TypeName)) + headOfType = fix $ \go -> \case + TypeApp _ ty _ -> go ty + KindApp _ ty _ -> go ty + TypeVar _ nm -> Qualified ByNullSourcePos (Left nm) + Skolem _ nm _ _ _ -> Qualified ByNullSourcePos (Left nm) + TypeConstructor _ (Qualified qb nm) -> Qualified qb (Right nm) + ty -> internalError $ "headOfType missing a case: " <> show (void ty) + usingLamIdent :: forall m. MonadSupply m => (Expr -> m Expr) -> m Expr usingLamIdent cb = do ident <- freshIdent "v" lam ident <$> cb (mkVar ident) -traverseFields :: forall f. Applicative f => (ParamUsage -> Expr -> f Expr) -> NonEmpty (PSString, ParamUsage) -> Expr -> f Expr +traverseFields :: forall c f. Applicative f => (ParamUsage c -> Expr -> f Expr) -> NonEmpty (PSString, ParamUsage c) -> Expr -> f Expr traverseFields f fields r = fmap (ObjectUpdate r) . for (toList fields) $ \(lbl, usage) -> (lbl, ) <$> f usage (Accessor lbl r) -unnestRecords :: forall f. Applicative f => (ParamUsage -> Expr -> f Expr) -> ParamUsage -> Expr -> f Expr +unnestRecords :: forall c f. Applicative f => (ParamUsage c -> Expr -> f Expr) -> ParamUsage c -> Expr -> f Expr unnestRecords f = fix $ \go -> \case IsRecord fields -> traverseFields go fields usage -> f usage mkCasesForTraversal - :: forall f m + :: forall c f m . Applicative f -- this effect distinguishes the semantics of maps, folds, and traversals => MonadSupply m => ModuleName - -> (ParamUsage -> Expr -> f Expr) -- how to handle constructor arguments + -> (ParamUsage c -> Expr -> f Expr) -- how to handle constructor arguments -> (f Expr -> m Expr) -- resolve the applicative effect into an expression - -> [(ProperName 'ConstructorName, [Maybe ParamUsage])] + -> [(ProperName 'ConstructorName, [Maybe (ParamUsage c)])] -> m Expr mkCasesForTraversal mn handleArg extractExpr ctors = do m <- freshIdent "m" @@ -449,51 +564,107 @@ mkCasesForTraversal mn handleArg extractExpr ctors = do fmap (CaseAlternative [caseBinder] . unguarded) . extractExpr $ fmap (foldl' App ctor) . for ctorArgs $ \(ident, mbUsage) -> maybe pure handleArg mbUsage $ mkVar ident +data TraversalExprs = TraversalExprs + { recurseVar :: Expr -- a var representing map, foldMap, or traverse, for handling structured values + , birecurseVar :: Expr -- same, but bimap, bifoldMap, or bitraverse + , lrecurseExpr :: Expr -- same, but lmap or ltraverse (there is no lfoldMap, but we can use `flip bifoldMap mempty`) + , rrecurseExpr :: Expr -- same, but rmap or rtraverse etc., which conceptually should be the same as recurseVar but the bi classes aren't subclasses of the mono classes + } + +data ContraversalExprs = ContraversalExprs + { crecurseVar :: Expr + , direcurseVar :: Expr + , lcrecurseVar :: Expr + , rprorecurseVar :: Expr + } + +appBirecurseExprs :: TraversalExprs -> These Expr Expr -> Expr +appBirecurseExprs TraversalExprs{..} = these (App lrecurseExpr) (App rrecurseExpr) (App . App birecurseVar) + +appDirecurseExprs :: ContraversalExprs -> These Expr Expr -> Expr +appDirecurseExprs ContraversalExprs{..} = these (App lcrecurseVar) (App rprorecurseVar) (App . App direcurseVar) + data TraversalOps m = forall f. Applicative f => TraversalOps { visitExpr :: m Expr -> f Expr -- lift an expression into the applicative effect defining the traversal , extractExpr :: f Expr -> m Expr -- resolve the applicative effect into an expression } mkTraversal - :: forall m + :: forall c m . MonadSupply m => ModuleName - -> Expr -- a var representing map, foldMap, or traverse, for handling structured values + -> Bool + -> TraversalExprs + -> (c -> ContraversalExprs) -> TraversalOps m - -> [(ProperName 'ConstructorName, [Maybe ParamUsage])] + -> [(ProperName 'ConstructorName, [Maybe (ParamUsage c)])] -> m Expr -mkTraversal mn recurseVar (TraversalOps @_ @f visitExpr extractExpr) ctors = do +mkTraversal mn isBi te@TraversalExprs{..} getContraversalExprs (TraversalOps @_ @f visitExpr extractExpr) ctors = do f <- freshIdent "f" + g <- if isBi then freshIdent "g" else pure f let - handleValue :: ParamUsage -> Expr -> f Expr + handleValue :: ParamUsage c -> Expr -> f Expr handleValue = unnestRecords $ \usage inputExpr -> visitExpr $ flip App inputExpr <$> mkFnExprForValue usage - mkFnExprForValue :: ParamUsage -> m Expr + mkFnExprForValue :: ParamUsage c -> m Expr mkFnExprForValue = \case IsParam -> + pure $ mkVar g + IsLParam -> pure $ mkVar f MentionsParam innerUsage -> App recurseVar <$> mkFnExprForValue innerUsage + MentionsParamBi theseInnerUsages -> + appBirecurseExprs te <$> both mkFnExprForValue theseInnerUsages + MentionsParamContravariantly c contraUsage -> do + let ce@ContraversalExprs{..} = getContraversalExprs c + case contraUsage of + MentionsParamContra innerUsage -> + App crecurseVar <$> mkFnExprForValue innerUsage + MentionsParamPro theseInnerUsages -> + appDirecurseExprs ce <$> both mkFnExprForValue theseInnerUsages IsRecord fields -> usingLamIdent $ extractExpr . traverseFields handleValue fields - lam f <$> mkCasesForTraversal mn handleValue extractExpr ctors + lam f . applyWhen isBi (lam g) <$> mkCasesForTraversal mn handleValue extractExpr ctors deriveFunctor :: forall m . MonadError MultipleErrors m => MonadState CheckState m => MonadSupply m - => Qualified (ProperName 'ClassName) + => Maybe Bool -- does left parameter exist, and is it contravariant? + -> Bool -- is the (right) parameter contravariant? + -> PSString -- name of the map function for this functor type + -> Qualified (ProperName 'ClassName) -> ModuleName -> ProperName 'TypeName -> m [(PSString, Expr)] -deriveFunctor nm mn tyConNm = do - ctors <- validateParamsInTypeConstructors nm mn tyConNm - mapFun <- mkTraversal mn mapVar (TraversalOps identity identity) ctors - pure [(Libs.S_map, mapFun)] +deriveFunctor mbLParamIsContravariant paramIsContravariant mapName nm mn tyConNm = do + ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi functorClasses $ Just $ ContravarianceSupport + { contravarianceWitness = () + , paramIsContravariant + , lparamIsContravariant = or mbLParamIsContravariant + , contravariantClasses + } + mapFun <- mkTraversal mn isBi mapExprs (const cmapExprs) (TraversalOps identity identity) ctors + pure [(mapName, mapFun)] where - mapVar = mkRef Libs.I_map + isBi = isJust mbLParamIsContravariant + mapExprs = TraversalExprs + { recurseVar = mkRef Libs.I_map + , birecurseVar = mkRef Libs.I_bimap + , lrecurseExpr = mkRef Libs.I_lmap + , rrecurseExpr = mkRef Libs.I_rmap + } + cmapExprs = ContraversalExprs + { crecurseVar = mkRef Libs.I_cmap + , direcurseVar = mkRef Libs.I_dimap + , lcrecurseVar = mkRef Libs.I_lcmap + , rprorecurseVar = mkRef Libs.I_profunctorRmap + } + functorClasses = CovariantClasses Libs.Functor Libs.Bifunctor + contravariantClasses = ContravariantClasses Libs.Contravariant Libs.Profunctor toConst :: forall f a b. f a -> Const [f a] b toConst = Const . pure @@ -509,42 +680,74 @@ deriveFoldable . MonadError MultipleErrors m => MonadState CheckState m => MonadSupply m - => Qualified (ProperName 'ClassName) + => Bool -- is there a left parameter (are we deriving Bifoldable)? + -> Qualified (ProperName 'ClassName) -> ModuleName -> ProperName 'TypeName -> m [(PSString, Expr)] -deriveFoldable nm mn tyConNm = do - ctors <- validateParamsInTypeConstructors nm mn tyConNm - foldlFun <- mkAsymmetricFoldFunction False foldlVar ctors - foldrFun <- mkAsymmetricFoldFunction True foldrVar ctors - foldMapFun <- mkTraversal mn foldMapVar foldMapOps ctors - pure [(Libs.S_foldl, foldlFun), (Libs.S_foldr, foldrFun), (Libs.S_foldMap, foldMapFun)] +deriveFoldable isBi nm mn tyConNm = do + ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi foldableClasses Nothing + foldlFun <- mkAsymmetricFoldFunction False foldlExprs ctors + foldrFun <- mkAsymmetricFoldFunction True foldrExprs ctors + foldMapFun <- mkTraversal mn isBi foldMapExprs absurd foldMapOps ctors + pure + [ (if isBi then Libs.S_bifoldl else Libs.S_foldl, foldlFun) + , (if isBi then Libs.S_bifoldr else Libs.S_foldr, foldrFun) + , (if isBi then Libs.S_bifoldMap else Libs.S_foldMap, foldMapFun) + ] where - foldlVar = mkRef Libs.I_foldl - foldrVar = mkRef Libs.I_foldr - foldMapVar = mkRef Libs.I_foldMap + foldableClasses = CovariantClasses Libs.Foldable Libs.Bifoldable + foldlExprs = TraversalExprs + { recurseVar = mkRef Libs.I_foldl + , birecurseVar = bifoldlVar + , lrecurseExpr = App (App flipVar bifoldlVar) constVar + , rrecurseExpr = App bifoldlVar constVar + } + foldrExprs = TraversalExprs + { recurseVar = mkRef Libs.I_foldr + , birecurseVar = bifoldrVar + , lrecurseExpr = App (App flipVar bifoldrVar) (App constVar identityVar) + , rrecurseExpr = App bifoldrVar (App constVar identityVar) + } + foldMapExprs = TraversalExprs + { recurseVar = mkRef Libs.I_foldMap + , birecurseVar = bifoldMapVar + , lrecurseExpr = App (App flipVar bifoldMapVar) memptyVar + , rrecurseExpr = App bifoldMapVar memptyVar + } + bifoldlVar = mkRef Libs.I_bifoldl + bifoldrVar = mkRef Libs.I_bifoldr + bifoldMapVar = mkRef Libs.I_bifoldMap + constVar = mkRef Libs.I_const flipVar = mkRef Libs.I_flip + identityVar = mkRef Libs.I_identity + memptyVar = mkRef Libs.I_mempty - mkAsymmetricFoldFunction :: Bool -> Expr -> [(ProperName 'ConstructorName, [Maybe ParamUsage])] -> m Expr - mkAsymmetricFoldFunction isRightFold recurseVar ctors = do + mkAsymmetricFoldFunction :: Bool -> TraversalExprs -> [(ProperName 'ConstructorName, [Maybe (ParamUsage Void)])] -> m Expr + mkAsymmetricFoldFunction isRightFold te@TraversalExprs{..} ctors = do f <- freshIdent "f" + g <- if isBi then freshIdent "g" else pure f z <- freshIdent "z" let appCombiner :: (Bool, Expr) -> Expr -> Expr -> Expr appCombiner (isFlipped, fn) = applyWhen (isFlipped == isRightFold) flip $ App . App fn - mkCombinerExpr :: ParamUsage -> m Expr + mkCombinerExpr :: ParamUsage Void -> m Expr mkCombinerExpr = fmap (uncurry $ \isFlipped -> applyWhen isFlipped $ App flipVar) . getCombiner - handleValue :: ParamUsage -> Expr -> Const [m (Expr -> Expr)] Expr + handleValue :: ParamUsage Void -> Expr -> Const [m (Expr -> Expr)] Expr handleValue = unnestRecords $ \usage inputExpr -> toConst $ flip appCombiner inputExpr <$> getCombiner usage - getCombiner :: ParamUsage -> m (Bool, Expr) + getCombiner :: ParamUsage Void -> m (Bool, Expr) getCombiner = \case IsParam -> + pure (False, mkVar g) + IsLParam -> pure (False, mkVar f) MentionsParam innerUsage -> (isRightFold, ) . App recurseVar <$> mkCombinerExpr innerUsage + MentionsParamBi theseInnerUsages -> + (isRightFold, ) . appBirecurseExprs te <$> both mkCombinerExpr theseInnerUsages IsRecord fields -> do let foldFieldsOf = traverseFields handleValue fields fmap (False, ) . usingLamIdent $ \lVar -> @@ -556,7 +759,7 @@ deriveFoldable nm mn tyConNm = do extractExprStartingWith :: Expr -> Const [m (Expr -> Expr)] Expr -> m Expr extractExprStartingWith = consumeConst . if isRightFold then foldr ($) else foldl' (&) - lam f . lam z <$> mkCasesForTraversal mn handleValue (extractExprStartingWith $ mkVar z) ctors + lam f . applyWhen isBi (lam g) . lam z <$> mkCasesForTraversal mn handleValue (extractExprStartingWith $ mkVar z) ctors foldMapOps :: forall m. Applicative m => TraversalOps m foldMapOps = TraversalOps { visitExpr = toConst, .. } @@ -574,17 +777,29 @@ deriveTraversable . MonadError MultipleErrors m => MonadState CheckState m => MonadSupply m - => Qualified (ProperName 'ClassName) + => Bool -- is there a left parameter (are we deriving Bitraversable)? + -> Qualified (ProperName 'ClassName) -> ModuleName -> ProperName 'TypeName -> m [(PSString, Expr)] -deriveTraversable nm mn tyConNm = do - ctors <- validateParamsInTypeConstructors nm mn tyConNm - traverseFun <- mkTraversal mn traverseVar traverseOps ctors - sequenceFun <- usingLamIdent $ pure . App (App traverseVar identityVar) - pure [(Libs.S_traverse, traverseFun), (Libs.S_sequence, sequenceFun)] +deriveTraversable isBi nm mn tyConNm = do + ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi traversableClasses Nothing + traverseFun <- mkTraversal mn isBi traverseExprs absurd traverseOps ctors + sequenceFun <- usingLamIdent $ pure . App (App (if isBi then App bitraverseVar identityVar else traverseVar) identityVar) + pure + [ (if isBi then Libs.S_bitraverse else Libs.S_traverse, traverseFun) + , (if isBi then Libs.S_bisequence else Libs.S_sequence, sequenceFun) + ] where + traversableClasses = CovariantClasses Libs.Traversable Libs.Bitraversable + traverseExprs = TraversalExprs + { recurseVar = traverseVar + , birecurseVar = bitraverseVar + , lrecurseExpr = mkRef Libs.I_ltraverse + , rrecurseExpr = mkRef Libs.I_rtraverse + } traverseVar = mkRef Libs.I_traverse + bitraverseVar = mkRef Libs.I_bitraverse identityVar = mkRef Libs.I_identity traverseOps :: forall m. MonadSupply m => TraversalOps m diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index 381f83fc0c..d5b315d490 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -7,6 +7,7 @@ module Language.PureScript.TypeChecker.Entailment , replaceTypeClassDictionaries , newDictionaries , entails + , findDicts ) where import Prelude @@ -94,6 +95,9 @@ type InstanceContext = M.Map QualifiedBy (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NonEmpty NamedDict))) +findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> QualifiedBy -> [TypeClassDict] +findDicts ctx cn = fmap (fmap NamedInstance) . foldMap NEL.toList . foldMap M.elems . (M.lookup cn <=< flip M.lookup ctx) + -- | A type substitution which makes an instance head match a list of types. -- -- Note: we store many types per type variable name. For any name, all types @@ -224,9 +228,6 @@ entails SolverOptions{..} constraint context hints = ctorModules (KindedType _ ty _) = ctorModules ty ctorModules _ = Nothing - findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> QualifiedBy -> [TypeClassDict] - findDicts ctx cn = fmap (fmap NamedInstance) . foldMap NEL.toList . foldMap M.elems . (M.lookup cn <=< flip M.lookup ctx) - valUndefined :: Expr valUndefined = Var nullSourceSpan C.I_undefined diff --git a/tests/purs/failing/BifunctorInstance1.out b/tests/purs/failing/BifunctorInstance1.out new file mode 100644 index 0000000000..db6922613c --- /dev/null +++ b/tests/purs/failing/BifunctorInstance1.out @@ -0,0 +1,16 @@ +Error found: +in module BifunctorInstance1 +at tests/purs/failing/BifunctorInstance1.purs:10:1 - 10:31 (line 10, column 1 - line 10, column 31) + + One or more type variables are in positions that prevent Bifunctor from being derived. + To derive this class, make sure that these variables are only used as the final arguments to type constructors, that their variance matches the variance of Bifunctor, and that those type constructors themselves have instances of Data.Functor.Functor, Data.Bifunctor.Bifunctor, Data.Functor.Contravariant.Contravariant, or Data.Profunctor.Profunctor. + + tests/purs/failing/BifunctorInstance1.purs: +  8  +  9 data Test a b = Test (Tuple (Predicate a) (Predicate b)) (Tuple a b) +  10 derive instance Bifunctor Test + + +See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/BifunctorInstance1.purs b/tests/purs/failing/BifunctorInstance1.purs new file mode 100644 index 0000000000..264cae5708 --- /dev/null +++ b/tests/purs/failing/BifunctorInstance1.purs @@ -0,0 +1,10 @@ +-- @shouldFailWith CannotDeriveInvalidConstructorArg +module BifunctorInstance1 where + +import Prelude +import Data.Bifunctor (class Bifunctor) +import Data.Predicate (Predicate) +import Data.Tuple (Tuple) + +data Test a b = Test (Tuple (Predicate a) (Predicate b)) (Tuple a b) +derive instance Bifunctor Test diff --git a/tests/purs/failing/ContravariantInstance1.out b/tests/purs/failing/ContravariantInstance1.out new file mode 100644 index 0000000000..e539305cf8 --- /dev/null +++ b/tests/purs/failing/ContravariantInstance1.out @@ -0,0 +1,16 @@ +Error found: +in module ContravariantInstance1 +at tests/purs/failing/ContravariantInstance1.purs:9:1 - 9:35 (line 9, column 1 - line 9, column 35) + + One or more type variables are in positions that prevent Contravariant from being derived. + To derive this class, make sure that these variables are only used as the final arguments to type constructors, that their variance matches the variance of Contravariant, and that those type constructors themselves have instances of Data.Functor.Functor, Data.Bifunctor.Bifunctor, Data.Functor.Contravariant.Contravariant, or Data.Profunctor.Profunctor. + + tests/purs/failing/ContravariantInstance1.purs: +  6  +  7 newtype Test a = Test (Predicate (Predicate a)) +  8  + + +See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ContravariantInstance1.purs b/tests/purs/failing/ContravariantInstance1.purs new file mode 100644 index 0000000000..ddd318e0d9 --- /dev/null +++ b/tests/purs/failing/ContravariantInstance1.purs @@ -0,0 +1,9 @@ +-- @shouldFailWith CannotDeriveInvalidConstructorArg +module ContravariantInstance1 where + +import Data.Functor.Contravariant (class Contravariant) +import Data.Predicate (Predicate) + +newtype Test a = Test (Predicate (Predicate a)) + +derive instance Contravariant Test diff --git a/tests/purs/failing/FoldableInstance10.out b/tests/purs/failing/FoldableInstance10.out index d05c441e19..089056df60 100644 --- a/tests/purs/failing/FoldableInstance10.out +++ b/tests/purs/failing/FoldableInstance10.out @@ -3,7 +3,7 @@ in module FoldableInstance10 at tests/purs/failing/FoldableInstance10.purs:11:1 - 11:30 (line 11, column 1 - line 11, column 30) One or more type variables are in positions that prevent Foldable from being derived. - To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Foldable. + To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Data.Foldable.Foldable or Data.Bifoldable.Bifoldable. tests/purs/failing/FoldableInstance10.purs:  9  diff --git a/tests/purs/failing/FoldableInstance4.out b/tests/purs/failing/FoldableInstance4.out index 4e53669e6b..693fa4b766 100644 --- a/tests/purs/failing/FoldableInstance4.out +++ b/tests/purs/failing/FoldableInstance4.out @@ -2,22 +2,15 @@ Error found: in module FoldableInstance4 at tests/purs/failing/FoldableInstance4.purs:8:1 - 8:27 (line 8, column 1 - line 8, column 27) - No type class instance was found for -   -  Data.Foldable.Foldable (Function t3) -   - The instance head contains unknown type variables. Consider adding a type annotation. + One or more type variables are in positions that prevent Foldable from being derived. + To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Data.Foldable.Foldable or Data.Bifoldable.Bifoldable. -while applying a function foldl - of type Foldable t0 => (t1 -> t2 -> t1) -> t1 -> t0 t2 -> t1 - to argument $f1 -while inferring the type of foldl $f1 + tests/purs/failing/FoldableInstance4.purs: +  6  +  7 data T a = T (forall t. Show t => t -> a) +  8 derive instance Foldable T -where t0 is an unknown type - t2 is an unknown type - t1 is an unknown type - t3 is an unknown type -See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information, or to contribute content related to this error. diff --git a/tests/purs/failing/FoldableInstance4.purs b/tests/purs/failing/FoldableInstance4.purs index 6dd856540f..ad01c8be93 100644 --- a/tests/purs/failing/FoldableInstance4.purs +++ b/tests/purs/failing/FoldableInstance4.purs @@ -1,4 +1,4 @@ --- @shouldFailWith NoInstanceFound +-- @shouldFailWith CannotDeriveInvalidConstructorArg module FoldableInstance4 where import Prelude diff --git a/tests/purs/failing/FoldableInstance5.out b/tests/purs/failing/FoldableInstance5.out deleted file mode 100644 index 485007f557..0000000000 --- a/tests/purs/failing/FoldableInstance5.out +++ /dev/null @@ -1,16 +0,0 @@ -Error found: -in module FoldableInstance5 -at tests/purs/failing/FoldableInstance5.purs:9:1 - 9:30 (line 9, column 1 - line 9, column 30) - - One or more type variables are in positions that prevent Foldable from being derived. - To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Foldable. - - tests/purs/failing/FoldableInstance5.purs: -  7  -  8 data Test a = Test (Tuple a Int) -  9 derive instance Foldable Test - - -See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information, -or to contribute content related to this error. - diff --git a/tests/purs/failing/FoldableInstance5.purs b/tests/purs/failing/FoldableInstance5.purs deleted file mode 100644 index cf86966245..0000000000 --- a/tests/purs/failing/FoldableInstance5.purs +++ /dev/null @@ -1,9 +0,0 @@ --- @shouldFailWith CannotDeriveInvalidConstructorArg -module FoldableInstance5 where - -import Prelude -import Data.Foldable (class Foldable) -import Data.Tuple (Tuple(..)) - -data Test a = Test (Tuple a Int) -derive instance Foldable Test diff --git a/tests/purs/failing/FoldableInstance6.out b/tests/purs/failing/FoldableInstance6.out index 148f229dad..31028db8eb 100644 --- a/tests/purs/failing/FoldableInstance6.out +++ b/tests/purs/failing/FoldableInstance6.out @@ -3,7 +3,7 @@ in module FoldableInstance6 at tests/purs/failing/FoldableInstance6.purs:8:1 - 8:30 (line 8, column 1 - line 8, column 30) One or more type variables are in positions that prevent Foldable from being derived. - To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Foldable. + To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Data.Foldable.Foldable or Data.Bifoldable.Bifoldable. tests/purs/failing/FoldableInstance6.purs:  6  diff --git a/tests/purs/failing/FoldableInstance7.out b/tests/purs/failing/FoldableInstance7.out deleted file mode 100644 index 2a8ebf28dd..0000000000 --- a/tests/purs/failing/FoldableInstance7.out +++ /dev/null @@ -1,16 +0,0 @@ -Error found: -in module FoldableInstance6 -at tests/purs/failing/FoldableInstance7.purs:9:1 - 9:30 (line 9, column 1 - line 9, column 30) - - One or more type variables are in positions that prevent Foldable from being derived. - To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Foldable. - - tests/purs/failing/FoldableInstance7.purs: -  7  -  8 data Test a = Test (Tuple a a) -  9 derive instance Foldable Test - - -See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information, -or to contribute content related to this error. - diff --git a/tests/purs/failing/FoldableInstance7.purs b/tests/purs/failing/FoldableInstance7.purs deleted file mode 100644 index ce11d35547..0000000000 --- a/tests/purs/failing/FoldableInstance7.purs +++ /dev/null @@ -1,9 +0,0 @@ --- @shouldFailWith CannotDeriveInvalidConstructorArg -module FoldableInstance6 where - -import Prelude -import Data.Tuple (Tuple(..)) -import Data.Foldable (class Foldable) - -data Test a = Test (Tuple a a) -derive instance Foldable Test diff --git a/tests/purs/failing/FoldableInstance8.out b/tests/purs/failing/FoldableInstance8.out index c5fdd33b3f..9199ad2211 100644 --- a/tests/purs/failing/FoldableInstance8.out +++ b/tests/purs/failing/FoldableInstance8.out @@ -3,11 +3,11 @@ in module FoldableInstance6 at tests/purs/failing/FoldableInstance8.purs:8:1 - 8:34 (line 8, column 1 - line 8, column 34) One or more type variables are in positions that prevent Foldable from being derived. - To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Foldable. + To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Data.Foldable.Foldable or Data.Bifoldable.Bifoldable. tests/purs/failing/FoldableInstance8.purs:  6  -  7 data Test f a = Test (f a a) +  7 data Test f a = Test (f a a)  8 derive instance Foldable (Test f) diff --git a/tests/purs/failing/FoldableInstance9.out b/tests/purs/failing/FoldableInstance9.out index 862543eda1..f48b5fc556 100644 --- a/tests/purs/failing/FoldableInstance9.out +++ b/tests/purs/failing/FoldableInstance9.out @@ -3,13 +3,13 @@ in module FoldableInstance9 at tests/purs/failing/FoldableInstance9.purs:53:1 - 53:38 (line 53, column 1 - line 53, column 38) One or more type variables are in positions that prevent Foldable from being derived. - To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Foldable. + To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of Data.Foldable.Foldable or Data.Bifoldable.Bifoldable. tests/purs/failing/FoldableInstance9.purs:  15 data Test f g h a -  16  = Test1 (f a a a) (f Int a a) (f a a Int) (f Int a Int) (f Int Int Int) -  17  | Test2 { all :: f a a a -  18  , rights :: f Int a a +  16  = Test1 (f a a a) (f Int a a) (f a a Int) (f Int a Int) (f Int Int Int) +  17  | Test2 { all :: f a a a +  18  , rights :: f Int a a  19  , lefts :: f a a Int  20  , middle :: f Int a Int  21  , none :: f Int Int Int @@ -20,7 +20,9 @@ at tests/purs/failing/FoldableInstance9.purs:53:1 - 53:38 (line 53, column 1 - l  26  , lefts :: f a a Int  27  , middle :: f Int a Int  28  , none :: f Int Int Int -  ... +  29  } +  30  a) +  31  | Test4 (h  32  { nested1 ::  33  { all :: f a a a  34  , rights :: f Int a a @@ -37,10 +39,10 @@ at tests/purs/failing/FoldableInstance9.purs:53:1 - 53:38 (line 53, column 1 - l  46  }  47  a  48  } -  49  a) +  49  a)  50  | Test5 (Rec f a) -  51  | Test6 (g (Rec f a) a) -  52  | Test7 (h { nested1 :: Rec f a, nested2 :: g (Rec f a) a } a) +  51  | Test6 (g (Rec f a) a) +  52  | Test7 (h { nested1 :: Rec f a, nested2 :: g (Rec f a) a } a)  53 derive instance Foldable (Test f g h) diff --git a/tests/purs/failing/FunctorInstance1.out b/tests/purs/failing/FunctorInstance1.out new file mode 100644 index 0000000000..0f2e05c6d8 --- /dev/null +++ b/tests/purs/failing/FunctorInstance1.out @@ -0,0 +1,16 @@ +Error found: +in module FunctorInstance1 +at tests/purs/failing/FunctorInstance1.purs:8:1 - 8:29 (line 8, column 1 - line 8, column 29) + + One or more type variables are in positions that prevent Functor from being derived. + To derive this class, make sure that these variables are only used as the final arguments to type constructors, that their variance matches the variance of Functor, and that those type constructors themselves have instances of Data.Functor.Functor, Data.Bifunctor.Bifunctor, Data.Functor.Contravariant.Contravariant, or Data.Profunctor.Profunctor. + + tests/purs/failing/FunctorInstance1.purs: +  6  +  7 data Test a = Test (Predicate a) +  8 derive instance Functor Test + + +See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/FunctorInstance1.purs b/tests/purs/failing/FunctorInstance1.purs new file mode 100644 index 0000000000..2883d98528 --- /dev/null +++ b/tests/purs/failing/FunctorInstance1.purs @@ -0,0 +1,8 @@ +-- @shouldFailWith CannotDeriveInvalidConstructorArg +module FunctorInstance1 where + +import Prelude +import Data.Predicate (Predicate) + +data Test a = Test (Predicate a) +derive instance Functor Test diff --git a/tests/purs/passing/DerivingBifunctor.purs b/tests/purs/passing/DerivingBifunctor.purs new file mode 100644 index 0000000000..e5f7fc86a8 --- /dev/null +++ b/tests/purs/passing/DerivingBifunctor.purs @@ -0,0 +1,26 @@ +module Main where + +import Prelude + +import Data.Bifoldable (class Bifoldable) +import Data.Bifunctor (class Bifunctor) +import Data.Bitraversable (class Bitraversable) +import Data.Predicate (Predicate) +import Data.Tuple (Tuple) +import Effect.Console (log) + +data Test f a b + = Test0 + | Test1 (Array a) b + | Test2 Int (forall a. Array a -> Array a) + | Test3 Int (f a b) (f a Int) (f Int b) + | Test4 (Array (Tuple a Int)) (Tuple b Int) + | Test5 { nested :: Array { x :: f { a :: a } { b :: b } } } +derive instance Bifunctor f => Bifunctor (Test f) +derive instance Bifoldable f => Bifoldable (Test f) +derive instance Bitraversable f => Bitraversable (Test f) + +data FromProAndContra a b = FromProAndContra (Predicate (a -> Int)) (Predicate b -> Int) +derive instance Bifunctor FromProAndContra + +main = log "Done" diff --git a/tests/purs/passing/DerivingContravariant.purs b/tests/purs/passing/DerivingContravariant.purs new file mode 100644 index 0000000000..7816e5b319 --- /dev/null +++ b/tests/purs/passing/DerivingContravariant.purs @@ -0,0 +1,20 @@ +module Main where + +import Prelude + +import Data.Functor.Contravariant (class Contravariant) +import Data.Predicate (Predicate) +import Data.Tuple (Tuple) +import Effect.Console (log) + +data Test f a + = Test0 + | Test1 (Predicate a) + | Test2 (Predicate (Predicate (Predicate a))) + | Test3 Int (forall a. Array a -> Array a) + | Test4 Int (f a) + | Test5 (Array (a -> Int)) (Tuple (Predicate a) Int) + | Test6 { nested :: Array { x :: f { a :: a } } } +derive instance Contravariant f => Contravariant (Test f) + +main = log "Done" diff --git a/tests/purs/passing/DerivingFunctorFromBi.purs b/tests/purs/passing/DerivingFunctorFromBi.purs new file mode 100644 index 0000000000..f19bc3c913 --- /dev/null +++ b/tests/purs/passing/DerivingFunctorFromBi.purs @@ -0,0 +1,18 @@ +module Main where + +import Prelude + +import Data.Foldable (class Foldable) +import Data.Traversable (class Traversable) +import Data.Tuple (Tuple) +import Effect.Console (log) + +data Test a + = Test1 (Tuple a Int) + | Test2 (Tuple (Array a) a) + | Test3 { x :: Tuple { a :: a } Int, y :: Tuple { a :: Array a } { a :: a } } +derive instance Functor Test +derive instance Foldable Test +derive instance Traversable Test + +main = log "Done" diff --git a/tests/purs/passing/DerivingFunctorFromContra.purs b/tests/purs/passing/DerivingFunctorFromContra.purs new file mode 100644 index 0000000000..0eed77feb8 --- /dev/null +++ b/tests/purs/passing/DerivingFunctorFromContra.purs @@ -0,0 +1,13 @@ +module Main where + +import Prelude + +import Data.Predicate (Predicate) +import Effect.Console (log) + +data Test a + = Test1 (Predicate (Predicate a)) + | Test2 { x :: Predicate { y :: Predicate a } } +derive instance Functor Test + +main = log "Done" diff --git a/tests/purs/passing/DerivingFunctorFromPro.purs b/tests/purs/passing/DerivingFunctorFromPro.purs new file mode 100644 index 0000000000..dc038e9c09 --- /dev/null +++ b/tests/purs/passing/DerivingFunctorFromPro.purs @@ -0,0 +1,16 @@ +module Main where + +-- Note that Data.Profunctor is not in the dependencies of any types imported +-- here. The package that contains that module must be a dependency of the test +-- project. + +import Prelude + +import Effect.Console (log) + +data Test a + = Test1 ((Array a -> Int) -> Int) + | Test2 { f :: ({ a :: a } -> Int) -> Int } +derive instance Functor Test + +main = log "Done" diff --git a/tests/purs/passing/DerivingFunctorPrefersSimplerClasses.purs b/tests/purs/passing/DerivingFunctorPrefersSimplerClasses.purs new file mode 100644 index 0000000000..5051f5d145 --- /dev/null +++ b/tests/purs/passing/DerivingFunctorPrefersSimplerClasses.purs @@ -0,0 +1,46 @@ +module Main where + +import Prelude + +import Data.Bifunctor (class Bifunctor) +import Data.Profunctor (class Profunctor) +import Effect (Effect) +import Effect.Console (log) +import Test.Assert (assert') + +newtype MonoAndBi a b = MonoAndBi (Effect Unit) +derive instance Functor (MonoAndBi a) +instance Bifunctor MonoAndBi where + bimap _ _ _ = MonoAndBi (assert' "Bifunctor instance was used but the Functor instance was expected" false) + +newtype Test1 a = Test1 (MonoAndBi Int a) +derive instance Functor Test1 + +data ExclusivelyBi a b +derive instance Bifunctor ExclusivelyBi + +newtype Test2 a = Test2 (ExclusivelyBi Int a) +derive instance Functor Test2 + +newtype MonoAndPro a b = MonoAndPro (Effect Unit) +derive instance Functor (MonoAndPro a) +instance Profunctor MonoAndPro where + dimap _ _ _ = MonoAndPro (assert' "Profunctor instance was used but the Functor instance was expected" false) + +newtype Test3 a = Test3 (MonoAndPro Int a) +derive instance Functor Test3 + +data ExclusivelyPro a b +derive instance Profunctor ExclusivelyPro + +newtype Test4 a = Test4 (ExclusivelyPro Int a) +derive instance Functor Test4 + +main = do + let t = Test1 (MonoAndBi (pure unit)) + let Test1 (MonoAndBi result1) = map identity t + result1 + let t = Test3 (MonoAndPro (pure unit)) + let Test3 (MonoAndPro result3) = map identity t + result3 + log "Done" diff --git a/tests/purs/passing/DerivingProfunctor.purs b/tests/purs/passing/DerivingProfunctor.purs new file mode 100644 index 0000000000..b8a1cf95b9 --- /dev/null +++ b/tests/purs/passing/DerivingProfunctor.purs @@ -0,0 +1,19 @@ +module Main where + +import Prelude + +import Data.Predicate (Predicate) +import Data.Profunctor (class Profunctor) +import Data.Tuple (Tuple) +import Effect.Console (log) + +data Test f a b + = Test0 + | Test1 (Predicate a) b + | Test2 Int (forall a. Array a -> Array a) + | Test3 Int (f a b) (f a Int) (f Int b) + | Test4 (Array (a -> Int)) (Tuple b Int) + | Test5 { nested :: Array { x :: f { a :: a } { b :: b } } } +derive instance Profunctor f => Profunctor (Test f) + +main = log "Done" From 0adf19643c9501d58d5490c686d9ed9baf50bb8d Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Mon, 5 Dec 2022 22:56:46 +0800 Subject: [PATCH 09/68] Upgrade to GHC 9.2.4 (#4422) * Bump container to haskell:9.2.4 * Bump Stackage snapshot to 2022-11-12 * Fix error in ci.yml * Bump stack version * 9.2.3 -> 9.2.4 --- .github/workflows/ci.yml | 6 +++--- CHANGELOG.d/misc_bump-ghc.md | 1 + INSTALL.md | 4 ++-- stack.yaml | 2 +- 4 files changed, 7 insertions(+), 6 deletions(-) create mode 100644 CHANGELOG.d/misc_bump-ghc.md diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 8eb1a72572..c12699776e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -15,7 +15,7 @@ defaults: env: CI_PRERELEASE: "${{ github.event_name == 'push' }}" CI_RELEASE: "${{ github.event_name == 'release' }}" - STACK_VERSION: "2.7.5" + STACK_VERSION: "2.9.1" concurrency: # We never want two prereleases building at the same time, since they would @@ -38,7 +38,7 @@ jobs: include: - # If upgrading the Haskell image, also upgrade it in the lint job below os: "ubuntu-latest" - image: "ghcr.io/purescript/haskell:9.2.3-stretch@sha256:70fd2b6255deb5daa961e6983591a0e21e9ac1e793923bee54aa2cc62e01f867" + image: haskell:9.2.4@sha256:dceec00f8ad896c327c2b5c77ba91c9824bf3e26a837f538ccfb80fb379dc52f - os: "macOS-11" - os: "windows-2019" @@ -172,7 +172,7 @@ jobs: # means our published binaries will work on the widest number of platforms. # But the HLint binary downloaded by this job requires a newer glibc # version. - container: "haskell:9.2.3-buster@sha256:51e250369e4671a15c247cdc5047397be88d7eb8e95b97b0fd9f417854a78bec" + container: haskell:9.2.4@sha256:dceec00f8ad896c327c2b5c77ba91c9824bf3e26a837f538ccfb80fb379dc52f steps: - # We need a proper Git repository, but the checkout step will unpack a tarball instead of doing a clone diff --git a/CHANGELOG.d/misc_bump-ghc.md b/CHANGELOG.d/misc_bump-ghc.md new file mode 100644 index 0000000000..4ae15f7020 --- /dev/null +++ b/CHANGELOG.d/misc_bump-ghc.md @@ -0,0 +1 @@ +* Bump Stackage snapshot to 2022-11-12 and GHC to 9.2.4 diff --git a/INSTALL.md b/INSTALL.md index 29175f9af6..d928501371 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -4,12 +4,12 @@ If you are having difficulty installing the PureScript compiler, feel free to as ## Requirements -The PureScript compiler is built using GHC 9.2.3, and should be able to run on any operating system supported by GHC 9.2.3. In particular: +The PureScript compiler is built using GHC 9.2.4, and should be able to run on any operating system supported by GHC 9.2.4. In particular: * for Windows users, versions predating Vista are not officially supported, * for macOS / OS X users, versions predating Mac OS X 10.7 (Lion) are not officially supported. -See also for more details about the operating systems which GHC 9.2.3 supports. +See also for more details about the operating systems which GHC 9.2.4 supports. ## Official prebuilt binaries diff --git a/stack.yaml b/stack.yaml index ac0a546b08..397fc5894a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,6 @@ # Please update Haskell image versions under .github/workflows/ci.yml together to use the same GHC version # (or the CI build will fail) -resolver: nightly-2022-06-09 +resolver: nightly-2022-11-12 pvp-bounds: both packages: - '.' From a564c5b0a111723868d8b621cd388e286bc0f93e Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Tue, 6 Dec 2022 13:11:36 -0600 Subject: [PATCH 10/68] Fix installer (#4425) * Update installer to 0.3.3 --- CHANGELOG.d/fix_docker-install.md | 1 + npm-package/package.json | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 CHANGELOG.d/fix_docker-install.md diff --git a/CHANGELOG.d/fix_docker-install.md b/CHANGELOG.d/fix_docker-install.md new file mode 100644 index 0000000000..43702cada7 --- /dev/null +++ b/CHANGELOG.d/fix_docker-install.md @@ -0,0 +1 @@ +* Update installer to `0.3.3` to fix a few installation issues \ No newline at end of file diff --git a/npm-package/package.json b/npm-package/package.json index 490202617a..e3eb7ab648 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -15,7 +15,7 @@ "purs": "purs.bin" }, "dependencies": { - "purescript-installer": "^0.3.1" + "purescript-installer": "^0.3.3" }, "homepage": "https://github.com/purescript/purescript", "repository": { From b71cb532c7d8d97505376cb528080ca3046615fe Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Mon, 12 Dec 2022 10:31:26 -0500 Subject: [PATCH 11/68] Enable more GHC warnings (#4429) --- CHANGELOG.d/internal_enable-ghc-warnings.md | 1 + purescript.cabal | 55 +++++++++++++------ src/Language/PureScript/CST/Lexer.hs | 4 +- src/Language/PureScript/CodeGen/JS.hs | 4 +- .../PureScript/Docs/Convert/ReExports.hs | 3 +- src/Language/PureScript/Ide/CaseSplit.hs | 4 +- src/Language/PureScript/Ide/Completion.hs | 2 +- src/Language/PureScript/Ide/Error.hs | 2 +- src/Language/PureScript/Ide/Externs.hs | 10 ++-- src/Language/PureScript/Ide/Filter.hs | 6 +- src/Language/PureScript/Ide/State.hs | 2 +- src/Language/PureScript/Ide/Usage.hs | 2 +- src/Language/PureScript/Interactive.hs | 8 +-- src/Language/PureScript/Linter/Exhaustive.hs | 5 +- src/Language/PureScript/Make.hs | 8 +-- src/Language/PureScript/Make/Actions.hs | 4 +- src/Language/PureScript/Make/BuildPlan.hs | 2 +- src/Language/PureScript/Pretty/Common.hs | 4 +- src/Language/PureScript/Sugar/Names/Common.hs | 2 +- .../PureScript/TypeChecker/Deriving.hs | 1 - .../TypeChecker/Entailment/Coercible.hs | 3 - tests/TestMake.hs | 4 +- 22 files changed, 76 insertions(+), 60 deletions(-) create mode 100644 CHANGELOG.d/internal_enable-ghc-warnings.md diff --git a/CHANGELOG.d/internal_enable-ghc-warnings.md b/CHANGELOG.d/internal_enable-ghc-warnings.md new file mode 100644 index 0000000000..ed226bbb36 --- /dev/null +++ b/CHANGELOG.d/internal_enable-ghc-warnings.md @@ -0,0 +1 @@ +* Enable more GHC warnings diff --git a/purescript.cabal b/purescript.cabal index 57da11080e..170f09a01a 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -53,12 +53,40 @@ flag release default: False common defaults - -- Note: -Wall-incomplete-uni-patterns and -Wincomplete-record-updates can be - -- removed once we upgrade to GHC 9.2.1 since they are now included in -Wall. ghc-options: - -Wall - -Wincomplete-uni-patterns - -Wincomplete-record-updates + -- This list taken from https://medium.com/mercury-bank/enable-all-the-warnings-a0517bc081c3 + -- Enable all warnings with -Weverything, then disable the ones we don’t care about + -Weverything + + -- missing-exported-signatures turns off the more strict -Wmissing-signatures. See https://ghc.haskell.org/trac/ghc/ticket/14794#ticket + -Wno-missing-exported-signatures + + -- Requires explicit imports of _every_ function (e.g. ‘$’); too strict + -Wno-missing-import-lists + + -- When GHC can’t specialize a polymorphic function. No big deal and requires fixing underlying libraries to solve. + -Wno-missed-specialisations + -Wno-all-missed-specialisations + + -- Don’t use Safe Haskell warnings + -Wno-unsafe + -Wno-safe + -Wno-trustworthy-safe + -Wno-inferred-safe-imports + -Wno-missing-safe-haskell-mode + + -- Warning for polymorphic local bindings; nothing wrong with those. + -Wno-missing-local-signatures + + -- Don’t warn if the monomorphism restriction is used + -Wno-monomorphism-restriction + + -- Remaining options don't come from the above blog post + -Wno-missing-deriving-strategies + -Wno-missing-export-lists + -Wno-missing-kind-signatures + -Wno-partial-fields + -Wno-prepositive-qualified-module default-language: Haskell2010 default-extensions: BangPatterns @@ -127,7 +155,6 @@ common defaults -- specific version. aeson >=2.0.3.0 && <2.1, aeson-better-errors >=0.9.1.1 && <0.10, - aeson-pretty >=0.8.9 && <0.9, ansi-terminal >=0.11.3 && <0.12, array >=0.5.4.0 && <0.6, base >=4.16.2.0 && <4.17, @@ -149,7 +176,6 @@ common defaults edit-distance >=0.2.2.1 && <0.3, file-embed >=0.0.15.0 && <0.1, filepath >=1.4.2.2 && <1.5, - fsnotify >=0.3.0.1 && <0.4, Glob >=0.10.2 && <0.11, haskeline >=0.8.2 && <0.9, language-javascript ==0.7.0.0, @@ -172,19 +198,14 @@ common defaults semigroups ==0.20.*, semialign >=1.2.0.1 && <1.3, sourcemap >=0.1.7 && <0.2, - split >=0.2.3.4 && <0.3, stm >=2.5.0.2 && <2.6, stringsearch >=0.3.6.6 && <0.4, - syb >=0.7.2.1 && <0.8, template-haskell >=2.18.0.0 && <2.19, text >=1.2.5.0 && <1.3, these >=1.1.1.1 && <1.2, time >=1.11.1.1 && <1.12, transformers >=0.5.6.2 && <0.6, transformers-base >=0.4.6 && <0.5, - transformers-compat >=0.7.1 && <0.8, - typed-process >=0.2.10.1 && <0.3, - unordered-containers >=0.2.19.1 && <0.3, utf8-string >=1.0.2 && <1.1, vector >=0.12.3.1 && <0.13, witherable >=0.4.2 && <0.5 @@ -379,12 +400,10 @@ executable purs import: defaults hs-source-dirs: app main-is: Main.hs - ghc-options: -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N + ghc-options: -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N -Wno-unused-packages build-depends: ansi-wl-pprint >=0.6.9 && <0.7, exceptions >=0.10.4 && <0.11, - file-embed >=0.0.13.0 && <0.1, - http-types >=0.12.3 && <0.13, network >=3.1.2.7 && <3.2, optparse-applicative >=0.17.0.0 && <0.18, purescript @@ -415,7 +434,7 @@ test-suite tests hs-source-dirs: tests main-is: Main.hs -- Not a problem for this warning to arise in tests - ghc-options: -Wno-incomplete-uni-patterns + ghc-options: -Wno-incomplete-uni-patterns -Wno-unused-packages build-depends: purescript, generic-random >=1.5.0.1 && <1.6, @@ -423,7 +442,9 @@ test-suite tests 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.2 && <0.95 + regex-base >=0.94.0.2 && <0.95, + split >=0.2.3.4 && <0.3, + typed-process >=0.2.10.1 && <0.3 build-tool-depends: hspec-discover:hspec-discover -any -- we need the compiler's executable available for the ide tests diff --git a/src/Language/PureScript/CST/Lexer.hs b/src/Language/PureScript/CST/Lexer.hs index 5f71e2c5ae..ea9dba4827 100644 --- a/src/Language/PureScript/CST/Lexer.hs +++ b/src/Language/PureScript/CST/Lexer.hs @@ -201,7 +201,7 @@ breakComments = k0 [] goWs a _ = a goSpace a !n (' ' : ls) = goSpace a (n + 1) ls - goSpace a !n ls = goWs (Space n : a) ls + goSpace a n ls = goWs (Space n : a) ls isBlockComment = Parser $ \inp _ ksucc -> case Text.uncons inp of @@ -725,7 +725,7 @@ digitsToScientific :: String -> String -> (Integer, Int) digitsToScientific = go 0 . reverse where go !exp is [] = (digitsToInteger (reverse is), exp) - go !exp is (f : fs) = go (exp - 1) (f : is) fs + go exp is (f : fs) = go (exp - 1) (f : is) fs isSymbolChar :: Char -> Bool isSymbolChar c = (c `elem` (":!#$%&*+./<=>?@\\^|-~" :: String)) || (not (Char.isAscii c) && Char.isSymbol c) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index f5a02fe8e3..9d89092f55 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -52,7 +52,7 @@ import System.FilePath.Posix (()) -- module. moduleToJs :: forall m - . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m) + . (MonadReader Options m, MonadSupply m, MonadError MultipleErrors m) => Module Ann -> Maybe PSString -> m AST.Module @@ -232,7 +232,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = moduleBindToJs :: forall m - . (Monad m, MonadReader Options m, MonadSupply m, MonadWriter Any m, MonadError MultipleErrors m) + . (MonadReader Options m, MonadSupply m, MonadWriter Any m, MonadError MultipleErrors m) => ModuleName -> Bind Ann -> m [AST] diff --git a/src/Language/PureScript/Docs/Convert/ReExports.hs b/src/Language/PureScript/Docs/Convert/ReExports.hs index 6400eced8b..7ef61d988f 100644 --- a/src/Language/PureScript/Docs/Convert/ReExports.hs +++ b/src/Language/PureScript/Docs/Convert/ReExports.hs @@ -147,8 +147,7 @@ collectDeclarations reExports = do where collect - :: (Eq a, Show a) - => (P.ModuleName -> a -> m (P.ModuleName, [b])) + :: (P.ModuleName -> a -> m (P.ModuleName, [b])) -> Map a P.ExportSource -> m (Map P.ModuleName [b]) collect lookup' exps = do diff --git a/src/Language/PureScript/Ide/CaseSplit.hs b/src/Language/PureScript/Ide/CaseSplit.hs index 57b225f280..9643f642b1 100644 --- a/src/Language/PureScript/Ide/CaseSplit.hs +++ b/src/Language/PureScript/Ide/CaseSplit.hs @@ -91,8 +91,8 @@ splitTypeConstructor = go [] prettyCtor :: WildcardAnnotations -> Constructor -> Text prettyCtor _ (ctorName, []) = P.runProperName ctorName prettyCtor wsa (ctorName, ctorArgs) = - "("<> P.runProperName ctorName <> " " - <> T.unwords (map (prettyPrintWildcard wsa) ctorArgs) <>")" + "(" <> P.runProperName ctorName <> " " + <> T.unwords (map (prettyPrintWildcard wsa) ctorArgs) <> ")" prettyPrintWildcard :: WildcardAnnotations -> P.Type a -> Text prettyPrintWildcard (WildcardAnnotations True) = prettyWildcard diff --git a/src/Language/PureScript/Ide/Completion.hs b/src/Language/PureScript/Ide/Completion.hs index 516015a702..6fa69d5c00 100644 --- a/src/Language/PureScript/Ide/Completion.hs +++ b/src/Language/PureScript/Ide/Completion.hs @@ -89,7 +89,7 @@ groupCompletionReexports initial = where go (Match (moduleName, d@(IdeDeclarationAnn ann decl))) = let - origin = fromMaybe moduleName (ann^.annExportedFrom) + origin = fromMaybe moduleName (ann ^. annExportedFrom) in Map.alter (insertDeclaration moduleName origin d) diff --git a/src/Language/PureScript/Ide/Error.hs b/src/Language/PureScript/Ide/Error.hs index 523c335412..92ca14339b 100644 --- a/src/Language/PureScript/Ide/Error.hs +++ b/src/Language/PureScript/Ide/Error.hs @@ -90,7 +90,7 @@ textError :: IdeError -> Text textError (GeneralError msg) = msg textError (NotFound ident) = "Symbol '" <> ident <> "' not found." textError (ModuleNotFound ident) = "Module '" <> ident <> "' not found." -textError (ModuleFileNotFound ident) = "Extern file for module " <> ident <>" could not be found" +textError (ModuleFileNotFound ident) = "Extern file for module " <> ident <> " could not be found" textError (RebuildError _ err) = show err prettyPrintTypeSingleLine :: P.Type a -> Text diff --git a/src/Language/PureScript/Ide/Externs.hs b/src/Language/PureScript/Ide/Externs.hs index e23010f0cb..70c780b8aa 100644 --- a/src/Language/PureScript/Ide/Externs.hs +++ b/src/Language/PureScript/Ide/Externs.hs @@ -69,14 +69,14 @@ resolveSynonymsAndClasses trs decls = foldr go decls trs Nothing -> acc Just tyDecl -> IdeDeclTypeClass - (IdeTypeClass tcn (tyDecl^.ideTypeKind) []) + (IdeTypeClass tcn (tyDecl ^. ideTypeKind) []) : filter (not . anyOf (_IdeDeclType . ideTypeName) (== P.coerceProperName tcn)) acc SynonymToResolve tn ty -> case findType tn acc of Nothing -> acc Just tyDecl -> - IdeDeclTypeSynonym (IdeTypeSynonym tn ty (tyDecl^.ideTypeKind)) + IdeDeclTypeSynonym (IdeTypeSynonym tn ty (tyDecl ^. ideTypeKind)) : filter (not . anyOf (_IdeDeclType . ideTypeName) (== tn)) acc findType :: P.ProperName 'P.TypeName -> [IdeDeclaration] -> Maybe IdeType @@ -103,14 +103,14 @@ convertDecl ed = case ed of -- because those are typechecker internal definitions that shouldn't -- be user facing P.EDType{..} -> Right do - guard (isNothing (Text.find (== '$') (edTypeName^.properNameT))) + guard (isNothing (Text.find (== '$') (edTypeName ^. properNameT))) Just (IdeDeclType (IdeType edTypeName edTypeKind [])) P.EDTypeSynonym{..} -> - if isNothing (Text.find (== '$') (edTypeSynonymName^.properNameT)) + if isNothing (Text.find (== '$') (edTypeSynonymName ^. properNameT)) then Left (SynonymToResolve edTypeSynonymName edTypeSynonymType) else Right Nothing P.EDDataConstructor{..} -> Right do - guard (isNothing (Text.find (== '$') (edDataCtorName^.properNameT))) + guard (isNothing (Text.find (== '$') (edDataCtorName ^. properNameT))) Just (IdeDeclDataConstructor (IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType)) diff --git a/src/Language/PureScript/Ide/Filter.hs b/src/Language/PureScript/Ide/Filter.hs index a3086c9e0a..1fd9df394f 100644 --- a/src/Language/PureScript/Ide/Filter.hs +++ b/src/Language/PureScript/Ide/Filter.hs @@ -148,7 +148,7 @@ instance FromJSON Filter where search <- params .: "search" pure (exactFilter search) "prefix" -> do - params <- o.: "params" + params <- o .: "params" search <- params .: "search" pure (prefixFilter search) "namespace" -> do @@ -156,10 +156,10 @@ instance FromJSON Filter where namespaces <- params .: "namespaces" pure (namespaceFilter (Set.fromList namespaces)) "declarations" -> do - declarations <- o.: "params" + declarations <- o .: "params" pure (declarationTypeFilter (Set.fromList declarations)) "dependencies" -> do - params <- o.: "params" + params <- o .: "params" moduleText <- params .: "moduleText" qualifier <- fmap P.moduleNameFromString <$> params .:? "qualifier" case sliceImportSection (T.lines moduleText) of diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs index 7f947a91b3..99e5515f17 100644 --- a/src/Language/PureScript/Ide/State.hs +++ b/src/Language/PureScript/Ide/State.hs @@ -207,7 +207,7 @@ populateVolatileStateSync = do (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn))) (Map.filter reexportHasFailures results) -populateVolatileState :: (Ide m, MonadLogger m) => m (Async ()) +populateVolatileState :: Ide m => m (Async ()) populateVolatileState = do env <- ask let ll = confLogLevel (ideConfiguration env) diff --git a/src/Language/PureScript/Ide/Usage.hs b/src/Language/PureScript/Ide/Usage.hs index ded282c071..8616c55744 100644 --- a/src/Language/PureScript/Ide/Usage.hs +++ b/src/Language/PureScript/Ide/Usage.hs @@ -25,7 +25,7 @@ import Language.PureScript.Ide.Util -- module. -- 3. Apply the collected search specifications and collect the results findUsages - :: (MonadIO m, Ide m) + :: Ide m => IdeDeclaration -> P.ModuleName -> m (ModuleMap (NonEmpty P.SourceSpan)) diff --git a/src/Language/PureScript/Interactive.hs b/src/Language/PureScript/Interactive.hs index bae794517c..e1552e2d07 100644 --- a/src/Language/PureScript/Interactive.hs +++ b/src/Language/PureScript/Interactive.hs @@ -178,7 +178,7 @@ handleDecls ds = do -- | Show actual loaded modules in psci. handleShowLoadedModules - :: (MonadState PSCiState m, MonadIO m) + :: MonadState PSCiState m => (String -> m ()) -> m () handleShowLoadedModules print' = do @@ -189,7 +189,7 @@ handleShowLoadedModules print' = do -- | Show the imported modules in psci. handleShowImportedModules - :: (MonadState PSCiState m, MonadIO m) + :: MonadState PSCiState m => (String -> m ()) -> m () handleShowImportedModules print' = do @@ -230,7 +230,7 @@ handleShowImportedModules print' = do commaList = T.intercalate ", " handleShowPrint - :: (MonadState PSCiState m, MonadIO m) + :: MonadState PSCiState m => (String -> m ()) -> m () handleShowPrint print' = do @@ -305,7 +305,7 @@ handleKindOf print' typ = do -- | Browse a module and displays its signature handleBrowse - :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) + :: (MonadReader PSCiConfig m, MonadState PSCiState m) => (String -> m ()) -> P.ModuleName -> m () diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs index 145cffce95..db1373e686 100644 --- a/src/Language/PureScript/Linter/Exhaustive.hs +++ b/src/Language/PureScript/Linter/Exhaustive.hs @@ -15,7 +15,6 @@ import Control.Applicative import Control.Arrow (first, second) import Control.Monad (unless) import Control.Monad.Writer.Class -import Control.Monad.Supply.Class (MonadSupply) import Data.List (foldl', sortOn) import Data.Maybe (fromMaybe) @@ -237,7 +236,7 @@ missingAlternative env mn ca uncovered -- checkExhaustive :: forall m - . (MonadWriter MultipleErrors m, MonadSupply m) + . MonadWriter MultipleErrors m => SourceSpan -> Environment -> ModuleName @@ -292,7 +291,7 @@ checkExhaustive ss env mn numArgs cas expr = makeResult . first ordNub $ foldl' -- checkExhaustiveExpr :: forall m - . (MonadWriter MultipleErrors m, MonadSupply m) + . MonadWriter MultipleErrors m => SourceSpan -> Environment -> ModuleName diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index d9e7157f16..d5c0dd05f5 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -56,7 +56,7 @@ import System.FilePath (replaceExtension) -- This function is used for fast-rebuild workflows (PSCi and psc-ide are examples). rebuildModule :: forall m - . (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) + . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MakeActions m -> [ExternsFile] -> Module @@ -67,7 +67,7 @@ rebuildModule actions externs m = do rebuildModule' :: forall m - . (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) + . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MakeActions m -> Env -> [ExternsFile] @@ -77,7 +77,7 @@ rebuildModule' act env ext mdl = rebuildModuleWithIndex act env ext mdl Nothing rebuildModuleWithIndex :: forall m - . (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) + . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MakeActions m -> Env -> [ExternsFile] @@ -136,7 +136,7 @@ rebuildModuleWithIndex MakeActions{..} exEnv externs m@(Module _ _ moduleName _ -- -- If timestamps or hashes have not changed, existing externs files can be used to provide upstream modules' types without -- having to typecheck those modules again. -make :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) +make :: forall m. (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MakeActions m -> [CST.PartialResult Module] -> m [ExternsFile] diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 27a173e754..485086b838 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -293,7 +293,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = map (\(SMap _ orig gen) -> Mapping { mapOriginal = Just $ convertPos $ add 0 (-1) orig , mapSourceFile = sourceFile - , mapGenerated = convertPos $ add (extraLines+1) 0 gen + , mapGenerated = convertPos $ add (extraLines + 1) 0 gen , mapName = Nothing }) mappings } @@ -301,7 +301,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = writeJSONFile mapFile mapping where add :: Int -> Int -> SourcePos -> SourcePos - add n m (SourcePos n' m') = SourcePos (n+n') (m+m') + add n m (SourcePos n' m') = SourcePos (n + n') (m + m') convertPos :: SourcePos -> Pos convertPos SourcePos { sourcePosLine = l, sourcePosColumn = c } = diff --git a/src/Language/PureScript/Make/BuildPlan.hs b/src/Language/PureScript/Make/BuildPlan.hs index cf9c2833a9..d79dc4e2f8 100644 --- a/src/Language/PureScript/Make/BuildPlan.hs +++ b/src/Language/PureScript/Make/BuildPlan.hs @@ -127,7 +127,7 @@ getResult buildPlan moduleName = -- The given MakeActions are used to collect various timestamps in order to -- determine whether a module needs rebuilding. construct - :: forall m. (Monad m, MonadBaseControl IO m) + :: forall m. MonadBaseControl IO m => MakeActions m -> CacheDb -> ([CST.PartialResult Module], [(ModuleName, [ModuleName])]) diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs index 2f841c534b..04125f96e3 100644 --- a/src/Language/PureScript/Pretty/Common.hs +++ b/src/Language/PureScript/Pretty/Common.hs @@ -96,8 +96,8 @@ bumpPos :: SourcePos -> SMap -> SMap bumpPos p (SMap f s g) = SMap f s $ p `addPos` g addPos :: SourcePos -> SourcePos -> SourcePos -addPos (SourcePos n m) (SourcePos 0 m') = SourcePos n (m+m') -addPos (SourcePos n _) (SourcePos n' m') = SourcePos (n+n') m' +addPos (SourcePos n m) (SourcePos 0 m') = SourcePos n (m + m') +addPos (SourcePos n _) (SourcePos n' m') = SourcePos (n + n') m' data PrinterState = PrinterState { indent :: Int } diff --git a/src/Language/PureScript/Sugar/Names/Common.hs b/src/Language/PureScript/Sugar/Names/Common.hs index 4382342eea..9783d66dd3 100644 --- a/src/Language/PureScript/Sugar/Names/Common.hs +++ b/src/Language/PureScript/Sugar/Names/Common.hs @@ -40,7 +40,7 @@ warnDuplicateRefs pos toError refs = do -- but that requires additional changes in how warnings are printed. -- Example of keeping all duplicates (not what this code currently does): -- removeUnique [1,2,2,3,3,3,4] == [2,2,3,3,3] - removeUnique :: Eq a => Ord a => [a] -> [a] + removeUnique :: Ord a => [a] -> [a] removeUnique = concatMap (drop 1) . group . sort -- Deletes the constructor information from TypeRefs so that only the diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index 6c31cddcb6..375622a873 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -109,7 +109,6 @@ deriveNewtypeInstance :: forall m . MonadError MultipleErrors m => MonadState CheckState m - => MonadSupply m => MonadWriter MultipleErrors m => ModuleName -> Qualified (ProperName 'ClassName) diff --git a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs index 666fc398c6..d69e3cc7f6 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs @@ -779,7 +779,6 @@ decompose env tyName axs bxs = do -- @D@ is not a newtype, yield constraints on their arguments. canonDecomposition :: MonadError MultipleErrors m - => MonadState CheckState m => Environment -> SourceType -> SourceType @@ -797,7 +796,6 @@ canonDecomposition env a b -- newtypes, are insoluble. canonDecompositionFailure :: MonadError MultipleErrors m - => MonadState CheckState m => Environment -> SourceType -> SourceType @@ -847,7 +845,6 @@ canonDecompositionFailure env k a b -- to discharge it with the given. canonNewtypeDecomposition :: MonadError MultipleErrors m - => MonadState CheckState m => Environment -> Maybe [(SourceType, SourceType, SourceType)] -> SourceType diff --git a/tests/TestMake.hs b/tests/TestMake.hs index 75f422e8ac..7e41411e95 100644 --- a/tests/TestMake.hs +++ b/tests/TestMake.hs @@ -166,7 +166,7 @@ spec = do moduleContent2 = moduleContent1 <> "\ny :: Int\ny = 1" optsWithDocs = P.defaultOptions { P.optionsCodegenTargets = Set.fromList [P.JS, P.Docs] } go opts = compileWithOptions opts [modulePath] >>= assertSuccess - oneSecond = 10^(6::Int) -- microseconds. + oneSecond = 10 ^ (6::Int) -- microseconds. writeFileWithTimestamp modulePath timestampA moduleContent1 go optsWithDocs `shouldReturn` moduleNames ["Module"] @@ -184,7 +184,7 @@ spec = do moduleContent2 = moduleContent1 <> "\ny :: Int\ny = 1" optsCorefnOnly = P.defaultOptions { P.optionsCodegenTargets = Set.singleton P.CoreFn } go opts = compileWithOptions opts [modulePath] >>= assertSuccess - oneSecond = 10^(6::Int) -- microseconds. + oneSecond = 10 ^ (6::Int) -- microseconds. writeFileWithTimestamp modulePath timestampA moduleContent1 go optsCorefnOnly `shouldReturn` moduleNames ["Module"] From df5fcff1c396d520e8543d5d85ce1455e56e2696 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Mon, 12 Dec 2022 10:17:31 -0600 Subject: [PATCH 12/68] Prep 0.15.7 release (#4428) --- CHANGELOG.d/feature_derive-traversable-2.md | 4 - CHANGELOG.d/feature_ide-dependency-filter.md | 6 - .../feature_ide-rebuild-without-filesystem.md | 4 - CHANGELOG.d/feature_shorten-error-message.md | 3 - CHANGELOG.d/fix_docker-install.md | 1 - CHANGELOG.d/internal_enable-ghc-warnings.md | 1 - CHANGELOG.d/internal_organize-constants.md | 1 - CHANGELOG.d/misc_bump-ghc.md | 1 - CHANGELOG.d/misc_fix-typos.md | 1 - CHANGELOG.d/misc_overlapping-let.md | 1 - CHANGELOG.md | 65 +++++- LICENSE | 206 ------------------ npm-package/package.json | 4 +- purescript.cabal | 2 +- 14 files changed, 60 insertions(+), 240 deletions(-) delete mode 100644 CHANGELOG.d/feature_derive-traversable-2.md delete mode 100644 CHANGELOG.d/feature_ide-dependency-filter.md delete mode 100644 CHANGELOG.d/feature_ide-rebuild-without-filesystem.md delete mode 100644 CHANGELOG.d/feature_shorten-error-message.md delete mode 100644 CHANGELOG.d/fix_docker-install.md delete mode 100644 CHANGELOG.d/internal_enable-ghc-warnings.md delete mode 100644 CHANGELOG.d/internal_organize-constants.md delete mode 100644 CHANGELOG.d/misc_bump-ghc.md delete mode 100644 CHANGELOG.d/misc_fix-typos.md delete mode 100644 CHANGELOG.d/misc_overlapping-let.md diff --git a/CHANGELOG.d/feature_derive-traversable-2.md b/CHANGELOG.d/feature_derive-traversable-2.md deleted file mode 100644 index 03d755aac2..0000000000 --- a/CHANGELOG.d/feature_derive-traversable-2.md +++ /dev/null @@ -1,4 +0,0 @@ -* The compiler can now derive instances of `Bifunctor`, `Bifoldable`, - `Bitraversable`, `Contravariant`, and `Profunctor`, as well as use those - classes when deriving `Functor`, `Foldable`, and `Traversable`, enabling more - instances to be derived. diff --git a/CHANGELOG.d/feature_ide-dependency-filter.md b/CHANGELOG.d/feature_ide-dependency-filter.md deleted file mode 100644 index 66d9b6b1a4..0000000000 --- a/CHANGELOG.d/feature_ide-dependency-filter.md +++ /dev/null @@ -1,6 +0,0 @@ -```markdown -* Add `purs ide` dependency/imports filter (#4412 by @nwolverson) - - This allows IDE tooling to filter type searches according to the imports of a given module, - restricting to identifiers in scope. -``` diff --git a/CHANGELOG.d/feature_ide-rebuild-without-filesystem.md b/CHANGELOG.d/feature_ide-rebuild-without-filesystem.md deleted file mode 100644 index 7bb4b533d6..0000000000 --- a/CHANGELOG.d/feature_ide-rebuild-without-filesystem.md +++ /dev/null @@ -1,4 +0,0 @@ -* Allow IDE module rebuilds eschewing the filesystem - - This allows IDE clients to typecheck the module the user is currently typing in without modifying the output. - This allows for faster feedback cycles in editors and avoids producing a broken `/output` before the user actually saves the file. diff --git a/CHANGELOG.d/feature_shorten-error-message.md b/CHANGELOG.d/feature_shorten-error-message.md deleted file mode 100644 index 45697cdc2f..0000000000 --- a/CHANGELOG.d/feature_shorten-error-message.md +++ /dev/null @@ -1,3 +0,0 @@ -* Shorten the prefix for custom user defined error - messages to improve clarity and get to the relevant information - more quickly diff --git a/CHANGELOG.d/fix_docker-install.md b/CHANGELOG.d/fix_docker-install.md deleted file mode 100644 index 43702cada7..0000000000 --- a/CHANGELOG.d/fix_docker-install.md +++ /dev/null @@ -1 +0,0 @@ -* Update installer to `0.3.3` to fix a few installation issues \ No newline at end of file diff --git a/CHANGELOG.d/internal_enable-ghc-warnings.md b/CHANGELOG.d/internal_enable-ghc-warnings.md deleted file mode 100644 index ed226bbb36..0000000000 --- a/CHANGELOG.d/internal_enable-ghc-warnings.md +++ /dev/null @@ -1 +0,0 @@ -* Enable more GHC warnings diff --git a/CHANGELOG.d/internal_organize-constants.md b/CHANGELOG.d/internal_organize-constants.md deleted file mode 100644 index 1d0f0103d5..0000000000 --- a/CHANGELOG.d/internal_organize-constants.md +++ /dev/null @@ -1 +0,0 @@ -* Organize the compiler's internal constants files diff --git a/CHANGELOG.d/misc_bump-ghc.md b/CHANGELOG.d/misc_bump-ghc.md deleted file mode 100644 index 4ae15f7020..0000000000 --- a/CHANGELOG.d/misc_bump-ghc.md +++ /dev/null @@ -1 +0,0 @@ -* Bump Stackage snapshot to 2022-11-12 and GHC to 9.2.4 diff --git a/CHANGELOG.d/misc_fix-typos.md b/CHANGELOG.d/misc_fix-typos.md deleted file mode 100644 index 6daaeb3cc1..0000000000 --- a/CHANGELOG.d/misc_fix-typos.md +++ /dev/null @@ -1 +0,0 @@ -* Fix various typos in documentation and source comments. \ No newline at end of file diff --git a/CHANGELOG.d/misc_overlapping-let.md b/CHANGELOG.d/misc_overlapping-let.md deleted file mode 100644 index 0100fe2e42..0000000000 --- a/CHANGELOG.d/misc_overlapping-let.md +++ /dev/null @@ -1 +0,0 @@ -* Improve `DuplicateDeclarationsInLet` error so that it mentions what variable names were duplicated, reporting several in separate errors as necessary. diff --git a/CHANGELOG.md b/CHANGELOG.md index f3dbe6af11..5314a5561e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,55 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.7 + +New features: + +* Allow IDE module rebuilds eschewing the filesystem (#4399 by @i-am-the-slime) + + This allows IDE clients to typecheck the module the user is currently typing in without modifying the output. + This allows for faster feedback cycles in editors and avoids producing a broken `/output` before the user actually saves the file. + +* Add `purs ide` dependency/imports filter (#4412 by @nwolverson) + + This allows IDE tooling to filter type searches according to the imports of a given module, + restricting to identifiers in scope. + +* Shorten custom user-defined error message's prefix (#4418 by @i-am-the-slime) + + Improves clarity and gets to the relevant information faster. + +* The compiler can now derive instances for more types and type classes (#4420 by @rhendric) + + New type classes that the compiler can derive: + - `Bifunctor` + - `Bifoldable` + - `Bitraversable` + - `Contravariant` + - `Profunctor` + + Moreover, the compiler can also use these classes when deriving + `Functor`, `Foldable`, and `Traversable`, enabling more instances to be derived + whereas before such instances would need to be written manually. + +Bugfixes: + +* Update installer to `0.3.3` to fix a few installation issues (#4425 by @JordanMartinez) + +Other improvements: + +* Improve `DuplicateDeclarationsInLet` error so that it mentions what variable names were duplicated, reporting several in separate errors as necessary. (#4405 by @MonoidMusician) + +* Fix various typos in documentation and source comments. (#4415 by @Deltaspace0) + +* Bump Stackage snapshot to 2022-11-12 and GHC to 9.2.4 (#4422 by @purefunctor) + +Internal: + +* Organize the compiler's internal constants files (#4406 by @rhendric) + +* Enable more GHC warnings (#4429 by @rhendric) + ## 0.15.6 Bugfixes: @@ -3194,14 +3243,14 @@ The way names are resolved has now been updated in a way that may result in some Some examples: -| Import statement | Exposed members | -| --- | --- | -| `import X` | `A`, `f` | -| `import X as Y` | `Y.A` `Y.f` | -| `import X (A)` | `A` | -| `import X (A) as Y` | `Y.A` | -| `import X hiding (f)` | `A` | -| `import Y hiding (f) as Y` | `Y.A` | +| Import statement | Exposed members | +| -------------------------- | --------------- | +| `import X` | `A`, `f` | +| `import X as Y` | `Y.A` `Y.f` | +| `import X (A)` | `A` | +| `import X (A) as Y` | `Y.A` | +| `import X hiding (f)` | `A` | +| `import Y hiding (f) as Y` | `Y.A` | Qualified references like `Control.Monad.Eff.Console.log` will no longer resolve unless there is a corresponding `import Control.Monad.Eff.Console as Control.Monad.Eff.Console`. Importing a module unqualified does not allow you to reference it with qualification, so `import X` does not allow references to `X.A` unless there is also an `import X as X`. diff --git a/LICENSE b/LICENSE index 0acf73c6ea..29d843bea4 100644 --- a/LICENSE +++ b/LICENSE @@ -22,7 +22,6 @@ PureScript uses the following Haskell library packages. Their license files foll adjunctions aeson aeson-better-errors - aeson-pretty alex ansi-terminal ansi-wl-pprint @@ -45,9 +44,7 @@ PureScript uses the following Haskell library packages. Their license files foll boxes bytestring call-stack - case-insensitive cborg - cereal cheapskate clock colour @@ -77,15 +74,12 @@ PureScript uses the following Haskell library packages. Their license files foll file-embed filepath free - fsnotify ghc-bignum ghc-prim half happy hashable haskeline - hfsevents - http-types indexed-traversable indexed-traversable-instances integer-gmp @@ -422,39 +416,6 @@ aeson-better-errors LICENSE file: TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -aeson-pretty LICENSE file: - - Copyright (c)2011, Falko Peters - - 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 Falko Peters 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. - alex LICENSE file: Copyright (c) 1995-2011, Chris Dornan and Simon Marlow @@ -1204,40 +1165,6 @@ call-stack LICENSE file: OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -case-insensitive LICENSE file: - - Copyright (c) 2011-2013 Bas van Dijk - - 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. - - * The name of Bas van Dijk and the names of contributors may NOT - 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. - cborg LICENSE file: Copyright (c) 2015-2017 Duncan Coutts, @@ -1274,39 +1201,6 @@ cborg LICENSE file: (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -cereal LICENSE file: - - Copyright (c) Lennart Kolmodin, Galois, Inc. - - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions - are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - 2. 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. - - 3. Neither the name of the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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. - cheapskate LICENSE file: Copyright (c) 2013, John MacFarlane @@ -2200,39 +2094,6 @@ free LICENSE file: ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -fsnotify LICENSE file: - - Copyright (c) 2012, Mark Dittmer - - 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 Mark Dittmer 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. - ghc-bignum LICENSE file: The Glasgow Haskell Compiler License @@ -2456,73 +2317,6 @@ haskeline LICENSE file: 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. -hfsevents LICENSE file: - - Copyright (c) 2012, Luite Stegeman - - 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 Luite Stegeman 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. - -http-types LICENSE file: - - Copyright (c) 2011, Aristid Breitkreuz - Copyright (c) 2011, Michael Snoyman - - 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 Aristid Breitkreuz 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. - indexed-traversable LICENSE file: Copyright 2012-2016 Edward Kmett diff --git a/npm-package/package.json b/npm-package/package.json index e3eb7ab648..1cb36d4747 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.6", + "version": "0.15.7", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.6", + "postinstall": "install-purescript --purs-ver=0.15.7", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index 170f09a01a..cefdd51b3c 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.6 +version: 0.15.7 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From 3cf73939a4869090fb108d2e14de852ae513568b Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Mon, 9 Jan 2023 15:56:17 -0500 Subject: [PATCH 13/68] Fix instance deriving regression (#4432) --- CHANGELOG.d/fix_4431.purs | 1 + src/Language/PureScript/AST/Utils.hs | 14 ++- .../PureScript/Sugar/TypeClasses/Deriving.hs | 8 +- .../PureScript/TypeChecker/Deriving.hs | 118 ++++++++++-------- tests/purs/passing/4431-2.purs | 12 ++ tests/purs/passing/4431.purs | 11 ++ 6 files changed, 106 insertions(+), 58 deletions(-) create mode 100644 CHANGELOG.d/fix_4431.purs create mode 100644 tests/purs/passing/4431-2.purs create mode 100644 tests/purs/passing/4431.purs diff --git a/CHANGELOG.d/fix_4431.purs b/CHANGELOG.d/fix_4431.purs new file mode 100644 index 0000000000..05b8333c92 --- /dev/null +++ b/CHANGELOG.d/fix_4431.purs @@ -0,0 +1 @@ +* Fix instance deriving regression diff --git a/src/Language/PureScript/AST/Utils.hs b/src/Language/PureScript/AST/Utils.hs index 4e28f6e6ef..a62ed5593e 100644 --- a/src/Language/PureScript/AST/Utils.hs +++ b/src/Language/PureScript/AST/Utils.hs @@ -39,11 +39,21 @@ mkCtorBinder mn name = ConstructorBinder nullSourceSpan (Qualified (ByModuleName unguarded :: Expr -> [GuardedExpr] unguarded e = [MkUnguarded e] -unwrapTypeConstructor :: SourceType -> Maybe (Qualified (ProperName 'TypeName), [SourceType], [SourceType]) +data UnwrappedTypeConstructor = UnwrappedTypeConstructor + { utcModuleName :: ModuleName + , utcTyCon :: ProperName 'TypeName + , utcKindArgs :: [SourceType] + , utcArgs :: [SourceType] + } + +utcQTyCon :: UnwrappedTypeConstructor -> Qualified (ProperName 'TypeName) +utcQTyCon UnwrappedTypeConstructor{..} = Qualified (ByModuleName utcModuleName) utcTyCon + +unwrapTypeConstructor :: SourceType -> Maybe UnwrappedTypeConstructor unwrapTypeConstructor = go [] [] where go kargs args = \case - TypeConstructor _ tyCon -> Just (tyCon, kargs, args) + TypeConstructor _ (Qualified (ByModuleName mn) tyCon) -> Just (UnwrappedTypeConstructor mn tyCon kargs args) TypeApp _ ty arg -> go kargs (arg : args) ty KindApp _ ty karg -> go (karg : kargs) args ty _ -> Nothing diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs index bcd401a5bc..2389831c1e 100755 --- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs @@ -49,10 +49,10 @@ deriveInstance mn ds decl = binaryWildcardClass :: (Declaration -> [SourceType] -> m ([Declaration], SourceType)) -> m Declaration binaryWildcardClass f = case tys of [ty1, ty2] -> case unwrapTypeConstructor ty1 of - Just (Qualified (ByModuleName mn') tyCon, _, args) | mn == mn' -> do - checkIsWildcard ss tyCon ty2 - tyConDecl <- findTypeDecl ss tyCon ds - (members, ty2') <- f tyConDecl args + Just UnwrappedTypeConstructor{..} | mn == utcModuleName -> do + checkIsWildcard ss utcTyCon ty2 + tyConDecl <- findTypeDecl ss utcTyCon ds + (members, ty2') <- f tyConDecl utcArgs pure $ TypeInstanceDeclaration sa na ch idx nm deps className [ty1, ty2'] (ExplicitInstance members) _ -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty1 _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2 diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index 375622a873..8261802178 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -42,7 +42,7 @@ import Language.PureScript.Types -- we just match the newtype name. extractNewtypeName :: ModuleName -> [SourceType] -> Maybe (ModuleName, ProperName 'TypeName) extractNewtypeName mn - = fmap (\(n, _, _) -> qualify mn n) + = fmap (qualify mn . utcQTyCon) . (unwrapTypeConstructor <=< lastMay) deriveInstance @@ -58,7 +58,8 @@ deriveInstance deriveInstance instType className strategy = do mn <- unsafeCheckCurrentModule env <- getEnv - (fmap coerceProperName -> ctorName, _, tys) <- maybe (internalCompilerError "invalid instance type") pure $ unwrapTypeConstructor instType + instUtc@UnwrappedTypeConstructor{ utcArgs = tys } <- maybe (internalCompilerError "invalid instance type") pure $ unwrapTypeConstructor instType + let ctorName = coerceProperName <$> utcQTyCon instUtc TypeClassData{..} <- note (errorMessage . UnknownName $ fmap TyClassName className) $ @@ -66,15 +67,15 @@ deriveInstance instType className strategy = do case strategy of KnownClassStrategy -> let - unaryClass :: (ModuleName -> ProperName 'TypeName -> m [(PSString, Expr)]) -> m Expr + unaryClass :: (UnwrappedTypeConstructor -> m [(PSString, Expr)]) -> m Expr unaryClass f = case tys of [ty] -> case unwrapTypeConstructor ty of - Just (Qualified (ByModuleName mn') tyCon, _, _) | mn == mn' -> do + Just utc | mn == utcModuleName utc -> 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 + App (Constructor nullSourceSpan ctorName) . mkLit . ObjectLiteral . (++ superclasses) <$> f utc _ -> throwError . errorMessage $ ExpectedTypeConstructor className tys ty _ -> throwError . errorMessage $ InvalidDerivedInstance className tys 1 @@ -86,11 +87,11 @@ deriveInstance instType className strategy = do Libs.Bitraversable -> unaryClass' $ deriveTraversable True Libs.Contravariant -> unaryClass' $ deriveFunctor Nothing True Libs.S_cmap Libs.Eq -> unaryClass deriveEq - Libs.Eq1 -> unaryClass $ \_ _ -> deriveEq1 + Libs.Eq1 -> unaryClass $ const deriveEq1 Libs.Foldable -> unaryClass' $ deriveFoldable False Libs.Functor -> unaryClass' $ deriveFunctor Nothing False Libs.S_map Libs.Ord -> unaryClass deriveOrd - Libs.Ord1 -> unaryClass $ \_ _ -> deriveOrd1 + Libs.Ord1 -> unaryClass $ const deriveOrd1 Libs.Profunctor -> unaryClass' $ deriveFunctor (Just True) False Libs.S_dimap Libs.Traversable -> unaryClass' $ deriveTraversable False -- See L.P.Sugar.TypeClasses.Deriving for the classes that can be @@ -99,9 +100,9 @@ deriveInstance instType className strategy = do NewtypeStrategy -> case tys of - _ : _ | Just (Qualified (ByModuleName mn') tyCon, kargs, args) <- unwrapTypeConstructor (last tys) - , mn == mn' - -> deriveNewtypeInstance mn className tys tyCon kargs args + _ : _ | Just utc <- unwrapTypeConstructor (last tys) + , mn == utcModuleName utc + -> deriveNewtypeInstance className tys utc | otherwise -> throwError . errorMessage $ ExpectedTypeConstructor className tys (last tys) _ -> throwError . errorMessage $ InvalidNewtypeInstance className tys @@ -110,14 +111,11 @@ deriveNewtypeInstance . MonadError MultipleErrors m => MonadState CheckState m => MonadWriter MultipleErrors m - => ModuleName - -> Qualified (ProperName 'ClassName) - -> [SourceType] - -> ProperName 'TypeName - -> [SourceType] + => Qualified (ProperName 'ClassName) -> [SourceType] + -> UnwrappedTypeConstructor -> m Expr -deriveNewtypeInstance mn className tys tyConNm dkargs dargs = do +deriveNewtypeInstance className tys (UnwrappedTypeConstructor mn tyConNm dkargs dargs) = do verifySuperclasses (dtype, tyKindNames, tyArgNames, ctors) <- lookupTypeDecl mn tyConNm go dtype tyKindNames tyArgNames ctors @@ -190,17 +188,33 @@ deriveNewtypeInstance mn className tys tyConNm dkargs dargs = do $ dicts in lookIn suModule || lookIn newtypeModule +data TypeInfo = TypeInfo + { tiTypeParams :: [Text] + , tiCtors :: [(ProperName 'ConstructorName, [SourceType])] + , tiArgSubst :: [(Text, SourceType)] + } + +lookupTypeInfo + :: forall m + . MonadError MultipleErrors m + => MonadState CheckState m + => UnwrappedTypeConstructor + -> m TypeInfo +lookupTypeInfo UnwrappedTypeConstructor{..} = do + (_, kindParams, map fst -> tiTypeParams, tiCtors) <- lookupTypeDecl utcModuleName utcTyCon + let tiArgSubst = zip tiTypeParams utcArgs <> zip kindParams utcKindArgs + pure TypeInfo{..} + deriveEq :: forall m . MonadError MultipleErrors m => MonadState CheckState m => MonadSupply m - => ModuleName - -> ProperName 'TypeName + => UnwrappedTypeConstructor -> m [(PSString, Expr)] -deriveEq mn tyConNm = do - (_, _, _, ctors) <- lookupTypeDecl mn tyConNm - eqFun <- mkEqFunction ctors +deriveEq utc = do + TypeInfo{..} <- lookupTypeInfo utc + eqFun <- mkEqFunction tiCtors pure [(Libs.S_eq, eqFun)] where mkEqFunction :: [(ProperName 'ConstructorName, [SourceType])] -> m Expr @@ -233,7 +247,7 @@ deriveEq mn tyConNm = do 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 + caseBinder idents = mkCtorBinder (utcModuleName utc) ctorName $ map mkBinder idents conjAll :: [Expr] -> Expr conjAll = \case @@ -257,12 +271,11 @@ deriveOrd . MonadError MultipleErrors m => MonadState CheckState m => MonadSupply m - => ModuleName - -> ProperName 'TypeName + => UnwrappedTypeConstructor -> m [(PSString, Expr)] -deriveOrd mn tyConNm = do - (_, _, _, ctors) <- lookupTypeDecl mn tyConNm - compareFun <- mkCompareFunction ctors +deriveOrd utc = do + TypeInfo{..} <- lookupTypeInfo utc + compareFun <- mkCompareFunction tiCtors pure [(Libs.S_compare, compareFun)] where mkCompareFunction :: [(ProperName 'ConstructorName, [SourceType])] -> m Expr @@ -315,6 +328,7 @@ deriveOrd mn tyConNm = do : extras where + mn = utcModuleName utc caseBinder idents = mkCtorBinder mn ctorName $ map mkBinder idents nullCaseBinder = mkCtorBinder mn ctorName $ replicate (length tys) NullBinder @@ -426,32 +440,31 @@ validateParamsInTypeConstructors . MonadError MultipleErrors m => MonadState CheckState m => Qualified (ProperName 'ClassName) - -> ModuleName - -> ProperName 'TypeName + -> UnwrappedTypeConstructor -> Bool -> CovariantClasses -> Maybe (ContravarianceSupport c) -> m [(ProperName 'ConstructorName, [Maybe (ParamUsage c)])] -validateParamsInTypeConstructors derivingClass mn tyConNm isBi CovariantClasses{..} contravarianceSupport = do - (_, _, tyArgNames, ctors) <- lookupTypeDecl mn tyConNm +validateParamsInTypeConstructors derivingClass utc isBi CovariantClasses{..} contravarianceSupport = do + TypeInfo{..} <- lookupTypeInfo utc (mbLParam, param) <- liftEither . first (errorMessage . flip KindsDoNotUnify kindType . (kindType -:>)) $ - case (isBi, reverse $ map fst tyArgNames) of + case (isBi, reverse tiTypeParams) of (False, x : _) -> Right (Nothing, x) (False, _) -> Left kindType (True, y : x : _) -> Right (Just x, y) (True, _ : _) -> Left kindType (True, _) -> Left $ kindType -:> kindType - ctors' <- traverse (traverse $ traverse replaceAllTypeSynonyms) ctors + ctors <- traverse (traverse $ traverse replaceAllTypeSynonyms) tiCtors tcds <- getTypeClassDictionaries - let (ctorUsages, problemSpans) = runWriter $ traverse (traverse . traverse $ typeToUsageOf tcds (maybe That These mbLParam param) False) ctors' + let (ctorUsages, problemSpans) = runWriter $ traverse (traverse . traverse $ typeToUsageOf tcds tiArgSubst (maybe That These mbLParam param) False) ctors let relatedClasses = [monoClass, biClass] ++ ([contraClass, proClass] <*> (contravariantClasses <$> toList contravarianceSupport)) for_ (nonEmpty $ ordNub problemSpans) $ \sss -> throwError . addHint (RelatedPositions sss) . errorMessage $ CannotDeriveInvalidConstructorArg derivingClass relatedClasses (isJust contravarianceSupport) pure ctorUsages where - typeToUsageOf :: InstanceContext -> These Text Text -> Bool -> SourceType -> Writer [SourceSpan] (Maybe (ParamUsage c)) - typeToUsageOf tcds = fix $ \go params isNegative -> let + typeToUsageOf :: InstanceContext -> [(Text, SourceType)] -> These Text Text -> Bool -> SourceType -> Writer [SourceSpan] (Maybe (ParamUsage c)) + typeToUsageOf tcds subst = fix $ \go params isNegative -> let goCo = go params isNegative goContra = go params $ not isNegative @@ -482,6 +495,9 @@ validateParamsInTypeConstructors derivingClass mn tyConNm isBi CovariantClasses{ | otherwise = assertNoParamUsedIn tyArg $> Nothing + headOfTypeWithSubst :: SourceType -> Qualified (Either Text (ProperName 'TypeName)) + headOfTypeWithSubst = headOfType . replaceAllTypeVars subst + in \case ForAll _ name _ ty _ -> fmap join . traverse (\params' -> go params' isNegative ty) $ filterThese (/= name) params @@ -494,10 +510,10 @@ validateParamsInTypeConstructors derivingClass mn tyConNm isBi CovariantClasses{ fmap (lbl, ) <$> goCo ty TypeApp _ (TypeApp _ tyFn tyLArg) tyArg -> - assertNoParamUsedIn tyFn *> tryBiClasses (headOfType tyFn) tyLArg tyArg + assertNoParamUsedIn tyFn *> tryBiClasses (headOfTypeWithSubst tyFn) tyLArg tyArg TypeApp _ tyFn tyArg -> - assertNoParamUsedIn tyFn *> tryMonoClasses (headOfType tyFn) tyArg + assertNoParamUsedIn tyFn *> tryMonoClasses (headOfTypeWithSubst tyFn) tyArg TypeVar (ss, _) name -> mergeTheseWith (checkName lparamIsContra IsLParam) (checkName paramIsContra IsParam) (liftA2 (<|>)) params where @@ -636,17 +652,16 @@ deriveFunctor -> Bool -- is the (right) parameter contravariant? -> PSString -- name of the map function for this functor type -> Qualified (ProperName 'ClassName) - -> ModuleName - -> ProperName 'TypeName + -> UnwrappedTypeConstructor -> m [(PSString, Expr)] -deriveFunctor mbLParamIsContravariant paramIsContravariant mapName nm mn tyConNm = do - ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi functorClasses $ Just $ ContravarianceSupport +deriveFunctor mbLParamIsContravariant paramIsContravariant mapName nm utc = do + ctors <- validateParamsInTypeConstructors nm utc isBi functorClasses $ Just $ ContravarianceSupport { contravarianceWitness = () , paramIsContravariant , lparamIsContravariant = or mbLParamIsContravariant , contravariantClasses } - mapFun <- mkTraversal mn isBi mapExprs (const cmapExprs) (TraversalOps identity identity) ctors + mapFun <- mkTraversal (utcModuleName utc) isBi mapExprs (const cmapExprs) (TraversalOps identity identity) ctors pure [(mapName, mapFun)] where isBi = isJust mbLParamIsContravariant @@ -681,11 +696,10 @@ deriveFoldable => MonadSupply m => Bool -- is there a left parameter (are we deriving Bifoldable)? -> Qualified (ProperName 'ClassName) - -> ModuleName - -> ProperName 'TypeName + -> UnwrappedTypeConstructor -> m [(PSString, Expr)] -deriveFoldable isBi nm mn tyConNm = do - ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi foldableClasses Nothing +deriveFoldable isBi nm utc = do + ctors <- validateParamsInTypeConstructors nm utc isBi foldableClasses Nothing foldlFun <- mkAsymmetricFoldFunction False foldlExprs ctors foldrFun <- mkAsymmetricFoldFunction True foldrExprs ctors foldMapFun <- mkTraversal mn isBi foldMapExprs absurd foldMapOps ctors @@ -695,6 +709,7 @@ deriveFoldable isBi nm mn tyConNm = do , (if isBi then Libs.S_bifoldMap else Libs.S_foldMap, foldMapFun) ] where + mn = utcModuleName utc foldableClasses = CovariantClasses Libs.Foldable Libs.Bifoldable foldlExprs = TraversalExprs { recurseVar = mkRef Libs.I_foldl @@ -778,12 +793,11 @@ deriveTraversable => MonadSupply m => Bool -- is there a left parameter (are we deriving Bitraversable)? -> Qualified (ProperName 'ClassName) - -> ModuleName - -> ProperName 'TypeName + -> UnwrappedTypeConstructor -> m [(PSString, Expr)] -deriveTraversable isBi nm mn tyConNm = do - ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi traversableClasses Nothing - traverseFun <- mkTraversal mn isBi traverseExprs absurd traverseOps ctors +deriveTraversable isBi nm utc = do + ctors <- validateParamsInTypeConstructors nm utc isBi traversableClasses Nothing + traverseFun <- mkTraversal (utcModuleName utc) isBi traverseExprs absurd traverseOps ctors sequenceFun <- usingLamIdent $ pure . App (App (if isBi then App bitraverseVar identityVar else traverseVar) identityVar) pure [ (if isBi then Libs.S_bitraverse else Libs.S_traverse, traverseFun) diff --git a/tests/purs/passing/4431-2.purs b/tests/purs/passing/4431-2.purs new file mode 100644 index 0000000000..5d0d9823d6 --- /dev/null +++ b/tests/purs/passing/4431-2.purs @@ -0,0 +1,12 @@ +module Main where + +import Prelude +import Data.Const (Const) +import Effect.Console (log) + +data TypedCache :: (Type -> Type) -> Type -> Type +data TypedCache key a = Get (key a) + +derive instance Functor (TypedCache (Const k)) + +main = log "Done" diff --git a/tests/purs/passing/4431.purs b/tests/purs/passing/4431.purs new file mode 100644 index 0000000000..682117ef52 --- /dev/null +++ b/tests/purs/passing/4431.purs @@ -0,0 +1,11 @@ +module Main where + +import Prelude +import Effect.Console (log) + +data TypedCache :: (Type -> Type) -> Type -> Type +data TypedCache key a = Get (key a) + +derive instance Functor k => Functor (TypedCache k) + +main = log "Done" From 7a5b2b81374b0ad48be1482fd5b1d7d02bff02ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edvard=20Th=C3=B6rnros?= Date: Wed, 1 Feb 2023 15:35:38 +0100 Subject: [PATCH 14/68] Mention which row label the type error occurs on (#4411) Keep track of row labels as hints when recursing during unification and subsumption. --- .../fix_add-labels-in-type-mismatch-errors.md | 1 + CONTRIBUTORS.md | 1 + src/Language/PureScript/AST/Declarations.hs | 1 + src/Language/PureScript/Errors.hs | 6 ++++ .../PureScript/TypeChecker/Entailment.hs | 4 +-- .../TypeChecker/Entailment/Coercible.hs | 2 +- src/Language/PureScript/TypeChecker/Kinds.hs | 3 +- .../PureScript/TypeChecker/Subsumption.hs | 4 ++- src/Language/PureScript/TypeChecker/Unify.hs | 4 ++- src/Language/PureScript/Types.hs | 11 +++--- .../failing/NestedRecordLabelOnTypeError.out | 34 +++++++++++++++++++ .../failing/NestedRecordLabelOnTypeError.purs | 8 +++++ tests/purs/failing/RecordLabelOnTypeError.out | 26 ++++++++++++++ .../purs/failing/RecordLabelOnTypeError.purs | 8 +++++ .../RecordLabelOnTypeErrorImmediate.out | 22 ++++++++++++ .../RecordLabelOnTypeErrorImmediate.purs | 5 +++ 16 files changed, 129 insertions(+), 11 deletions(-) create mode 100644 CHANGELOG.d/fix_add-labels-in-type-mismatch-errors.md create mode 100644 tests/purs/failing/NestedRecordLabelOnTypeError.out create mode 100644 tests/purs/failing/NestedRecordLabelOnTypeError.purs create mode 100644 tests/purs/failing/RecordLabelOnTypeError.out create mode 100644 tests/purs/failing/RecordLabelOnTypeError.purs create mode 100644 tests/purs/failing/RecordLabelOnTypeErrorImmediate.out create mode 100644 tests/purs/failing/RecordLabelOnTypeErrorImmediate.purs diff --git a/CHANGELOG.d/fix_add-labels-in-type-mismatch-errors.md b/CHANGELOG.d/fix_add-labels-in-type-mismatch-errors.md new file mode 100644 index 0000000000..f658f51f9a --- /dev/null +++ b/CHANGELOG.d/fix_add-labels-in-type-mismatch-errors.md @@ -0,0 +1 @@ + * Outputs what label the type-error occurred on when types don't match diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 9c62eee433..d029c433af 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -160,6 +160,7 @@ If you would prefer to use different terms, please use the section below instead | [@sd-yip](https://github.com/sd-yip) | Nicholas Yip | [MIT license](http://opensource.org/licenses/MIT) | | [@j-nava](https://github.com/j-nava) | Jesse Nava | [MIT license](http://opensource.org/licenses/MIT) | | [@imcotton](https://github.com/imcotton) | Cotton Hou | [MIT license](http://opensource.org/licenses/MIT) | +| [@FredTheDino](https://github.com/FredTheDino) | Edvard Thörnros | [MIT license](http://opensource.org/licenses/MIT) | | [@wclr](https://github.com/wclr) | Alex Osh | [MIT license](http://opensource.org/licenses/MIT) | | [@Deltaspace0](https://github.com/Deltaspace0) | Ruslan Gadeev | [MIT license](http://opensource.org/licenses/MIT) | diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs index 2ac1ee1ded..87490404d2 100644 --- a/src/Language/PureScript/AST/Declarations.hs +++ b/src/Language/PureScript/AST/Declarations.hs @@ -66,6 +66,7 @@ data ErrorMessageHint | ErrorInModule ModuleName | ErrorInInstance (Qualified (ProperName 'ClassName)) [SourceType] | ErrorInSubsumption SourceType SourceType + | ErrorInRowLabel Label | ErrorCheckingAccessor Expr PSString | ErrorCheckingType Expr SourceType | ErrorCheckingKind SourceType SourceType diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 3302625670..824d5d0b7b 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -1433,6 +1433,12 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon , markCodeBox $ typeAsBox prettyDepth t2 ] ] + renderHint (ErrorInRowLabel lb) detail = + paras [ detail + , Box.hsep 1 Box.top [ line "while matching label" + , markCodeBox $ line $ prettyPrintObjectKey (runLabel lb) + ] + ] renderHint (ErrorInInstance nm ts) detail = paras [ detail , line "in type class instance" diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index d5b315d490..393f637b6a 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -751,7 +751,7 @@ matches deps TypeClassDictionaryInScope{..} tys = typeHeadsAreEqual r1@RCons{} r2@RCons{} = foldr both (uncurry go rest) common where - (common, rest) = alignRowsWith typeHeadsAreEqual r1 r2 + (common, rest) = alignRowsWith (const typeHeadsAreEqual) r1 r2 go :: ([RowListItem a], Type a) -> ([RowListItem a], Type a) -> (Matched (), Matching [Type a]) go (l, KindedType _ t1 _) (r, t2) = go (l, t1) (r, t2) @@ -796,7 +796,7 @@ matches deps TypeClassDictionaryInScope{..} tys = typesAreEqual (KindApp _ h1 t1) (KindApp _ h2 t2) = typesAreEqual h1 h2 <> typesAreEqual t1 t2 typesAreEqual (REmpty _) (REmpty _) = Match () typesAreEqual r1 r2 | isRCons r1 || isRCons r2 = - let (common, rest) = alignRowsWith typesAreEqual r1 r2 + let (common, rest) = alignRowsWith (const typesAreEqual) r1 r2 in fold common <> uncurry go rest where go :: ([RowListItem a], Type a) -> ([RowListItem a], Type a) -> Matched () diff --git a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs index d69e3cc7f6..301e4b6e8d 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs @@ -584,7 +584,7 @@ canonRow -> MaybeT m Canonicalized canonRow a b | RCons{} <- a = - case alignRowsWith (,) a b of + case alignRowsWith (const (,)) a b of -- We throw early when a bare unknown remains on either side after -- aligning the rows because we don't know how to canonicalize them yet -- and the unification error thrown when the rows are misaligned should diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs index e9ddf6cd31..56dc95aa06 100644 --- a/src/Language/PureScript/TypeChecker/Kinds.hs +++ b/src/Language/PureScript/TypeChecker/Kinds.hs @@ -419,6 +419,7 @@ unifyKindsWithFailure -> m () unifyKindsWithFailure onFailure = go where + goWithLabel l t1 t2 = withErrorMessageHint (ErrorInRowLabel l) $ go t1 t2 go = curry $ \case (TypeApp _ p1 p2, TypeApp _ p3 p4) -> do go p1 p3 @@ -444,7 +445,7 @@ unifyKindsWithFailure onFailure = go onFailure w1 w2 unifyRows r1 r2 = do - let (matches, rest) = alignRowsWith go r1 r2 + let (matches, rest) = alignRowsWith goWithLabel r1 r2 sequence_ matches unifyTails rest diff --git a/src/Language/PureScript/TypeChecker/Subsumption.hs b/src/Language/PureScript/TypeChecker/Subsumption.hs index be6e9f292c..8fdd798990 100644 --- a/src/Language/PureScript/TypeChecker/Subsumption.hs +++ b/src/Language/PureScript/TypeChecker/Subsumption.hs @@ -103,7 +103,8 @@ subsumes' SElaborate (ConstrainedType _ con ty1) ty2 = do let addDicts val = App val (TypeClassDictionary con dicts hints) return (elaborate . addDicts) subsumes' mode (TypeApp _ f1 r1) (TypeApp _ f2 r2) | eqType f1 tyRecord && eqType f2 tyRecord = do - let (common, ((ts1', r1'), (ts2', r2'))) = alignRowsWith (subsumes' SNoElaborate) r1 r2 + let goWithLabel l t1 t2 = withErrorMessageHint (ErrorInRowLabel l) $ subsumes' SNoElaborate t1 t2 + let (common, ((ts1', r1'), (ts2', r2'))) = alignRowsWith goWithLabel r1 r2 -- For { ts1 | r1 } to subsume { ts2 | r2 } when r1 is empty (= we're working with a closed row), -- every property in ts2 must appear in ts1. If not, then the candidate expression is missing a required property. -- Conversely, when r2 is empty, every property in ts1 must appear in ts2, or else the expression has @@ -114,6 +115,7 @@ subsumes' mode (TypeApp _ f1 r1) (TypeApp _ f2 r2) | eqType f1 tyRecord && eqTyp (for_ (firstMissingProp ts1' ts2') (throwError . errorMessage . AdditionalProperty . rowListLabel)) -- Check subsumption for common labels sequence_ common + -- Inject the info here unifyTypes (rowFromList (ts1', r1')) (rowFromList (ts2', r2')) -- Nothing was elaborated, return the default coercion return (defaultCoercion mode) diff --git a/src/Language/PureScript/TypeChecker/Unify.hs b/src/Language/PureScript/TypeChecker/Unify.hs index 38e181b365..1d59876d88 100644 --- a/src/Language/PureScript/TypeChecker/Unify.hs +++ b/src/Language/PureScript/TypeChecker/Unify.hs @@ -162,7 +162,9 @@ unifyTypes t1 t2 = do -- trailing row unification variable, if appropriate. unifyRows :: forall m. (MonadError MultipleErrors m, MonadState CheckState m) => SourceType -> SourceType -> m () unifyRows r1 r2 = sequence_ matches *> uncurry unifyTails rest where - (matches, rest) = alignRowsWith unifyTypes r1 r2 + unifyTypesWithLabel l t1 t2 = withErrorMessageHint (ErrorInRowLabel l) $ unifyTypes t1 t2 + + (matches, rest) = alignRowsWith unifyTypesWithLabel r1 r2 unifyTails :: ([RowListItem SourceAnn], SourceType) -> ([RowListItem SourceAnn], SourceType) -> m () unifyTails ([], TUnknown _ u) (sd, r) = solveType u (rowFromList (sd, r)) diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs index 6e394cd980..b9f2463aab 100644 --- a/src/Language/PureScript/Types.hs +++ b/src/Language/PureScript/Types.hs @@ -443,7 +443,7 @@ rowFromList (xs, r) = foldr (\(RowListItem ann name ty) -> RCons ann name ty) r -- -- Note: importantly, we preserve the order of the types with a given label. alignRowsWith - :: (Type a -> Type a -> r) + :: (Label -> Type a -> Type a -> r) -> Type a -> Type a -> ([r], (([RowListItem a], Type a), ([RowListItem a], Type a))) @@ -453,10 +453,11 @@ alignRowsWith f ty1 ty2 = go s1 s2 where go [] r = ([], (([], tail1), (r, tail2))) go r [] = ([], ((r, tail1), ([], tail2))) - go lhs@(RowListItem a1 l1 t1 : r1) rhs@(RowListItem a2 l2 t2 : r2) - | l1 < l2 = (second . first . first) (RowListItem a1 l1 t1 :) (go r1 rhs) - | l2 < l1 = (second . second . first) (RowListItem a2 l2 t2 :) (go lhs r2) - | otherwise = first (f t1 t2 :) (go r1 r2) + go lhs@(RowListItem a1 l1 t1 : r1) rhs@(RowListItem a2 l2 t2 : r2) = + case compare l1 l2 of + LT -> (second . first . first) (RowListItem a1 l1 t1 :) (go r1 rhs) + GT -> (second . second . first) (RowListItem a2 l2 t2 :) (go lhs r2) + EQ -> first (f l1 t1 t2 :) (go r1 r2) -- | Check whether a type is a monotype isMonoType :: Type a -> Bool diff --git a/tests/purs/failing/NestedRecordLabelOnTypeError.out b/tests/purs/failing/NestedRecordLabelOnTypeError.out new file mode 100644 index 0000000000..911ad038f4 --- /dev/null +++ b/tests/purs/failing/NestedRecordLabelOnTypeError.out @@ -0,0 +1,34 @@ +Error found: +in module NestedRecordLabelOnTypeError +at tests/purs/failing/NestedRecordLabelOnTypeError.purs:8:9 - 8:15 (line 8, column 9 - line 8, column 15) + + Could not match type +   +  Int +   + with type +   +  String +   + +while matching label c +while matching label b +while matching label a +while checking that type { a :: { b :: { c :: Int +  }  +  }  + }  + is at least as general as type { a :: { b :: { c :: String +  }  +  }  + }  +while checking that expression record + has type { a :: { b :: { c :: String +  }  +  }  + }  +in value declaration error + +See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/NestedRecordLabelOnTypeError.purs b/tests/purs/failing/NestedRecordLabelOnTypeError.purs new file mode 100644 index 0000000000..b91481cbe2 --- /dev/null +++ b/tests/purs/failing/NestedRecordLabelOnTypeError.purs @@ -0,0 +1,8 @@ +-- @shouldFailWith TypesDoNotUnify +module NestedRecordLabelOnTypeError where + +record :: { a :: { b :: { c :: Int } } } +record = { a: { b: { c: 1 } } } + +error :: { a :: { b :: { c :: String } } } +error = record -- this should trigger an error, telling us there's a mismatch in the field `a > b > c` diff --git a/tests/purs/failing/RecordLabelOnTypeError.out b/tests/purs/failing/RecordLabelOnTypeError.out new file mode 100644 index 0000000000..78088babe2 --- /dev/null +++ b/tests/purs/failing/RecordLabelOnTypeError.out @@ -0,0 +1,26 @@ +Error found: +in module RecordLabelOnTypeError +at tests/purs/failing/RecordLabelOnTypeError.purs:8:5 - 8:6 (line 8, column 5 - line 8, column 6) + + Could not match type +   +  Int +   + with type +   +  String +   + +while matching label field +while checking that type { field :: Int + }  + is at least as general as type { field :: String + }  +while checking that expression a + has type { field :: String + }  +in value declaration b + +See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/RecordLabelOnTypeError.purs b/tests/purs/failing/RecordLabelOnTypeError.purs new file mode 100644 index 0000000000..8c8fb5ce13 --- /dev/null +++ b/tests/purs/failing/RecordLabelOnTypeError.purs @@ -0,0 +1,8 @@ +-- @shouldFailWith TypesDoNotUnify +module RecordLabelOnTypeError where + +a :: { field :: Int } +a = { field: 1 } + +b :: { field :: String } +b = a -- this should trigger an error, telling us the `field` tag where the type discrepancy happened diff --git a/tests/purs/failing/RecordLabelOnTypeErrorImmediate.out b/tests/purs/failing/RecordLabelOnTypeErrorImmediate.out new file mode 100644 index 0000000000..d846482602 --- /dev/null +++ b/tests/purs/failing/RecordLabelOnTypeErrorImmediate.out @@ -0,0 +1,22 @@ +Error found: +in module NestedRecordLabelOnTypeError +at tests/purs/failing/RecordLabelOnTypeErrorImmediate.purs:5:15 - 5:18 (line 5, column 15 - line 5, column 18) + + Could not match type +   +  String +   + with type +   +  Int +   + +while checking that type String + is at least as general as type Int +while checking that expression "a" + has type Int +in value declaration record + +See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/RecordLabelOnTypeErrorImmediate.purs b/tests/purs/failing/RecordLabelOnTypeErrorImmediate.purs new file mode 100644 index 0000000000..02333b244b --- /dev/null +++ b/tests/purs/failing/RecordLabelOnTypeErrorImmediate.purs @@ -0,0 +1,5 @@ +-- @shouldFailWith TypesDoNotUnify +module NestedRecordLabelOnTypeError where + +record :: { a :: Int } +record = { a: "a" } -- Triggers an error, but the label is explicitly not added since it caused other errors to be worse. See https://github.com/purescript/purescript/pull/4411 for more information. From 4cdf6df1dd28fa941979ea5fda8d4c830c3ffde6 Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Sat, 4 Feb 2023 11:32:14 +0700 Subject: [PATCH 15/68] Depend on `hspec-2.10.9` (#4435) --- purescript.cabal | 2 +- stack.yaml | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/purescript.cabal b/purescript.cabal index cefdd51b3c..b426757e8a 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -438,7 +438,7 @@ test-suite tests build-depends: purescript, generic-random >=1.5.0.1 && <1.6, - hspec ==2.9.2, + hspec >= 2.10.7 && < 3, HUnit >=1.6.2.0 && <1.7, newtype >=0.2.2.0 && <0.3, QuickCheck >=2.14.2 && <2.15, diff --git a/stack.yaml b/stack.yaml index 397fc5894a..268c062a08 100644 --- a/stack.yaml +++ b/stack.yaml @@ -20,13 +20,15 @@ extra-deps: - Cabal-3.6.3.0 # Protolude is not yet in resolver snapshot - protolude-0.3.1 -# hspec@2.9.3 is the first version that starts depending on ghc +# hspec versions 2.9.3 to 2.10.6 depend on ghc # ghc depends on terminfo by default, but that can be ignored # if one uses the '-terminfo' flag. # Unfortunately, hspec doesn't expose a similar flag. -- hspec-2.9.2 -- hspec-core-2.9.2 -- hspec-discover-2.9.2 +# +# Using hspec >= 2.10.7 addresses this. +- hspec-2.10.9 +- hspec-core-2.10.9 +- hspec-discover-2.10.9 nix: packages: - zlib From 7e448730da86c7e6605647fde54aff5227968348 Mon Sep 17 00:00:00 2001 From: Andy Date: Sun, 5 Feb 2023 08:11:06 +0100 Subject: [PATCH 16/68] Upgrade to GHC 9.2.5 (#4433) Co-authored-by: purefunctor --- .github/workflows/ci.yml | 6 +++--- CHANGELOG.d/misc_bump-ghc.md | 1 + CONTRIBUTORS.md | 1 + INSTALL.md | 4 ++-- stack.yaml | 4 +--- 5 files changed, 8 insertions(+), 8 deletions(-) create mode 100644 CHANGELOG.d/misc_bump-ghc.md diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c12699776e..6500158fa6 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -15,7 +15,7 @@ defaults: env: CI_PRERELEASE: "${{ github.event_name == 'push' }}" CI_RELEASE: "${{ github.event_name == 'release' }}" - STACK_VERSION: "2.9.1" + STACK_VERSION: "2.9.3" concurrency: # We never want two prereleases building at the same time, since they would @@ -38,7 +38,7 @@ jobs: include: - # If upgrading the Haskell image, also upgrade it in the lint job below os: "ubuntu-latest" - image: haskell:9.2.4@sha256:dceec00f8ad896c327c2b5c77ba91c9824bf3e26a837f538ccfb80fb379dc52f + image: haskell:9.2.5@sha256:2597b0e2458165a6635906204f7fac43c22e7d2a46aca1235a811194bb6cd419 - os: "macOS-11" - os: "windows-2019" @@ -172,7 +172,7 @@ jobs: # means our published binaries will work on the widest number of platforms. # But the HLint binary downloaded by this job requires a newer glibc # version. - container: haskell:9.2.4@sha256:dceec00f8ad896c327c2b5c77ba91c9824bf3e26a837f538ccfb80fb379dc52f + container: haskell:9.2.5@sha256:2597b0e2458165a6635906204f7fac43c22e7d2a46aca1235a811194bb6cd419 steps: - # We need a proper Git repository, but the checkout step will unpack a tarball instead of doing a clone diff --git a/CHANGELOG.d/misc_bump-ghc.md b/CHANGELOG.d/misc_bump-ghc.md new file mode 100644 index 0000000000..165ac355c5 --- /dev/null +++ b/CHANGELOG.d/misc_bump-ghc.md @@ -0,0 +1 @@ +* Bump Stackage snapshot to lts-20.9 and GHC to 9.2.5 diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index d029c433af..a2c3142b83 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -19,6 +19,7 @@ If you would prefer to use different terms, please use the section below instead | [@alexbiehl](https://github.com/alexbiehl) | Alexander Biehl | [MIT license](http://opensource.org/licenses/MIT) | | [@andreypopp](https://github.com/andreypopp) | Andrey Popp | MIT license | | [@andyarvanitis](https://github.com/andyarvanitis) | Andy Arvanitis | [MIT license](http://opensource.org/licenses/MIT) | +| [@andys8](https://github.com/andys8) | andys8 | [MIT license](http://opensource.org/licenses/MIT) | | [@anthok88](https://github.com/anthok88) | anthoq88 | MIT license | | [@ardumont](https://github.com/ardumont) | Antoine R. Dumont | [MIT license](http://opensource.org/licenses/MIT) | | [@arrowd](https://github.com/arrowd) | Gleb Popov | [MIT license](http://opensource.org/licenses/MIT) | diff --git a/INSTALL.md b/INSTALL.md index d928501371..041cd3315d 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -4,12 +4,12 @@ If you are having difficulty installing the PureScript compiler, feel free to as ## Requirements -The PureScript compiler is built using GHC 9.2.4, and should be able to run on any operating system supported by GHC 9.2.4. In particular: +The PureScript compiler is built using GHC 9.2.5, and should be able to run on any operating system supported by GHC 9.2.5. In particular: * for Windows users, versions predating Vista are not officially supported, * for macOS / OS X users, versions predating Mac OS X 10.7 (Lion) are not officially supported. -See also for more details about the operating systems which GHC 9.2.4 supports. +See also for more details about the operating systems which GHC 9.2.5 supports. ## Official prebuilt binaries diff --git a/stack.yaml b/stack.yaml index 268c062a08..cbf7426e01 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,6 @@ # Please update Haskell image versions under .github/workflows/ci.yml together to use the same GHC version # (or the CI build will fail) -resolver: nightly-2022-11-12 +resolver: lts-20.9 pvp-bounds: both packages: - '.' @@ -18,8 +18,6 @@ extra-deps: - process-1.6.13.1 # The Cabal library is not in Stackage - Cabal-3.6.3.0 -# Protolude is not yet in resolver snapshot -- protolude-0.3.1 # hspec versions 2.9.3 to 2.10.6 depend on ghc # ghc depends on terminfo by default, but that can be ignored # if one uses the '-terminfo' flag. From 042150325abf842064877ce9268fbce8df029e64 Mon Sep 17 00:00:00 2001 From: Andy Date: Sun, 5 Feb 2023 09:51:45 +0100 Subject: [PATCH 17/68] Single link reference to MIT license (#4434) --- CONTRIBUTORS.md | 325 ++++++++++++++++++++++++------------------------ 1 file changed, 164 insertions(+), 161 deletions(-) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index a2c3142b83..a4ad8416af 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -14,178 +14,181 @@ If you would prefer to use different terms, please use the section below instead | Username | Name | License | | :------- | :--- | :------ | -| [@5outh](https://github.com/5outh) | Benjamin Kovach | MIT license | -| [@actionshrimp](https://github.com/actionshrimp) | David Aitken | [MIT license](http://opensource.org/licenses/MIT) | -| [@alexbiehl](https://github.com/alexbiehl) | Alexander Biehl | [MIT license](http://opensource.org/licenses/MIT) | -| [@andreypopp](https://github.com/andreypopp) | Andrey Popp | MIT license | -| [@andyarvanitis](https://github.com/andyarvanitis) | Andy Arvanitis | [MIT license](http://opensource.org/licenses/MIT) | -| [@andys8](https://github.com/andys8) | andys8 | [MIT license](http://opensource.org/licenses/MIT) | -| [@anthok88](https://github.com/anthok88) | anthoq88 | MIT license | -| [@ardumont](https://github.com/ardumont) | Antoine R. Dumont | [MIT license](http://opensource.org/licenses/MIT) | -| [@arrowd](https://github.com/arrowd) | Gleb Popov | [MIT license](http://opensource.org/licenses/MIT) | -| [@aspidites](https://github.com/aspidites) | Edwin Marshall | [MIT license](http://opensource.org/licenses/MIT) | -| [@bagl](https://github.com/bagl) | Petr Vapenka | [MIT license](http://opensource.org/licenses/MIT) | -| [@balajirrao](https://github.com/balajirrao) | Balaji Rao | MIT license | -| [@bbqbaron](https://github.com/bbqbaron) | Eric Loren | [MIT license](http://opensource.org/licenses/MIT) | -| [@bergmark](https://github.com/bergmark) | Adam Bergmark | MIT license | -| [@bitemyapp](https://github.com/bitemyapp) | Chris Allen | [MIT license](http://opensource.org/licenses/MIT) | -| [@bmjames](https://github.com/bmjames) | Ben James | [MIT license](http://opensource.org/licenses/MIT) | -| [@Bogdanp](https://github.com/Bogdanp) | Bogdan Paul Popa | [MIT license](http://opensource.org/licenses/MIT) | -| [@brandonhamilton](https://github.com/brandonhamilton) | Brandon Hamilton | [MIT license](http://opensource.org/licenses/MIT) | -| [@bsermons](https://github.com/bsermons) | Brian Sermons | [MIT license](http://opensource.org/licenses/MIT) | -| [@cdepillabout](https://github.com/cdepillabout) | Dennis Gosnell | [MIT license](http://opensource.org/licenses/MIT) | -| [@chexxor](https://github.com/chexxor) | Alex Berg | [MIT license](http://opensource.org/licenses/MIT) | -| [@chrisdone](https://github.com/chrisdone) | Chris Done | MIT license | -| [@cmdv](https://github.com/cmdv) | Vincent Orr | MIT license | -| [@codedmart](https://github.com/codedmart) | Brandon Martin | [MIT license](http://opensource.org/licenses/MIT) | -| [@coot](https://github.com/coot) | Marcin Szamotulski | [MIT license](http://opensource.org/licenses/MIT) | -| [@davidchambers](https://github.com/davidchambers) | David Chambers | [MIT license](http://opensource.org/licenses/MIT) | -| [@DavidLindbom](https://github.com/DavidLindbom) | David Lindbom | [MIT license](http://opensource.org/licenses/MIT) | -| [@dckc](https://github.com/dckc) | Dan Connolly | [MIT license](http://opensource.org/licenses/MIT) | -| [@kleeneplus](https://github.com/dgendill) | Dominick Gendill | [MIT license](http://opensource.org/licenses/MIT) | -| [@ealmansi](https://github.com/ealmansi) | Emilio Almansi | MIT license | -| [@eamelink](https://github.com/eamelink) | Erik Bakker | MIT license | -| [@EMattfolk](https://github.com/EMattfolk) | Erik Mattfolk | [MIT license](http://opensource.org/licenses/MIT) | -| [@epost](https://github.com/epost) | Erik Post | MIT license | -| [@erdeszt](https://github.com/erdeszt) | Tibor Erdesz | [MIT license](http://opensource.org/licenses/MIT) | -| [@etrepum](https://github.com/etrepum) | Bob Ippolito | [MIT license](http://opensource.org/licenses/MIT) | -| [@faineance](https://github.com/faineance) | faineance | [MIT license](http://opensource.org/licenses/MIT) | -| [@fehrenbach](https://github.com/fehrenbach) | Stefan Fehrenbach | [MIT license](http://opensource.org/licenses/MIT) | -| [@felixSchl](https://github.com/felixSchl) | Felix Schlitter | [MIT license](http://opensource.org/licenses/MIT) | -| [@FrigoEU](https://github.com/FrigoEU) | Simon Van Casteren | [MIT license](http://opensource.org/licenses/MIT) | -| [@fsoikin](https://github.com/fsoikin) | Fyodor Soikin | [MIT license](http://opensource.org/licenses/MIT) | -| [@f-f](https://github.com/f-f) | Fabrizio Ferrai | [MIT license](http://opensource.org/licenses/MIT) | -| [@garyb](https://github.com/garyb) | Gary Burgess | [MIT license](http://opensource.org/licenses/MIT) | -| [@hdgarrood](https://github.com/hdgarrood) | Harry Garrood | [MIT license](http://opensource.org/licenses/MIT) | -| [@houli](https://github.com/houli) | Eoin Houlihan | [MIT license](http://opensource.org/licenses/MIT) | -| [@ianbollinger](https://github.com/ianbollinger) | Ian D. Bollinger | [MIT license](http://opensource.org/licenses/MIT) | -| [@ilovezfs](https://github.com/ilovezfs) | ilovezfs | MIT license | -| [@i-am-tom](https://github.com/i-am-tom) | i-am-tom | [MIT license](http://opensource.org/licenses/MIT) | -| [@izgzhen](https://github.com/izgzhen) | Zhen Zhang | [MIT license](http://opensource.org/licenses/MIT) | -| [@jacereda](https://github.com/jacereda) | Jorge Acereda | [MIT license](http://opensource.org/licenses/MIT) | -| [@japesinator](https://github.com/japesinator) | JP Smith | [MIT license](http://opensource.org/licenses/MIT) | -| [@jkachmar](https://github.com/jkachmar) | Joe Kachmar | MIT license | -| [@joneshf](https://github.com/joneshf) | Hardy Jones | MIT license | -| [@jy14898](https://github.com/jy14898) | Joseph Young | MIT license | -| [@kika](https://github.com/kika) | Kirill Pertsev | MIT license | -| [@kRITZCREEK](https://github.com/kRITZCREEK) | Christoph Hegemann | MIT license | -| [@L8D](https://github.com/L8D) | Tenor Biel | [MIT license](http://opensource.org/licenses/MIT) | -| [@legrostdg](https://github.com/legrostdg) | Félix Sipma | [MIT license](http://opensource.org/licenses/MIT) | -| [@LiamGoodacre](https://github.com/LiamGoodacre) | Liam Goodacre | [MIT license](http://opensource.org/licenses/MIT) | -| [@lukerandall](https://github.com/lukerandall) | Luke Randall | [MIT license](http://opensource.org/licenses/MIT) | -| [@lunaris](https://github.com/lunaris) | Will Jones | [MIT license](http://opensource.org/licenses/MIT) | -| [@matthewleon](https://github.com/matthewleon) | Matthew Leon | [MIT license](http://opensource.org/licenses/MIT) | -| [@mcoffin](https://github.com/mcoffin) | Matt Coffin | [MIT license](http://opensource.org/licenses/MIT) | -| [@mhcurylo](https://github.com/mhcurylo) | Mateusz Curylo | [MIT license](http://opensource.org/licenses/MIT) | -| [@mikesol](https://github.com/mikesol) | Mike Solomon | [MIT license](http://opensource.org/licenses/MIT) | -| [@MiracleBlue](https://github.com/MiracleBlue) | Nicholas Kircher | [MIT license](http://opensource.org/licenses/MIT) | -| [@mrkgnao](https://github.com/mrkgnao) | Soham Chowdhury | [MIT license](http://opensource.org/licenses/MIT) | -| [@mgmeier](https://github.com/mgmeier) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) | -| [@michaelficarra](https://github.com/michaelficarra) | Michael Ficarra | [MIT license](http://opensource.org/licenses/MIT) | -| [@MichaelXavier](https://github.com/MichaelXavier) | Michael Xavier | MIT license | -| [@milesfrain](https://github.com/milesfrain) | Miles Frain | [MIT license](http://opensource.org/licenses/MIT) | -| [@mjgpy3](https://github.com/mjgpy3) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) | -| [@mpietrzak](https://github.com/mpietrzak) | Maciej Pietrzak | [MIT license](http://opensource.org/licenses/MIT) | -| [@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) | -| [@osa1](https://github.com/osa1) | Ömer Sinan Ağacan | MIT license | -| [@paf31](https://github.com/paf31) | Phil Freeman | [MIT license](http://opensource.org/licenses/MIT) | -| [@parsonsmatt](https://github.com/parsonsmatt) | Matt Parsons | [MIT license](http://opensource.org/licenses/MIT) | -| [@passy](https://github.com/passy) | Pascal Hartig | [MIT license](http://opensource.org/licenses/MIT) | -| [@paulyoung](https://github.com/paulyoung) | Paul Young | [MIT license](http://opensource.org/licenses/MIT) | -| [@pelotom](https://github.com/pelotom) | Thomas Crockett | [MIT license](http://opensource.org/licenses/MIT) | -| [@peterbecich](https://github.com/peterbecich) | Peter Becich | [MIT license](http://opensource.org/licenses/MIT) | -| [@phadej](https://github.com/phadej) | Oleg Grenrus | [MIT license](http://opensource.org/licenses/MIT) | -| [@phiggins](https://github.com/phiggins) | Pete Higgins | [MIT license](http://opensource.org/licenses/MIT) | -| [@philopon](https://github.com/philopon) | Hirotomo Moriwaki | [MIT license](http://opensource.org/licenses/MIT) | -| [@pseudonom](https://github.com/pseudonom) | Eric Easley | [MIT license](http://opensource.org/licenses/MIT) | -| [@ptrfrncsmrph](https://github.com/ptrfrncsmrph) | Peter Murphy | [MIT license](http://opensource.org/licenses/MIT) | -| [@quesebifurcan](https://github.com/quesebifurcan) | Fredrik Wallberg | [MIT license](http://opensource.org/licenses/MIT) | -| [@radrow](https://github.com/radrow) | Radosław Rowicki | [MIT license](http://opensource.org/licenses/MIT) | -| [@rhendric](https://github.com/rhendric) | Ryan Hendrickson | [MIT license](http://opensource.org/licenses/MIT) | -| [@rightfold](https://github.com/rightfold) | rightfold | [MIT license](https://opensource.org/licenses/MIT) | -| [@rndnoise](https://www.github.com/rndnoise) | rndnoise | [MIT license](http://opensource.org/licenses/MIT) | -| [@robdaemon](https://github.com/robdaemon) | Robert Roland | [MIT license](http://opensource.org/licenses/MIT) | -| [@RossMeikleham](https://github.com/RossMeikleham) | Ross Meikleham | [MIT license](http://opensource.org/licenses/MIT) | -| [@Rufflewind](https://github.com/Rufflewind) | Phil Ruffwind | [MIT license](https://opensource.org/licenses/MIT) | -| [@rvion](https://github.com/rvion) | Rémi Vion | [MIT license](http://opensource.org/licenses/MIT) | -| [@RyanGlScott](https://github.com/RyanGlScott) | Ryan Scott | [MIT license](http://opensource.org/licenses/MIT) | -| [@sebastiaanvisser](https://github.com/sebastiaanvisser) | Sebastiaan Visser | MIT license | -| [@sectore](https://github.com/sectore) | Jens Krause | [MIT license](http://opensource.org/licenses/MIT) | -| [@senju](https://github.com/senju) | senju | [MIT license](http://opensource.org/licenses/MIT) | -| [@seungha-kim](https://github.com/seungha-kim) | Seungha Kim | [MIT license](http://opensource.org/licenses/MIT) | -| [@simonyangme](https://github.com/simonyangme) | Simon Yang | [MIT license](http://opensource.org/licenses/MIT) | -| [@sharkdp](https://github.com/sharkdp) | David Peter | [MIT license](http://opensource.org/licenses/MIT) | -| [@soupi](https://github.com/soupi) | Gil Mizrahi | [MIT license](http://opensource.org/licenses/MIT) | -| [@stefanholzmueller](https://github.com/stefanholzmueller) | Stefan Holzmüller | [MIT license](http://opensource.org/licenses/MIT) | -| [@sztupi](https://github.com/sztupi) | Attila Sztupak | [MIT license](http://opensource.org/licenses/MIT) | -| [@taktoa](https://github.com/taktoa) | Remy Goldschmidt | [MIT license](http://opensource.org/licenses/MIT) | -| [@taku0](https://github.com/taku0) | taku0 | [MIT license](http://opensource.org/licenses/MIT) | -| [@tfausak](https://github.com/tfausak) | Taylor Fausak | [MIT license](http://opensource.org/licenses/MIT) | -| [@thoradam](https://github.com/thoradam) | Thor Adam | [MIT license](http://opensource.org/licenses/MIT) | -| [@tmcgilchrist](https://github.com/tmcgilchrist) | Tim McGilchrist | [MIT license](http://opensource.org/licenses/MIT) | -| [@trofi](https://github.com/trofi) | Sergei Trofimovich | [MIT license](http://opensource.org/licenses/MIT) | -| [@utkarshkukreti](https://github.com/utkarshkukreti) | Utkarsh Kukreti | [MIT license](http://opensource.org/licenses/MIT) | -| [@vkorablin](https://github.com/vkorablin) | Vladimir Korablin | MIT license | -| [@vladciobanu](https://github.com/vladciobanu) | Vladimir Ciobanu | [MIT license](http://opensource.org/licenses/MIT) | -| [@zudov](https://github.com/zudov) | Konstantin Zudov | [MIT license](http://opensource.org/licenses/MIT) | -| [@b123400](https://github.com/b123400) | b123400 | [MIT license](https://opensource.org/licenses/MIT) | -| [@kcsongor](https://github.com/kcsongor) | Csongor Kiss | [MIT license](http://opensource.org/licenses/MIT) | -| [@drets](https://github.com/drets) | Dmytro Rets | [MIT license](http://opensource.org/licenses/MIT) | -| [@bjornmelgaaard](https://github.com/BjornMelgaard) | Sergey Homa | [MIT license](http://opensource.org/licenses/MIT) | -| [@thimoteus](https://github.com/Thimoteus) | thimoteus | [MIT license](http://opensource.org/licenses/MIT) | -| [@sloosch](https://github.com/sloosch) | Simon Looschen | [MIT license](http://opensource.org/licenses/MIT) | -| [@rgrinberg](https://github.com/rgrinberg) | Rudi Grinberg | [MIT license](http://opensource.org/licenses/MIT) | -| [@gabejohnson](https://github.com/gabejohnson) | Gabe Johnson | [MIT license](http://opensource.org/licenses/MIT) | -| [@dariooddenino](https://github.com/dariooddenino) | Dario Oddenino | [MIT license](http://opensource.org/licenses/MIT) | -| [@jordanmartinez](https://github.com/jordanmartinez) | Jordan Martinez | [MIT license](http://opensource.org/licenses/MIT) | -| [@Saulukass](https://github.com/Saulukass) | Saulius Skliutas | [MIT license](http://opensource.org/licenses/MIT) | -| [@adnelson](https://github.com/adnelson) | Allen Nelson | [MIT license](http://opensource.org/licenses/MIT) | -| [@dyerw](https://github.com/dyerw) | Liam Dyer | [MIT license](http://opensource.org/licenses/MIT) | -| [@marcosh](https://github.com/marcosh) | Marco Perone | [MIT license](http://opensource.org/licenses/MIT) | -| [@matthew-hilty](https://github.com/matthew-hilty) | Matthew Hilty | [MIT license](http://opensource.org/licenses/MIT) | -| [@woody88](https://github.com/woody88) | Woodson Delhia | [MIT license](http://opensource.org/licenses/MIT) | -| [@mhmdanas](https://github.com/mhmdanas) | Mohammed Anas | [MIT license](http://opensource.org/licenses/MIT) | -| [@kl0tl](https://github.com/kl0tl) | Cyril Sobierajewicz | [MIT license](http://opensource.org/licenses/MIT) | -| [@PureFunctor](https://github.com/PureFunctor), [@sjpgarcia](https://github.com/sjpgarcia) | Justin Garcia | [MIT license](http://opensource.org/licenses/MIT) | -| [@xgrommx](https://github.com/xgrommx) | Denis Stoyanov | [MIT license](http://opensource.org/licenses/MIT) | -| [@MonoidMusician](https://github.com/MonoidMusician) | Verity Scheel | [MIT license](http://opensource.org/licenses/MIT) | -| [@thomashoneyman](https://github.com/thomashoneyman) | Thomas Honeyman | [MIT license](http://opensource.org/licenses/MIT) | -| [@sigma-andex](https://github.com/sigma-andex) | Jan Schulte | [MIT license](http://opensource.org/licenses/MIT) | -| [@i-am-the-slime](https://github.com/i-am-the-slime) | Mark Eibes | [MIT license](http://opensource.org/licenses/MIT) | -| [@sd-yip](https://github.com/sd-yip) | Nicholas Yip | [MIT license](http://opensource.org/licenses/MIT) | -| [@j-nava](https://github.com/j-nava) | Jesse Nava | [MIT license](http://opensource.org/licenses/MIT) | -| [@imcotton](https://github.com/imcotton) | Cotton Hou | [MIT license](http://opensource.org/licenses/MIT) | -| [@FredTheDino](https://github.com/FredTheDino) | Edvard Thörnros | [MIT license](http://opensource.org/licenses/MIT) | -| [@wclr](https://github.com/wclr) | Alex Osh | [MIT license](http://opensource.org/licenses/MIT) | -| [@Deltaspace0](https://github.com/Deltaspace0) | Ruslan Gadeev | [MIT license](http://opensource.org/licenses/MIT) | +| [@5outh](https://github.com/5outh) | Benjamin Kovach | [MIT license] | +| [@actionshrimp](https://github.com/actionshrimp) | David Aitken | [MIT license] | +| [@adnelson](https://github.com/adnelson) | Allen Nelson | [MIT license] | +| [@alexbiehl](https://github.com/alexbiehl) | Alexander Biehl | [MIT license] | +| [@andreypopp](https://github.com/andreypopp) | Andrey Popp | [MIT license] | +| [@andyarvanitis](https://github.com/andyarvanitis) | Andy Arvanitis | [MIT license] | +| [@andys8](https://github.com/andys8) | andys8 | [MIT license] | +| [@anthok88](https://github.com/anthok88) | anthoq88 | [MIT license] | +| [@ardumont](https://github.com/ardumont) | Antoine R. Dumont | [MIT license] | +| [@arrowd](https://github.com/arrowd) | Gleb Popov | [MIT license] | +| [@aspidites](https://github.com/aspidites) | Edwin Marshall | [MIT license] | +| [@b123400](https://github.com/b123400) | b123400 | [MIT license] | +| [@bagl](https://github.com/bagl) | Petr Vapenka | [MIT license] | +| [@balajirrao](https://github.com/balajirrao) | Balaji Rao | [MIT license] | +| [@bbqbaron](https://github.com/bbqbaron) | Eric Loren | [MIT license] | +| [@bergmark](https://github.com/bergmark) | Adam Bergmark | [MIT license] | +| [@bitemyapp](https://github.com/bitemyapp) | Chris Allen | [MIT license] | +| [@bjornmelgaaard](https://github.com/BjornMelgaard) | Sergey Homa | [MIT license] | +| [@bmjames](https://github.com/bmjames) | Ben James | [MIT license] | +| [@Bogdanp](https://github.com/Bogdanp) | Bogdan Paul Popa | [MIT license] | +| [@brandonhamilton](https://github.com/brandonhamilton) | Brandon Hamilton | [MIT license] | +| [@bsermons](https://github.com/bsermons) | Brian Sermons | [MIT license] | +| [@cdepillabout](https://github.com/cdepillabout) | Dennis Gosnell | [MIT license] | +| [@chexxor](https://github.com/chexxor) | Alex Berg | [MIT license] | +| [@chrisdone](https://github.com/chrisdone) | Chris Done | [MIT license] | +| [@cmdv](https://github.com/cmdv) | Vincent Orr | [MIT license] | +| [@codedmart](https://github.com/codedmart) | Brandon Martin | [MIT license] | +| [@coot](https://github.com/coot) | Marcin Szamotulski | [MIT license] | +| [@dariooddenino](https://github.com/dariooddenino) | Dario Oddenino | [MIT license] | +| [@davidchambers](https://github.com/davidchambers) | David Chambers | [MIT license] | +| [@DavidLindbom](https://github.com/DavidLindbom) | David Lindbom | [MIT license] | +| [@dckc](https://github.com/dckc) | Dan Connolly | [MIT license] | +| [@Deltaspace0](https://github.com/Deltaspace0) | Ruslan Gadeev | [MIT license] | +| [@drets](https://github.com/drets) | Dmytro Rets | [MIT license] | +| [@dyerw](https://github.com/dyerw) | Liam Dyer | [MIT license] | +| [@ealmansi](https://github.com/ealmansi) | Emilio Almansi | [MIT license] | +| [@eamelink](https://github.com/eamelink) | Erik Bakker | [MIT license] | +| [@EMattfolk](https://github.com/EMattfolk) | Erik Mattfolk | [MIT license] | +| [@epost](https://github.com/epost) | Erik Post | [MIT license] | +| [@erdeszt](https://github.com/erdeszt) | Tibor Erdesz | [MIT license] | +| [@etrepum](https://github.com/etrepum) | Bob Ippolito | [MIT license] | +| [@f-f](https://github.com/f-f) | Fabrizio Ferrai | [MIT license] | +| [@faineance](https://github.com/faineance) | faineance | [MIT license] | +| [@fehrenbach](https://github.com/fehrenbach) | Stefan Fehrenbach | [MIT license] | +| [@felixSchl](https://github.com/felixSchl) | Felix Schlitter | [MIT license] | +| [@FredTheDino](https://github.com/FredTheDino) | Edvard Thörnros | [MIT license] | +| [@FrigoEU](https://github.com/FrigoEU) | Simon Van Casteren | [MIT license] | +| [@fsoikin](https://github.com/fsoikin) | Fyodor Soikin | [MIT license] | +| [@gabejohnson](https://github.com/gabejohnson) | Gabe Johnson | [MIT license] | +| [@garyb](https://github.com/garyb) | Gary Burgess | [MIT license] | +| [@hdgarrood](https://github.com/hdgarrood) | Harry Garrood | [MIT license] | +| [@houli](https://github.com/houli) | Eoin Houlihan | [MIT license] | +| [@i-am-the-slime](https://github.com/i-am-the-slime) | Mark Eibes | [MIT license] | +| [@i-am-tom](https://github.com/i-am-tom) | i-am-tom | [MIT license] | +| [@ianbollinger](https://github.com/ianbollinger) | Ian D. Bollinger | [MIT license] | +| [@ilovezfs](https://github.com/ilovezfs) | ilovezfs | [MIT license] | +| [@imcotton](https://github.com/imcotton) | Cotton Hou | [MIT license] | +| [@izgzhen](https://github.com/izgzhen) | Zhen Zhang | [MIT license] | +| [@j-nava](https://github.com/j-nava) | Jesse Nava | [MIT license] | +| [@jacereda](https://github.com/jacereda) | Jorge Acereda | [MIT license] | +| [@japesinator](https://github.com/japesinator) | JP Smith | [MIT license] | +| [@jkachmar](https://github.com/jkachmar) | Joe Kachmar | [MIT license] | +| [@joneshf](https://github.com/joneshf) | Hardy Jones | [MIT license] | +| [@jordanmartinez](https://github.com/jordanmartinez) | Jordan Martinez | [MIT license] | +| [@jy14898](https://github.com/jy14898) | Joseph Young | [MIT license] | +| [@kcsongor](https://github.com/kcsongor) | Csongor Kiss | [MIT license] | +| [@kika](https://github.com/kika) | Kirill Pertsev | [MIT license] | +| [@kl0tl](https://github.com/kl0tl) | Cyril Sobierajewicz | [MIT license] | +| [@kleeneplus](https://github.com/dgendill) | Dominick Gendill | [MIT license] | +| [@kRITZCREEK](https://github.com/kRITZCREEK) | Christoph Hegemann | [MIT license] | +| [@L8D](https://github.com/L8D) | Tenor Biel | [MIT license] | +| [@legrostdg](https://github.com/legrostdg) | Félix Sipma | [MIT license] | +| [@LiamGoodacre](https://github.com/LiamGoodacre) | Liam Goodacre | [MIT license] | +| [@lukerandall](https://github.com/lukerandall) | Luke Randall | [MIT license] | +| [@lunaris](https://github.com/lunaris) | Will Jones | [MIT license] | +| [@marcosh](https://github.com/marcosh) | Marco Perone | [MIT license] | +| [@matthew-hilty](https://github.com/matthew-hilty) | Matthew Hilty | [MIT license] | +| [@matthewleon](https://github.com/matthewleon) | Matthew Leon | [MIT license] | +| [@mcoffin](https://github.com/mcoffin) | Matt Coffin | [MIT license] | +| [@mgmeier](https://github.com/mgmeier) | Michael Gilliland | [MIT license] | +| [@mhcurylo](https://github.com/mhcurylo) | Mateusz Curylo | [MIT license] | +| [@mhmdanas](https://github.com/mhmdanas) | Mohammed Anas | [MIT license] | +| [@michaelficarra](https://github.com/michaelficarra) | Michael Ficarra | [MIT license] | +| [@MichaelXavier](https://github.com/MichaelXavier) | Michael Xavier | [MIT license] | +| [@mikesol](https://github.com/mikesol) | Mike Solomon | [MIT license] | +| [@milesfrain](https://github.com/milesfrain) | Miles Frain | [MIT license] | +| [@MiracleBlue](https://github.com/MiracleBlue) | Nicholas Kircher | [MIT license] | +| [@mjgpy3](https://github.com/mjgpy3) | Michael Gilliland | [MIT license] | +| [@MonoidMusician](https://github.com/MonoidMusician) | Verity Scheel | [MIT license] | +| [@mpietrzak](https://github.com/mpietrzak) | Maciej Pietrzak | [MIT license] | +| [@mrhania](https://github.com/mrhania) | Łukasz Hanuszczak | [MIT license] | +| [@mrkgnao](https://github.com/mrkgnao) | Soham Chowdhury | [MIT license] | +| [@natefaubion](https://github.com/natefaubion) | Nathan Faubion | [MIT license] | +| [@ncaq](https://github.com/ncaq) | ncaq | [MIT license] | +| [@NickMolloy](https://github.com/NickMolloy) | Nick Molloy | [MIT license] | +| [@nicodelpiano](https://github.com/nicodelpiano) | Nicolas Del Piano | [MIT license] | +| [@noraesae](https://github.com/noraesae) | Hyunje Jun | [MIT license] | +| [@nullobject](https://github.com/nullobject) | Josh Bassett | [MIT license] | +| [@osa1](https://github.com/osa1) | Ömer Sinan Ağacan | [MIT license] | +| [@paf31](https://github.com/paf31) | Phil Freeman | [MIT license] | +| [@parsonsmatt](https://github.com/parsonsmatt) | Matt Parsons | [MIT license] | +| [@passy](https://github.com/passy) | Pascal Hartig | [MIT license] | +| [@paulyoung](https://github.com/paulyoung) | Paul Young | [MIT license] | +| [@pelotom](https://github.com/pelotom) | Thomas Crockett | [MIT license] | +| [@peterbecich](https://github.com/peterbecich) | Peter Becich | [MIT license] | +| [@phadej](https://github.com/phadej) | Oleg Grenrus | [MIT license] | +| [@phiggins](https://github.com/phiggins) | Pete Higgins | [MIT license] | +| [@philopon](https://github.com/philopon) | Hirotomo Moriwaki | [MIT license] | +| [@pseudonom](https://github.com/pseudonom) | Eric Easley | [MIT license] | +| [@ptrfrncsmrph](https://github.com/ptrfrncsmrph) | Peter Murphy | [MIT license] | +| [@PureFunctor](https://github.com/PureFunctor), [@sjpgarcia](https://github.com/sjpgarcia) | Justin Garcia | [MIT license] | +| [@quesebifurcan](https://github.com/quesebifurcan) | Fredrik Wallberg | [MIT license] | +| [@radrow](https://github.com/radrow) | Radosław Rowicki | [MIT license] | +| [@rgrinberg](https://github.com/rgrinberg) | Rudi Grinberg | [MIT license] | +| [@rhendric](https://github.com/rhendric) | Ryan Hendrickson | [MIT license] | +| [@rightfold](https://github.com/rightfold) | rightfold | [MIT license] | +| [@rndnoise](https://www.github.com/rndnoise) | rndnoise | [MIT license] | +| [@robdaemon](https://github.com/robdaemon) | Robert Roland | [MIT license] | +| [@RossMeikleham](https://github.com/RossMeikleham) | Ross Meikleham | [MIT license] | +| [@Rufflewind](https://github.com/Rufflewind) | Phil Ruffwind | [MIT license] | +| [@rvion](https://github.com/rvion) | Rémi Vion | [MIT license] | +| [@RyanGlScott](https://github.com/RyanGlScott) | Ryan Scott | [MIT license] | +| [@Saulukass](https://github.com/Saulukass) | Saulius Skliutas | [MIT license] | +| [@sd-yip](https://github.com/sd-yip) | Nicholas Yip | [MIT license] | +| [@sebastiaanvisser](https://github.com/sebastiaanvisser) | Sebastiaan Visser | [MIT license] | +| [@sectore](https://github.com/sectore) | Jens Krause | [MIT license] | +| [@senju](https://github.com/senju) | senju | [MIT license] | +| [@seungha-kim](https://github.com/seungha-kim) | Seungha Kim | [MIT license] | +| [@sharkdp](https://github.com/sharkdp) | David Peter | [MIT license] | +| [@sigma-andex](https://github.com/sigma-andex) | Jan Schulte | [MIT license] | +| [@simonyangme](https://github.com/simonyangme) | Simon Yang | [MIT license] | +| [@sloosch](https://github.com/sloosch) | Simon Looschen | [MIT license] | +| [@soupi](https://github.com/soupi) | Gil Mizrahi | [MIT license] | +| [@stefanholzmueller](https://github.com/stefanholzmueller) | Stefan Holzmüller | [MIT license] | +| [@sztupi](https://github.com/sztupi) | Attila Sztupak | [MIT license] | +| [@taktoa](https://github.com/taktoa) | Remy Goldschmidt | [MIT license] | +| [@taku0](https://github.com/taku0) | taku0 | [MIT license] | +| [@tfausak](https://github.com/tfausak) | Taylor Fausak | [MIT license] | +| [@thimoteus](https://github.com/Thimoteus) | thimoteus | [MIT license] | +| [@thomashoneyman](https://github.com/thomashoneyman) | Thomas Honeyman | [MIT license] | +| [@thoradam](https://github.com/thoradam) | Thor Adam | [MIT license] | +| [@tmcgilchrist](https://github.com/tmcgilchrist) | Tim McGilchrist | [MIT license] | +| [@trofi](https://github.com/trofi) | Sergei Trofimovich | [MIT license] | +| [@utkarshkukreti](https://github.com/utkarshkukreti) | Utkarsh Kukreti | [MIT license] | +| [@vkorablin](https://github.com/vkorablin) | Vladimir Korablin | [MIT license] | +| [@vladciobanu](https://github.com/vladciobanu) | Vladimir Ciobanu | [MIT license] | +| [@wclr](https://github.com/wclr) | Alex Osh | [MIT license] | +| [@woody88](https://github.com/woody88) | Woodson Delhia | [MIT license] | +| [@xgrommx](https://github.com/xgrommx) | Denis Stoyanov | [MIT license] | +| [@zudov](https://github.com/zudov) | Konstantin Zudov | [MIT license] | + ### Contributors using Modified Terms | Username | Name | Terms | | :------- | :--- | :------ | -| [@charleso](https://github.com/charleso) | Charles O'Farrell | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Charles O'Farrell, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | -| [@chrissmoak](https://github.com/chrissmoak) | Chris Smoak | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Chris Smoak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | +| [@charleso](https://github.com/charleso) | Charles O'Farrell | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Charles O'Farrell, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. | +| [@chrissmoak](https://github.com/chrissmoak) | Chris Smoak | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Chris Smoak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. | | [@citizengabe](https://github.com/citizengabe) | Gabe Johnson | All contributions I have or will make using the @citizengabe GitHub account are during employment at [CitizenNet Inc.](#companies) who owns the copyright. All of my existing or future contributions made using the @gabejohnson GitHub account are personal contributions and subject to the terms specified [above](#contributors-using-standard-terms). | -| [@dylex](https://github.com/dylex) | Dylan Simon | My existing and all future contributions to the PureScript compiler until further notice are Copyright Dylan Simon, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | -| [@leighman](http://github.com/leighman) | Jack Leigh | My existing contributions and all future contributions until further notice are Copyright Jack Leigh, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | +| [@dylex](https://github.com/dylex) | Dylan Simon | My existing and all future contributions to the PureScript compiler until further notice are Copyright Dylan Simon, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. | +| [@leighman](http://github.com/leighman) | Jack Leigh | My existing contributions and all future contributions until further notice are Copyright Jack Leigh, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. | | [@nagisa](https://github.com/nagisa) | nagisa | I hereby release my [only contribution](https://github.com/purescript/purescript/commit/80287a5d0de619862d3b4cda9c1ee276d18fdcd8) into public domain. | | [@puffnfresh](https://github.com/puffnfresh) | Brian McKenna | All contributions I made during June 2015 were during employment at [SlamData, Inc.](#companies) who owns the copyright. I assign copyright of all my personal contributions before June 2015 to the owners of the PureScript compiler. | -| [@nwolverson](https://github.com/nwolverson) | Nicholas Wolverson | Contributions I made during March 2020 until further notice are in employment of [Id3as Company](#companies), who own the copyright. All other contributions remain Copyright Nicholas Wolverson, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | - +| [@nwolverson](https://github.com/nwolverson) | Nicholas Wolverson | Contributions I made during March 2020 until further notice are in employment of [Id3as Company](#companies), who own the copyright. All other contributions remain Copyright Nicholas Wolverson, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. | ### Companies | Username | Company | Terms | | :------- | :--- | :------ | -| [@citizennet](https://github.com/citizennet) | CitizenNet Inc. | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright CitizenNet Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@dbenyamin-cn](https://github.com/dbenyamin-cn) | -| [@slamdata](https://github.com/slamdata) | SlamData, Inc. | Speaking on behalf of SlamData for SlamData employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright SlamData Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - @jdegoes | -| [@qfpl](https://github.com/qfpl) | qfpl @ Data61 / CSIRO | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Data61 / CSIRO, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@lightandlight](https://github.com/lightandlight) | -| [@id3as](https://github.com/id3as) | id3as-company Ltd. | Speaking on behalf of id3as for id3as employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright id3as-company Ltd, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - @adrianroe | -| [@aeternity](https://aeternity.com/) | Aeternity Establishment | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Aeternity Establishment, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | +| [@citizennet](https://github.com/citizennet) | CitizenNet Inc. | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright CitizenNet Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. - [@dbenyamin-cn](https://github.com/dbenyamin-cn) | +| [@slamdata](https://github.com/slamdata) | SlamData, Inc. | Speaking on behalf of SlamData for SlamData employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright SlamData Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. - @jdegoes | +| [@qfpl](https://github.com/qfpl) | qfpl @ Data61 / CSIRO | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Data61 / CSIRO, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. - [@lightandlight](https://github.com/lightandlight) | +| [@id3as](https://github.com/id3as) | id3as-company Ltd. | Speaking on behalf of id3as for id3as employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright id3as-company Ltd, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. - @adrianroe | +| [@aeternity](https://aeternity.com/) | Aeternity Establishment | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Aeternity Establishment, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license]. | + + +[MIT license]: https://opensource.org/licenses/MIT From ab15ae7ae938d5a78c4854e1057ebb9f1b221020 Mon Sep 17 00:00:00 2001 From: sometimes-i-send-pull-requests Date: Thu, 2 Mar 2023 01:40:25 -0800 Subject: [PATCH 18/68] Dark mode support for Pursuit documentation (#4438) * Dark mode support for Pursuit documentation * Add changelog entry --------- Co-authored-by: Alex Kirchhoff --- CHANGELOG.d/feature_pursuit-dark-theme.md | 5 + CONTRIBUTORS.md | 1 + app/static/pursuit.css | 205 +++++++++++++++++++++- app/static/pursuit.less | 198 +++++++++++++++++++-- 4 files changed, 383 insertions(+), 26 deletions(-) create mode 100644 CHANGELOG.d/feature_pursuit-dark-theme.md diff --git a/CHANGELOG.d/feature_pursuit-dark-theme.md b/CHANGELOG.d/feature_pursuit-dark-theme.md new file mode 100644 index 0000000000..f74097901f --- /dev/null +++ b/CHANGELOG.d/feature_pursuit-dark-theme.md @@ -0,0 +1,5 @@ +* Generated documentation now supports dark mode + + PureScript documentation has a new dark theme available. It will + automatically be used based on your browser or system's color scheme + preferences. diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index a4ad8416af..a4f8790422 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -146,6 +146,7 @@ If you would prefer to use different terms, please use the section below instead | [@sigma-andex](https://github.com/sigma-andex) | Jan Schulte | [MIT license] | | [@simonyangme](https://github.com/simonyangme) | Simon Yang | [MIT license] | | [@sloosch](https://github.com/sloosch) | Simon Looschen | [MIT license] | +| [@sometimes-i-send-pull-requests](https://github.com/sometimes-i-send-pull-requests) | Alexander Kirchhoff | [MIT license] | | [@soupi](https://github.com/soupi) | Gil Mizrahi | [MIT license] | | [@stefanholzmueller](https://github.com/stefanholzmueller) | Stefan Holzmüller | [MIT license] | | [@sztupi](https://github.com/sztupi) | Attila Sztupak | [MIT license] | diff --git a/app/static/pursuit.css b/app/static/pursuit.css index eba6222be5..d7641624e0 100644 --- a/app/static/pursuit.css +++ b/app/static/pursuit.css @@ -49,6 +49,9 @@ * ========================================================================== */ /* Section: Document Styles * ========================================================================== */ +:root { + color-scheme: light dark; +} html { box-sizing: border-box; /* This overflow rule prevents everything from shifting slightly to the side @@ -63,11 +66,17 @@ html { } body { background-color: #ffffff; - color: #000; + color: #000000; font-family: "Roboto", sans-serif; font-size: 87.5%; line-height: 1.563; } +@media (prefers-color-scheme: dark) { + body { + background-color: #141417; + color: #dedede; + } +} @media (min-width: 38em) { body { font-size: 100%; @@ -158,6 +167,12 @@ body { background-color: #1d222d; color: #f0f0f0; } +@media (prefers-color-scheme: dark) { + .footer { + background-color: #1d222d; + color: #f0f0f0; + } +} .footer * { margin-bottom: 0; } @@ -169,16 +184,32 @@ body { :target { background-color: #f1f5f9; } +@media (prefers-color-scheme: dark) { + :target { + background-color: #232327; + } +} a, a:visited { color: #c4953a; text-decoration: none; font-weight: bold; } +@media (prefers-color-scheme: dark) { + a, + a:visited { + color: #d8ac55; + } +} a:hover { color: #7b5904; text-decoration: none; } +@media (prefers-color-scheme: dark) { + a:hover { + color: #f0dcab; + } +} code, pre { background-color: #f1f5f9; @@ -187,10 +218,23 @@ pre { font-family: "Roboto Mono", monospace; font-size: 87.5%; } +@media (prefers-color-scheme: dark) { + code, + pre { + background-color: #232327; + color: #c1d3da; + } +} :target code, :target pre { background-color: #dfe8f1; } +@media (prefers-color-scheme: dark) { + :target code, + :target pre { + background-color: #2f2f34; + } +} code { padding: 0.2em 0; margin: 0; @@ -212,6 +256,11 @@ a > code::before { a:hover > code { color: #c4953a; } +@media (prefers-color-scheme: dark) { + a:hover > code { + color: #d8ac55; + } +} pre { margin-top: 0; margin-bottom: 0; @@ -255,14 +304,14 @@ h1 { h2 { font-size: 1.953em; font-weight: normal; - line-height: 1.250; + line-height: 1.25; margin-top: 3.052rem; margin-bottom: 1rem; } h3 { font-size: 1.563em; font-weight: normal; - line-height: 1.250; + line-height: 1.25; margin-top: 2.441rem; margin-bottom: 1rem; } @@ -285,6 +334,11 @@ hr { height: 1px; background-color: #cccccc; } +@media (prefers-color-scheme: dark) { + hr { + background-color: #43434e; + } +} img { border-style: none; max-width: 100%; @@ -302,6 +356,11 @@ table { margin-bottom: 1rem; width: 100%; } +@media (prefers-color-scheme: dark) { + table { + border-bottom-color: #43434e; + } +} td, th { text-align: left; @@ -310,6 +369,11 @@ th { td { border-top: 1px solid #cccccc; } +@media (prefers-color-scheme: dark) { + td { + border-top-color: #43434e; + } +} td:first-child, th:first-child { padding-left: 0; @@ -326,7 +390,7 @@ ul { } ul li { position: relative; - padding-left: 1.250em; + padding-left: 1.25em; } ul li::before { position: absolute; @@ -334,7 +398,12 @@ ul li::before { content: "–"; display: inline-block; margin-left: -1.25em; - width: 1.250em; + width: 1.25em; +} +@media (prefers-color-scheme: dark) { + ul li::before { + color: #a0a0a0; + } } /* Tying this tightly to ul at the moment because it's a slight variation thereof */ ul.ul--search li::before { @@ -345,7 +414,7 @@ ul.ul--search li::before { ol { margin-top: 1rem; margin-bottom: 1rem; - padding-left: 1.250em; + padding-left: 1.25em; } ol li { position: relative; @@ -359,9 +428,9 @@ ol li { position: relative; top: -0.1em; display: inline-block; - background-color: #000; + background-color: #000000; border-radius: 1.3em; - color: #fff; + color: #ffffff; font-size: 77%; font-weight: bold; line-height: 1.563; @@ -369,10 +438,21 @@ ol li { height: 1.5em; width: 1.5em; } +@media (prefers-color-scheme: dark) { + .badge { + background-color: #dedede; + color: #141417; + } +} .badge.badge--package { background-color: #c4953a; letter-spacing: -0.1em; } +@media (prefers-color-scheme: dark) { + .badge.badge--package { + background-color: #d8ac55; + } +} .badge.badge--module { background-color: #75B134; } @@ -396,9 +476,20 @@ ol li { left: -0.8em; color: #bababa; } +@media (prefers-color-scheme: dark) { + .decl__anchor, + .decl__anchor:visited { + color: #878787; + } +} .decl__anchor:hover { color: #c4953a; } +@media (prefers-color-scheme: dark) { + .decl__anchor:hover { + color: #d8ac55; + } +} .decl__signature { background-color: transparent; border-radius: 0; @@ -406,6 +497,12 @@ ol li { border-bottom: 1px solid #cccccc; padding: 0; } +@media (prefers-color-scheme: dark) { + .decl__signature { + border-top-color: #43434e; + border-bottom-color: #43434e; + } +} .decl__signature code { display: block; padding: 0.328em 0; @@ -437,6 +534,11 @@ ol li { .decl__kind { border-bottom: 1px solid #cccccc; } +@media (prefers-color-scheme: dark) { + .decl__kind { + border-bottom-color: #43434e; + } +} :target .decl__signature, :target .decl__signature code { /* We want the background to be transparent, even when the parent is a target */ @@ -444,7 +546,13 @@ ol li { } .decl__body .keyword, .decl__body .syntax { - color: #0B71B4; + color: #0b71b4; +} +@media (prefers-color-scheme: dark) { + .decl__body .keyword, + .decl__body .syntax { + color: #3796d5; + } } .decl__child_comments { margin-top: 1rem; @@ -465,12 +573,22 @@ ol li { font-size: 0.8em; line-height: 1; } +@media (prefers-color-scheme: dark) { + .deplink__version { + color: #a0a0a0; + } +} /* Component: Grouped List * -------------------------------------------------------------------------- */ .grouped-list { border-top: 1px solid #cccccc; margin: 0 0 2.44em 0; } +@media (prefers-color-scheme: dark) { + .grouped-list { + border-top-color: #43434e; + } +} .grouped-list__title { color: #666666; font-size: 0.8em; @@ -479,6 +597,11 @@ ol li { margin: 0.8em 0 -0.1em 0; text-transform: uppercase; } +@media (prefers-color-scheme: dark) { + .grouped-list__title { + border-top-color: #a0a0a0; + } +} .grouped-list__item { margin: 0; } @@ -493,10 +616,22 @@ ol li { background-color: #fff0f0; border-color: #c85050; } +@media (prefers-color-scheme: dark) { + .message.message--error { + background-color: #6b0e0e; + border-color: #c85050; + } +} .message.message--not-available { background-color: #f0f096; border-color: #e3e33d; } +@media (prefers-color-scheme: dark) { + .message.message--not-available { + background-color: #56560b; + border-color: #b0b017; + } +} /* Component: Multi Col * Multiple columns side by side * -------------------------------------------------------------------------- */ @@ -548,6 +683,11 @@ ol li { text-transform: uppercase; z-index: 1; } +@media (prefers-color-scheme: dark) { + .page-title__label { + color: #a0a0a0; + } +} /* Component: Top Banner * -------------------------------------------------------------------------- */ .top-banner { @@ -555,6 +695,12 @@ ol li { color: #f0f0f0; font-weight: normal; } +@media (prefers-color-scheme: dark) { + .top-banner { + background-color: #1d222d; + color: #f0f0f0; + } +} .top-banner__logo, .top-banner__logo:visited { float: left; @@ -564,6 +710,12 @@ ol li { line-height: 90px; margin: 0; } +@media (prefers-color-scheme: dark) { + .top-banner__logo, + .top-banner__logo:visited { + color: #f0f0f0; + } +} .top-banner__logo:hover { color: #c4953a; text-decoration: none; @@ -574,12 +726,20 @@ ol li { .top-banner__form input { border: 1px solid #1d222d; border-radius: 3px; + background-color: #ffffff; color: #1d222d; font-weight: 300; line-height: 2; padding: 0.21em 0.512em; width: 100%; } +@media (prefers-color-scheme: dark) { + .top-banner__form input { + border-color: #1d222d; + background-color: #141417; + color: #dedede; + } +} .top-banner__actions { float: right; text-align: right; @@ -597,9 +757,20 @@ ol li { .top-banner__actions__item a:visited { color: #f0f0f0; } +@media (prefers-color-scheme: dark) { + .top-banner__actions__item a, + .top-banner__actions__item a:visited { + color: #f0f0f0; + } +} .top-banner__actions__item a:hover { color: #c4953a; } +@media (prefers-color-scheme: dark) { + .top-banner__actions__item a:hover { + color: #d8ac55; + } +} @media (min-width: 38em) { .top-banner__logo { float: left; @@ -641,6 +812,12 @@ ol li { border-bottom: 1px solid #cccccc; padding: 0.328em 0; } +@media (prefers-color-scheme: dark) { + .result__signature { + border-top-color: #43434e; + border-bottom-color: #43434e; + } +} .result__signature code { display: block; padding-left: 2.441em; @@ -707,6 +884,11 @@ ol li { color: #777; border-left: 0.25em solid #ddd; } +@media (prefers-color-scheme: dark) { + .markdown-body blockquote { + border-left-color: #444; + } +} .markdown-body blockquote > :first-child { margin-top: 0; } @@ -721,6 +903,11 @@ ol li { /* Keyword */ color: #a0a0a0; } +@media (prefers-color-scheme: dark) { + .markdown-body .pl-k { + color: #676767; + } +} .markdown-body .pl-c1, .markdown-body .pl-en { /* Not really sure what this is */ diff --git a/app/static/pursuit.less b/app/static/pursuit.less index 5358322d41..2520590ca3 100644 --- a/app/static/pursuit.less +++ b/app/static/pursuit.less @@ -49,9 +49,9 @@ /* Section: Variables * ========================================================================== */ @background: rgb(255, 255, 255); +@foreground: rgb(0, 0, 0); @banner_background: rgb(29, 34, 45); -@package_banner_background: lighten(@banner_background, 30%); -@dark_foreground: rgb(240, 240, 240); +@dim_foreground: rgb(240, 240, 240); @link: rgb(196, 149, 58); @link_active: rgb(123, 89, 4); @error_background: rgb(255, 240, 240); @@ -59,12 +59,32 @@ @not_available_background: rgb(240, 240, 150); @code_foreground: rgb(25, 74, 91); @code_background: rgb(241, 245, 249); -@light_glyph: rgb(160, 160, 160); -@light_type: rgb(102, 102, 102); +@dim_glyph: rgb(160, 160, 160); +@dim_type: rgb(102, 102, 102); +@keyword: rgb(11, 113, 180); + +@dark_background: rgb(20, 20, 23); +@dark_foreground: rgb(222, 222, 222); +@dark_banner_background: rgb(29, 34, 45); +@dark_dim_foreground: rgb(240, 240, 240); +@dark_link: rgb(216, 172, 85); +@dark_link_active: rgb(240, 220, 171); +@dark_error_background: rgb(107, 14, 14); +@dark_error_border: rgb(200, 80, 80); +@dark_not_available_background: rgb(86, 86, 11); +@dark_code_foreground: rgb(193, 211, 218); +@dark_code_background: rgb(35, 35, 39); +@dark_dim_glyph: rgb(160, 160, 160); +@dark_dim_type: rgb(160, 160, 160); +@dark_keyword: rgb(55, 150, 213); /* Section: Document Styles * ========================================================================== */ +:root { + color-scheme: light dark; +} + html { box-sizing: border-box; @@ -80,10 +100,15 @@ html { body { background-color: @background; - color: #000; + color: @foreground; font-family: "Roboto", sans-serif; font-size: 87.5%; line-height: 1.563; + + @media (prefers-color-scheme: dark) { + background-color: @dark_background; + color: @dark_foreground; + } } @media (min-width: 38em) { @@ -193,7 +218,12 @@ html, body { width: 100%; text-align: center; background-color: @banner_background; - color: @dark_foreground; + color: @dim_foreground; + + @media (prefers-color-scheme: dark) { + background-color: @dark_banner_background; + color: @dark_dim_foreground; + } } .footer * { @@ -209,17 +239,29 @@ html, body { :target { background-color: @code_background; + + @media (prefers-color-scheme: dark) { + background-color: @dark_code_background; + } } a, a:visited { color: @link; text-decoration: none; font-weight: bold; + + @media (prefers-color-scheme: dark) { + color: @dark_link; + } } a:hover { color: @link_active; text-decoration: none; + + @media (prefers-color-scheme: dark) { + color: @dark_link_active; + } } code, pre { @@ -228,11 +270,20 @@ code, pre { color: @code_foreground; font-family: "Roboto Mono", monospace; font-size: 87.5%; + + @media (prefers-color-scheme: dark) { + background-color: @dark_code_background; + color: @dark_code_foreground; + } } :target code, :target pre { background-color: darken(@code_background, 5%); + + @media (prefers-color-scheme: dark) { + background-color: lighten(@dark_code_background, 5%); + } } code { @@ -259,6 +310,10 @@ a > code::before { a:hover > code { color: @link; + + @media (prefers-color-scheme: dark) { + color: @dark_link; + } } pre { @@ -341,6 +396,10 @@ hr { border: none; height: 1px; background-color: darken(@background, 20%); + + @media (prefers-color-scheme: dark) { + background-color: lighten(@dark_background, 20%); + } } img { @@ -361,6 +420,10 @@ table { margin-top: 1rem; margin-bottom: 1rem; width: 100%; + + @media (prefers-color-scheme: dark) { + border-bottom-color: lighten(@dark_background, 20%); + } } td, th { @@ -370,6 +433,10 @@ td, th { td { border-top: 1px solid darken(@background, 20%); + + @media (prefers-color-scheme: dark) { + border-top-color: lighten(@dark_background, 20%); + } } td:first-child, th:first-child { @@ -394,11 +461,15 @@ ul li { ul li::before { position: absolute; - color: @light_glyph; + color: @dim_glyph; content: "–"; display: inline-block; margin-left: -1.250em; width: 1.250em; + + @media (prefers-color-scheme: dark) { + color: @dark_dim_glyph; + } } /* Tying this tightly to ul at the moment because it's a slight variation thereof */ @@ -430,20 +501,29 @@ ol li { position: relative; top: -0.1em; display: inline-block; - background-color: #000; + background-color: @foreground; border-radius: 1.3em; - color: #fff; + color: @background; font-size: 77%; font-weight: bold; line-height: 1.563; text-align: center; height: 1.5em; width: 1.5em; + + @media (prefers-color-scheme: dark) { + background-color: @dark_foreground; + color: @dark_background; + } } .badge.badge--package { background-color: @link; letter-spacing: -0.1em; + + @media (prefers-color-scheme: dark) { + background-color: @dark_link; + } } .badge.badge--module { @@ -473,11 +553,19 @@ ol li { .decl__anchor, .decl__anchor:visited { position: absolute; left: -0.8em; - color: lighten(@light_glyph, 10%); + color: lighten(@dim_glyph, 10%); + + @media (prefers-color-scheme: dark) { + color: darken(@dark_dim_glyph, 10%); + } } .decl__anchor:hover { color: @link; + + @media (prefers-color-scheme: dark) { + color: @dark_link; + } } .decl__signature { @@ -486,6 +574,11 @@ ol li { border-top: 1px solid darken(@background, 20%); border-bottom: 1px solid darken(@background, 20%); padding: 0; + + @media (prefers-color-scheme: dark) { + border-top-color: lighten(@dark_background, 20%); + border-bottom-color: lighten(@dark_background, 20%); + } } .decl__signature code { @@ -524,6 +617,10 @@ ol li { .decl__kind { border-bottom: 1px solid darken(@background, 20%); + + @media (prefers-color-scheme: dark) { + border-bottom-color: lighten(@dark_background, 20%); + } } :target .decl__signature, @@ -534,7 +631,11 @@ ol li { .decl__body .keyword, .decl__body .syntax { - color: #0B71B4; + color: @keyword; + + @media (prefers-color-scheme: dark) { + color: @dark_keyword; + } } .decl__child_comments { @@ -553,10 +654,14 @@ ol li { } .deplink__version { - color: @light_type; + color: @dim_type; display: inline-block; font-size: 0.8em; line-height: 1; + + @media (prefers-color-scheme: dark) { + color: @dark_dim_type; + } } @@ -566,15 +671,23 @@ ol li { .grouped-list { border-top: 1px solid darken(@background, 20%); margin: 0 0 2.44em 0; + + @media (prefers-color-scheme: dark) { + border-top-color: lighten(@dark_background, 20%); + } } .grouped-list__title { - color: @light_type; + color: @dim_type; font-size: 0.8em; font-weight: 300; letter-spacing: 1px; margin: 0.8em 0 -0.1em 0; text-transform: uppercase; + + @media (prefers-color-scheme: dark) { + border-top-color: @dark_dim_type; + } } .grouped-list__item { @@ -594,11 +707,21 @@ ol li { .message.message--error { background-color: @error_background; border-color: @error_border; + + @media (prefers-color-scheme: dark) { + background-color: @dark_error_background; + border-color: @dark_error_border; + } } .message.message--not-available { background-color: @not_available_background; border-color: darken(@not_available_background, 20%); + + @media (prefers-color-scheme: dark) { + background-color: @dark_not_available_background; + border-color: lighten(@dark_not_available_background, 20%); + } } @@ -655,13 +778,17 @@ ol li { .page-title__label { position: relative; - color: @light_type; + color: @dim_type; font-size: 0.8rem; font-weight: 300; letter-spacing: 1px; margin-bottom: -0.8em; text-transform: uppercase; z-index: 1; + + @media (prefers-color-scheme: dark) { + color: @dark_dim_type; + } } @@ -670,18 +797,27 @@ ol li { .top-banner { background-color: @banner_background; - color: @dark_foreground; + color: @dim_foreground; font-weight: normal; + + @media (prefers-color-scheme: dark) { + background-color: @dark_banner_background; + color: @dark_dim_foreground; + } } .top-banner__logo, .top-banner__logo:visited { float: left; - color: @dark_foreground; + color: @dim_foreground; font-size: 2.44em; font-weight: 300; line-height: 90px; margin: 0; + + @media (prefers-color-scheme: dark) { + color: @dark_dim_foreground; + } } .top-banner__logo:hover { @@ -696,11 +832,18 @@ ol li { .top-banner__form input { border: 1px solid @banner_background; border-radius: 3px; + background-color: @background; color: @banner_background; font-weight: 300; line-height: 2; padding: 0.21em 0.512em; width: 100%; + + @media (prefers-color-scheme: dark) { + border-color: @dark_banner_background; + background-color: @dark_background; + color: @dark_foreground; + } } .top-banner__actions { @@ -721,11 +864,19 @@ ol li { .top-banner__actions__item a, .top-banner__actions__item a:visited { - color: @dark_foreground; + color: @dim_foreground; + + @media (prefers-color-scheme: dark) { + color: @dark_dim_foreground; + } } .top-banner__actions__item a:hover { color: @link; + + @media (prefers-color-scheme: dark) { + color: @dark_link; + } } @media (min-width: 38em) { @@ -780,6 +931,11 @@ ol li { border-top: 1px solid darken(@background, 20%); border-bottom: 1px solid darken(@background, 20%); padding: 0.328em 0; + + @media (prefers-color-scheme: dark) { + border-top-color: lighten(@dark_background, 20%); + border-bottom-color: lighten(@dark_background, 20%); + } } .result__signature code { @@ -864,6 +1020,10 @@ ol li { padding: 0 1em; color: #777; border-left: 0.25em solid #ddd; + + @media (prefers-color-scheme: dark) { + border-left-color: #444; + } } .markdown-body blockquote>:first-child { @@ -882,6 +1042,10 @@ ol li { .markdown-body .pl-k { /* Keyword */ color: #a0a0a0; + + @media (prefers-color-scheme: dark) { + color: #676767; + } } .markdown-body .pl-c1, From 2298c2fd07ab99b8e6bdd9149104424a71f534a9 Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Sat, 4 Mar 2023 08:29:39 +0800 Subject: [PATCH 19/68] Account for typed holes when checking declarations (#4437) * Account for typed holes when checking declarations * Fix indentation * Float declaration info upwards * Add comment for implementation --- CHANGELOG.d/fix_4408.md | 49 +++++++++++++++++++ .../PureScript/Sugar/BindingGroups.hs | 37 ++++++++++++-- tests/purs/failing/4408Acyclic.out | 22 +++++++++ tests/purs/failing/4408Acyclic.purs | 22 +++++++++ tests/purs/failing/4408AcyclicRecursive.out | 23 +++++++++ tests/purs/failing/4408AcyclicRecursive.purs | 23 +++++++++ tests/purs/failing/4408Cyclic.out | 31 ++++++++++++ tests/purs/failing/4408Cyclic.purs | 29 +++++++++++ tests/purs/failing/4408CyclicTail.out | 26 ++++++++++ tests/purs/failing/4408CyclicTail.purs | 28 +++++++++++ tests/purs/failing/4408CyclicTriple.out | 32 ++++++++++++ tests/purs/failing/4408CyclicTriple.purs | 25 ++++++++++ 12 files changed, 343 insertions(+), 4 deletions(-) create mode 100644 CHANGELOG.d/fix_4408.md create mode 100644 tests/purs/failing/4408Acyclic.out create mode 100644 tests/purs/failing/4408Acyclic.purs create mode 100644 tests/purs/failing/4408AcyclicRecursive.out create mode 100644 tests/purs/failing/4408AcyclicRecursive.purs create mode 100644 tests/purs/failing/4408Cyclic.out create mode 100644 tests/purs/failing/4408Cyclic.purs create mode 100644 tests/purs/failing/4408CyclicTail.out create mode 100644 tests/purs/failing/4408CyclicTail.purs create mode 100644 tests/purs/failing/4408CyclicTriple.out create mode 100644 tests/purs/failing/4408CyclicTriple.purs diff --git a/CHANGELOG.d/fix_4408.md b/CHANGELOG.d/fix_4408.md new file mode 100644 index 0000000000..caf7f86f39 --- /dev/null +++ b/CHANGELOG.d/fix_4408.md @@ -0,0 +1,49 @@ +* Account for typed holes when checking value declarations + + The compiler now takes into account typed holes when ordering value declarations + for type checking, allowing more top-level values to be suggested instead of + being limited by reverse lexicographical ordering. + + Given: + ```purescript + module Main where + + newtype K = K Int + + aRinku :: Int -> K + aRinku = K + + bMaho :: K + bMaho = ?help 0 + + cMuni :: Int -> K + cMuni = K + + dRei :: Int -> K + dRei _ = bMaho + ``` + + Before: + ``` + Hole 'help' has the inferred type + + Int -> K + + You could substitute the hole with one of these values: + + Main.cMuni :: Int -> K + Main.K :: Int -> K + ``` + + After: + ``` + Hole 'help' has the inferred type + + Int -> K + + You could substitute the hole with one of these values: + + Main.aRinku :: Int -> K + Main.cMuni :: Int -> K + Main.K :: Int -> K + ``` diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs index ab78f79d8c..b3e87e779e 100644 --- a/src/Language/PureScript/Sugar/BindingGroups.hs +++ b/src/Language/PureScript/Sugar/BindingGroups.hs @@ -9,7 +9,7 @@ module Language.PureScript.Sugar.BindingGroups ) where import Prelude -import Protolude (ordNub) +import Protolude (ordNub, swap) import Control.Monad ((<=<), guard) import Control.Monad.Error.Class (MonadError(..)) @@ -21,6 +21,7 @@ import Data.Foldable (find) import Data.Functor (($>)) import Data.Maybe (isJust, mapMaybe) import qualified Data.List.NonEmpty as NEL +import qualified Data.Map as M import qualified Data.Set as S import Language.PureScript.AST @@ -103,9 +104,24 @@ createBindingGroups moduleName = mapM f <=< handleDecls in (d, (name, vty), self ++ deps) dataVerts = fmap mkVert allDecls dataBindingGroupDecls <- parU (stronglyConnCompR dataVerts) toDataBindingGroup - let allIdents = fmap valdeclIdent values - valueVerts = fmap (\d -> (d, valdeclIdent d, usedIdents moduleName d `intersect` allIdents)) values - bindingGroupDecls <- parU (stronglyConnComp valueVerts) (toBindingGroup moduleName) + let + -- #4437 + -- + -- The idea here is to create a `Graph` whose `key` is a tuple: `(Bool, Ident)`, + -- where the `Bool` encodes the absence of a type hole. This relies on an implementation + -- detail for `stronglyConnComp` which allows identifiers with no type holes to "float" + -- and get checked before those that do, while preserving reverse topological sorting. + makeValueDeclarationKey = (,) <$> exprHasNoTypeHole . valdeclExpression <*> valdeclIdent + valueDeclarationKeys = makeValueDeclarationKey <$> values + + valueDeclarationInfo = M.fromList $ swap <$> valueDeclarationKeys + findDeclarationInfo i = (M.findWithDefault False i valueDeclarationInfo, i) + computeValueDependencies = (`intersect` valueDeclarationKeys) . fmap findDeclarationInfo . usedIdents moduleName + + makeValueDeclarationVert = (,,) <$> id <*> makeValueDeclarationKey <*> computeValueDependencies + valueDeclarationVerts = makeValueDeclarationVert <$> values + + bindingGroupDecls <- parU (stronglyConnComp valueDeclarationVerts) (toBindingGroup moduleName) return $ filter isImportDecl ds ++ dataBindingGroupDecls ++ filter isTypeClassInstanceDecl ds ++ @@ -116,6 +132,19 @@ createBindingGroups moduleName = mapM f <=< handleDecls extractGuardedExpr [MkUnguarded expr] = expr extractGuardedExpr _ = internalError "Expected Guards to have been desugared in handleDecls." + exprHasNoTypeHole :: Expr -> Bool + exprHasNoTypeHole = not . exprHasTypeHole + where + exprHasTypeHole :: Expr -> Bool + (_, exprHasTypeHole, _, _, _) = everythingOnValues (||) goDefault goExpr goDefault goDefault goDefault + where + goExpr :: Expr -> Bool + goExpr (Hole _) = True + goExpr _ = False + + goDefault :: forall a. a -> Bool + goDefault = const False + -- | -- Collapse all binding groups to individual declarations -- diff --git a/tests/purs/failing/4408Acyclic.out b/tests/purs/failing/4408Acyclic.out new file mode 100644 index 0000000000..b5decae42a --- /dev/null +++ b/tests/purs/failing/4408Acyclic.out @@ -0,0 +1,22 @@ +Error found: +in module Main +at tests/purs/failing/4408Acyclic.purs:16:9 - 16:14 (line 16, column 9 - line 16, column 14) + + Hole 'help' has the inferred type +   +  Int -> K +   + You could substitute the hole with one of these values: +   +  Main.aRinku :: Int -> K  +  Main.cMuni :: Int -> K  +  Safe.Coerce.coerce :: forall a b. Coercible a b => a -> b +  Unsafe.Coerce.unsafeCoerce :: forall a b. a -> b  +  Main.K :: Int -> K  +   + +in value declaration bMaho + +See https://github.com/purescript/documentation/blob/master/errors/HoleInferredType.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/4408Acyclic.purs b/tests/purs/failing/4408Acyclic.purs new file mode 100644 index 0000000000..df5a7ea8e3 --- /dev/null +++ b/tests/purs/failing/4408Acyclic.purs @@ -0,0 +1,22 @@ +-- @shouldFailWith HoleInferredType +module Main where + +-- Expected: +-- +-- aRinku+cMuni -> bMaho -> dRei +-- +-- Both aRinku and cMuni is suggested + +newtype K = K Int + +aRinku :: Int -> K +aRinku = K + +bMaho :: K +bMaho = ?help 0 + +cMuni :: Int -> K +cMuni = K + +dRei :: Int -> K +dRei _ = bMaho diff --git a/tests/purs/failing/4408AcyclicRecursive.out b/tests/purs/failing/4408AcyclicRecursive.out new file mode 100644 index 0000000000..fbfe1db8c8 --- /dev/null +++ b/tests/purs/failing/4408AcyclicRecursive.out @@ -0,0 +1,23 @@ +Error found: +in module Main +at tests/purs/failing/4408AcyclicRecursive.purs:17:11 - 17:16 (line 17, column 11 - line 17, column 16) + + Hole 'help' has the inferred type +   +  Int -> K +   + You could substitute the hole with one of these values: +   +  Main.aRinku :: Int -> K  +  Main.bMaho :: Int -> K  +  Main.cMuni :: Int -> K  +  Safe.Coerce.coerce :: forall a b. Coercible a b => a -> b +  Unsafe.Coerce.unsafeCoerce :: forall a b. a -> b  +  Main.K :: Int -> K  +   + +in value declaration bMaho + +See https://github.com/purescript/documentation/blob/master/errors/HoleInferredType.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/4408AcyclicRecursive.purs b/tests/purs/failing/4408AcyclicRecursive.purs new file mode 100644 index 0000000000..c4d7ad140b --- /dev/null +++ b/tests/purs/failing/4408AcyclicRecursive.purs @@ -0,0 +1,23 @@ +-- @shouldFailWith HoleInferredType +module Main where + +-- Expected: +-- +-- aRinku+cMuni -> bMaho -> dRei +-- +-- aRinku, cMuni, and bMaho are all suggested. +-- bMaho can be aware of itself during checking. + +newtype K = K Int + +aRinku :: Int -> K +aRinku = K + +bMaho :: Int -> K +bMaho _ = ?help 0 + +cMuni :: Int -> K +cMuni = K + +dRei :: Int -> K +dRei _ = bMaho diff --git a/tests/purs/failing/4408Cyclic.out b/tests/purs/failing/4408Cyclic.out new file mode 100644 index 0000000000..24aed1b1c1 --- /dev/null +++ b/tests/purs/failing/4408Cyclic.out @@ -0,0 +1,31 @@ +Error found: +in module Main +at tests/purs/failing/4408Cyclic.purs:23:29 - 23:34 (line 23, column 29 - line 23, column 34) + + Hole 'help' has the inferred type +   +  Int -> K +   + You could substitute the hole with one of these values: +   +  Main.aSaki :: Int -> K  +  Main.bNoa :: forall a. a -> K  +  Main.cTowa :: forall a. a -> K  +  Main.eSaki :: Int -> K  +  Safe.Coerce.coerce :: forall a b. Coercible a b => a -> b +  Unsafe.Coerce.unsafeCoerce :: forall a b. a -> b  +  Main.K :: Int -> K  +   + in the following context: + + a :: a0 + + +in binding group cTowa, bNoa + +where a0 is a rigid type variable + bound at (line 0, column 0 - line 0, column 0) + +See https://github.com/purescript/documentation/blob/master/errors/HoleInferredType.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/4408Cyclic.purs b/tests/purs/failing/4408Cyclic.purs new file mode 100644 index 0000000000..96d15e4532 --- /dev/null +++ b/tests/purs/failing/4408Cyclic.purs @@ -0,0 +1,29 @@ +-- @shouldFailWith HoleInferredType +module Main where + +-- Expected: +-- +-- aSaki/eSaki -> bNoa~cTowa -> dIbuki +-- +-- Only aSaki/eSaki, bNoa, and cTowa is suggested. +-- +-- The mutual recursion between bNoa and cTowa +-- ensures they exist "at the same time". dIbuki +-- depends on cTowa, so it's checked much later. + +newtype K = K Int + +aSaki :: Int -> K +aSaki = K + +bNoa :: forall a. a -> K +bNoa a = let _ = cTowa a in K 0 + +cTowa :: forall a. a -> K +cTowa a = let _ = bNoa a in ?help 0 + +dIbuki :: Int -> K +dIbuki = bNoa + +eSaki :: Int -> K +eSaki = K diff --git a/tests/purs/failing/4408CyclicTail.out b/tests/purs/failing/4408CyclicTail.out new file mode 100644 index 0000000000..9dfe2fa39d --- /dev/null +++ b/tests/purs/failing/4408CyclicTail.out @@ -0,0 +1,26 @@ +Error found: +in module Main +at tests/purs/failing/4408CyclicTail.purs:22:11 - 22:16 (line 22, column 11 - line 22, column 16) + + Hole 'help' has the inferred type +   +  Int -> K +   + You could substitute the hole with one of these values: +   +  Main.aKyoko :: Int -> K  +  Main.bShinobu :: forall a. a -> K  +  Main.cEsora :: forall a. a -> K  +  Main.dYuka :: Int -> K  +  Main.eShinobu :: forall a. a -> K  +  Main.fEsora :: forall a. a -> K  +  Safe.Coerce.coerce :: forall a b. Coercible a b => a -> b +  Unsafe.Coerce.unsafeCoerce :: forall a b. a -> b  +  Main.K :: Int -> K  +   + +in value declaration dYuka + +See https://github.com/purescript/documentation/blob/master/errors/HoleInferredType.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/4408CyclicTail.purs b/tests/purs/failing/4408CyclicTail.purs new file mode 100644 index 0000000000..17347d43b0 --- /dev/null +++ b/tests/purs/failing/4408CyclicTail.purs @@ -0,0 +1,28 @@ +-- @shouldFailWith HoleInferredType +module Main where + +-- Expected: +-- +-- aKyoko -> bShinobu~cEsora/eShinobu~fEsora -> dYuka +-- +-- All are suggested, as dYuka is also recursive. + +newtype K = K Int + +aKyoko :: Int -> K +aKyoko = K + +bShinobu :: forall a. a -> K +bShinobu a = let _ = cEsora a in K 0 + +cEsora :: forall a. a -> K +cEsora a = let _ = bShinobu a in K 0 + +dYuka :: Int -> K +dYuka _ = ?help 0 + +eShinobu :: forall a. a -> K +eShinobu a = let _ = fEsora a in K 0 + +fEsora :: forall a. a -> K +fEsora a = let _ = eShinobu a in K 0 diff --git a/tests/purs/failing/4408CyclicTriple.out b/tests/purs/failing/4408CyclicTriple.out new file mode 100644 index 0000000000..d6d0925b8a --- /dev/null +++ b/tests/purs/failing/4408CyclicTriple.out @@ -0,0 +1,32 @@ +Error found: +in module Main +at tests/purs/failing/4408CyclicTriple.purs:22:33 - 22:38 (line 22, column 33 - line 22, column 38) + + Hole 'help' has the inferred type +   +  Int -> K +   + You could substitute the hole with one of these values: +   +  Main.aHaruna :: Int -> K  +  Main.bMiyu :: forall a. a -> K  +  Main.cKurumi :: forall a. a -> K  +  Main.dMiiko :: forall a. a -> K  +  Main.eHaruna :: Int -> K  +  Safe.Coerce.coerce :: forall a b. Coercible a b => a -> b +  Unsafe.Coerce.unsafeCoerce :: forall a b. a -> b  +  Main.K :: Int -> K  +   + in the following context: + + a :: a0 + + +in binding group dMiiko, cKurumi, bMiyu + +where a0 is a rigid type variable + bound at (line 0, column 0 - line 0, column 0) + +See https://github.com/purescript/documentation/blob/master/errors/HoleInferredType.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/4408CyclicTriple.purs b/tests/purs/failing/4408CyclicTriple.purs new file mode 100644 index 0000000000..d0b3d35a80 --- /dev/null +++ b/tests/purs/failing/4408CyclicTriple.purs @@ -0,0 +1,25 @@ +-- @shouldFailWith HoleInferredType +module Main where + +-- Expected: +-- +-- aHaruna/eHaruna -> bMiyu~cKurumi~dMiiko +-- +-- All are suggested. + +newtype K = K Int + +aHaruna :: Int -> K +aHaruna = K + +bMiyu :: forall a. a -> K +bMiyu a = let _ = dMiiko a in K 0 + +cKurumi :: forall a. a -> K +cKurumi a = let _ = bMiyu a in K 0 + +dMiiko :: forall a. a -> K +dMiiko a = let _ = cKurumi a in ?help 0 + +eHaruna :: Int -> K +eHaruna = K From 85043bfbafad8064212c5ab6ca9ce4a729bb0025 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Fri, 3 Mar 2023 21:59:25 -0600 Subject: [PATCH 20/68] Update internal scripts to latest resolvers (#4445) * Update generator to latest resolver * Fix multiple packages define same module problem * Update changelog script to latest resolver; fix issues * Add changelog entry --- .../internal_update-script-resolvers.md | 1 + license-generator/generate.hs | 10 +++++- update-changelog.hs | 33 +++++++++++++------ 3 files changed, 33 insertions(+), 11 deletions(-) create mode 100644 CHANGELOG.d/internal_update-script-resolvers.md diff --git a/CHANGELOG.d/internal_update-script-resolvers.md b/CHANGELOG.d/internal_update-script-resolvers.md new file mode 100644 index 0000000000..6a913f5501 --- /dev/null +++ b/CHANGELOG.d/internal_update-script-resolvers.md @@ -0,0 +1 @@ +* Update license/changelog scrips to latest Stack resolver diff --git a/license-generator/generate.hs b/license-generator/generate.hs index 817d39c715..d000f2276c 100644 --- a/license-generator/generate.hs +++ b/license-generator/generate.hs @@ -1,5 +1,13 @@ #!/usr/bin/env stack --- stack --resolver lts-13.12 script +{- stack + --resolver lts-20.9 script + --package bytestring + --package http-client-tls + --package http-client + --package http-types + --package text + --package split +-} {-# LANGUAGE TupleSections #-} -- | diff --git a/update-changelog.hs b/update-changelog.hs index bb149ec903..b9296440d4 100755 --- a/update-changelog.hs +++ b/update-changelog.hs @@ -1,5 +1,18 @@ #!/usr/bin/env stack --- stack --resolver lts-17.6 script +{- stack + --resolver lts-20.9 script + --package bytestring + --package filepath + --package text + --package github-rest + --package directory + --package simple-cmd + --package time + --package bifunctors + --package attoparsec + --package aeson + --package protolude +-} {-# LANGUAGE DeriveFoldable , DeriveFunctor @@ -37,11 +50,11 @@ import qualified Protolude import Control.Monad.Fail (fail) import qualified Data.Aeson as JSON +import qualified Data.Aeson.KeyMap as KM import Data.Attoparsec.ByteString (maybeResult, parse) import "bifunctors" Data.Bifunctor.Flip (Flip(..)) import qualified Data.ByteString as BS -import qualified Data.HashMap.Lazy as HM import qualified Data.List.NonEmpty as NEL import Data.String (String) import qualified Data.String as String @@ -49,12 +62,12 @@ import qualified Data.Text as T import Data.Time.Clock (UTCTime) import Data.Time.Format.ISO8601 (iso8601ParseM) import Data.Time.LocalTime (zonedTimeToUTC) -import GitHub.REST (GHEndpoint(..), GitHubState(..), KeyValue(..), MonadGitHubREST, StdMethod(..), queryGitHub, runGitHubT) +import GitHub.REST (GHEndpoint(..), GitHubSettings(..), KeyValue(..), MonadGitHubREST, StdMethod(..), queryGitHub, runGitHubT) import qualified SimpleCmd.Git as IOGit import System.Directory (setCurrentDirectory) import System.FilePath (normalise, takeFileName, ()) -main = runGitHubT gitHubState $ do +main = runGitHubT gitHubSettings $ do git "rev-parse" ["--show-toplevel"] >>= liftIO . setCurrentDirectory entries <- String.lines <$> git "ls-tree" ["--name-only", "HEAD", "CHANGELOG.d/"] @@ -87,8 +100,8 @@ main = runGitHubT gitHubState $ do git_ "add" ["CHANGELOG.md"] git_ "rm" $ "-q" : entryFiles -gitHubState :: GitHubState -gitHubState = GitHubState Nothing "purescript/purescript update-changelog.hs" "v3" +gitHubSettings :: GitHubSettings +gitHubSettings = GitHubSettings Nothing "purescript/purescript update-changelog.hs" "v3" processEntriesStartingWith :: (MonadFail m, MonadGitHubREST m, MonadIO m) => String -> [String] -> m [ChangelogEntry] processEntriesStartingWith prefix @@ -126,8 +139,8 @@ updateEntry file = do parsePRNumber :: Text -> Maybe (CommitType, Int) parsePRNumber = liftA2 (<|>) - (fmap (MergeCommit, ) . readMaybe . toS . fst . T.breakOn " " <=< T.stripPrefix "Merge pull request #") - (fmap (SquashCommit, ) . readMaybe . toS <=< T.stripSuffix ")" . snd . T.breakOnEnd "(#") + (fmap (MergeCommit, ) . readMaybe . (toS :: T.Text -> String) . fst . T.breakOn " " <=< T.stripPrefix "Merge pull request #") + (fmap (SquashCommit, ) . readMaybe . (toS :: T.Text -> String) <=< T.stripSuffix ")" . snd . T.breakOnEnd "(#") -- | -- This function helps us exclude PRs that are just fixups of changelog @@ -149,7 +162,7 @@ lookupPRAuthor prNum = , ghData = [] } >>= \case - JSON.Object (HM.lookup "user" -> Just (JSON.Object (HM.lookup "login" -> Just (JSON.String name)))) -> pure name + JSON.Object (KM.lookup "user" -> Just (JSON.Object (KM.lookup "login" -> Just (JSON.String name)))) -> pure name _ -> fail "error accessing GitHub API" commaSeparate :: [Text] -> Text @@ -162,7 +175,7 @@ commaSeparate = \case getVersion :: (MonadFail m, MonadIO m) => m Text getVersion = (liftIO . BS.readFile) ("npm-package" "package.json") >>= \case - (maybeResult . parse JSON.json -> Just (JSON.Object (HM.lookup "version" -> Just (JSON.String v)))) -> pure v + (maybeResult . parse JSON.json -> Just (JSON.Object (KM.lookup "version" -> Just (JSON.String v)))) -> pure v _ -> fail "could not read version from npm-package/package.json" conditionalSection :: Text -> [ChangelogEntry] -> Text From f496fc4c09c90df181b361a3586962d36230e03f Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Mon, 6 Mar 2023 05:12:01 -0600 Subject: [PATCH 21/68] Prep 0.15.8 release (#4444) * Bump version to 0.15.8 * Update license * Update changelog --- CHANGELOG.d/feature_pursuit-dark-theme.md | 5 -- CHANGELOG.d/fix_4408.md | 49 ------------ CHANGELOG.d/fix_4431.purs | 1 - .../fix_add-labels-in-type-mismatch-errors.md | 1 - .../internal_update-script-resolvers.md | 1 - CHANGELOG.d/misc_bump-ghc.md | 1 - CHANGELOG.md | 74 +++++++++++++++++++ LICENSE | 34 +++++++++ npm-package/package.json | 4 +- purescript.cabal | 2 +- 10 files changed, 111 insertions(+), 61 deletions(-) delete mode 100644 CHANGELOG.d/feature_pursuit-dark-theme.md delete mode 100644 CHANGELOG.d/fix_4408.md delete mode 100644 CHANGELOG.d/fix_4431.purs delete mode 100644 CHANGELOG.d/fix_add-labels-in-type-mismatch-errors.md delete mode 100644 CHANGELOG.d/internal_update-script-resolvers.md delete mode 100644 CHANGELOG.d/misc_bump-ghc.md diff --git a/CHANGELOG.d/feature_pursuit-dark-theme.md b/CHANGELOG.d/feature_pursuit-dark-theme.md deleted file mode 100644 index f74097901f..0000000000 --- a/CHANGELOG.d/feature_pursuit-dark-theme.md +++ /dev/null @@ -1,5 +0,0 @@ -* Generated documentation now supports dark mode - - PureScript documentation has a new dark theme available. It will - automatically be used based on your browser or system's color scheme - preferences. diff --git a/CHANGELOG.d/fix_4408.md b/CHANGELOG.d/fix_4408.md deleted file mode 100644 index caf7f86f39..0000000000 --- a/CHANGELOG.d/fix_4408.md +++ /dev/null @@ -1,49 +0,0 @@ -* Account for typed holes when checking value declarations - - The compiler now takes into account typed holes when ordering value declarations - for type checking, allowing more top-level values to be suggested instead of - being limited by reverse lexicographical ordering. - - Given: - ```purescript - module Main where - - newtype K = K Int - - aRinku :: Int -> K - aRinku = K - - bMaho :: K - bMaho = ?help 0 - - cMuni :: Int -> K - cMuni = K - - dRei :: Int -> K - dRei _ = bMaho - ``` - - Before: - ``` - Hole 'help' has the inferred type - - Int -> K - - You could substitute the hole with one of these values: - - Main.cMuni :: Int -> K - Main.K :: Int -> K - ``` - - After: - ``` - Hole 'help' has the inferred type - - Int -> K - - You could substitute the hole with one of these values: - - Main.aRinku :: Int -> K - Main.cMuni :: Int -> K - Main.K :: Int -> K - ``` diff --git a/CHANGELOG.d/fix_4431.purs b/CHANGELOG.d/fix_4431.purs deleted file mode 100644 index 05b8333c92..0000000000 --- a/CHANGELOG.d/fix_4431.purs +++ /dev/null @@ -1 +0,0 @@ -* Fix instance deriving regression diff --git a/CHANGELOG.d/fix_add-labels-in-type-mismatch-errors.md b/CHANGELOG.d/fix_add-labels-in-type-mismatch-errors.md deleted file mode 100644 index f658f51f9a..0000000000 --- a/CHANGELOG.d/fix_add-labels-in-type-mismatch-errors.md +++ /dev/null @@ -1 +0,0 @@ - * Outputs what label the type-error occurred on when types don't match diff --git a/CHANGELOG.d/internal_update-script-resolvers.md b/CHANGELOG.d/internal_update-script-resolvers.md deleted file mode 100644 index 6a913f5501..0000000000 --- a/CHANGELOG.d/internal_update-script-resolvers.md +++ /dev/null @@ -1 +0,0 @@ -* Update license/changelog scrips to latest Stack resolver diff --git a/CHANGELOG.d/misc_bump-ghc.md b/CHANGELOG.d/misc_bump-ghc.md deleted file mode 100644 index 165ac355c5..0000000000 --- a/CHANGELOG.d/misc_bump-ghc.md +++ /dev/null @@ -1 +0,0 @@ -* Bump Stackage snapshot to lts-20.9 and GHC to 9.2.5 diff --git a/CHANGELOG.md b/CHANGELOG.md index 5314a5561e..d1c1c3d925 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,80 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.8 + +New features: + +* Generated documentation now supports dark mode (#4438 by @sometimes-i-send-pull-requests) + + PureScript documentation has a new dark theme available. It will + automatically be used based on your browser or system's color scheme + preferences. + +Bugfixes: + +* Fix instance deriving regression (#4432 by @rhendric) + +* Outputs what label the type-error occurred on when types don't match (#4411 by @FredTheDino) + +* Account for typed holes when checking value declarations (#4437 by @purefunctor) + + The compiler now takes into account typed holes when ordering value declarations + for type checking, allowing more top-level values to be suggested instead of + being limited by reverse lexicographical ordering. + + Given: + ```purescript + module Main where + + newtype K = K Int + + aRinku :: Int -> K + aRinku = K + + bMaho :: K + bMaho = ?help 0 + + cMuni :: Int -> K + cMuni = K + + dRei :: Int -> K + dRei _ = bMaho + ``` + + Before: + ``` + Hole 'help' has the inferred type + + Int -> K + + You could substitute the hole with one of these values: + + Main.cMuni :: Int -> K + Main.K :: Int -> K + ``` + + After: + ``` + Hole 'help' has the inferred type + + Int -> K + + You could substitute the hole with one of these values: + + Main.aRinku :: Int -> K + Main.cMuni :: Int -> K + Main.K :: Int -> K + ``` + +Other improvements: + +* Bump Stackage snapshot to lts-20.9 and GHC to 9.2.5 (#4422, #4428, and #4433 by @purefunctor, @JordanMartinez, and @andys8) + +Internal: + +* Update license/changelog scrips to latest Stack resolver (#4445 by @JordanMartinez) + ## 0.15.7 New features: diff --git a/LICENSE b/LICENSE index 29d843bea4..490ff3651c 100644 --- a/LICENSE +++ b/LICENSE @@ -56,6 +56,7 @@ PureScript uses the following Haskell library packages. Their license files foll contravariant cryptonite css-text + data-array-byte data-default data-default-class data-default-instances-containers @@ -1518,6 +1519,39 @@ css-text LICENSE file: OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +data-array-byte LICENSE file: + + Copyright (c) 2008-2009, Roman Leshchinskiy + 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 name of the University nor the names of its contributors may be + used to endorse or promote products derived from this software without + specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF + GLASGOW AND THE 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 + UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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. + + data-default LICENSE file: Copyright (c) 2013 Lukas Mai diff --git a/npm-package/package.json b/npm-package/package.json index 1cb36d4747..b0ac8d355c 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.7", + "version": "0.15.8", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.7", + "postinstall": "install-purescript --purs-ver=0.15.8", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index b426757e8a..4f95bc4e43 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.7 +version: 0.15.8 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From 5a79544af92e2a1247c015e7f9155400155e58c9 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Fri, 10 Mar 2023 19:29:17 -0600 Subject: [PATCH 22/68] Simplify imports with post qualified style (#4451) - Changes made across `app`, `src`, and `tests`: ```diff -import qualified Foo +import Foo qualified -import qualified Foo as F +import Foo qualified as F -import qualified Foo as F +import Foo qualified as F -import Foo +import Foo -import Foo (bar) +import Foo (bar) -import "monad-logger" Foo +import "monad-logger" Foo ``` - added `ImportQualifiedPost` extension - removed `-Wno-prepositive-qualified-module` --- CHANGELOG.d/internal_simplify-imports.md | 1 + app/Command/Bundle.hs | 6 +- app/Command/Compile.hs | 42 ++++---- app/Command/Docs.hs | 36 +++---- app/Command/Docs/Html.hs | 32 +++--- app/Command/Docs/Markdown.hs | 12 +-- app/Command/Graph.hs | 28 ++--- app/Command/Hierarchy.hs | 34 +++--- app/Command/Ide.hs | 44 ++++---- app/Command/Publish.hs | 18 ++-- app/Command/REPL.hs | 40 +++---- app/Main.hs | 30 +++--- app/Version.hs | 2 +- purescript.cabal | 2 +- src/Language/PureScript.hs | 2 +- src/Language/PureScript/AST/Declarations.hs | 6 +- .../PureScript/AST/Declarations/ChainId.hs | 2 +- src/Language/PureScript/AST/Exported.hs | 2 +- src/Language/PureScript/AST/Operators.hs | 2 +- src/Language/PureScript/AST/SourcePos.hs | 4 +- src/Language/PureScript/AST/Traversals.hs | 6 +- src/Language/PureScript/Bundle.hs | 4 +- src/Language/PureScript/CST.hs | 6 +- src/Language/PureScript/CST/Convert.hs | 18 ++-- src/Language/PureScript/CST/Errors.hs | 2 +- src/Language/PureScript/CST/Layout.hs | 2 +- src/Language/PureScript/CST/Lexer.hs | 10 +- src/Language/PureScript/CST/Monad.hs | 2 +- src/Language/PureScript/CST/Positions.hs | 4 +- src/Language/PureScript/CST/Print.hs | 4 +- src/Language/PureScript/CST/Types.hs | 4 +- src/Language/PureScript/CST/Utils.hs | 8 +- src/Language/PureScript/CodeGen/JS.hs | 16 +-- src/Language/PureScript/CodeGen/JS/Common.hs | 2 +- src/Language/PureScript/CodeGen/JS/Printer.hs | 6 +- src/Language/PureScript/Constants/Libs.hs | 4 +- src/Language/PureScript/Constants/Prim.hs | 2 +- src/Language/PureScript/CoreFn/CSE.hs | 8 +- src/Language/PureScript/CoreFn/Desugar.hs | 8 +- src/Language/PureScript/CoreFn/FromJSON.hs | 36 +++---- src/Language/PureScript/CoreFn/Laziness.hs | 12 +-- src/Language/PureScript/CoreFn/Optimizer.hs | 4 +- src/Language/PureScript/CoreFn/ToJSON.hs | 36 +++---- src/Language/PureScript/CoreImp/Module.hs | 2 +- .../PureScript/CoreImp/Optimizer/Inliner.hs | 6 +- .../PureScript/CoreImp/Optimizer/MagicDo.hs | 2 +- .../PureScript/CoreImp/Optimizer/TCO.hs | 2 +- .../PureScript/CoreImp/Optimizer/Unused.hs | 4 +- src/Language/PureScript/Docs/AsHtml.hs | 14 +-- src/Language/PureScript/Docs/AsMarkdown.hs | 6 +- src/Language/PureScript/Docs/Collect.hs | 28 ++--- src/Language/PureScript/Docs/Convert.hs | 28 ++--- .../PureScript/Docs/Convert/ReExports.hs | 18 ++-- .../PureScript/Docs/Convert/Single.hs | 14 +-- src/Language/PureScript/Docs/Prim.hs | 12 +-- src/Language/PureScript/Docs/Render.hs | 10 +- .../PureScript/Docs/RenderedCode/Types.hs | 8 +- src/Language/PureScript/Docs/Tags.hs | 8 +- src/Language/PureScript/Docs/Types.hs | 30 +++--- src/Language/PureScript/Environment.hs | 16 +-- src/Language/PureScript/Errors.hs | 100 +++++++++--------- src/Language/PureScript/Errors/JSON.hs | 6 +- src/Language/PureScript/Externs.hs | 6 +- src/Language/PureScript/Graph.hs | 42 ++++---- src/Language/PureScript/Hierarchy.hs | 10 +- src/Language/PureScript/Ide.hs | 50 ++++----- src/Language/PureScript/Ide/CaseSplit.hs | 24 ++--- src/Language/PureScript/Ide/Command.hs | 22 ++-- src/Language/PureScript/Ide/Completion.hs | 24 ++--- src/Language/PureScript/Ide/Error.hs | 16 +-- src/Language/PureScript/Ide/Externs.hs | 22 ++-- src/Language/PureScript/Ide/Filter.hs | 28 ++--- .../PureScript/Ide/Filter/Declaration.hs | 6 +- src/Language/PureScript/Ide/Filter/Imports.hs | 4 +- src/Language/PureScript/Ide/Imports.hs | 18 ++-- .../PureScript/Ide/Imports/Actions.hs | 34 +++--- src/Language/PureScript/Ide/Logging.hs | 12 +-- src/Language/PureScript/Ide/Matcher.hs | 20 ++-- src/Language/PureScript/Ide/Prim.hs | 14 +-- src/Language/PureScript/Ide/Rebuild.hs | 40 +++---- src/Language/PureScript/Ide/Reexports.hs | 12 +-- src/Language/PureScript/Ide/SourceFile.hs | 16 +-- src/Language/PureScript/Ide/State.hs | 38 +++---- src/Language/PureScript/Ide/Types.hs | 26 ++--- src/Language/PureScript/Ide/Usage.hs | 16 +-- src/Language/PureScript/Ide/Util.hs | 24 ++--- src/Language/PureScript/Interactive.hs | 66 ++++++------ .../PureScript/Interactive/Completion.hs | 22 ++-- .../PureScript/Interactive/Message.hs | 12 +-- src/Language/PureScript/Interactive/Module.hs | 14 +-- src/Language/PureScript/Interactive/Parser.hs | 26 ++--- .../PureScript/Interactive/Printer.hs | 18 ++-- src/Language/PureScript/Interactive/Types.hs | 16 +-- src/Language/PureScript/Label.hs | 2 +- src/Language/PureScript/Linter.hs | 6 +- src/Language/PureScript/Linter/Exhaustive.hs | 6 +- src/Language/PureScript/Linter/Imports.hs | 6 +- src/Language/PureScript/Make.hs | 80 +++++++------- src/Language/PureScript/Make/Actions.hs | 94 ++++++++-------- src/Language/PureScript/Make/BuildPlan.hs | 44 ++++---- src/Language/PureScript/Make/Cache.hs | 10 +- src/Language/PureScript/Make/Monad.hs | 56 +++++----- src/Language/PureScript/ModuleDependencies.hs | 18 ++-- src/Language/PureScript/Names.hs | 4 +- src/Language/PureScript/Options.hs | 4 +- src/Language/PureScript/PSString.hs | 12 +-- src/Language/PureScript/Pretty/Common.hs | 4 +- src/Language/PureScript/Pretty/Types.hs | 2 +- src/Language/PureScript/Pretty/Values.hs | 6 +- src/Language/PureScript/Publish.hs | 16 +-- .../PureScript/Publish/BoxesHelpers.hs | 4 +- .../PureScript/Publish/ErrorsWarnings.hs | 10 +- .../PureScript/Publish/Registry/Compat.hs | 4 +- src/Language/PureScript/Renamer.hs | 6 +- src/Language/PureScript/Roles.hs | 4 +- src/Language/PureScript/Sugar/AdoNotation.hs | 18 ++-- .../PureScript/Sugar/BindingGroups.hs | 6 +- src/Language/PureScript/Sugar/DoNotation.hs | 22 ++-- src/Language/PureScript/Sugar/Names.hs | 6 +- src/Language/PureScript/Sugar/Names/Env.hs | 6 +- .../PureScript/Sugar/Names/Exports.hs | 2 +- .../PureScript/Sugar/Names/Imports.hs | 4 +- .../PureScript/Sugar/ObjectWildcards.hs | 24 ++--- src/Language/PureScript/Sugar/Operators.hs | 4 +- .../PureScript/Sugar/Operators/Common.hs | 10 +- .../PureScript/Sugar/Operators/Expr.hs | 4 +- src/Language/PureScript/Sugar/TypeClasses.hs | 48 ++++----- .../PureScript/Sugar/TypeClasses/Deriving.hs | 32 +++--- src/Language/PureScript/TypeChecker.hs | 10 +- .../PureScript/TypeChecker/Deriving.hs | 6 +- .../PureScript/TypeChecker/Entailment.hs | 12 +-- .../TypeChecker/Entailment/Coercible.hs | 6 +- .../TypeChecker/Entailment/IntCompare.hs | 10 +- src/Language/PureScript/TypeChecker/Kinds.hs | 8 +- src/Language/PureScript/TypeChecker/Monad.hs | 6 +- src/Language/PureScript/TypeChecker/Roles.hs | 4 +- .../PureScript/TypeChecker/Synonyms.hs | 22 ++-- .../PureScript/TypeChecker/TypeSearch.hs | 40 +++---- src/Language/PureScript/TypeChecker/Types.hs | 8 +- src/Language/PureScript/TypeChecker/Unify.hs | 6 +- src/Language/PureScript/Types.hs | 10 +- src/System/IO/UTF8.hs | 14 +-- .../Language/PureScript/Ide/CompletionSpec.hs | 4 +- tests/Language/PureScript/Ide/FilterSpec.hs | 20 ++-- tests/Language/PureScript/Ide/ImportsSpec.hs | 26 ++--- tests/Language/PureScript/Ide/MatcherSpec.hs | 12 +-- tests/Language/PureScript/Ide/RebuildSpec.hs | 24 ++--- .../Language/PureScript/Ide/ReexportsSpec.hs | 16 +-- .../Language/PureScript/Ide/SourceFileSpec.hs | 14 +-- tests/Language/PureScript/Ide/StateSpec.hs | 16 +-- tests/Language/PureScript/Ide/Test.hs | 28 ++--- tests/Language/PureScript/Ide/UsageSpec.hs | 18 ++-- tests/Main.hs | 30 +++--- tests/TestCompiler.hs | 8 +- tests/TestCst.hs | 6 +- tests/TestDocs.hs | 12 +-- tests/TestGraph.hs | 4 +- tests/TestHierarchy.hs | 2 +- tests/TestIde.hs | 10 +- tests/TestMake.hs | 10 +- tests/TestPrimDocs.hs | 8 +- tests/TestPscPublish.hs | 8 +- tests/TestPsci/CompletionTest.hs | 16 +-- tests/TestPsci/EvalTest.hs | 22 ++-- tests/TestPsci/TestEnv.hs | 30 +++--- tests/TestSourceMaps.hs | 8 +- tests/TestUtils.hs | 18 ++-- 167 files changed, 1339 insertions(+), 1338 deletions(-) create mode 100644 CHANGELOG.d/internal_simplify-imports.md diff --git a/CHANGELOG.d/internal_simplify-imports.md b/CHANGELOG.d/internal_simplify-imports.md new file mode 100644 index 0000000000..13bf406888 --- /dev/null +++ b/CHANGELOG.d/internal_simplify-imports.md @@ -0,0 +1 @@ +* Refactor module imports to make identifiers' origins obvious diff --git a/app/Command/Bundle.hs b/app/Command/Bundle.hs index 266e91a708..99c72312b9 100644 --- a/app/Command/Bundle.hs +++ b/app/Command/Bundle.hs @@ -3,9 +3,9 @@ module Command.Bundle (command) where import Prelude -import System.Exit (exitFailure) -import System.IO (stderr, hPutStrLn) -import qualified Options.Applicative as Opts +import System.Exit (exitFailure) +import System.IO (stderr, hPutStrLn) +import Options.Applicative qualified as Opts app :: IO () app = do diff --git a/app/Command/Compile.hs b/app/Command/Compile.hs index 3972994194..f5c82186e2 100644 --- a/app/Command/Compile.hs +++ b/app/Command/Compile.hs @@ -2,27 +2,27 @@ module Command.Compile (command) where import Prelude -import Control.Applicative -import Control.Monad -import qualified Data.Aeson as A -import Data.Bool (bool) -import qualified Data.ByteString.Lazy.UTF8 as LBU8 -import Data.List (intercalate) -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Text as T -import Data.Traversable (for) -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import Language.PureScript.Errors.JSON -import Language.PureScript.Make -import qualified Options.Applicative as Opts -import qualified System.Console.ANSI as ANSI -import System.Exit (exitSuccess, exitFailure) -import System.Directory (getCurrentDirectory) -import System.FilePath.Glob (glob) -import System.IO (hPutStr, hPutStrLn, stderr, stdout) -import System.IO.UTF8 (readUTF8FilesT) +import Control.Applicative +import Control.Monad +import Data.Aeson qualified as A +import Data.Bool (bool) +import Data.ByteString.Lazy.UTF8 qualified as LBU8 +import Data.List (intercalate) +import Data.Map qualified as M +import Data.Set qualified as S +import Data.Text qualified as T +import Data.Traversable (for) +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.Errors.JSON +import Language.PureScript.Make +import Options.Applicative qualified as Opts +import System.Console.ANSI qualified as ANSI +import System.Exit (exitSuccess, exitFailure) +import System.Directory (getCurrentDirectory) +import System.FilePath.Glob (glob) +import System.IO (hPutStr, hPutStrLn, stderr, stdout) +import System.IO.UTF8 (readUTF8FilesT) data PSCMakeOptions = PSCMakeOptions { pscmInput :: [FilePath] diff --git a/app/Command/Docs.hs b/app/Command/Docs.hs index cd73eda4eb..bb30171afb 100644 --- a/app/Command/Docs.hs +++ b/app/Command/Docs.hs @@ -3,24 +3,24 @@ module Command.Docs (command, infoModList) where import Prelude -import Command.Docs.Html -import Command.Docs.Markdown -import Control.Applicative -import Control.Monad.Writer -import Control.Monad.Trans.Except (runExceptT) -import Data.Maybe (fromMaybe) -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.Docs as D -import Language.PureScript.Docs.Tags (dumpCtags, dumpEtags) -import qualified Options.Applicative as Opts -import qualified Text.PrettyPrint.ANSI.Leijen as PP -import System.Directory (getCurrentDirectory, createDirectoryIfMissing, removeFile) -import System.Exit (exitFailure) -import System.FilePath (()) -import System.FilePath.Glob (compile, glob, globDir1) -import System.IO (hPutStrLn, stderr) -import System.IO.UTF8 (writeUTF8FileT) +import Command.Docs.Html +import Command.Docs.Markdown +import Control.Applicative +import Control.Monad.Writer +import Control.Monad.Trans.Except (runExceptT) +import Data.Maybe (fromMaybe) +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Docs qualified as D +import Language.PureScript.Docs.Tags (dumpCtags, dumpEtags) +import Options.Applicative qualified as Opts +import Text.PrettyPrint.ANSI.Leijen qualified as PP +import System.Directory (getCurrentDirectory, createDirectoryIfMissing, removeFile) +import System.Exit (exitFailure) +import System.FilePath (()) +import System.FilePath.Glob (compile, glob, globDir1) +import System.IO (hPutStrLn, stderr) +import System.IO.UTF8 (writeUTF8FileT) -- | Available output formats data Format diff --git a/app/Command/Docs/Html.hs b/app/Command/Docs/Html.hs index f49cdf9305..18fcb93720 100644 --- a/app/Command/Docs/Html.hs +++ b/app/Command/Docs/Html.hs @@ -7,22 +7,22 @@ module Command.Docs.Html import Prelude -import Control.Applicative -import Control.Arrow ((&&&)) -import Control.Monad.Writer -import Data.List (sort) -import Data.Text (Text) -import Data.Text.Lazy (toStrict) -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.Docs as D -import qualified Language.PureScript.Docs.AsHtml as D -import Text.Blaze.Html5 (Html, (!), toMarkup) -import qualified Text.Blaze.Html5 as H -import qualified Text.Blaze.Html5.Attributes as A -import qualified Text.Blaze.Html.Renderer.Text as Blaze -import System.IO.UTF8 (writeUTF8FileT) -import Version (versionString) +import Control.Applicative +import Control.Arrow ((&&&)) +import Control.Monad.Writer +import Data.List (sort) +import Data.Text (Text) +import Data.Text.Lazy (toStrict) +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Docs qualified as D +import Language.PureScript.Docs.AsHtml qualified as D +import Text.Blaze.Html5 (Html, (!), toMarkup) +import Text.Blaze.Html5 qualified as H +import Text.Blaze.Html5.Attributes qualified as A +import Text.Blaze.Html.Renderer.Text qualified as Blaze +import System.IO.UTF8 (writeUTF8FileT) +import Version (versionString) writeHtmlModules :: FilePath -> [(P.ModuleName, D.HtmlOutputModule Html)] -> IO () writeHtmlModules outputDir modules = do diff --git a/app/Command/Docs/Markdown.hs b/app/Command/Docs/Markdown.hs index e14a4e408a..1a05590d3f 100644 --- a/app/Command/Docs/Markdown.hs +++ b/app/Command/Docs/Markdown.hs @@ -5,12 +5,12 @@ module Command.Docs.Markdown import Prelude -import Data.Text (Text) -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.Docs as D -import qualified Language.PureScript.Docs.AsMarkdown as D -import System.IO.UTF8 (writeUTF8FileT) +import Data.Text (Text) +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Docs qualified as D +import Language.PureScript.Docs.AsMarkdown qualified as D +import System.IO.UTF8 (writeUTF8FileT) asMarkdown :: D.Module -> (P.ModuleName, Text) asMarkdown m = (D.modName m, D.runDocs . D.moduleAsMarkdown $ m) diff --git a/app/Command/Graph.hs b/app/Command/Graph.hs index 7d8467a7e8..338a303c8e 100644 --- a/app/Command/Graph.hs +++ b/app/Command/Graph.hs @@ -2,20 +2,20 @@ module Command.Graph (command) where import Prelude -import Control.Applicative (many) -import Control.Monad (unless, when) -import qualified Data.Aeson as Json -import Data.Bool (bool) -import qualified Data.ByteString.Lazy as LB -import qualified Data.ByteString.Lazy.UTF8 as LBU8 -import qualified Language.PureScript as P -import Language.PureScript.Errors.JSON -import qualified Options.Applicative as Opts -import qualified System.Console.ANSI as ANSI -import System.Exit (exitFailure) -import System.Directory (getCurrentDirectory) -import System.FilePath.Glob (glob) -import System.IO (hPutStr, hPutStrLn, stderr) +import Control.Applicative (many) +import Control.Monad (unless, when) +import Data.Aeson qualified as Json +import Data.Bool (bool) +import Data.ByteString.Lazy qualified as LB +import Data.ByteString.Lazy.UTF8 qualified as LBU8 +import Language.PureScript qualified as P +import Language.PureScript.Errors.JSON +import Options.Applicative qualified as Opts +import System.Console.ANSI qualified as ANSI +import System.Exit (exitFailure) +import System.Directory (getCurrentDirectory) +import System.FilePath.Glob (glob) +import System.IO (hPutStr, hPutStrLn, stderr) data GraphOptions = GraphOptions { graphInput :: [FilePath] diff --git a/app/Command/Hierarchy.hs b/app/Command/Hierarchy.hs index f7690599aa..4da946ba1f 100644 --- a/app/Command/Hierarchy.hs +++ b/app/Command/Hierarchy.hs @@ -15,24 +15,24 @@ module Command.Hierarchy (command) where -import Prelude -import Protolude (catMaybes) +import Prelude +import Protolude (catMaybes) -import Control.Applicative (optional) -import Data.Foldable (for_) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Options.Applicative (Parser) -import qualified Options.Applicative as Opts -import System.Directory (createDirectoryIfMissing) -import System.FilePath (()) -import System.FilePath.Glob (glob) -import System.Exit (exitFailure, exitSuccess) -import System.IO (hPutStr, stderr) -import System.IO.UTF8 (readUTF8FilesT) -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import Language.PureScript.Hierarchy (Graph(..), _unDigraph, _unGraphName, typeClasses) +import Control.Applicative (optional) +import Data.Foldable (for_) +import Data.Text qualified as T +import Data.Text.IO qualified as T +import Options.Applicative (Parser) +import Options.Applicative qualified as Opts +import System.Directory (createDirectoryIfMissing) +import System.FilePath (()) +import System.FilePath.Glob (glob) +import System.Exit (exitFailure, exitSuccess) +import System.IO (hPutStr, stderr) +import System.IO.UTF8 (readUTF8FilesT) +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.Hierarchy (Graph(..), _unDigraph, _unGraphName, typeClasses) data HierarchyOptions = HierarchyOptions { _hierarchyInput :: FilePath diff --git a/app/Command/Ide.hs b/app/Command/Ide.hs index 5da186a7c0..cbb5270a9b 100644 --- a/app/Command/Ide.hs +++ b/app/Command/Ide.hs @@ -17,28 +17,28 @@ module Command.Ide (command) where -import Protolude - -import qualified Data.Aeson as Aeson -import Control.Concurrent.STM -import "monad-logger" Control.Monad.Logger -import Data.IORef -import qualified Data.Text.IO as T -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.ByteString.Lazy.Char8 as BSL8 -import GHC.IO.Exception (IOErrorType(..), IOException(..)) -import Language.PureScript.Ide -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Util -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.State (updateCacheTimestamp) -import Language.PureScript.Ide.Types -import qualified Network.Socket as Network -import qualified Options.Applicative as Opts -import System.Directory -import System.FilePath -import System.IO hiding (putStrLn, print) -import System.IO.Error (isEOFError) +import Protolude + +import Data.Aeson qualified as Aeson +import Control.Concurrent.STM +import "monad-logger" Control.Monad.Logger +import Data.IORef +import Data.Text.IO qualified as T +import Data.ByteString.Char8 qualified as BS8 +import Data.ByteString.Lazy.Char8 qualified as BSL8 +import GHC.IO.Exception (IOErrorType(..), IOException(..)) +import Language.PureScript.Ide +import Language.PureScript.Ide.Command +import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.State (updateCacheTimestamp) +import Language.PureScript.Ide.Types +import Network.Socket qualified as Network +import Options.Applicative qualified as Opts +import System.Directory +import System.FilePath +import System.IO hiding (putStrLn, print) +import System.IO.Error (isEOFError) listenOnLocalhost :: Network.PortNumber -> IO Network.Socket listenOnLocalhost port = do diff --git a/app/Command/Publish.hs b/app/Command/Publish.hs index 930d48a79c..95e5f42ca0 100644 --- a/app/Command/Publish.hs +++ b/app/Command/Publish.hs @@ -2,15 +2,15 @@ module Command.Publish (command) where import Prelude -import Control.Monad.IO.Class (liftIO) -import qualified Data.Aeson as A -import qualified Data.ByteString.Lazy.Char8 as BL -import Data.Time.Clock (getCurrentTime) -import Data.Version (Version(..)) -import Language.PureScript.Publish -import Language.PureScript.Publish.ErrorsWarnings -import Options.Applicative (Parser) -import qualified Options.Applicative as Opts +import Control.Monad.IO.Class (liftIO) +import Data.Aeson qualified as A +import Data.ByteString.Lazy.Char8 qualified as BL +import Data.Time.Clock (getCurrentTime) +import Data.Version (Version(..)) +import Language.PureScript.Publish +import Language.PureScript.Publish.ErrorsWarnings +import Options.Applicative (Parser) +import Options.Applicative qualified as Opts data PublishOptionsCLI = PublishOptionsCLI { cliManifestPath :: FilePath diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index dede7db03e..194e2cc236 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -3,26 +3,26 @@ module Command.REPL (command) where -import Prelude -import Control.Applicative (many, (<|>)) -import Control.Monad -import Control.Monad.Catch (MonadMask) -import Control.Monad.IO.Class (liftIO, MonadIO) -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except (ExceptT(..), runExceptT) -import Control.Monad.Trans.State.Strict (StateT, evalStateT) -import Control.Monad.Trans.Reader (ReaderT, runReaderT) -import Data.Foldable (for_) -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import Language.PureScript.Interactive -import qualified Options.Applicative as Opts -import System.Console.Haskeline -import System.IO.UTF8 (readUTF8File) -import System.Exit -import System.Directory (doesFileExist, getCurrentDirectory) -import System.FilePath (()) -import qualified System.FilePath.Glob as Glob +import Prelude +import Control.Applicative (many, (<|>)) +import Control.Monad +import Control.Monad.Catch (MonadMask) +import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except (ExceptT(..), runExceptT) +import Control.Monad.Trans.State.Strict (StateT, evalStateT) +import Control.Monad.Trans.Reader (ReaderT, runReaderT) +import Data.Foldable (for_) +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.Interactive +import Options.Applicative qualified as Opts +import System.Console.Haskeline +import System.IO.UTF8 (readUTF8File) +import System.Exit +import System.Directory (doesFileExist, getCurrentDirectory) +import System.FilePath (()) +import System.FilePath.Glob qualified as Glob import System.IO (hPutStrLn, stderr) -- | Command line options diff --git a/app/Main.hs b/app/Main.hs index 757ef645d6..c925a4a313 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,21 +2,21 @@ module Main where import Prelude -import qualified Command.Bundle as Bundle -import qualified Command.Compile as Compile -import qualified Command.Docs as Docs -import qualified Command.Graph as Graph -import qualified Command.Hierarchy as Hierarchy -import qualified Command.Ide as Ide -import qualified Command.Publish as Publish -import qualified Command.REPL as REPL -import Control.Monad (join) -import Data.Foldable (fold) -import qualified Options.Applicative as Opts -import System.Environment (getArgs) -import qualified System.IO as IO -import qualified Text.PrettyPrint.ANSI.Leijen as Doc -import Version (versionString) +import Command.Bundle qualified as Bundle +import Command.Compile qualified as Compile +import Command.Docs qualified as Docs +import Command.Graph qualified as Graph +import Command.Hierarchy qualified as Hierarchy +import Command.Ide qualified as Ide +import Command.Publish qualified as Publish +import Command.REPL qualified as REPL +import Control.Monad (join) +import Data.Foldable (fold) +import Options.Applicative qualified as Opts +import System.Environment (getArgs) +import System.IO qualified as IO +import Text.PrettyPrint.ANSI.Leijen qualified as Doc +import Version (versionString) main :: IO () diff --git a/app/Version.hs b/app/Version.hs index 633a0d8053..35f620b127 100644 --- a/app/Version.hs +++ b/app/Version.hs @@ -9,7 +9,7 @@ import Data.Version (showVersion) import Paths_purescript as Paths #ifndef RELEASE -import qualified Development.GitRev as GitRev +import Development.GitRev qualified as GitRev #endif -- Unfortunately, Cabal doesn't support prerelease identifiers on versions. To diff --git a/purescript.cabal b/purescript.cabal index 4f95bc4e43..859126a658 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -86,7 +86,6 @@ common defaults -Wno-missing-export-lists -Wno-missing-kind-signatures -Wno-partial-fields - -Wno-prepositive-qualified-module default-language: Haskell2010 default-extensions: BangPatterns @@ -103,6 +102,7 @@ common defaults FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving + ImportQualifiedPost KindSignatures LambdaCase MultiParamTypeClasses diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs index d1e70f73d2..f2309f3549 100644 --- a/src/Language/PureScript.hs +++ b/src/Language/PureScript.hs @@ -30,7 +30,7 @@ import Language.PureScript.Sugar as P import Language.PureScript.TypeChecker as P import Language.PureScript.Types as P -import qualified Paths_purescript as Paths +import Paths_purescript qualified as Paths version :: Version version = Paths.version diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs index 87490404d2..22ee15ed26 100644 --- a/src/Language/PureScript/AST/Declarations.hs +++ b/src/Language/PureScript/AST/Declarations.hs @@ -14,9 +14,9 @@ import Control.DeepSeq (NFData) import Data.Functor.Identity import Data.Aeson.TH -import qualified Data.Map as M +import Data.Map qualified as M import Data.Text (Text) -import qualified Data.List.NonEmpty as NEL +import Data.List.NonEmpty qualified as NEL import GHC.Generics (Generic) import Language.PureScript.AST.Binders @@ -32,7 +32,7 @@ import Language.PureScript.Roles import Language.PureScript.TypeClassDictionaries import Language.PureScript.Comments import Language.PureScript.Environment -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Prim qualified as C -- | A map of locally-bound names in scope. type Context = [(Ident, SourceType)] diff --git a/src/Language/PureScript/AST/Declarations/ChainId.hs b/src/Language/PureScript/AST/Declarations/ChainId.hs index a5b47f6d37..aacfc11fe8 100644 --- a/src/Language/PureScript/AST/Declarations/ChainId.hs +++ b/src/Language/PureScript/AST/Declarations/ChainId.hs @@ -4,7 +4,7 @@ module Language.PureScript.AST.Declarations.ChainId ) where import Prelude -import qualified Language.PureScript.AST.SourcePos as Pos +import Language.PureScript.AST.SourcePos qualified as Pos import Control.DeepSeq (NFData) import Codec.Serialise (Serialise) diff --git a/src/Language/PureScript/AST/Exported.hs b/src/Language/PureScript/AST/Exported.hs index 287060a5d5..20f963ee06 100644 --- a/src/Language/PureScript/AST/Exported.hs +++ b/src/Language/PureScript/AST/Exported.hs @@ -10,7 +10,7 @@ import Control.Category ((>>>)) import Control.Applicative ((<|>)) import Data.Maybe (mapMaybe) -import qualified Data.Map as M +import Data.Map qualified as M import Language.PureScript.AST.Declarations import Language.PureScript.Types diff --git a/src/Language/PureScript/AST/Operators.hs b/src/Language/PureScript/AST/Operators.hs index 347729e1ce..9d3364f681 100644 --- a/src/Language/PureScript/AST/Operators.hs +++ b/src/Language/PureScript/AST/Operators.hs @@ -9,7 +9,7 @@ import Codec.Serialise (Serialise) import GHC.Generics (Generic) import Control.DeepSeq (NFData) import Data.Aeson ((.=)) -import qualified Data.Aeson as A +import Data.Aeson qualified as A import Language.PureScript.Crash diff --git a/src/Language/PureScript/AST/SourcePos.hs b/src/Language/PureScript/AST/SourcePos.hs index e266680175..31811d8cb7 100644 --- a/src/Language/PureScript/AST/SourcePos.hs +++ b/src/Language/PureScript/AST/SourcePos.hs @@ -12,8 +12,8 @@ import Data.Aeson ((.=), (.:)) import Data.Text (Text) import GHC.Generics (Generic) import Language.PureScript.Comments -import qualified Data.Aeson as A -import qualified Data.Text as T +import Data.Aeson qualified as A +import Data.Text qualified as T import System.FilePath (makeRelative) -- | Source annotation - position information and comments. diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs index c5c181b917..cda37d8e7b 100644 --- a/src/Language/PureScript/AST/Traversals.hs +++ b/src/Language/PureScript/AST/Traversals.hs @@ -13,9 +13,9 @@ import Data.Foldable (fold) import Data.Functor.Identity (runIdentity) import Data.List (mapAccumL) import Data.Maybe (mapMaybe) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Map as M -import qualified Data.Set as S +import Data.List.NonEmpty qualified as NEL +import Data.Map qualified as M +import Data.Set qualified as S import Language.PureScript.AST.Binders import Language.PureScript.AST.Declarations diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index dbfaa610e3..3f612e7b9b 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -24,8 +24,8 @@ import Data.Aeson ((.=)) import Data.Char (chr, digitToInt) import Data.Foldable (fold) import Data.Maybe (mapMaybe, maybeToList) -import qualified Data.Aeson as A -import qualified Data.Text.Lazy as LT +import Data.Aeson qualified as A +import Data.Text.Lazy qualified as LT import Language.JavaScript.Parser import Language.JavaScript.Parser.AST diff --git a/src/Language/PureScript/CST.hs b/src/Language/PureScript/CST.hs index eaa6de4daa..b8e895fb20 100644 --- a/src/Language/PureScript/CST.hs +++ b/src/Language/PureScript/CST.hs @@ -22,10 +22,10 @@ import Prelude hiding (lex) import Control.Monad.Error.Class (MonadError(..)) import Control.Parallel.Strategies (withStrategy, parList, evalTuple2, r0, rseq) -import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty qualified as NE import Data.Text (Text) -import qualified Language.PureScript.AST as AST -import qualified Language.PureScript.Errors as E +import Language.PureScript.AST qualified as AST +import Language.PureScript.Errors qualified as E import Language.PureScript.CST.Convert import Language.PureScript.CST.Errors import Language.PureScript.CST.Lexer diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs index 3b750e2fd9..b70754f897 100644 --- a/src/Language/PureScript/CST/Convert.hs +++ b/src/Language/PureScript/CST/Convert.hs @@ -21,19 +21,19 @@ import Data.Bifunctor (bimap, first) import Data.Char (toLower) import Data.Foldable (foldl', toList) import Data.Functor (($>)) -import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty qualified as NE import Data.Maybe (isJust, fromJust, mapMaybe) -import qualified Data.Text as Text -import qualified Language.PureScript.AST as AST +import Data.Text qualified as Text +import Language.PureScript.AST qualified as AST import Language.PureScript.AST.Declarations.ChainId (mkChainId) -import qualified Language.PureScript.AST.SourcePos as Pos -import qualified Language.PureScript.Comments as C +import Language.PureScript.AST.SourcePos qualified as Pos +import Language.PureScript.Comments qualified as C import Language.PureScript.Crash (internalError) -import qualified Language.PureScript.Environment as Env -import qualified Language.PureScript.Label as L -import qualified Language.PureScript.Names as N +import Language.PureScript.Environment qualified as Env +import Language.PureScript.Label qualified as L +import Language.PureScript.Names qualified as N import Language.PureScript.PSString (mkString, prettyPrintStringJS) -import qualified Language.PureScript.Types as T +import Language.PureScript.Types qualified as T import Language.PureScript.CST.Positions import Language.PureScript.CST.Print (printToken) import Language.PureScript.CST.Types diff --git a/src/Language/PureScript/CST/Errors.hs b/src/Language/PureScript/CST/Errors.hs index ce776c87c2..fdea6dcefa 100644 --- a/src/Language/PureScript/CST/Errors.hs +++ b/src/Language/PureScript/CST/Errors.hs @@ -11,7 +11,7 @@ module Language.PureScript.CST.Errors import Prelude -import qualified Data.Text as Text +import Data.Text qualified as Text import Data.Char (isSpace, toUpper) import Language.PureScript.CST.Layout import Language.PureScript.CST.Print diff --git a/src/Language/PureScript/CST/Layout.hs b/src/Language/PureScript/CST/Layout.hs index ea2dbfa769..6ab82153ec 100644 --- a/src/Language/PureScript/CST/Layout.hs +++ b/src/Language/PureScript/CST/Layout.hs @@ -171,7 +171,7 @@ module Language.PureScript.CST.Layout where import Prelude import Data.DList (snoc) -import qualified Data.DList as DList +import Data.DList qualified as DList import Data.Foldable (find) import Data.Function ((&)) import Language.PureScript.CST.Types diff --git a/src/Language/PureScript/CST/Lexer.hs b/src/Language/PureScript/CST/Lexer.hs index ea9dba4827..bb8ec99571 100644 --- a/src/Language/PureScript/CST/Lexer.hs +++ b/src/Language/PureScript/CST/Lexer.hs @@ -10,15 +10,15 @@ module Language.PureScript.CST.Lexer import Prelude hiding (lex, exp, exponent, lines) import Control.Monad (join) -import qualified Data.Char as Char -import qualified Data.DList as DList +import Data.Char qualified as Char +import Data.DList qualified as DList import Data.Foldable (foldl') import Data.Functor (($>)) -import qualified Data.Scientific as Sci +import Data.Scientific qualified as Sci import Data.String (fromString) import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.PureScript as Text +import Data.Text qualified as Text +import Data.Text.PureScript qualified as Text import Language.PureScript.CST.Errors import Language.PureScript.CST.Monad hiding (token) import Language.PureScript.CST.Layout diff --git a/src/Language/PureScript/CST/Monad.hs b/src/Language/PureScript/CST/Monad.hs index 038c4137d8..9245c59dff 100644 --- a/src/Language/PureScript/CST/Monad.hs +++ b/src/Language/PureScript/CST/Monad.hs @@ -3,7 +3,7 @@ module Language.PureScript.CST.Monad where import Prelude import Data.List (sortOn) -import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty qualified as NE import Data.Ord (comparing) import Data.Text (Text) import Language.PureScript.CST.Errors diff --git a/src/Language/PureScript/CST/Positions.hs b/src/Language/PureScript/CST/Positions.hs index 34e13cacbe..f8b6167d51 100644 --- a/src/Language/PureScript/CST/Positions.hs +++ b/src/Language/PureScript/CST/Positions.hs @@ -8,11 +8,11 @@ module Language.PureScript.CST.Positions where import Prelude import Data.Foldable (foldl') -import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Void (Void) -import qualified Data.Text as Text +import Data.Text qualified as Text import Language.PureScript.CST.Types advanceToken :: SourcePos -> Token -> SourcePos diff --git a/src/Language/PureScript/CST/Print.hs b/src/Language/PureScript/CST/Print.hs index 5cbb3467dd..9becaaf24c 100644 --- a/src/Language/PureScript/CST/Print.hs +++ b/src/Language/PureScript/CST/Print.hs @@ -12,9 +12,9 @@ module Language.PureScript.CST.Print import Prelude -import qualified Data.DList as DList +import Data.DList qualified as DList import Data.Text (Text) -import qualified Data.Text as Text +import Data.Text qualified as Text import Language.PureScript.CST.Types import Language.PureScript.CST.Flatten (flattenModule) diff --git a/src/Language/PureScript/CST/Types.hs b/src/Language/PureScript/CST/Types.hs index 7450058e61..d4dec40c04 100644 --- a/src/Language/PureScript/CST/Types.hs +++ b/src/Language/PureScript/CST/Types.hs @@ -13,8 +13,8 @@ import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import Data.Void (Void) import GHC.Generics (Generic) -import qualified Language.PureScript.Names as N -import qualified Language.PureScript.Roles as R +import Language.PureScript.Names qualified as N +import Language.PureScript.Roles qualified as R import Language.PureScript.PSString (PSString) data SourcePos = SourcePos diff --git a/src/Language/PureScript/CST/Utils.hs b/src/Language/PureScript/CST/Utils.hs index 8ffb536f9e..2d7a152e2f 100644 --- a/src/Language/PureScript/CST/Utils.hs +++ b/src/Language/PureScript/CST/Utils.hs @@ -6,17 +6,17 @@ import Control.Monad (unless) import Data.Coerce (coerce) import Data.Foldable (for_) import Data.Functor (($>)) -import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty qualified as NE import Data.Set (Set) -import qualified Data.Set as Set +import Data.Set qualified as Set import Data.Text (Text) -import qualified Data.Text as Text +import Data.Text qualified as Text import Language.PureScript.CST.Errors import Language.PureScript.CST.Monad import Language.PureScript.CST.Positions import Language.PureScript.CST.Traversals.Type import Language.PureScript.CST.Types -import qualified Language.PureScript.Names as N +import Language.PureScript.Names qualified as N import Language.PureScript.PSString (PSString, mkString) -- | diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 9d89092f55..c801dc22d8 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -18,21 +18,21 @@ import Control.Monad.Writer (MonadWriter, runWriterT, writer) import Data.Bifunctor (first) import Data.List ((\\), intersect) -import qualified Data.List.NonEmpty as NEL (nonEmpty) -import qualified Data.Foldable as F -import qualified Data.Map as M -import qualified Data.Set as S +import Data.List.NonEmpty qualified as NEL (nonEmpty) +import Data.Foldable qualified as F +import Data.Map qualified as M +import Data.Set qualified as S import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import Data.Monoid (Any(..)) import Data.String (fromString) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.AST.SourcePos import Language.PureScript.CodeGen.JS.Common as Common import Language.PureScript.CoreImp.AST (AST, InitializerEffects(..), everywhere, everywhereTopDownM, withSourceSpan) -import qualified Language.PureScript.CoreImp.AST as AST -import qualified Language.PureScript.CoreImp.Module as AST +import Language.PureScript.CoreImp.AST qualified as AST +import Language.PureScript.CoreImp.Module qualified as AST import Language.PureScript.CoreImp.Optimizer import Language.PureScript.CoreFn import Language.PureScript.CoreFn.Laziness (applyLazinessTransform) @@ -44,7 +44,7 @@ import Language.PureScript.Names import Language.PureScript.Options import Language.PureScript.PSString (PSString, mkString) import Language.PureScript.Traversals (sndM) -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Prim qualified as C import System.FilePath.Posix (()) diff --git a/src/Language/PureScript/CodeGen/JS/Common.hs b/src/Language/PureScript/CodeGen/JS/Common.hs index 9d82a19776..2e17518e2e 100644 --- a/src/Language/PureScript/CodeGen/JS/Common.hs +++ b/src/Language/PureScript/CodeGen/JS/Common.hs @@ -5,7 +5,7 @@ import Prelude import Data.Char import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.Crash import Language.PureScript.Names diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index 901bf4c178..905cc34b63 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -10,12 +10,12 @@ import Control.Arrow ((<+>)) import Control.Monad (forM, mzero) import Control.Monad.State (StateT, evalStateT) import Control.PatternArrows -import qualified Control.Arrow as A +import Control.Arrow qualified as A import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.List.NonEmpty as NEL (toList) +import Data.Text qualified as T +import Data.List.NonEmpty qualified as NEL (toList) import Language.PureScript.AST (SourceSpan(..)) import Language.PureScript.CodeGen.JS.Common diff --git a/src/Language/PureScript/Constants/Libs.hs b/src/Language/PureScript/Constants/Libs.hs index 3ec062a7d9..75c7385e0e 100644 --- a/src/Language/PureScript/Constants/Libs.hs +++ b/src/Language/PureScript/Constants/Libs.hs @@ -3,11 +3,11 @@ -- | Various constants which refer to things in the Prelude and other core libraries module Language.PureScript.Constants.Libs where -import qualified Protolude as P +import Protolude qualified as P import Data.String (IsString) import Language.PureScript.PSString (PSString) -import qualified Language.PureScript.Constants.TH as TH +import Language.PureScript.Constants.TH qualified as TH -- Core lib values diff --git a/src/Language/PureScript/Constants/Prim.hs b/src/Language/PureScript/Constants/Prim.hs index 795dbffdd9..bd8580e748 100644 --- a/src/Language/PureScript/Constants/Prim.hs +++ b/src/Language/PureScript/Constants/Prim.hs @@ -4,7 +4,7 @@ module Language.PureScript.Constants.Prim where import Language.PureScript.Names -import qualified Language.PureScript.Constants.TH as TH +import Language.PureScript.Constants.TH qualified as TH $(TH.declare do TH.mod "Prim" do diff --git a/src/Language/PureScript/CoreFn/CSE.hs b/src/Language/PureScript/CoreFn/CSE.hs index 0ea811a980..225f7a616e 100644 --- a/src/Language/PureScript/CoreFn/CSE.hs +++ b/src/Language/PureScript/CoreFn/CSE.hs @@ -10,16 +10,16 @@ import Control.Monad.Supply.Class (MonadSupply) import Control.Monad.RWS (MonadWriter, RWST, censor, evalRWST, listen, pass, tell) import Data.Bitraversable (bitraverse) import Data.Functor.Compose (Compose(..)) -import qualified Data.IntMap.Monoidal as IM -import qualified Data.IntSet as IS -import qualified Data.Map as M +import Data.IntMap.Monoidal qualified as IM +import Data.IntSet qualified as IS +import Data.Map qualified as M import Data.Maybe (fromJust) import Data.Semigroup (Min(..)) import Data.Semigroup.Generic (GenericSemigroupMonoid(..)) import Language.PureScript.AST.Literals import Language.PureScript.AST.SourcePos (nullSourceSpan) -import qualified Language.PureScript.Constants.Libs as C +import Language.PureScript.Constants.Libs qualified as C import Language.PureScript.CoreFn.Ann (Ann) import Language.PureScript.CoreFn.Binders import Language.PureScript.CoreFn.Expr diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs index 1cf6d5efe0..29303e05c4 100644 --- a/src/Language/PureScript/CoreFn/Desugar.hs +++ b/src/Language/PureScript/CoreFn/Desugar.hs @@ -8,8 +8,8 @@ import Control.Arrow (second) import Data.Function (on) import Data.Maybe (mapMaybe) import Data.Tuple (swap) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Map as M +import Data.List.NonEmpty qualified as NEL +import Data.Map qualified as M import Language.PureScript.AST.Literals import Language.PureScript.AST.SourcePos @@ -24,8 +24,8 @@ import Language.PureScript.Crash import Language.PureScript.Environment import Language.PureScript.Names import Language.PureScript.Types -import qualified Language.PureScript.AST as A -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.AST qualified as A +import Language.PureScript.Constants.Prim qualified as C -- | Desugars a module from AST to CoreFn representation. moduleToCoreFn :: Environment -> A.Module -> Module Ann diff --git a/src/Language/PureScript/CoreFn/FromJSON.hs b/src/Language/PureScript/CoreFn/FromJSON.hs index 3d42bb727a..50b5010259 100644 --- a/src/Language/PureScript/CoreFn/FromJSON.hs +++ b/src/Language/PureScript/CoreFn/FromJSON.hs @@ -9,24 +9,24 @@ module Language.PureScript.CoreFn.FromJSON import Prelude -import Control.Applicative ((<|>)) - -import Data.Aeson -import Data.Aeson.Types (Parser, listParser) -import qualified Data.Map.Strict as M -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Vector as V -import Data.Version (Version, parseVersion) - -import Language.PureScript.AST.SourcePos (SourceSpan(..)) -import Language.PureScript.AST.Literals -import Language.PureScript.CoreFn.Ann -import Language.PureScript.CoreFn -import Language.PureScript.Names -import Language.PureScript.PSString (PSString) - -import Text.ParserCombinators.ReadP (readP_to_S) +import Control.Applicative ((<|>)) + +import Data.Aeson +import Data.Aeson.Types (Parser, listParser) +import Data.Map.Strict qualified as M +import Data.Text (Text) +import Data.Text qualified as T +import Data.Vector qualified as V +import Data.Version (Version, parseVersion) + +import Language.PureScript.AST.SourcePos (SourceSpan(..)) +import Language.PureScript.AST.Literals +import Language.PureScript.CoreFn.Ann +import Language.PureScript.CoreFn +import Language.PureScript.Names +import Language.PureScript.PSString (PSString) + +import Text.ParserCombinators.ReadP (readP_to_S) parseVersion' :: String -> Maybe Version parseVersion' str = diff --git a/src/Language/PureScript/CoreFn/Laziness.hs b/src/Language/PureScript/CoreFn/Laziness.hs index 5055151596..24d7290108 100644 --- a/src/Language/PureScript/CoreFn/Laziness.hs +++ b/src/Language/PureScript/CoreFn/Laziness.hs @@ -6,18 +6,18 @@ import Protolude hiding (force) import Protolude.Unsafe (unsafeHead) import Control.Arrow ((&&&)) -import qualified Data.Array as A +import Data.Array qualified as A import Data.Coerce (coerce) import Data.Graph (SCC(..), stronglyConnComp) import Data.List (foldl1', (!!)) -import qualified Data.IntMap.Monoidal as IM -import qualified Data.IntSet as IS -import qualified Data.Map.Monoidal as M +import Data.IntMap.Monoidal qualified as IM +import Data.IntSet qualified as IS +import Data.Map.Monoidal qualified as M import Data.Semigroup (Max(..)) -import qualified Data.Set as S +import Data.Set qualified as S import Language.PureScript.AST.SourcePos -import qualified Language.PureScript.Constants.Libs as C +import Language.PureScript.Constants.Libs qualified as C import Language.PureScript.CoreFn import Language.PureScript.Crash import Language.PureScript.Names diff --git a/src/Language/PureScript/CoreFn/Optimizer.hs b/src/Language/PureScript/CoreFn/Optimizer.hs index 94d7b77a5a..40a31ed3dc 100644 --- a/src/Language/PureScript/CoreFn/Optimizer.hs +++ b/src/Language/PureScript/CoreFn/Optimizer.hs @@ -13,8 +13,8 @@ import Language.PureScript.CoreFn.Module import Language.PureScript.CoreFn.Traversals import Language.PureScript.Label import Language.PureScript.Types -import qualified Language.PureScript.Constants.Libs as C -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Libs qualified as C +import Language.PureScript.Constants.Prim qualified as C -- | -- CoreFn optimization pass. diff --git a/src/Language/PureScript/CoreFn/ToJSON.hs b/src/Language/PureScript/CoreFn/ToJSON.hs index 9a8a600f83..ea71162176 100644 --- a/src/Language/PureScript/CoreFn/ToJSON.hs +++ b/src/Language/PureScript/CoreFn/ToJSON.hs @@ -7,24 +7,24 @@ module Language.PureScript.CoreFn.ToJSON ( moduleToJSON ) where -import Prelude - -import Control.Arrow ((***)) -import Data.Either (isLeft) -import qualified Data.Map.Strict as M -import Data.Aeson hiding ((.=)) -import qualified Data.Aeson -import qualified Data.Aeson.Key -import Data.Aeson.Types (Pair) -import Data.Version (Version, showVersion) -import Data.Text (Text) -import qualified Data.Text as T - -import Language.PureScript.AST.Literals -import Language.PureScript.AST.SourcePos (SourceSpan(..)) -import Language.PureScript.CoreFn -import Language.PureScript.Names -import Language.PureScript.PSString (PSString) +import Prelude + +import Control.Arrow ((***)) +import Data.Either (isLeft) +import Data.Map.Strict qualified as M +import Data.Aeson hiding ((.=)) +import Data.Aeson qualified +import Data.Aeson.Key qualified +import Data.Aeson.Types (Pair) +import Data.Version (Version, showVersion) +import Data.Text (Text) +import Data.Text qualified as T + +import Language.PureScript.AST.Literals +import Language.PureScript.AST.SourcePos (SourceSpan(..)) +import Language.PureScript.CoreFn +import Language.PureScript.Names +import Language.PureScript.PSString (PSString) constructorTypeToJSON :: ConstructorType -> Value constructorTypeToJSON ProductType = toJSON "ProductType" diff --git a/src/Language/PureScript/CoreImp/Module.hs b/src/Language/PureScript/CoreImp/Module.hs index efd591508f..5460a012cd 100644 --- a/src/Language/PureScript/CoreImp/Module.hs +++ b/src/Language/PureScript/CoreImp/Module.hs @@ -1,7 +1,7 @@ module Language.PureScript.CoreImp.Module where import Protolude -import qualified Data.List.NonEmpty as NEL (NonEmpty) +import Data.List.NonEmpty qualified as NEL (NonEmpty) import Language.PureScript.Comments import Language.PureScript.CoreImp.AST diff --git a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs index 77e5ea4c77..0e3dd5a8c5 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs @@ -19,15 +19,15 @@ import Control.Monad.Supply.Class (MonadSupply, freshName) import Data.Either (rights) import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (PSString, mkString) import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common import Language.PureScript.AST (SourceSpan(..)) -import qualified Language.PureScript.Constants.Libs as C -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Libs qualified as C +import Language.PureScript.Constants.Prim qualified as C -- TODO: Potential bug: -- Shouldn't just inline this case: { var x = 0; x.toFixed(10); } diff --git a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs index fb9ed17ad5..5b933c2cdb 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs @@ -11,7 +11,7 @@ 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.Libs as C +import Language.PureScript.Constants.Libs qualified as C -- | Inline type class dictionaries for >>= and return for the Eff monad -- diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs index f9bb433514..bd85924eae 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs @@ -7,7 +7,7 @@ import Control.Applicative (empty, liftA2) import Control.Monad (guard) import Control.Monad.State (State, evalState, get, modify) import Data.Functor (($>), (<&>)) -import qualified Data.Set as S +import Data.Set qualified as S import Data.Text (Text, pack) import Language.PureScript.CoreImp.AST import Language.PureScript.AST.SourcePos (SourceSpan) diff --git a/src/Language/PureScript/CoreImp/Optimizer/Unused.hs b/src/Language/PureScript/CoreImp/Optimizer/Unused.hs index f920d79af0..a06eaf5660 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Unused.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Unused.hs @@ -9,12 +9,12 @@ import Prelude import Control.Monad (filterM) import Data.Monoid (Any(..)) -import qualified Data.Set as S +import Data.Set qualified as S import Data.Text (Text) import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Prim qualified as C removeCodeAfterReturnStatements :: AST -> AST removeCodeAfterReturnStatements = everywhere (removeFromBlock go) diff --git a/src/Language/PureScript/Docs/AsHtml.hs b/src/Language/PureScript/Docs/AsHtml.hs index ed4e12498a..e05cf220aa 100644 --- a/src/Language/PureScript/Docs/AsHtml.hs +++ b/src/Language/PureScript/Docs/AsHtml.hs @@ -19,24 +19,24 @@ import Control.Monad (unless) import Data.Bifunctor (bimap) import Data.Char (isUpper) import Data.Either (isRight) -import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) import Data.Foldable (for_) import Data.String (fromString) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Text.Blaze.Html5 as H hiding (map) -import qualified Text.Blaze.Html5.Attributes as A -import qualified Cheapskate +import Text.Blaze.Html5.Attributes qualified as A +import Cheapskate qualified -import qualified Language.PureScript as P +import Language.PureScript qualified as P import Language.PureScript.Docs.Types import Language.PureScript.Docs.RenderedCode hiding (sp) -import qualified Language.PureScript.Docs.Render as Render -import qualified Language.PureScript.CST as CST +import Language.PureScript.Docs.Render qualified as Render +import Language.PureScript.CST qualified as CST data HtmlOutput a = HtmlOutput { htmlIndex :: [(Maybe Char, a)] diff --git a/src/Language/PureScript/Docs/AsMarkdown.hs b/src/Language/PureScript/Docs/AsMarkdown.hs index efe15b0252..530feba933 100644 --- a/src/Language/PureScript/Docs/AsMarkdown.hs +++ b/src/Language/PureScript/Docs/AsMarkdown.hs @@ -13,12 +13,12 @@ import Control.Monad.Writer (Writer, tell, execWriter) import Data.Foldable (for_) import Data.List (partition) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.Docs.RenderedCode import Language.PureScript.Docs.Types -import qualified Language.PureScript as P -import qualified Language.PureScript.Docs.Render as Render +import Language.PureScript qualified as P +import Language.PureScript.Docs.Render qualified as Render moduleAsMarkdown :: Module -> Docs moduleAsMarkdown Module{..} = do diff --git a/src/Language/PureScript/Docs/Collect.hs b/src/Language/PureScript/Docs/Collect.hs index 32bece3738..3570ecf2fe 100644 --- a/src/Language/PureScript/Docs/Collect.hs +++ b/src/Language/PureScript/Docs/Collect.hs @@ -6,12 +6,12 @@ module Language.PureScript.Docs.Collect import Protolude hiding (check) import Control.Arrow ((&&&)) -import qualified Data.Aeson.BetterErrors as ABE -import qualified Data.ByteString as BS -import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified Data.Text as T -import qualified Data.Text.IO as TIO +import Data.Aeson.BetterErrors qualified as ABE +import Data.ByteString qualified as BS +import Data.Map qualified as Map +import Data.Set qualified as Set +import Data.Text qualified as T +import Data.Text.IO qualified as TIO import System.FilePath (()) import System.IO.UTF8 (readUTF8FileT, readUTF8FilesT) @@ -19,14 +19,14 @@ import Language.PureScript.Docs.Convert.ReExports (updateReExports) import Language.PureScript.Docs.Prim (primModules) import Language.PureScript.Docs.Types -import qualified Language.PureScript.AST as P -import qualified Language.PureScript.CST as P -import qualified Language.PureScript.Crash as P -import qualified Language.PureScript.Errors as P -import qualified Language.PureScript.Externs as P -import qualified Language.PureScript.Make as P -import qualified Language.PureScript.Names as P -import qualified Language.PureScript.Options as P +import Language.PureScript.AST qualified as P +import Language.PureScript.CST qualified as P +import Language.PureScript.Crash qualified as P +import Language.PureScript.Errors qualified as P +import Language.PureScript.Externs qualified as P +import Language.PureScript.Make qualified as P +import Language.PureScript.Names qualified as P +import Language.PureScript.Options qualified as P import Web.Bower.PackageMeta (PackageName) diff --git a/src/Language/PureScript/Docs/Convert.hs b/src/Language/PureScript/Docs/Convert.hs index 446e10510f..ce25a9102b 100644 --- a/src/Language/PureScript/Docs/Convert.hs +++ b/src/Language/PureScript/Docs/Convert.hs @@ -10,24 +10,24 @@ import Protolude hiding (check) import Control.Category ((>>>)) import Control.Monad.Writer.Strict (runWriterT) import Control.Monad.Supply (evalSupplyT) -import qualified Data.List.NonEmpty as NE -import qualified Data.Map as Map +import Data.List.NonEmpty qualified as NE +import Data.Map qualified as Map import Data.String (String) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.Docs.Convert.Single (convertSingleModule) import Language.PureScript.Docs.Types -import qualified Language.PureScript.CST as CST -import qualified Language.PureScript.AST as P -import qualified Language.PureScript.Crash as P -import qualified Language.PureScript.Errors as P -import qualified Language.PureScript.Externs as P -import qualified Language.PureScript.Environment as P -import qualified Language.PureScript.Names as P -import qualified Language.PureScript.Roles as P -import qualified Language.PureScript.Sugar as P -import qualified Language.PureScript.Types as P -import qualified Language.PureScript.Constants.Prim as Prim +import Language.PureScript.CST qualified as CST +import Language.PureScript.AST qualified as P +import Language.PureScript.Crash qualified as P +import Language.PureScript.Errors qualified as P +import Language.PureScript.Externs qualified as P +import Language.PureScript.Environment qualified as P +import Language.PureScript.Names qualified as P +import Language.PureScript.Roles qualified as P +import Language.PureScript.Sugar qualified as P +import Language.PureScript.Types qualified as P +import Language.PureScript.Constants.Prim qualified as Prim import Language.PureScript.Sugar (RebracketCaller(CalledByDocs)) -- | diff --git a/src/Language/PureScript/Docs/Convert/ReExports.hs b/src/Language/PureScript/Docs/Convert/ReExports.hs index 7ef61d988f..9ce51d4433 100644 --- a/src/Language/PureScript/Docs/Convert/ReExports.hs +++ b/src/Language/PureScript/Docs/Convert/ReExports.hs @@ -15,19 +15,19 @@ import Data.Either import Data.Foldable (fold, traverse_) import Data.Map (Map) import Data.Maybe (mapMaybe) -import qualified Data.Map as Map +import Data.Map qualified as Map import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.Docs.Types -import qualified Language.PureScript.AST as P -import qualified Language.PureScript.Crash as P -import qualified Language.PureScript.Errors as P -import qualified Language.PureScript.Externs as P -import qualified Language.PureScript.ModuleDependencies as P -import qualified Language.PureScript.Names as P -import qualified Language.PureScript.Types as P +import Language.PureScript.AST qualified as P +import Language.PureScript.Crash qualified as P +import Language.PureScript.Errors qualified as P +import Language.PureScript.Externs qualified as P +import Language.PureScript.ModuleDependencies qualified as P +import Language.PureScript.Names qualified as P +import Language.PureScript.Types qualified as P -- | diff --git a/src/Language/PureScript/Docs/Convert/Single.hs b/src/Language/PureScript/Docs/Convert/Single.hs index 8cd99da145..50a6fe0c88 100644 --- a/src/Language/PureScript/Docs/Convert/Single.hs +++ b/src/Language/PureScript/Docs/Convert/Single.hs @@ -7,16 +7,16 @@ import Protolude hiding (moduleName) import Control.Category ((>>>)) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.Docs.Types -import qualified Language.PureScript.AST as P -import qualified Language.PureScript.Comments as P -import qualified Language.PureScript.Crash as P -import qualified Language.PureScript.Names as P -import qualified Language.PureScript.Roles as P -import qualified Language.PureScript.Types as P +import Language.PureScript.AST qualified as P +import Language.PureScript.Comments qualified as P +import Language.PureScript.Crash qualified as P +import Language.PureScript.Names qualified as P +import Language.PureScript.Roles qualified as P +import Language.PureScript.Types qualified as P -- | -- Convert a single Module, but ignore re-exports; any re-exported types or diff --git a/src/Language/PureScript/Docs/Prim.hs b/src/Language/PureScript/Docs/Prim.hs index cd8a4697cd..4b19adbac3 100644 --- a/src/Language/PureScript/Docs/Prim.hs +++ b/src/Language/PureScript/Docs/Prim.hs @@ -9,14 +9,14 @@ module Language.PureScript.Docs.Prim import Prelude hiding (fail) import Data.Functor (($>)) import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Map as Map +import Data.Text qualified as T +import Data.Map qualified as Map import Language.PureScript.Docs.Types -import qualified Language.PureScript.Constants.Prim as P -import qualified Language.PureScript.Crash as P -import qualified Language.PureScript.Environment as P -import qualified Language.PureScript.Names as P +import Language.PureScript.Constants.Prim qualified as P +import Language.PureScript.Crash qualified as P +import Language.PureScript.Environment qualified as P +import Language.PureScript.Names qualified as P primModules :: [Module] primModules = diff --git a/src/Language/PureScript/Docs/Render.hs b/src/Language/PureScript/Docs/Render.hs index 0dc548f763..31629d0fe8 100644 --- a/src/Language/PureScript/Docs/Render.hs +++ b/src/Language/PureScript/Docs/Render.hs @@ -13,16 +13,16 @@ import Prelude import Data.Maybe (maybeToList) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.Docs.RenderedCode import Language.PureScript.Docs.Types import Language.PureScript.Docs.Utils.MonoidExtras -import qualified Language.PureScript.AST as P -import qualified Language.PureScript.Environment as P -import qualified Language.PureScript.Names as P -import qualified Language.PureScript.Types as P +import Language.PureScript.AST qualified as P +import Language.PureScript.Environment qualified as P +import Language.PureScript.Names qualified as P +import Language.PureScript.Types qualified as P renderKindSig :: Text -> KindInfo -> RenderedCode renderKindSig declTitle KindInfo{..} = diff --git a/src/Language/PureScript/Docs/RenderedCode/Types.hs b/src/Language/PureScript/Docs/RenderedCode/Types.hs index f4844dc754..9b8c6f9b5b 100644 --- a/src/Language/PureScript/Docs/RenderedCode/Types.hs +++ b/src/Language/PureScript/Docs/RenderedCode/Types.hs @@ -39,11 +39,11 @@ import Control.DeepSeq (NFData) import Control.Monad.Error.Class (MonadError(..)) import Data.Aeson.BetterErrors (Parse, nth, withText, withValue, toAesonParser, perhaps, asText) -import qualified Data.Aeson as A +import Data.Aeson qualified as A import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.ByteString.Lazy as BS -import qualified Data.Text.Encoding as TE +import Data.Text qualified as T +import Data.ByteString.Lazy qualified as BS +import Data.Text.Encoding qualified as TE import Language.PureScript.Names import Language.PureScript.AST (Associativity(..)) diff --git a/src/Language/PureScript/Docs/Tags.hs b/src/Language/PureScript/Docs/Tags.hs index 95d4b07faf..2b9a2b0172 100644 --- a/src/Language/PureScript/Docs/Tags.hs +++ b/src/Language/PureScript/Docs/Tags.hs @@ -6,10 +6,10 @@ module Language.PureScript.Docs.Tags import Prelude -import Control.Arrow (first) -import Data.List (sort) -import Data.Maybe (mapMaybe) -import qualified Data.Text as T +import Control.Arrow (first) +import Data.List (sort) +import Data.Maybe (mapMaybe) +import Data.Text qualified as T import Language.PureScript.AST (SourceSpan, sourcePosLine, spanStart) import Language.PureScript.Docs.Types diff --git a/src/Language/PureScript/Docs/Types.hs b/src/Language/PureScript/Docs/Types.hs index fd5e4bd1b6..d9ac6ab849 100644 --- a/src/Language/PureScript/Docs/Types.hs +++ b/src/Language/PureScript/Docs/Types.hs @@ -10,28 +10,28 @@ import Prelude (String, unlines, lookup) import Control.Arrow ((***)) import Data.Aeson ((.=)) -import qualified Data.Aeson.Key as A.Key +import Data.Aeson.Key qualified as A.Key import Data.Aeson.BetterErrors (Parse, keyOrDefault, throwCustomError, key, asText, keyMay, withString, eachInArray, asNull, (.!), toAesonParser, toAesonParser', fromAesonParser, perhaps, withText, asIntegral, nth, eachInObjectWithKey, asString) -import qualified Data.Map as Map +import Data.Map qualified as Map import Data.Time.Clock (UTCTime) -import qualified Data.Time.Format as TimeFormat +import Data.Time.Format qualified as TimeFormat import Data.Version -import qualified Data.Aeson as A -import qualified Data.Text as T -import qualified Data.Vector as V - -import qualified Language.PureScript.AST as P -import qualified Language.PureScript.CoreFn.FromJSON as P -import qualified Language.PureScript.Crash as P -import qualified Language.PureScript.Environment as P -import qualified Language.PureScript.Names as P -import qualified Language.PureScript.Roles as P -import qualified Language.PureScript.Types as P -import qualified Paths_purescript as Paths +import Data.Aeson qualified as A +import Data.Text qualified as T +import Data.Vector qualified as V + +import Language.PureScript.AST qualified as P +import Language.PureScript.CoreFn.FromJSON qualified as P +import Language.PureScript.Crash qualified as P +import Language.PureScript.Environment qualified as P +import Language.PureScript.Names qualified as P +import Language.PureScript.Roles qualified as P +import Language.PureScript.Types qualified as P +import Paths_purescript qualified as Paths import Web.Bower.PackageMeta hiding (Version, displayError) diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs index 96dd1d2215..ab995eb12e 100644 --- a/src/Language/PureScript/Environment.hs +++ b/src/Language/PureScript/Environment.hs @@ -7,18 +7,18 @@ import Control.DeepSeq (NFData) import Control.Monad (unless) import Codec.Serialise (Serialise) import Data.Aeson ((.=), (.:)) -import qualified Data.Aeson as A +import Data.Aeson qualified as A import Data.Foldable (find, fold) import Data.Functor ((<&>)) -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS -import qualified Data.Map as M -import qualified Data.Set as S +import Data.IntMap qualified as IM +import Data.IntSet qualified as IS +import Data.Map qualified as M +import Data.Set qualified as S import Data.Maybe (fromMaybe) import Data.Semigroup (First(..)) import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.List.NonEmpty as NEL +import Data.Text qualified as T +import Data.List.NonEmpty qualified as NEL import Language.PureScript.AST.SourcePos import Language.PureScript.Crash @@ -26,7 +26,7 @@ import Language.PureScript.Names import Language.PureScript.Roles import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Prim qualified as C -- | The @Environment@ defines all values and types which are currently in scope: data Environment = Environment diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 824d5d0b7b..49a4348a3b 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -3,56 +3,56 @@ module Language.PureScript.Errors , module Language.PureScript.Errors ) where -import Prelude -import Protolude (unsnoc) - -import Control.Arrow ((&&&)) -import Control.Exception (displayException) -import Control.Lens (both, head1, over) -import Control.Monad -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Trans.State.Lazy -import Control.Monad.Writer -import Data.Bifunctor (first, second) -import Data.Bitraversable (bitraverse) -import Data.Char (isSpace) -import Data.Containers.ListUtils (nubOrdOn) -import Data.Either (partitionEithers) -import Data.Foldable (fold) -import Data.Function (on) -import Data.Functor (($>)) -import Data.Functor.Identity (Identity(..)) -import Data.List (transpose, nubBy, partition, dropWhileEnd, sortOn, uncons) -import qualified Data.List.NonEmpty as NEL -import Data.List.NonEmpty (NonEmpty((:|))) -import Data.Maybe (maybeToList, fromMaybe, isJust, mapMaybe) -import qualified Data.Map as M -import Data.Ord (Down(..)) -import qualified Data.Set as S -import qualified Data.Text as T -import Data.Text (Text) -import Data.Traversable (for) -import qualified GHC.Stack -import Language.PureScript.AST -import qualified Language.PureScript.Bundle as Bundle -import qualified Language.PureScript.Constants.Libs as C -import qualified Language.PureScript.Constants.Prim as C -import Language.PureScript.Crash -import qualified Language.PureScript.CST.Errors as CST -import qualified Language.PureScript.CST.Print as CST -import Language.PureScript.Label (Label(..)) -import Language.PureScript.Names -import Language.PureScript.Pretty -import Language.PureScript.Pretty.Common (endWith) -import Language.PureScript.PSString (decodeStringWithReplacement) -import Language.PureScript.Roles -import Language.PureScript.Traversals -import Language.PureScript.Types -import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers -import qualified System.Console.ANSI as ANSI -import System.FilePath (makeRelative) -import qualified Text.PrettyPrint.Boxes as Box -import Witherable (wither) +import Prelude +import Protolude (unsnoc) + +import Control.Arrow ((&&&)) +import Control.Exception (displayException) +import Control.Lens (both, head1, over) +import Control.Monad +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.Trans.State.Lazy +import Control.Monad.Writer +import Data.Bifunctor (first, second) +import Data.Bitraversable (bitraverse) +import Data.Char (isSpace) +import Data.Containers.ListUtils (nubOrdOn) +import Data.Either (partitionEithers) +import Data.Foldable (fold) +import Data.Function (on) +import Data.Functor (($>)) +import Data.Functor.Identity (Identity(..)) +import Data.List (transpose, nubBy, partition, dropWhileEnd, sortOn, uncons) +import Data.List.NonEmpty qualified as NEL +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Maybe (maybeToList, fromMaybe, isJust, mapMaybe) +import Data.Map qualified as M +import Data.Ord (Down(..)) +import Data.Set qualified as S +import Data.Text qualified as T +import Data.Text (Text) +import Data.Traversable (for) +import GHC.Stack qualified +import Language.PureScript.AST +import Language.PureScript.Bundle qualified as Bundle +import Language.PureScript.Constants.Libs qualified as C +import Language.PureScript.Constants.Prim qualified as C +import Language.PureScript.Crash +import Language.PureScript.CST.Errors qualified as CST +import Language.PureScript.CST.Print qualified as CST +import Language.PureScript.Label (Label(..)) +import Language.PureScript.Names +import Language.PureScript.Pretty +import Language.PureScript.Pretty.Common (endWith) +import Language.PureScript.PSString (decodeStringWithReplacement) +import Language.PureScript.Roles +import Language.PureScript.Traversals +import Language.PureScript.Types +import Language.PureScript.Publish.BoxesHelpers qualified as BoxHelpers +import System.Console.ANSI qualified as ANSI +import System.FilePath (makeRelative) +import Text.PrettyPrint.Boxes qualified as Box +import Witherable (wither) -- | A type of error messages data SimpleErrorMessage diff --git a/src/Language/PureScript/Errors/JSON.hs b/src/Language/PureScript/Errors/JSON.hs index 924e452309..9e2af78668 100644 --- a/src/Language/PureScript/Errors/JSON.hs +++ b/src/Language/PureScript/Errors/JSON.hs @@ -4,11 +4,11 @@ module Language.PureScript.Errors.JSON where import Prelude -import qualified Data.Aeson.TH as A -import qualified Data.List.NonEmpty as NEL +import Data.Aeson.TH qualified as A +import Data.List.NonEmpty qualified as NEL import Data.Text (Text) -import qualified Language.PureScript as P +import Language.PureScript qualified as P data ErrorPosition = ErrorPosition { startLine :: Int diff --git a/src/Language/PureScript/Externs.hs b/src/Language/PureScript/Externs.hs index 477c2e68f4..83cd88147f 100644 --- a/src/Language/PureScript/Externs.hs +++ b/src/Language/PureScript/Externs.hs @@ -23,10 +23,10 @@ import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import Data.List (foldl', find) import Data.Foldable (fold) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Data.Version (showVersion) -import qualified Data.Map as M -import qualified Data.List.NonEmpty as NEL +import Data.Map qualified as M +import Data.List.NonEmpty qualified as NEL import Language.PureScript.AST import Language.PureScript.AST.Declarations.ChainId (ChainId) diff --git a/src/Language/PureScript/Graph.hs b/src/Language/PureScript/Graph.hs index 9c2c6e09d2..fc2ae68fcb 100644 --- a/src/Language/PureScript/Graph.hs +++ b/src/Language/PureScript/Graph.hs @@ -2,27 +2,27 @@ module Language.PureScript.Graph (graph) where import Prelude -import qualified Data.Aeson as Json -import qualified Data.Aeson.Key as Json.Key -import qualified Data.Aeson.KeyMap as Json.Map -import qualified Data.Map as Map - -import Control.Monad (forM) -import Data.Aeson ((.=)) -import Data.Foldable (foldl') -import Data.Map (Map) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import System.IO.UTF8 (readUTF8FileT) - -import qualified Language.PureScript.Crash as Crash -import qualified Language.PureScript.CST as CST -import qualified Language.PureScript.Make as Make -import qualified Language.PureScript.ModuleDependencies as Dependencies -import qualified Language.PureScript.Options as Options - -import Language.PureScript.Errors (MultipleErrors) -import Language.PureScript.Names (ModuleName, runModuleName) +import Data.Aeson qualified as Json +import Data.Aeson.Key qualified as Json.Key +import Data.Aeson.KeyMap qualified as Json.Map +import Data.Map qualified as Map + +import Control.Monad (forM) +import Data.Aeson ((.=)) +import Data.Foldable (foldl') +import Data.Map (Map) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import System.IO.UTF8 (readUTF8FileT) + +import Language.PureScript.Crash qualified as Crash +import Language.PureScript.CST qualified as CST +import Language.PureScript.Make qualified as Make +import Language.PureScript.ModuleDependencies qualified as Dependencies +import Language.PureScript.Options qualified as Options + +import Language.PureScript.Errors (MultipleErrors) +import Language.PureScript.Names (ModuleName, runModuleName) -- | Given a set of filepaths, try to build the dependency graph and return diff --git a/src/Language/PureScript/Hierarchy.hs b/src/Language/PureScript/Hierarchy.hs index fb9a25f018..c4919fb60d 100644 --- a/src/Language/PureScript/Hierarchy.hs +++ b/src/Language/PureScript/Hierarchy.hs @@ -15,12 +15,12 @@ module Language.PureScript.Hierarchy where -import Prelude -import Protolude (ordNub) +import Prelude +import Protolude (ordNub) -import Data.List (sort) -import qualified Data.Text as T -import qualified Language.PureScript as P +import Data.List (sort) +import Data.Text qualified as T +import Language.PureScript qualified as P newtype SuperMap = SuperMap { _unSuperMap :: Either (P.ProperName 'P.ClassName) (P.ProperName 'P.ClassName, P.ProperName 'P.ClassName) diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs index fdee5c6f4a..a7b4eb5095 100644 --- a/src/Language/PureScript/Ide.hs +++ b/src/Language/PureScript/Ide.hs @@ -18,31 +18,31 @@ module Language.PureScript.Ide ( handleCommand ) where -import Protolude hiding (moduleName) - -import "monad-logger" Control.Monad.Logger -import qualified Data.Map as Map -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.Ide.CaseSplit as CS -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Externs -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Imports hiding (Import) -import Language.PureScript.Ide.Imports.Actions -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Prim -import Language.PureScript.Ide.Rebuild -import Language.PureScript.Ide.SourceFile -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util -import Language.PureScript.Ide.Usage (findUsages) -import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist) -import System.FilePath ((), normalise) -import System.FilePath.Glob (glob) +import Protolude hiding (moduleName) + +import "monad-logger" Control.Monad.Logger +import Data.Map qualified as Map +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Ide.CaseSplit qualified as CS +import Language.PureScript.Ide.Command +import Language.PureScript.Ide.Completion +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.Externs +import Language.PureScript.Ide.Filter +import Language.PureScript.Ide.Imports hiding (Import) +import Language.PureScript.Ide.Imports.Actions +import Language.PureScript.Ide.Matcher +import Language.PureScript.Ide.Prim +import Language.PureScript.Ide.Rebuild +import Language.PureScript.Ide.SourceFile +import Language.PureScript.Ide.State +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Usage (findUsages) +import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist) +import System.FilePath ((), normalise) +import System.FilePath.Glob (glob) -- | Accepts a Command and runs it against psc-ide's State. This is the main -- entry point for the server. diff --git a/src/Language/PureScript/Ide/CaseSplit.hs b/src/Language/PureScript/Ide/CaseSplit.hs index 9643f642b1..db2174ebe1 100644 --- a/src/Language/PureScript/Ide/CaseSplit.hs +++ b/src/Language/PureScript/Ide/CaseSplit.hs @@ -21,18 +21,18 @@ module Language.PureScript.Ide.CaseSplit , caseSplit ) where -import Protolude hiding (Constructor) - -import qualified Data.List.NonEmpty as NE -import qualified Data.Map as M -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST - -import Language.PureScript.Externs -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Types +import Protolude hiding (Constructor) + +import Data.List.NonEmpty qualified as NE +import Data.Map qualified as M +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST + +import Language.PureScript.Externs +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.State +import Language.PureScript.Ide.Types type Constructor = (P.ProperName 'P.ConstructorName, [P.SourceType]) diff --git a/src/Language/PureScript/Ide/Command.hs b/src/Language/PureScript/Ide/Command.hs index 185474f11e..ace3a05a1e 100644 --- a/src/Language/PureScript/Ide/Command.hs +++ b/src/Language/PureScript/Ide/Command.hs @@ -14,18 +14,18 @@ module Language.PureScript.Ide.Command where -import Protolude +import Protolude -import Control.Monad.Fail (fail) -import Data.Aeson -import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified Language.PureScript as P -import Language.PureScript.Ide.CaseSplit -import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Types +import Control.Monad.Fail (fail) +import Data.Aeson +import Data.Map qualified as Map +import Data.Set qualified as Set +import Language.PureScript qualified as P +import Language.PureScript.Ide.CaseSplit +import Language.PureScript.Ide.Completion +import Language.PureScript.Ide.Filter +import Language.PureScript.Ide.Matcher +import Language.PureScript.Ide.Types data Command = Load [P.ModuleName] diff --git a/src/Language/PureScript/Ide/Completion.hs b/src/Language/PureScript/Ide/Completion.hs index 6fa69d5c00..78edbf6a96 100644 --- a/src/Language/PureScript/Ide/Completion.hs +++ b/src/Language/PureScript/Ide/Completion.hs @@ -9,18 +9,18 @@ module Language.PureScript.Ide.Completion , applyCompletionOptions ) where -import Protolude hiding ((<&>), moduleName) - -import Control.Lens hiding (op, (&)) -import Data.Aeson -import qualified Data.Map as Map -import qualified Data.Text as T -import qualified Language.PureScript as P -import Language.PureScript.Ide.Error (prettyPrintTypeSingleLine) -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Protolude hiding ((<&>), moduleName) + +import Control.Lens hiding (op, (&)) +import Data.Aeson +import Data.Map qualified as Map +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Ide.Error (prettyPrintTypeSingleLine) +import Language.PureScript.Ide.Filter +import Language.PureScript.Ide.Matcher +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util -- | Applies the CompletionFilters and the Matcher to the given Modules -- and sorts the found Completions according to the Matching Score diff --git a/src/Language/PureScript/Ide/Error.hs b/src/Language/PureScript/Ide/Error.hs index 92ca14339b..cb7105358d 100644 --- a/src/Language/PureScript/Ide/Error.hs +++ b/src/Language/PureScript/Ide/Error.hs @@ -17,14 +17,14 @@ module Language.PureScript.Ide.Error , prettyPrintTypeSingleLine ) where -import Data.Aeson -import qualified Data.Aeson.Types as Aeson -import qualified Data.Aeson.KeyMap as KM -import qualified Data.Text as T -import qualified Language.PureScript as P -import Language.PureScript.Errors.JSON -import Language.PureScript.Ide.Types (ModuleIdent, Completion(..)) -import Protolude +import Data.Aeson +import Data.Aeson.Types qualified as Aeson +import Data.Aeson.KeyMap qualified as KM +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Errors.JSON +import Language.PureScript.Ide.Types (ModuleIdent, Completion(..)) +import Protolude data IdeError = GeneralError Text diff --git a/src/Language/PureScript/Ide/Externs.hs b/src/Language/PureScript/Ide/Externs.hs index 70c780b8aa..df9edabcb1 100644 --- a/src/Language/PureScript/Ide/Externs.hs +++ b/src/Language/PureScript/Ide/Externs.hs @@ -5,18 +5,18 @@ module Language.PureScript.Ide.Externs , convertExterns ) where -import Protolude hiding (to, from, (&)) +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 -import qualified Language.PureScript as P -import qualified Language.PureScript.Make.Monad as Make -import Language.PureScript.Ide.Error (IdeError (..)) -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util (properNameT) +import Codec.CBOR.Term as Term +import Control.Lens hiding (anyOf) +import "monad-logger" Control.Monad.Logger +import Data.Version (showVersion) +import Data.Text qualified as Text +import Language.PureScript qualified as P +import Language.PureScript.Make.Monad qualified as Make +import Language.PureScript.Ide.Error (IdeError (..)) +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util (properNameT) readExternFile :: (MonadIO m, MonadError IdeError m, MonadLogger m) diff --git a/src/Language/PureScript/Ide/Filter.hs b/src/Language/PureScript/Ide/Filter.hs index 1fd9df394f..f3c693673c 100644 --- a/src/Language/PureScript/Ide/Filter.hs +++ b/src/Language/PureScript/Ide/Filter.hs @@ -23,20 +23,20 @@ module Language.PureScript.Ide.Filter , applyFilters ) where -import Protolude hiding (isPrefixOf, Prefix) - -import Control.Monad.Fail (fail) -import Data.Aeson -import Data.Text (isPrefixOf) -import qualified Data.Set as Set -import qualified Data.Map as Map -import Language.PureScript.Ide.Filter.Declaration (DeclarationType) -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Imports -import Language.PureScript.Ide.Util - -import qualified Language.PureScript as P -import qualified Data.Text as T +import Protolude hiding (isPrefixOf, Prefix) + +import Control.Monad.Fail (fail) +import Data.Aeson +import Data.Text (isPrefixOf) +import Data.Set qualified as Set +import Data.Map qualified as Map +import Language.PureScript.Ide.Filter.Declaration (DeclarationType) +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Imports +import Language.PureScript.Ide.Util + +import Language.PureScript qualified as P +import Data.Text qualified as T import Language.PureScript.Ide.Filter.Imports diff --git a/src/Language/PureScript/Ide/Filter/Declaration.hs b/src/Language/PureScript/Ide/Filter/Declaration.hs index 563bd151e2..c3bd6fead3 100644 --- a/src/Language/PureScript/Ide/Filter/Declaration.hs +++ b/src/Language/PureScript/Ide/Filter/Declaration.hs @@ -2,10 +2,10 @@ module Language.PureScript.Ide.Filter.Declaration ( DeclarationType(..) ) where -import Protolude hiding (isPrefixOf) +import Protolude hiding (isPrefixOf) -import Control.Monad.Fail (fail) -import Data.Aeson +import Control.Monad.Fail (fail) +import Data.Aeson data DeclarationType = Value diff --git a/src/Language/PureScript/Ide/Filter/Imports.hs b/src/Language/PureScript/Ide/Filter/Imports.hs index f1870b4d09..fcdf0fcab7 100644 --- a/src/Language/PureScript/Ide/Filter/Imports.hs +++ b/src/Language/PureScript/Ide/Filter/Imports.hs @@ -1,12 +1,12 @@ module Language.PureScript.Ide.Filter.Imports where -import Protolude hiding (isPrefixOf) +import Protolude hiding (isPrefixOf) import Language.PureScript.Ide.Types import Language.PureScript.Ide.Imports -import qualified Language.PureScript as P +import Language.PureScript qualified as P matchImport :: Maybe P.ModuleName -> P.ModuleName -> IdeDeclarationAnn -> Import -> Bool matchImport matchQualifier declMod (IdeDeclarationAnn _ decl) (Import importMod declTy qualifier) | declMod == importMod && matchQualifier == qualifier = diff --git a/src/Language/PureScript/Ide/Imports.hs b/src/Language/PureScript/Ide/Imports.hs index 94e6d78fd7..cc788308c4 100644 --- a/src/Language/PureScript/Ide/Imports.hs +++ b/src/Language/PureScript/Ide/Imports.hs @@ -24,16 +24,16 @@ module Language.PureScript.Ide.Imports ) where -import Protolude hiding (moduleName) +import Protolude hiding (moduleName) -import Control.Lens ((^.), (%~), ix) -import Data.List (partition) -import qualified Data.List.NonEmpty as NE -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Util +import Control.Lens ((^.), (%~), ix) +import Data.List (partition) +import Data.List.NonEmpty qualified as NE +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.Util data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName) deriving (Eq, Show) diff --git a/src/Language/PureScript/Ide/Imports/Actions.hs b/src/Language/PureScript/Ide/Imports/Actions.hs index 6d69491587..af48677df7 100644 --- a/src/Language/PureScript/Ide/Imports/Actions.hs +++ b/src/Language/PureScript/Ide/Imports/Actions.hs @@ -11,23 +11,23 @@ module Language.PureScript.Ide.Imports.Actions ) where -import Protolude hiding (moduleName) - -import Control.Lens ((^.), has) -import Data.List (nubBy) -import qualified Data.Map as Map -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.Constants.Prim as C -import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Imports -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Prim -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util -import System.IO.UTF8 (writeUTF8FileT) +import Protolude hiding (moduleName) + +import Control.Lens ((^.), has) +import Data.List (nubBy) +import Data.Map qualified as Map +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Constants.Prim qualified as C +import Language.PureScript.Ide.Completion +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.Filter +import Language.PureScript.Ide.Imports +import Language.PureScript.Ide.State +import Language.PureScript.Ide.Prim +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util +import System.IO.UTF8 (writeUTF8FileT) -- | Adds an implicit import like @import Prelude@ to a Sourcefile. addImplicitImport diff --git a/src/Language/PureScript/Ide/Logging.hs b/src/Language/PureScript/Ide/Logging.hs index 9ffaafa278..4b1159deb8 100644 --- a/src/Language/PureScript/Ide/Logging.hs +++ b/src/Language/PureScript/Ide/Logging.hs @@ -7,13 +7,13 @@ module Language.PureScript.Ide.Logging , labelTimespec ) where -import Protolude +import Protolude -import "monad-logger" Control.Monad.Logger -import qualified Data.Text as T -import Language.PureScript.Ide.Types -import System.Clock -import Text.Printf +import "monad-logger" Control.Monad.Logger +import Data.Text qualified as T +import Language.PureScript.Ide.Types +import System.Clock +import Text.Printf runLogger :: MonadIO m => IdeLogLevel -> LoggingT m a -> m a runLogger logLevel' = diff --git a/src/Language/PureScript/Ide/Matcher.hs b/src/Language/PureScript/Ide/Matcher.hs index 9263abdb5e..a959c103dd 100644 --- a/src/Language/PureScript/Ide/Matcher.hs +++ b/src/Language/PureScript/Ide/Matcher.hs @@ -19,16 +19,16 @@ module Language.PureScript.Ide.Matcher , flexMatcher ) where -import Protolude - -import Control.Monad.Fail (fail) -import Data.Aeson -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util -import Text.EditDistance -import Text.Regex.TDFA ((=~)) +import Protolude + +import Control.Monad.Fail (fail) +import Data.Aeson +import Data.Text qualified as T +import Data.Text.Encoding qualified as TE +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util +import Text.EditDistance +import Text.Regex.TDFA ((=~)) type ScoredMatch a = (Match a, Double) diff --git a/src/Language/PureScript/Ide/Prim.hs b/src/Language/PureScript/Ide/Prim.hs index c65e98447b..ff60533d8f 100644 --- a/src/Language/PureScript/Ide/Prim.hs +++ b/src/Language/PureScript/Ide/Prim.hs @@ -1,13 +1,13 @@ module Language.PureScript.Ide.Prim (idePrimDeclarations) where -import Protolude +import Protolude -import qualified Data.Text as T -import qualified Data.Map as Map -import qualified Language.PureScript as P -import qualified Language.PureScript.Constants.Prim as C -import qualified Language.PureScript.Environment as PEnv -import Language.PureScript.Ide.Types +import Data.Text qualified as T +import Data.Map qualified as Map +import Language.PureScript qualified as P +import Language.PureScript.Constants.Prim qualified as C +import Language.PureScript.Environment qualified as PEnv +import Language.PureScript.Ide.Types idePrimDeclarations :: ModuleMap [IdeDeclarationAnn] idePrimDeclarations = Map.fromList diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs index 51d9dd996e..d9eccc9d57 100644 --- a/src/Language/PureScript/Ide/Rebuild.hs +++ b/src/Language/PureScript/Ide/Rebuild.hs @@ -6,26 +6,26 @@ module Language.PureScript.Ide.Rebuild , rebuildFile ) where -import Protolude hiding (moduleName) - -import "monad-logger" Control.Monad.Logger -import qualified Data.List as List -import qualified Data.Map.Lazy as M -import Data.Maybe (fromJust) -import qualified Data.Set as S -import qualified Data.Time as Time -import qualified Data.Text as Text -import qualified Language.PureScript as P -import Language.PureScript.Make (ffiCodegen') -import Language.PureScript.Make.Cache (CacheInfo(..), normaliseForCache) -import qualified Language.PureScript.CST as CST - -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Logging -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util -import System.Directory (getCurrentDirectory) +import Protolude hiding (moduleName) + +import "monad-logger" Control.Monad.Logger +import Data.List qualified as List +import Data.Map.Lazy qualified as M +import Data.Maybe (fromJust) +import Data.Set qualified as S +import Data.Time qualified as Time +import Data.Text qualified as Text +import Language.PureScript qualified as P +import Language.PureScript.Make (ffiCodegen') +import Language.PureScript.Make.Cache (CacheInfo(..), normaliseForCache) +import Language.PureScript.CST qualified as CST + +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.Logging +import Language.PureScript.Ide.State +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util +import System.Directory (getCurrentDirectory) -- | Given a filepath performs the following steps: -- diff --git a/src/Language/PureScript/Ide/Reexports.hs b/src/Language/PureScript/Ide/Reexports.hs index 50f7acb549..c862c63c87 100644 --- a/src/Language/PureScript/Ide/Reexports.hs +++ b/src/Language/PureScript/Ide/Reexports.hs @@ -22,13 +22,13 @@ module Language.PureScript.Ide.Reexports , resolveReexports' ) where -import Protolude hiding (moduleName) +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 Control.Lens hiding (anyOf, (&)) +import Data.Map qualified as Map +import Language.PureScript qualified as P +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util -- | Contains the module with resolved reexports, and possible failures data ReexportResult a diff --git a/src/Language/PureScript/Ide/SourceFile.hs b/src/Language/PureScript/Ide/SourceFile.hs index 61dfcb4e14..333101a025 100644 --- a/src/Language/PureScript/Ide/SourceFile.hs +++ b/src/Language/PureScript/Ide/SourceFile.hs @@ -20,15 +20,15 @@ module Language.PureScript.Ide.SourceFile , extractTypeAnnotations ) where -import Protolude +import Protolude -import Control.Parallel.Strategies (withStrategy, parList, rseq) -import qualified Data.Map as Map -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Control.Parallel.Strategies (withStrategy, parList, rseq) +import Data.Map qualified as Map +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util parseModule :: FilePath -> Text -> Either FilePath (FilePath, P.Module) parseModule path file = diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs index 99e5515f17..03bb241d8d 100644 --- a/src/Language/PureScript/Ide/State.hs +++ b/src/Language/PureScript/Ide/State.hs @@ -37,25 +37,25 @@ module Language.PureScript.Ide.State , resolveDataConstructorsForModule ) where -import Protolude hiding (moduleName, unzip) - -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 -import Data.Time.Clock (UTCTime) -import Data.Zip (unzip) -import qualified Language.PureScript as P -import Language.PureScript.Docs.Convert.Single (convertComments) -import Language.PureScript.Externs -import Language.PureScript.Make.Actions (cacheDbFile) -import Language.PureScript.Ide.Externs -import Language.PureScript.Ide.Reexports -import Language.PureScript.Ide.SourceFile -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util -import System.Directory (getModificationTime) +import Protolude hiding (moduleName, unzip) + +import Control.Concurrent.STM +import Control.Lens hiding (anyOf, op, (&)) +import "monad-logger" Control.Monad.Logger +import Data.IORef +import Data.Map.Lazy qualified as Map +import Data.Time.Clock (UTCTime) +import Data.Zip (unzip) +import Language.PureScript qualified as P +import Language.PureScript.Docs.Convert.Single (convertComments) +import Language.PureScript.Externs +import Language.PureScript.Make.Actions (cacheDbFile) +import Language.PureScript.Ide.Externs +import Language.PureScript.Ide.Reexports +import Language.PureScript.Ide.SourceFile +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util +import System.Directory (getModificationTime) -- | Resets all State inside psc-ide resetIdeState :: Ide m => m () diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs index f2748cdb50..b8fcda9dd5 100644 --- a/src/Language/PureScript/Ide/Types.hs +++ b/src/Language/PureScript/Ide/Types.hs @@ -5,19 +5,19 @@ module Language.PureScript.Ide.Types where -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 -import Data.IORef (IORef) -import Data.Time.Clock (UTCTime) -import qualified Data.Map.Lazy as M -import qualified Language.PureScript as P -import qualified Language.PureScript.Errors.JSON as P -import Language.PureScript.Ide.Filter.Declaration (DeclarationType(..)) +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 Data.Aeson qualified as Aeson +import Data.IORef (IORef) +import Data.Time.Clock (UTCTime) +import Data.Map.Lazy qualified as M +import Language.PureScript qualified as P +import Language.PureScript.Errors.JSON qualified as P +import Language.PureScript.Ide.Filter.Declaration (DeclarationType(..)) type ModuleIdent = Text type ModuleMap a = Map P.ModuleName a diff --git a/src/Language/PureScript/Ide/Usage.hs b/src/Language/PureScript/Ide/Usage.hs index 8616c55744..5d04654a3c 100644 --- a/src/Language/PureScript/Ide/Usage.hs +++ b/src/Language/PureScript/Ide/Usage.hs @@ -6,15 +6,15 @@ module Language.PureScript.Ide.Usage , findUsages ) where -import Protolude hiding (moduleName) +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 Control.Lens (preview) +import Data.Map qualified as Map +import Data.Set qualified as Set +import Language.PureScript qualified as P +import Language.PureScript.Ide.State (getAllModules, getFileState) +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util -- | -- How we find usages, given an IdeDeclaration and the module it was defined in: diff --git a/src/Language/PureScript/Ide/Util.hs b/src/Language/PureScript/Ide/Util.hs index 5f13157ed2..f7f90f5236 100644 --- a/src/Language/PureScript/Ide/Util.hs +++ b/src/Language/PureScript/Ide/Util.hs @@ -29,20 +29,20 @@ module Language.PureScript.Ide.Util , module Language.PureScript.Ide.Logging ) where -import Protolude hiding (decodeUtf8, +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 -import Data.Text.Lazy.Encoding as TLE -import qualified Language.PureScript as P -import Language.PureScript.Ide.Error (IdeError(..)) -import Language.PureScript.Ide.Logging -import Language.PureScript.Ide.Types -import System.IO.UTF8 (readUTF8FileT) -import System.Directory (makeAbsolute) +import Control.Lens hiding (op, (&)) +import Data.Aeson +import Data.Text qualified as T +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.Encoding as TLE +import Language.PureScript qualified as P +import Language.PureScript.Ide.Error (IdeError(..)) +import Language.PureScript.Ide.Logging +import Language.PureScript.Ide.Types +import System.IO.UTF8 (readUTF8FileT) +import System.Directory (makeAbsolute) identifierFromIdeDeclaration :: IdeDeclaration -> Text identifierFromIdeDeclaration d = case d of diff --git a/src/Language/PureScript/Interactive.hs b/src/Language/PureScript/Interactive.hs index e1552e2d07..820aefc080 100644 --- a/src/Language/PureScript/Interactive.hs +++ b/src/Language/PureScript/Interactive.hs @@ -9,39 +9,39 @@ module Language.PureScript.Interactive , runMake ) where -import Prelude -import Protolude (ordNub) - -import Data.List (sort, find, foldl') -import Data.Maybe (fromMaybe, mapMaybe) -import qualified Data.Map as M -import qualified Data.Set as S -import Data.Text (Text) -import qualified Data.Text as T - -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.State.Class -import Control.Monad.Reader.Class -import Control.Monad.Trans.Except (ExceptT(..), runExceptT) -import Control.Monad.Trans.State.Strict (StateT, runStateT, evalStateT) -import Control.Monad.Writer.Strict (Writer(), runWriter) - -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import qualified Language.PureScript.Names as N -import qualified Language.PureScript.Constants.Prim as C - -import Language.PureScript.Interactive.Completion as Interactive -import Language.PureScript.Interactive.IO as Interactive -import Language.PureScript.Interactive.Message as Interactive -import Language.PureScript.Interactive.Module as Interactive -import Language.PureScript.Interactive.Parser as Interactive -import Language.PureScript.Interactive.Printer as Interactive -import Language.PureScript.Interactive.Types as Interactive - -import System.Directory (getCurrentDirectory) -import System.FilePath (()) -import System.FilePath.Glob (glob) +import Prelude +import Protolude (ordNub) + +import Data.List (sort, find, foldl') +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Map qualified as M +import Data.Set qualified as S +import Data.Text (Text) +import Data.Text qualified as T + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.State.Class +import Control.Monad.Reader.Class +import Control.Monad.Trans.Except (ExceptT(..), runExceptT) +import Control.Monad.Trans.State.Strict (StateT, runStateT, evalStateT) +import Control.Monad.Writer.Strict (Writer(), runWriter) + +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.Names qualified as N +import Language.PureScript.Constants.Prim qualified as C + +import Language.PureScript.Interactive.Completion as Interactive +import Language.PureScript.Interactive.IO as Interactive +import Language.PureScript.Interactive.Message as Interactive +import Language.PureScript.Interactive.Module as Interactive +import Language.PureScript.Interactive.Parser as Interactive +import Language.PureScript.Interactive.Printer as Interactive +import Language.PureScript.Interactive.Types as Interactive + +import System.Directory (getCurrentDirectory) +import System.FilePath (()) +import System.FilePath.Glob (glob) -- | Pretty-print errors printErrors :: MonadIO m => P.MultipleErrors -> m () diff --git a/src/Language/PureScript/Interactive/Completion.hs b/src/Language/PureScript/Interactive/Completion.hs index d79627801a..d4fd68d770 100644 --- a/src/Language/PureScript/Interactive/Completion.hs +++ b/src/Language/PureScript/Interactive/Completion.hs @@ -9,17 +9,17 @@ module Language.PureScript.Interactive.Completion import Prelude import Protolude (ordNub) -import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.State.Class (MonadState(..)) -import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT) -import Data.List (nub, isPrefixOf, isInfixOf, isSuffixOf, sortBy, stripPrefix) -import Data.Map (keys) -import Data.Maybe (mapMaybe) -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.Interactive.Directive as D -import Language.PureScript.Interactive.Types -import System.Console.Haskeline +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.State.Class (MonadState(..)) +import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT) +import Data.List (nub, isPrefixOf, isInfixOf, isSuffixOf, sortBy, stripPrefix) +import Data.Map (keys) +import Data.Maybe (mapMaybe) +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Interactive.Directive qualified as D +import Language.PureScript.Interactive.Types +import System.Console.Haskeline -- Completions may read the state, but not modify it. type CompletionM = ReaderT PSCiState IO diff --git a/src/Language/PureScript/Interactive/Message.hs b/src/Language/PureScript/Interactive/Message.hs index 17488149b8..f99aabbe86 100644 --- a/src/Language/PureScript/Interactive/Message.hs +++ b/src/Language/PureScript/Interactive/Message.hs @@ -1,12 +1,12 @@ module Language.PureScript.Interactive.Message where -import Prelude +import Prelude -import Data.List (intercalate) -import Data.Version (showVersion) -import qualified Paths_purescript as Paths -import qualified Language.PureScript.Interactive.Directive as D -import Language.PureScript.Interactive.Types +import Data.List (intercalate) +import Data.Version (showVersion) +import Paths_purescript qualified as Paths +import Language.PureScript.Interactive.Directive qualified as D +import Language.PureScript.Interactive.Types -- Messages diff --git a/src/Language/PureScript/Interactive/Module.hs b/src/Language/PureScript/Interactive/Module.hs index 9c90a890af..3230a44321 100644 --- a/src/Language/PureScript/Interactive/Module.hs +++ b/src/Language/PureScript/Interactive/Module.hs @@ -1,13 +1,13 @@ module Language.PureScript.Interactive.Module where -import Prelude +import Prelude -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import Language.PureScript.Interactive.Types -import System.Directory (getCurrentDirectory) -import System.FilePath (pathSeparator, makeRelative) -import System.IO.UTF8 (readUTF8FilesT) +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.Interactive.Types +import System.Directory (getCurrentDirectory) +import System.FilePath (pathSeparator, makeRelative) +import System.IO.UTF8 (readUTF8FilesT) -- * Support Module diff --git a/src/Language/PureScript/Interactive/Parser.hs b/src/Language/PureScript/Interactive/Parser.hs index 4f55bfb566..0347064dd7 100644 --- a/src/Language/PureScript/Interactive/Parser.hs +++ b/src/Language/PureScript/Interactive/Parser.hs @@ -6,19 +6,19 @@ module Language.PureScript.Interactive.Parser , parseCommand ) where -import Prelude - -import Control.Monad (join) -import Data.Bifunctor (bimap) -import Data.Char (isSpace) -import Data.List (intercalate) -import qualified Data.List.NonEmpty as NE -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import qualified Language.PureScript.CST.Monad as CSTM -import qualified Language.PureScript.Interactive.Directive as D -import Language.PureScript.Interactive.Types +import Prelude + +import Control.Monad (join) +import Data.Bifunctor (bimap) +import Data.Char (isSpace) +import Data.List (intercalate) +import Data.List.NonEmpty qualified as NE +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.CST.Monad qualified as CSTM +import Language.PureScript.Interactive.Directive qualified as D +import Language.PureScript.Interactive.Types -- | -- Parses a limited set of commands from from .purs-repl diff --git a/src/Language/PureScript/Interactive/Printer.hs b/src/Language/PureScript/Interactive/Printer.hs index e1775a6997..cd0b8f58f3 100644 --- a/src/Language/PureScript/Interactive/Printer.hs +++ b/src/Language/PureScript/Interactive/Printer.hs @@ -1,14 +1,14 @@ module Language.PureScript.Interactive.Printer where -import Prelude - -import Data.List (intersperse) -import qualified Data.Map as M -import Data.Maybe (mapMaybe) -import qualified Data.Text as T -import Data.Text (Text) -import qualified Language.PureScript as P -import qualified Text.PrettyPrint.Boxes as Box +import Prelude + +import Data.List (intersperse) +import Data.Map qualified as M +import Data.Maybe (mapMaybe) +import Data.Text qualified as T +import Data.Text (Text) +import Language.PureScript qualified as P +import Text.PrettyPrint.Boxes qualified as Box -- TODO (Christoph): Text version of boxes textT :: Text -> Box.Box diff --git a/src/Language/PureScript/Interactive/Types.hs b/src/Language/PureScript/Interactive/Types.hs index c6257fed3a..83fedf811d 100644 --- a/src/Language/PureScript/Interactive/Types.hs +++ b/src/Language/PureScript/Interactive/Types.hs @@ -30,14 +30,14 @@ module Language.PureScript.Interactive.Types import Prelude -import qualified Language.PureScript as P -import qualified Data.Map as M -import Data.List (foldl') -import Language.PureScript.Sugar.Names.Env (nullImports, primExports) -import Control.Monad (foldM) -import Control.Monad.Trans.Except (runExceptT) -import Control.Monad.Trans.State (execStateT) -import Control.Monad.Writer.Strict (runWriterT) +import Language.PureScript qualified as P +import Data.Map qualified as M +import Data.List (foldl') +import Language.PureScript.Sugar.Names.Env (nullImports, primExports) +import Control.Monad (foldM) +import Control.Monad.Trans.Except (runExceptT) +import Control.Monad.Trans.State (execStateT) +import Control.Monad.Writer.Strict (runWriterT) -- | The PSCI configuration. diff --git a/src/Language/PureScript/Label.hs b/src/Language/PureScript/Label.hs index f3d257b0fa..a5d080a76c 100644 --- a/src/Language/PureScript/Label.hs +++ b/src/Language/PureScript/Label.hs @@ -6,7 +6,7 @@ import Codec.Serialise (Serialise) import Control.DeepSeq (NFData) import Data.Monoid () import Data.String (IsString(..)) -import qualified Data.Aeson as A +import Data.Aeson qualified as A import Language.PureScript.PSString (PSString) diff --git a/src/Language/PureScript/Linter.hs b/src/Language/PureScript/Linter.hs index 15265fbf84..bffde54883 100644 --- a/src/Language/PureScript/Linter.hs +++ b/src/Language/PureScript/Linter.hs @@ -8,9 +8,9 @@ import Prelude import Control.Monad.Writer.Class import Data.Maybe (mapMaybe) -import qualified Data.Set as S +import Data.Set qualified as S import Data.Text (Text) -import qualified Data.Text as Text +import Data.Text qualified as Text import Control.Monad ((<=<)) import Language.PureScript.AST @@ -19,7 +19,7 @@ import Language.PureScript.Linter.Exhaustive as L import Language.PureScript.Linter.Imports as L import Language.PureScript.Names import Language.PureScript.Types -import qualified Language.PureScript.Constants.Libs as C +import Language.PureScript.Constants.Libs qualified as C -- | Lint the PureScript AST. -- | diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs index db1373e686..60a20ff3cf 100644 --- a/src/Language/PureScript/Linter/Exhaustive.hs +++ b/src/Language/PureScript/Linter/Exhaustive.hs @@ -18,8 +18,8 @@ import Control.Monad.Writer.Class import Data.List (foldl', sortOn) import Data.Maybe (fromMaybe) -import qualified Data.Map as M -import qualified Data.Text as T +import Data.Map qualified as M +import Data.Text qualified as T import Language.PureScript.AST.Binders import Language.PureScript.AST.Declarations @@ -31,7 +31,7 @@ import Language.PureScript.Names as P import Language.PureScript.Pretty.Values (prettyPrintBinderAtom) import Language.PureScript.Traversals import Language.PureScript.Types as P -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Prim qualified as C -- | There are two modes of failure for the redundancy check: -- diff --git a/src/Language/PureScript/Linter/Imports.hs b/src/Language/PureScript/Linter/Imports.hs index 9b81691411..9c88597978 100644 --- a/src/Language/PureScript/Linter/Imports.hs +++ b/src/Language/PureScript/Linter/Imports.hs @@ -16,8 +16,8 @@ import Data.List (find, intersect, groupBy, sort, sortOn, (\\)) import Data.Maybe (mapMaybe) import Data.Monoid (Sum(..)) import Data.Traversable (forM) -import qualified Data.Text as T -import qualified Data.Map as M +import Data.Text qualified as T +import Data.Map qualified as M import Language.PureScript.AST.Declarations import Language.PureScript.AST.SourcePos @@ -27,7 +27,7 @@ import Language.PureScript.Names import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs) import Language.PureScript.Sugar.Names.Env import Language.PureScript.Sugar.Names.Imports -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Prim qualified as C -- | -- Map of module name to list of imported names from that module which have diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index d5c0dd05f5..ad361342c5 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -9,47 +9,47 @@ module Language.PureScript.Make , module Actions ) where -import Prelude +import Prelude -import Control.Concurrent.Lifted as C -import Control.Exception.Base (onException) -import Control.Monad hiding (sequence) -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.IO.Class -import Control.Monad.Supply -import Control.Monad.Trans.Control (MonadBaseControl(..), control) -import Control.Monad.Trans.State (runStateT) -import Control.Monad.Writer.Class (MonadWriter(..), censor) -import Control.Monad.Writer.Strict (runWriterT) -import Data.Function (on) -import Data.Foldable (fold, for_) -import Data.List (foldl', sortOn) -import qualified Data.List.NonEmpty as NEL -import Data.Maybe (fromMaybe) -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Text as T -import Language.PureScript.AST -import Language.PureScript.Crash -import qualified Language.PureScript.CST as CST -import qualified Language.PureScript.Docs.Convert as Docs -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Externs -import Language.PureScript.Linter -import Language.PureScript.ModuleDependencies -import Language.PureScript.Names -import Language.PureScript.Renamer -import Language.PureScript.Sugar -import Language.PureScript.TypeChecker -import Language.PureScript.Make.BuildPlan -import qualified Language.PureScript.Make.BuildPlan as BuildPlan -import qualified Language.PureScript.Make.Cache as Cache -import Language.PureScript.Make.Actions as Actions -import Language.PureScript.Make.Monad as Monad -import qualified Language.PureScript.CoreFn as CF -import System.Directory (doesFileExist) -import System.FilePath (replaceExtension) +import Control.Concurrent.Lifted as C +import Control.Exception.Base (onException) +import Control.Monad hiding (sequence) +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.IO.Class +import Control.Monad.Supply +import Control.Monad.Trans.Control (MonadBaseControl(..), control) +import Control.Monad.Trans.State (runStateT) +import Control.Monad.Writer.Class (MonadWriter(..), censor) +import Control.Monad.Writer.Strict (runWriterT) +import Data.Function (on) +import Data.Foldable (fold, for_) +import Data.List (foldl', sortOn) +import Data.List.NonEmpty qualified as NEL +import Data.Maybe (fromMaybe) +import Data.Map qualified as M +import Data.Set qualified as S +import Data.Text qualified as T +import Language.PureScript.AST +import Language.PureScript.Crash +import Language.PureScript.CST qualified as CST +import Language.PureScript.Docs.Convert qualified as Docs +import Language.PureScript.Environment +import Language.PureScript.Errors +import Language.PureScript.Externs +import Language.PureScript.Linter +import Language.PureScript.ModuleDependencies +import Language.PureScript.Names +import Language.PureScript.Renamer +import Language.PureScript.Sugar +import Language.PureScript.TypeChecker +import Language.PureScript.Make.BuildPlan +import Language.PureScript.Make.BuildPlan qualified as BuildPlan +import Language.PureScript.Make.Cache qualified as Cache +import Language.PureScript.Make.Actions as Actions +import Language.PureScript.Make.Monad as Monad +import Language.PureScript.CoreFn qualified as CF +import System.Directory (doesFileExist) +import System.FilePath (replaceExtension) -- | Rebuild a single module. -- diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 485086b838..6c6d251bae 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -11,53 +11,53 @@ module Language.PureScript.Make.Actions , ffiCodegen' ) where -import Prelude - -import Control.Monad hiding (sequence) -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.IO.Class -import Control.Monad.Reader (asks) -import Control.Monad.Supply -import Control.Monad.Trans.Class (MonadTrans(..)) -import Control.Monad.Writer.Class (MonadWriter(..)) -import Data.Aeson (Value(String), (.=), object) -import Data.Bifunctor (bimap, first) -import Data.Either (partitionEithers) -import Data.Foldable (for_) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Map as M -import Data.Maybe (fromMaybe, maybeToList) -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Text.IO as TIO -import qualified Data.Text.Encoding as TE -import Data.Time.Clock (UTCTime) -import Data.Version (showVersion) -import qualified Language.JavaScript.Parser as JS -import Language.PureScript.AST -import qualified Language.PureScript.Bundle as Bundle -import qualified Language.PureScript.CodeGen.JS as J -import Language.PureScript.CodeGen.JS.Printer -import qualified Language.PureScript.CoreFn as CF -import qualified Language.PureScript.CoreFn.ToJSON as CFJ -import Language.PureScript.Crash -import qualified Language.PureScript.CST as CST -import qualified Language.PureScript.Docs.Prim as Docs.Prim -import qualified Language.PureScript.Docs.Types as Docs -import Language.PureScript.Errors -import Language.PureScript.Externs (ExternsFile, externsFileName) -import Language.PureScript.Make.Monad -import Language.PureScript.Make.Cache -import Language.PureScript.Names -import Language.PureScript.Options hiding (codegenTargets) -import Language.PureScript.Pretty.Common (SMap(..)) -import qualified Paths_purescript as Paths -import SourceMap -import SourceMap.Types -import System.Directory (getCurrentDirectory) -import System.FilePath ((), makeRelative, splitPath, normalise, splitDirectories) -import qualified System.FilePath.Posix as Posix -import System.IO (stderr) +import Prelude + +import Control.Monad hiding (sequence) +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.IO.Class +import Control.Monad.Reader (asks) +import Control.Monad.Supply +import Control.Monad.Trans.Class (MonadTrans(..)) +import Control.Monad.Writer.Class (MonadWriter(..)) +import Data.Aeson (Value(String), (.=), object) +import Data.Bifunctor (bimap, first) +import Data.Either (partitionEithers) +import Data.Foldable (for_) +import Data.List.NonEmpty qualified as NEL +import Data.Map qualified as M +import Data.Maybe (fromMaybe, maybeToList) +import Data.Set qualified as S +import Data.Text qualified as T +import Data.Text.IO qualified as TIO +import Data.Text.Encoding qualified as TE +import Data.Time.Clock (UTCTime) +import Data.Version (showVersion) +import Language.JavaScript.Parser qualified as JS +import Language.PureScript.AST +import Language.PureScript.Bundle qualified as Bundle +import Language.PureScript.CodeGen.JS qualified as J +import Language.PureScript.CodeGen.JS.Printer +import Language.PureScript.CoreFn qualified as CF +import Language.PureScript.CoreFn.ToJSON qualified as CFJ +import Language.PureScript.Crash +import Language.PureScript.CST qualified as CST +import Language.PureScript.Docs.Prim qualified as Docs.Prim +import Language.PureScript.Docs.Types qualified as Docs +import Language.PureScript.Errors +import Language.PureScript.Externs (ExternsFile, externsFileName) +import Language.PureScript.Make.Monad +import Language.PureScript.Make.Cache +import Language.PureScript.Names +import Language.PureScript.Options hiding (codegenTargets) +import Language.PureScript.Pretty.Common (SMap(..)) +import Paths_purescript qualified as Paths +import SourceMap +import SourceMap.Types +import System.Directory (getCurrentDirectory) +import System.FilePath ((), makeRelative, splitPath, normalise, splitDirectories) +import System.FilePath.Posix qualified as Posix +import System.IO (stderr) -- | Determines when to rebuild a module data RebuildPolicy diff --git a/src/Language/PureScript/Make/BuildPlan.hs b/src/Language/PureScript/Make/BuildPlan.hs index d79dc4e2f8..7ac97532f1 100644 --- a/src/Language/PureScript/Make/BuildPlan.hs +++ b/src/Language/PureScript/Make/BuildPlan.hs @@ -9,28 +9,28 @@ module Language.PureScript.Make.BuildPlan , needsRebuild ) where -import Prelude - -import Control.Concurrent.Async.Lifted as A -import Control.Concurrent.Lifted as C -import Control.Monad.Base (liftBase) -import Control.Monad hiding (sequence) -import Control.Monad.Trans.Control (MonadBaseControl(..)) -import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) -import Data.Foldable (foldl') -import qualified Data.Map as M -import Data.Maybe (fromMaybe, mapMaybe) -import Data.Time.Clock (UTCTime) -import Language.PureScript.AST -import Language.PureScript.Crash -import qualified Language.PureScript.CST as CST -import Language.PureScript.Errors -import Language.PureScript.Externs -import Language.PureScript.Make.Actions as Actions -import Language.PureScript.Make.Cache -import Language.PureScript.Names (ModuleName) -import Language.PureScript.Sugar.Names.Env -import System.Directory (getCurrentDirectory) +import Prelude + +import Control.Concurrent.Async.Lifted as A +import Control.Concurrent.Lifted as C +import Control.Monad.Base (liftBase) +import Control.Monad hiding (sequence) +import Control.Monad.Trans.Control (MonadBaseControl(..)) +import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) +import Data.Foldable (foldl') +import Data.Map qualified as M +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Time.Clock (UTCTime) +import Language.PureScript.AST +import Language.PureScript.Crash +import Language.PureScript.CST qualified as CST +import Language.PureScript.Errors +import Language.PureScript.Externs +import Language.PureScript.Make.Actions as Actions +import Language.PureScript.Make.Cache +import Language.PureScript.Names (ModuleName) +import Language.PureScript.Sugar.Names.Env +import System.Directory (getCurrentDirectory) -- | The BuildPlan tracks information about our build progress, and holds all -- prebuilt modules for incremental builds. diff --git a/src/Language/PureScript/Make/Cache.hs b/src/Language/PureScript/Make/Cache.hs index b56261951f..092544fa73 100644 --- a/src/Language/PureScript/Make/Cache.hs +++ b/src/Language/PureScript/Make/Cache.hs @@ -13,13 +13,13 @@ import Prelude import Control.Category ((>>>)) import Control.Monad ((>=>)) import Crypto.Hash (HashAlgorithm, Digest, SHA512) -import qualified Crypto.Hash as Hash -import qualified Data.Aeson as Aeson +import Crypto.Hash qualified as Hash +import Data.Aeson qualified as Aeson import Data.Align (align) import Data.ByteArray.Encoding (Base(Base16), convertToBase, convertFromBase) -import qualified Data.ByteString as BS +import Data.ByteString qualified as BS import Data.Map (Map) -import qualified Data.Map as Map +import Data.Map qualified as Map import Data.Maybe (fromMaybe) import Data.Monoid (All(..)) import Data.Set (Set) @@ -28,7 +28,7 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Data.These (These(..)) import Data.Time.Clock (UTCTime) import Data.Traversable (for) -import qualified System.FilePath as FilePath +import System.FilePath qualified as FilePath import Language.PureScript.Names (ModuleName) diff --git a/src/Language/PureScript/Make/Monad.hs b/src/Language/PureScript/Make/Monad.hs index cea5fa882f..dbb7c0607b 100644 --- a/src/Language/PureScript/Make/Monad.hs +++ b/src/Language/PureScript/Make/Monad.hs @@ -19,34 +19,34 @@ module Language.PureScript.Make.Monad , copyFile ) where -import Prelude - -import Codec.Serialise (Serialise) -import qualified Codec.Serialise as Serialise -import Control.Exception (fromException, tryJust) -import Control.Monad (join, guard) -import Control.Monad.Base (MonadBase(..)) -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.IO.Class -import Control.Monad.Logger -import Control.Monad.Reader (MonadReader(..), ReaderT(..)) -import Control.Monad.Trans.Control (MonadBaseControl(..)) -import Control.Monad.Trans.Except -import Control.Monad.Writer.Class (MonadWriter(..)) -import qualified Data.Aeson as Aeson -import qualified Data.ByteString as B -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Time.Clock (UTCTime) -import Language.PureScript.Errors -import Language.PureScript.Externs (ExternsFile, externsIsCurrentVersion) -import Language.PureScript.Make.Cache (ContentHash, hash) -import Language.PureScript.Options -import System.Directory (createDirectoryIfMissing, getModificationTime) -import qualified System.Directory as Directory -import System.FilePath (takeDirectory) -import System.IO.Error (tryIOError, isDoesNotExistError) -import System.IO.UTF8 (readUTF8FileT) +import Prelude + +import Codec.Serialise (Serialise) +import Codec.Serialise qualified as Serialise +import Control.Exception (fromException, tryJust) +import Control.Monad (join, guard) +import Control.Monad.Base (MonadBase(..)) +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.IO.Class +import Control.Monad.Logger +import Control.Monad.Reader (MonadReader(..), ReaderT(..)) +import Control.Monad.Trans.Control (MonadBaseControl(..)) +import Control.Monad.Trans.Except +import Control.Monad.Writer.Class (MonadWriter(..)) +import Data.Aeson qualified as Aeson +import Data.ByteString qualified as B +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Time.Clock (UTCTime) +import Language.PureScript.Errors +import Language.PureScript.Externs (ExternsFile, externsIsCurrentVersion) +import Language.PureScript.Make.Cache (ContentHash, hash) +import Language.PureScript.Options +import System.Directory (createDirectoryIfMissing, getModificationTime) +import System.Directory qualified as Directory +import System.FilePath (takeDirectory) +import System.IO.Error (tryIOError, isDoesNotExistError) +import System.IO.UTF8 (readUTF8FileT) -- | A monad for running make actions newtype Make a = Make diff --git a/src/Language/PureScript/ModuleDependencies.hs b/src/Language/PureScript/ModuleDependencies.hs index 909f5046f9..ae55e1138f 100644 --- a/src/Language/PureScript/ModuleDependencies.hs +++ b/src/Language/PureScript/ModuleDependencies.hs @@ -7,16 +7,16 @@ module Language.PureScript.ModuleDependencies , moduleSignature ) where -import Protolude hiding (head) +import Protolude hiding (head) -import Data.Array ((!)) -import Data.Graph -import qualified Data.Set as S -import Language.PureScript.AST -import qualified Language.PureScript.Constants.Prim as C -import Language.PureScript.Crash -import Language.PureScript.Errors hiding (nonEmpty) -import Language.PureScript.Names +import Data.Array ((!)) +import Data.Graph +import Data.Set qualified as S +import Language.PureScript.AST +import Language.PureScript.Constants.Prim qualified as C +import Language.PureScript.Crash +import Language.PureScript.Errors hiding (nonEmpty) +import Language.PureScript.Names -- | A list of modules with their transitive dependencies type ModuleGraph = [(ModuleName, [ModuleName])] diff --git a/src/Language/PureScript/Names.hs b/src/Language/PureScript/Names.hs index 16dda5e1bb..4783f4f165 100644 --- a/src/Language/PureScript/Names.hs +++ b/src/Language/PureScript/Names.hs @@ -12,13 +12,13 @@ import Control.Applicative ((<|>)) import Control.Monad.Supply.Class import Control.DeepSeq (NFData) import Data.Functor.Contravariant (contramap) -import qualified Data.Vector as V +import Data.Vector qualified as V import GHC.Generics (Generic) import Data.Aeson import Data.Aeson.TH import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.AST.SourcePos (SourcePos, pattern SourcePos) diff --git a/src/Language/PureScript/Options.hs b/src/Language/PureScript/Options.hs index b0e44bc16d..d94d344cf0 100644 --- a/src/Language/PureScript/Options.hs +++ b/src/Language/PureScript/Options.hs @@ -2,9 +2,9 @@ module Language.PureScript.Options where import Prelude -import qualified Data.Set as S +import Data.Set qualified as S import Data.Map (Map) -import qualified Data.Map as Map +import Data.Map qualified as Map -- | The data type of compiler options data Options = Options diff --git a/src/Language/PureScript/PSString.hs b/src/Language/PureScript/PSString.hs index 44a617e73a..2ceb481181 100644 --- a/src/Language/PureScript/PSString.hs +++ b/src/Language/PureScript/PSString.hs @@ -15,24 +15,24 @@ import Codec.Serialise (Serialise) import Control.DeepSeq (NFData) import Control.Exception (try, evaluate) import Control.Applicative ((<|>)) -import qualified Data.Char as Char +import Data.Char qualified as Char import Data.Bits (shiftR) import Data.Either (fromRight) import Data.List (unfoldr) import Data.Scientific (toBoundedInteger) import Data.String (IsString(..)) import Data.ByteString (ByteString) -import qualified Data.ByteString as BS +import Data.ByteString qualified as BS import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Data.Text.Encoding (decodeUtf16BE) import Data.Text.Encoding.Error (UnicodeException) -import qualified Data.Vector as V +import Data.Vector qualified as V import Data.Word (Word16, Word8) import Numeric (showHex) import System.IO.Unsafe (unsafePerformIO) -import qualified Data.Aeson as A -import qualified Data.Aeson.Types as A +import Data.Aeson qualified as A +import Data.Aeson.Types qualified as A -- | -- Strings in PureScript are sequences of UTF-16 code units, which do not diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs index 04125f96e3..2f32e7bcbc 100644 --- a/src/Language/PureScript/Pretty/Common.hs +++ b/src/Language/PureScript/Pretty/Common.hs @@ -9,13 +9,13 @@ import Control.Monad.State (StateT, modify, get) import Data.List (elemIndices, intersperse) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.AST (SourcePos(..), SourceSpan(..), nullSourceSpan) import Language.PureScript.CST.Lexer (isUnquotedKey) import Text.PrettyPrint.Boxes hiding ((<>)) -import qualified Text.PrettyPrint.Boxes as Box +import Text.PrettyPrint.Boxes qualified as Box parensT :: Text -> Text parensT s = "(" <> s <> ")" diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs index d7c90374c3..e26f3cb131 100644 --- a/src/Language/PureScript/Pretty/Types.hs +++ b/src/Language/PureScript/Pretty/Types.hs @@ -27,7 +27,7 @@ import Control.PatternArrows as PA import Data.Bifunctor (first) import Data.Maybe (fromMaybe, catMaybes) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Language.PureScript.Crash import Language.PureScript.Environment diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs index 24638f6932..d0b0f823f2 100644 --- a/src/Language/PureScript/Pretty/Values.hs +++ b/src/Language/PureScript/Pretty/Values.hs @@ -12,9 +12,9 @@ import Prelude hiding ((<>)) import Control.Arrow (second) import Data.Text (Text) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Monoid as Monoid ((<>)) -import qualified Data.Text as T +import Data.List.NonEmpty qualified as NEL +import Data.Monoid qualified as Monoid ((<>)) +import Data.Text qualified as T import Language.PureScript.AST import Language.PureScript.Crash diff --git a/src/Language/PureScript/Publish.hs b/src/Language/PureScript/Publish.hs index cc4f94cae1..58b502cb84 100644 --- a/src/Language/PureScript/Publish.hs +++ b/src/Language/PureScript/Publish.hs @@ -23,29 +23,29 @@ import Control.Arrow ((***)) import Control.Category ((>>>)) import Control.Monad.Writer.Strict (MonadWriter, WriterT, runWriterT, tell) -import qualified Data.ByteString.Lazy as BL +import Data.ByteString.Lazy qualified as BL import Data.String (String, lines) import Data.List (stripPrefix, (\\)) -import qualified Data.Text as T +import Data.Text qualified as T import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Version -import qualified Distribution.SPDX as SPDX -import qualified Distribution.Parsec as CabalParsec +import Distribution.SPDX qualified as SPDX +import Distribution.Parsec qualified as CabalParsec import System.Directory (doesFileExist) import System.FilePath.Glob (globDir1) import System.Process (readProcess) import Web.Bower.PackageMeta (PackageMeta(..), PackageName, Repository(..)) -import qualified Web.Bower.PackageMeta as Bower +import Web.Bower.PackageMeta qualified as Bower import Language.PureScript.Publish.ErrorsWarnings import Language.PureScript.Publish.Registry.Compat import Language.PureScript.Publish.Utils -import qualified Language.PureScript as P (version, ModuleName) -import qualified Language.PureScript.CoreFn.FromJSON as P -import qualified Language.PureScript.Docs as D +import Language.PureScript qualified as P (version, ModuleName) +import Language.PureScript.CoreFn.FromJSON qualified as P +import Language.PureScript.Docs qualified as D import Data.Aeson.BetterErrors (Parse, withString, eachInObjectWithKey, asString, key, keyMay, parse, mapError) import Language.PureScript.Docs.Types (ManifestError(BowerManifest, PursManifest)) diff --git a/src/Language/PureScript/Publish/BoxesHelpers.hs b/src/Language/PureScript/Publish/BoxesHelpers.hs index b37e794ab6..36d9a180b9 100644 --- a/src/Language/PureScript/Publish/BoxesHelpers.hs +++ b/src/Language/PureScript/Publish/BoxesHelpers.hs @@ -7,10 +7,10 @@ module Language.PureScript.Publish.BoxesHelpers import Prelude import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import System.IO (hPutStr, stderr) -import qualified Text.PrettyPrint.Boxes as Boxes +import Text.PrettyPrint.Boxes qualified as Boxes width :: Int width = 79 diff --git a/src/Language/PureScript/Publish/ErrorsWarnings.hs b/src/Language/PureScript/Publish/ErrorsWarnings.hs index b4f48949e1..ef08193b34 100644 --- a/src/Language/PureScript/Publish/ErrorsWarnings.hs +++ b/src/Language/PureScript/Publish/ErrorsWarnings.hs @@ -22,16 +22,16 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe import Data.Monoid import Data.Version -import qualified Data.List.NonEmpty as NonEmpty +import Data.List.NonEmpty qualified as NonEmpty import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T -import qualified Language.PureScript.Docs.Types as D -import qualified Language.PureScript as P +import Language.PureScript.Docs.Types qualified as D +import Language.PureScript qualified as P import Language.PureScript.Publish.BoxesHelpers import Web.Bower.PackageMeta (PackageName, runPackageName, showBowerError) -import qualified Web.Bower.PackageMeta as Bower +import Web.Bower.PackageMeta qualified as Bower import Language.PureScript.Docs.Types (showManifestError) -- | An error which meant that it was not possible to retrieve metadata for a diff --git a/src/Language/PureScript/Publish/Registry/Compat.hs b/src/Language/PureScript/Publish/Registry/Compat.hs index d9bf5038ae..a1a01ed9a4 100644 --- a/src/Language/PureScript/Publish/Registry/Compat.hs +++ b/src/Language/PureScript/Publish/Registry/Compat.hs @@ -8,8 +8,8 @@ module Language.PureScript.Publish.Registry.Compat where import Protolude -import qualified Data.Map as Map -import qualified Web.Bower.PackageMeta as Bower +import Data.Map qualified as Map +import Web.Bower.PackageMeta qualified as Bower import Data.Bitraversable (Bitraversable(..)) import Data.Aeson.BetterErrors (key, asText, keyMay, eachInObject, Parse, throwCustomError) diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs index a822b2081c..369ba80486 100644 --- a/src/Language/PureScript/Renamer.hs +++ b/src/Language/PureScript/Renamer.hs @@ -10,9 +10,9 @@ import Control.Monad.State import Data.Functor ((<&>)) import Data.List (find) import Data.Maybe (fromJust, fromMaybe) -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Text as T +import Data.Map qualified as M +import Data.Set qualified as S +import Data.Text qualified as T import Language.PureScript.CoreFn import Language.PureScript.Names diff --git a/src/Language/PureScript/Roles.hs b/src/Language/PureScript/Roles.hs index 498a899d48..7a73062993 100644 --- a/src/Language/PureScript/Roles.hs +++ b/src/Language/PureScript/Roles.hs @@ -12,8 +12,8 @@ import Prelude import Codec.Serialise (Serialise) import Control.DeepSeq (NFData) -import qualified Data.Aeson as A -import qualified Data.Aeson.TH as A +import Data.Aeson qualified as A +import Data.Aeson.TH qualified as A import Data.Text (Text) import GHC.Generics (Generic) diff --git a/src/Language/PureScript/Sugar/AdoNotation.hs b/src/Language/PureScript/Sugar/AdoNotation.hs index 4e138f2c98..047d413edb 100644 --- a/src/Language/PureScript/Sugar/AdoNotation.hs +++ b/src/Language/PureScript/Sugar/AdoNotation.hs @@ -3,16 +3,16 @@ module Language.PureScript.Sugar.AdoNotation (desugarAdoModule) where -import Prelude hiding (abs) +import Prelude hiding (abs) -import Control.Monad (foldM) -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Supply.Class -import Data.List (foldl') -import Language.PureScript.AST -import Language.PureScript.Errors -import Language.PureScript.Names -import qualified Language.PureScript.Constants.Libs as C +import Control.Monad (foldM) +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.Supply.Class +import Data.List (foldl') +import Language.PureScript.AST +import Language.PureScript.Errors +import Language.PureScript.Names +import Language.PureScript.Constants.Libs qualified as C -- | Replace all @AdoNotationBind@ and @AdoNotationValue@ constructors with -- applications of the pure and apply functions in scope, and all @AdoNotationLet@ diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs index b3e87e779e..61de1090ca 100644 --- a/src/Language/PureScript/Sugar/BindingGroups.hs +++ b/src/Language/PureScript/Sugar/BindingGroups.hs @@ -20,9 +20,9 @@ import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty) import Data.Foldable (find) import Data.Functor (($>)) import Data.Maybe (isJust, mapMaybe) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Map as M -import qualified Data.Set as S +import Data.List.NonEmpty qualified as NEL +import Data.Map qualified as M +import Data.Set qualified as S import Language.PureScript.AST import Language.PureScript.Crash diff --git a/src/Language/PureScript/Sugar/DoNotation.hs b/src/Language/PureScript/Sugar/DoNotation.hs index 008af901da..f6b9a819ec 100644 --- a/src/Language/PureScript/Sugar/DoNotation.hs +++ b/src/Language/PureScript/Sugar/DoNotation.hs @@ -3,18 +3,18 @@ module Language.PureScript.Sugar.DoNotation (desugarDoModule) where -import Prelude +import Prelude -import Control.Applicative ((<|>)) -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Supply.Class -import Data.Maybe (fromMaybe) -import Data.Monoid (First(..)) -import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Errors -import Language.PureScript.Names -import qualified Language.PureScript.Constants.Libs as C +import Control.Applicative ((<|>)) +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.Supply.Class +import Data.Maybe (fromMaybe) +import Data.Monoid (First(..)) +import Language.PureScript.AST +import Language.PureScript.Crash +import Language.PureScript.Errors +import Language.PureScript.Names +import Language.PureScript.Constants.Libs qualified as C -- | Replace all @DoNotationBind@ and @DoNotationValue@ constructors with -- applications of the bind function in scope, and all @DoNotationLet@ diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs index 7c09126af8..2fc947c738 100644 --- a/src/Language/PureScript/Sugar/Names.hs +++ b/src/Language/PureScript/Sugar/Names.hs @@ -18,10 +18,10 @@ import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Lazy import Control.Monad.Writer (MonadWriter(..)) -import qualified Data.List.NonEmpty as NEL +import Data.List.NonEmpty qualified as NEL import Data.Maybe (fromMaybe, mapMaybe) -import qualified Data.Map as M -import qualified Data.Set as S +import Data.Map qualified as M +import Data.Set qualified as S import Language.PureScript.AST import Language.PureScript.Crash diff --git a/src/Language/PureScript/Sugar/Names/Env.hs b/src/Language/PureScript/Sugar/Names/Env.hs index 5b3616fdad..a83c555144 100644 --- a/src/Language/PureScript/Sugar/Names/Env.hs +++ b/src/Language/PureScript/Sugar/Names/Env.hs @@ -29,10 +29,10 @@ import Data.Foldable (find) import Data.List (groupBy, sortOn, delete) import Data.Maybe (mapMaybe) import Safe (headMay) -import qualified Data.Map as M -import qualified Data.Set as S +import Data.Map qualified as M +import Data.Set qualified as S -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Prim qualified as C import Language.PureScript.AST import Language.PureScript.Crash import Language.PureScript.Environment diff --git a/src/Language/PureScript/Sugar/Names/Exports.hs b/src/Language/PureScript/Sugar/Names/Exports.hs index c87e17d3eb..70f0402fcb 100644 --- a/src/Language/PureScript/Sugar/Names/Exports.hs +++ b/src/Language/PureScript/Sugar/Names/Exports.hs @@ -13,7 +13,7 @@ import Data.Function (on) import Data.Foldable (traverse_) import Data.List (intersect, groupBy, sortOn) import Data.Maybe (fromMaybe, mapMaybe) -import qualified Data.Map as M +import Data.Map qualified as M import Language.PureScript.AST import Language.PureScript.Crash diff --git a/src/Language/PureScript/Sugar/Names/Imports.hs b/src/Language/PureScript/Sugar/Names/Imports.hs index 846b03e19b..91577f83af 100644 --- a/src/Language/PureScript/Sugar/Names/Imports.hs +++ b/src/Language/PureScript/Sugar/Names/Imports.hs @@ -12,8 +12,8 @@ import Control.Monad.Error.Class (MonadError(..)) import Data.Foldable (for_, traverse_) import Data.Maybe (fromMaybe) -import qualified Data.Map as M -import qualified Data.Set as S +import Data.Map qualified as M +import Data.Set qualified as S import Language.PureScript.AST import Language.PureScript.Crash diff --git a/src/Language/PureScript/Sugar/ObjectWildcards.hs b/src/Language/PureScript/Sugar/ObjectWildcards.hs index 51bbb48016..01e46e74b9 100644 --- a/src/Language/PureScript/Sugar/ObjectWildcards.hs +++ b/src/Language/PureScript/Sugar/ObjectWildcards.hs @@ -3,19 +3,19 @@ module Language.PureScript.Sugar.ObjectWildcards , desugarDecl ) where -import Prelude +import Prelude -import Control.Monad (forM) -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Supply.Class -import Data.Foldable (toList) -import Data.List (foldl') -import Data.Maybe (catMaybes) -import Language.PureScript.AST -import Language.PureScript.Environment (NameKind(..)) -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.PSString (PSString) +import Control.Monad (forM) +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.Supply.Class +import Data.Foldable (toList) +import Data.List (foldl') +import Data.Maybe (catMaybes) +import Language.PureScript.AST +import Language.PureScript.Environment (NameKind(..)) +import Language.PureScript.Errors +import Language.PureScript.Names +import Language.PureScript.PSString (PSString) desugarObjectConstructors diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs index 1009ce3fbd..6b807d344b 100644 --- a/src/Language/PureScript/Sugar/Operators.hs +++ b/src/Language/PureScript/Sugar/Operators.hs @@ -37,10 +37,10 @@ import Data.Functor (($>)) import Data.Functor.Identity (Identity(..), runIdentity) import Data.List (groupBy, sortOn) import Data.Maybe (mapMaybe, listToMaybe) -import qualified Data.Map as M +import Data.Map qualified as M import Data.Ord (Down(..)) -import qualified Language.PureScript.Constants.Libs as C +import Language.PureScript.Constants.Libs qualified as C -- | -- Removes unary negation operators and replaces them with calls to `negate`. diff --git a/src/Language/PureScript/Sugar/Operators/Common.hs b/src/Language/PureScript/Sugar/Operators/Common.hs index 0d7fdaaa8f..fe65bb342b 100644 --- a/src/Language/PureScript/Sugar/Operators/Common.hs +++ b/src/Language/PureScript/Sugar/Operators/Common.hs @@ -9,12 +9,12 @@ import Data.Either (rights) import Data.Functor.Identity import Data.List (sortOn) import Data.Maybe (mapMaybe, fromJust) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Map as M +import Data.List.NonEmpty qualified as NEL +import Data.Map qualified as M -import qualified Text.Parsec as P -import qualified Text.Parsec.Pos as P -import qualified Text.Parsec.Expr as P +import Text.Parsec qualified as P +import Text.Parsec.Pos qualified as P +import Text.Parsec.Expr qualified as P import Language.PureScript.AST import Language.PureScript.Crash diff --git a/src/Language/PureScript/Sugar/Operators/Expr.hs b/src/Language/PureScript/Sugar/Operators/Expr.hs index a53390b99e..efb3842bfd 100644 --- a/src/Language/PureScript/Sugar/Operators/Expr.hs +++ b/src/Language/PureScript/Sugar/Operators/Expr.hs @@ -5,8 +5,8 @@ import Prelude import Control.Monad.Except import Data.Functor.Identity -import qualified Text.Parsec as P -import qualified Text.Parsec.Expr as P +import Text.Parsec qualified as P +import Text.Parsec.Expr qualified as P import Language.PureScript.AST import Language.PureScript.Names diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs index 28c633dfe5..9a279ba375 100644 --- a/src/Language/PureScript/Sugar/TypeClasses.hs +++ b/src/Language/PureScript/Sugar/TypeClasses.hs @@ -10,30 +10,30 @@ module Language.PureScript.Sugar.TypeClasses import Prelude -import Control.Arrow (first, second) -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State -import Control.Monad.Supply.Class -import Data.Graph -import Data.List (find, partition) -import Data.List.NonEmpty (nonEmpty) -import qualified Data.Map as M -import Data.Maybe (catMaybes, mapMaybe, isJust) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Set as S -import Data.Text (Text) -import Data.Traversable (for) -import qualified Language.PureScript.Constants.Prim as C -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors hiding (isExported, nonEmpty) -import Language.PureScript.Externs -import Language.PureScript.Label (Label(..)) -import Language.PureScript.Names -import Language.PureScript.PSString (mkString) -import Language.PureScript.Sugar.CaseDeclarations -import Language.PureScript.TypeClassDictionaries (superclassName) -import Language.PureScript.Types +import Control.Arrow (first, second) +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.State +import Control.Monad.Supply.Class +import Data.Graph +import Data.List (find, partition) +import Data.List.NonEmpty (nonEmpty) +import Data.Map qualified as M +import Data.Maybe (catMaybes, mapMaybe, isJust) +import Data.List.NonEmpty qualified as NEL +import Data.Set qualified as S +import Data.Text (Text) +import Data.Traversable (for) +import Language.PureScript.Constants.Prim qualified as C +import Language.PureScript.Crash +import Language.PureScript.Environment +import Language.PureScript.Errors hiding (isExported, nonEmpty) +import Language.PureScript.Externs +import Language.PureScript.Label (Label(..)) +import Language.PureScript.Names +import Language.PureScript.PSString (mkString) +import Language.PureScript.Sugar.CaseDeclarations +import Language.PureScript.TypeClassDictionaries (superclassName) +import Language.PureScript.Types type MemberMap = M.Map (ModuleName, ProperName 'ClassName) TypeClassData diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs index 2389831c1e..622d872874 100755 --- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs @@ -1,22 +1,22 @@ -- | This module implements the generic deriving elaboration that takes place during desugaring. module Language.PureScript.Sugar.TypeClasses.Deriving (deriveInstances) where -import Prelude -import Protolude (note) - -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Supply.Class (MonadSupply) -import Data.List (foldl', find, unzip5) -import Language.PureScript.AST -import Language.PureScript.AST.Utils -import qualified Language.PureScript.Constants.Libs as Libs -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.PSString (mkString) -import Language.PureScript.Types -import Language.PureScript.TypeChecker (checkNewtype) +import Prelude +import Protolude (note) + +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.Supply.Class (MonadSupply) +import Data.List (foldl', find, unzip5) +import Language.PureScript.AST +import Language.PureScript.AST.Utils +import Language.PureScript.Constants.Libs qualified as Libs +import Language.PureScript.Crash +import Language.PureScript.Environment +import Language.PureScript.Errors +import Language.PureScript.Names +import Language.PureScript.PSString (mkString) +import Language.PureScript.Types +import Language.PureScript.TypeChecker (checkNewtype) -- | Elaborates deriving instance declarations by code generation. deriveInstances diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index e08be7b998..dec85ada99 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -22,14 +22,14 @@ import Data.List (nub, nubBy, (\\), sort, group) import Data.Maybe import Data.Either (partitionEithers) import Data.Text (Text) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Text as T +import Data.List.NonEmpty qualified as NEL +import Data.Map qualified as M +import Data.Set qualified as S +import Data.Text qualified as T import Language.PureScript.AST import Language.PureScript.AST.Declarations.ChainId (ChainId) -import qualified Language.PureScript.Constants.Libs as Libs +import Language.PureScript.Constants.Libs qualified as Libs import Language.PureScript.Crash import Language.PureScript.Environment import Language.PureScript.Errors diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index 8261802178..3381cd649f 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -12,14 +12,14 @@ import Control.Monad.Writer.Class (MonadWriter(..)) import Data.Align (align, unalign) import Data.Foldable (foldl1, foldr1) import Data.List (init, last, zipWith3, (!!)) -import qualified Data.Map as M +import Data.Map qualified as M import Data.These (These(..), mergeTheseWith, these) import Control.Monad.Supply.Class import Language.PureScript.AST import Language.PureScript.AST.Utils -import qualified Language.PureScript.Constants.Libs as Libs -import qualified Language.PureScript.Constants.Prim as Prim +import Language.PureScript.Constants.Libs qualified as Libs +import Language.PureScript.Constants.Prim qualified as Prim import Language.PureScript.Crash import Language.PureScript.Environment import Language.PureScript.Errors hiding (nonEmpty) diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index 393f637b6a..bf775042c7 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -25,13 +25,13 @@ import Data.Function (on) import Data.Functor (($>)) import Data.List (delete, findIndices, minimumBy, nubBy, sortOn, tails) import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe) -import qualified Data.Map as M -import qualified Data.Set as S +import Data.Map qualified as M +import Data.Set qualified as S import Data.Traversable (for) import Data.Text (Text, stripPrefix, stripSuffix) -import qualified Data.Text as T +import Data.Text qualified as T import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.List.NonEmpty as NEL +import Data.List.NonEmpty qualified as NEL import Language.PureScript.AST import Language.PureScript.Crash @@ -48,8 +48,8 @@ import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types import Language.PureScript.Label (Label(..)) import Language.PureScript.PSString (PSString, mkString, decodeString) -import qualified Language.PureScript.Constants.Libs as C -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Libs qualified as C +import Language.PureScript.Constants.Prim qualified as C -- | Describes what sort of dictionary to generate for type class instances data Evidence diff --git a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs index 301e4b6e8d..648a3aa696 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs @@ -32,8 +32,8 @@ import Data.Maybe (fromMaybe, isJust) import Data.Monoid (Any(..)) import Data.Text (Text) -import qualified Data.Map as M -import qualified Data.Set as S +import Data.Map qualified as M +import Data.Set qualified as S import Language.PureScript.Crash import Language.PureScript.Environment @@ -46,7 +46,7 @@ import Language.PureScript.TypeChecker.Synonyms import Language.PureScript.TypeChecker.Unify import Language.PureScript.Roles import Language.PureScript.Types -import qualified Language.PureScript.Constants.Prim as Prim +import Language.PureScript.Constants.Prim qualified as Prim -- | State of the given constraints solver. data GivenSolverState = diff --git a/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs b/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs index fb21d989b4..802e9d611e 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs @@ -6,12 +6,12 @@ module Language.PureScript.TypeChecker.Entailment.IntCompare where import Protolude -import qualified Data.Graph as G -import qualified Data.Map as M +import Data.Graph qualified as G +import Data.Map qualified as M -import qualified Language.PureScript.Names as P -import qualified Language.PureScript.Types as P -import qualified Language.PureScript.Constants.Prim as P +import Language.PureScript.Names qualified as P +import Language.PureScript.Types qualified as P +import Language.PureScript.Constants.Prim qualified as P data Relation a = Equal a a diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs index 56dc95aa06..fe1a582b4d 100644 --- a/src/Language/PureScript/TypeChecker/Kinds.hs +++ b/src/Language/PureScript/TypeChecker/Kinds.hs @@ -39,16 +39,16 @@ import Data.Bitraversable (bitraverse) import Data.Foldable (for_, traverse_) import Data.Function (on) import Data.Functor (($>)) -import qualified Data.IntSet as IS +import Data.IntSet qualified as IS import Data.List (nubBy, sortOn, (\\)) -import qualified Data.Map as M +import Data.Map qualified as M import Data.Maybe (fromJust, fromMaybe) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Data.Traversable (for) import Language.PureScript.Crash -import qualified Language.PureScript.Environment as E +import Language.PureScript.Environment qualified as E import Language.PureScript.Errors import Language.PureScript.Names import Language.PureScript.TypeChecker.Monad diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs index 7db6cbeb5e..fb02264de5 100644 --- a/src/Language/PureScript/TypeChecker/Monad.hs +++ b/src/Language/PureScript/TypeChecker/Monad.hs @@ -13,10 +13,10 @@ import Control.Monad.State import Control.Monad.Writer.Class (MonadWriter(..), censor) import Data.Maybe -import qualified Data.Map as M -import qualified Data.Set as S +import Data.Map qualified as M +import Data.Set qualified as S import Data.Text (Text, isPrefixOf, unpack) -import qualified Data.List.NonEmpty as NEL +import Data.List.NonEmpty qualified as NEL import Language.PureScript.Crash (internalError) import Language.PureScript.Environment diff --git a/src/Language/PureScript/TypeChecker/Roles.hs b/src/Language/PureScript/TypeChecker/Roles.hs index effb5c265a..885d3f8c11 100644 --- a/src/Language/PureScript/TypeChecker/Roles.hs +++ b/src/Language/PureScript/TypeChecker/Roles.hs @@ -18,9 +18,9 @@ import Control.Monad (unless, when, zipWithM_) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State (MonadState(..), runState, state) import Data.Coerce (coerce) -import qualified Data.Map as M +import Data.Map qualified as M import Data.Maybe (fromMaybe) -import qualified Data.Set as S +import Data.Set qualified as S import Data.Semigroup (Any(..)) import Data.Text (Text) diff --git a/src/Language/PureScript/TypeChecker/Synonyms.hs b/src/Language/PureScript/TypeChecker/Synonyms.hs index 80e1407f31..90e6da28f6 100644 --- a/src/Language/PureScript/TypeChecker/Synonyms.hs +++ b/src/Language/PureScript/TypeChecker/Synonyms.hs @@ -10,18 +10,18 @@ module Language.PureScript.TypeChecker.Synonyms , replaceAllTypeSynonymsM ) where -import Prelude +import Prelude -import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State -import Data.Maybe (fromMaybe) -import qualified Data.Map as M -import Data.Text (Text) -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.TypeChecker.Monad -import Language.PureScript.Types +import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.State +import Data.Maybe (fromMaybe) +import Data.Map qualified as M +import Data.Text (Text) +import Language.PureScript.Environment +import Language.PureScript.Errors +import Language.PureScript.Names +import Language.PureScript.TypeChecker.Monad +import Language.PureScript.Types -- | Type synonym information (arguments with kinds, aliased type), indexed by name type SynonymMap = M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceType)], SourceType) diff --git a/src/Language/PureScript/TypeChecker/TypeSearch.hs b/src/Language/PureScript/TypeChecker/TypeSearch.hs index 6a8afa685c..5b40636ece 100644 --- a/src/Language/PureScript/TypeChecker/TypeSearch.hs +++ b/src/Language/PureScript/TypeChecker/TypeSearch.hs @@ -2,26 +2,26 @@ module Language.PureScript.TypeChecker.TypeSearch ( typeSearch ) where -import Protolude - -import Control.Monad.Writer (WriterT, runWriterT) -import qualified Data.Map as Map -import qualified Language.PureScript.TypeChecker.Entailment as Entailment - -import qualified Language.PureScript.TypeChecker.Monad as TC -import Language.PureScript.TypeChecker.Subsumption -import Language.PureScript.TypeChecker.Unify as P - -import Control.Monad.Supply as P -import Language.PureScript.AST as P -import Language.PureScript.Environment as P -import Language.PureScript.Errors as P -import Language.PureScript.Label -import Language.PureScript.Names as P -import Language.PureScript.Pretty.Types as P -import Language.PureScript.TypeChecker.Skolems as Skolem -import Language.PureScript.TypeChecker.Synonyms as P -import Language.PureScript.Types as P +import Protolude + +import Control.Monad.Writer (WriterT, runWriterT) +import Data.Map qualified as Map +import Language.PureScript.TypeChecker.Entailment qualified as Entailment + +import Language.PureScript.TypeChecker.Monad qualified as TC +import Language.PureScript.TypeChecker.Subsumption +import Language.PureScript.TypeChecker.Unify as P + +import Control.Monad.Supply as P +import Language.PureScript.AST as P +import Language.PureScript.Environment as P +import Language.PureScript.Errors as P +import Language.PureScript.Label +import Language.PureScript.Names as P +import Language.PureScript.Pretty.Types as P +import Language.PureScript.TypeChecker.Skolems as Skolem +import Language.PureScript.TypeChecker.Synonyms as P +import Language.PureScript.Types as P checkInEnvironment :: Environment diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs index 9e9bc44443..7947a4d2f2 100644 --- a/src/Language/PureScript/TypeChecker/Types.hs +++ b/src/Language/PureScript/TypeChecker/Types.hs @@ -40,10 +40,10 @@ import Data.List (transpose, (\\), partition, delete) import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Traversable (for) -import qualified Data.List.NonEmpty as NEL -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.IntSet as IS +import Data.List.NonEmpty qualified as NEL +import Data.Map qualified as M +import Data.Set qualified as S +import Data.IntSet qualified as IS import Language.PureScript.AST import Language.PureScript.Crash diff --git a/src/Language/PureScript/TypeChecker/Unify.hs b/src/Language/PureScript/TypeChecker/Unify.hs index 1d59876d88..98af9804da 100644 --- a/src/Language/PureScript/TypeChecker/Unify.hs +++ b/src/Language/PureScript/TypeChecker/Unify.hs @@ -23,11 +23,11 @@ import Control.Monad.Writer.Class (MonadWriter(..)) import Data.Foldable (traverse_) import Data.Maybe (fromMaybe) -import qualified Data.Map as M -import qualified Data.Text as T +import Data.Map qualified as M +import Data.Text qualified as T import Language.PureScript.Crash -import qualified Language.PureScript.Environment as E +import Language.PureScript.Environment qualified as E import Language.PureScript.Errors import Language.PureScript.TypeChecker.Kinds (elaborateKind, instantiateKind, unifyKinds') import Language.PureScript.TypeChecker.Monad diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs index b9f2463aab..2f11ea4062 100644 --- a/src/Language/PureScript/Types.hs +++ b/src/Language/PureScript/Types.hs @@ -13,18 +13,18 @@ import Control.DeepSeq (NFData) import Control.Lens (Lens', (^.), set) import Control.Monad ((<=<), (>=>)) import Data.Aeson ((.:), (.:?), (.!=), (.=)) -import qualified Data.Aeson as A -import qualified Data.Aeson.Types as A +import Data.Aeson qualified as A +import Data.Aeson.Types qualified as A import Data.Foldable (fold, foldl') -import qualified Data.IntSet as IS +import Data.IntSet qualified as IS import Data.List (sortOn) import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import GHC.Generics (Generic) import Language.PureScript.AST.SourcePos -import qualified Language.PureScript.Constants.Prim as C +import Language.PureScript.Constants.Prim qualified as C import Language.PureScript.Names import Language.PureScript.Label (Label) import Language.PureScript.PSString (PSString) diff --git a/src/System/IO/UTF8.hs b/src/System/IO/UTF8.hs index d999b0969b..9ac916cf93 100644 --- a/src/System/IO/UTF8.hs +++ b/src/System/IO/UTF8.hs @@ -2,13 +2,13 @@ module System.IO.UTF8 where import Prelude -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BSL -import qualified Data.ByteString.Search as BSS -import qualified Data.ByteString.UTF8 as UTF8 -import Data.Text (Text) -import qualified Data.Text.Encoding as TE -import Protolude (ordNub) +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as BSL +import Data.ByteString.Search qualified as BSS +import Data.ByteString.UTF8 qualified as UTF8 +import Data.Text (Text) +import Data.Text.Encoding qualified as TE +import Protolude (ordNub) -- | Unfortunately ByteString's readFile does not convert line endings on -- Windows, so we have to do it ourselves diff --git a/tests/Language/PureScript/Ide/CompletionSpec.hs b/tests/Language/PureScript/Ide/CompletionSpec.hs index d8704ed78a..3b838badb7 100644 --- a/tests/Language/PureScript/Ide/CompletionSpec.hs +++ b/tests/Language/PureScript/Ide/CompletionSpec.hs @@ -2,11 +2,11 @@ module Language.PureScript.Ide.CompletionSpec where import Protolude -import qualified Language.PureScript as P +import Language.PureScript qualified as P import Language.PureScript.Ide.Test as Test import Language.PureScript.Ide.Command as Command import Language.PureScript.Ide.Completion -import qualified Language.PureScript.Ide.Filter.Declaration as DeclarationType +import Language.PureScript.Ide.Filter.Declaration qualified as DeclarationType import Language.PureScript.Ide.Types import Test.Hspec diff --git a/tests/Language/PureScript/Ide/FilterSpec.hs b/tests/Language/PureScript/Ide/FilterSpec.hs index 2e4eb1f698..2ead8749d8 100644 --- a/tests/Language/PureScript/Ide/FilterSpec.hs +++ b/tests/Language/PureScript/Ide/FilterSpec.hs @@ -1,15 +1,15 @@ module Language.PureScript.Ide.FilterSpec where -import Protolude -import qualified Data.Map as Map -import qualified Data.Set as Set -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Filter.Declaration as D -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Imports -import Language.PureScript.Ide.Test as T -import qualified Language.PureScript as P -import Test.Hspec +import Protolude +import Data.Map qualified as Map +import Data.Set qualified as Set +import Language.PureScript.Ide.Filter +import Language.PureScript.Ide.Filter.Declaration as D +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Imports +import Language.PureScript.Ide.Test as T +import Language.PureScript qualified as P +import Test.Hspec type Module = (P.ModuleName, [IdeDeclarationAnn]) diff --git a/tests/Language/PureScript/Ide/ImportsSpec.hs b/tests/Language/PureScript/Ide/ImportsSpec.hs index 91c51c7045..a060ca3edf 100644 --- a/tests/Language/PureScript/Ide/ImportsSpec.hs +++ b/tests/Language/PureScript/Ide/ImportsSpec.hs @@ -1,19 +1,19 @@ module Language.PureScript.Ide.ImportsSpec where -import Protolude hiding (moduleName) -import Data.Maybe (fromJust) -import qualified Data.Set as Set +import Protolude hiding (moduleName) +import Data.Maybe (fromJust) +import Data.Set qualified as Set -import qualified Language.PureScript as P -import Language.PureScript.Ide.Command as Command -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Imports -import Language.PureScript.Ide.Imports.Actions -import Language.PureScript.Ide.Filter (moduleFilter) -import qualified Language.PureScript.Ide.Test as Test -import Language.PureScript.Ide.Types -import System.FilePath -import Test.Hspec +import Language.PureScript qualified as P +import Language.PureScript.Ide.Command as Command +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.Imports +import Language.PureScript.Ide.Imports.Actions +import Language.PureScript.Ide.Filter (moduleFilter) +import Language.PureScript.Ide.Test qualified as Test +import Language.PureScript.Ide.Types +import System.FilePath +import Test.Hspec noImportsFile :: [Text] noImportsFile = diff --git a/tests/Language/PureScript/Ide/MatcherSpec.hs b/tests/Language/PureScript/Ide/MatcherSpec.hs index f792c4ce94..90b1a8dd4d 100644 --- a/tests/Language/PureScript/Ide/MatcherSpec.hs +++ b/tests/Language/PureScript/Ide/MatcherSpec.hs @@ -1,12 +1,12 @@ module Language.PureScript.Ide.MatcherSpec where -import Protolude +import Protolude -import qualified Language.PureScript as P -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util -import Test.Hspec +import Language.PureScript qualified as P +import Language.PureScript.Ide.Matcher +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Util +import Test.Hspec value :: Text -> IdeDeclarationAnn value s = withEmptyAnn (IdeDeclValue (IdeValue (P.Ident (toS s)) P.srcREmpty)) diff --git a/tests/Language/PureScript/Ide/RebuildSpec.hs b/tests/Language/PureScript/Ide/RebuildSpec.hs index 6f32c3e112..24364f2310 100644 --- a/tests/Language/PureScript/Ide/RebuildSpec.hs +++ b/tests/Language/PureScript/Ide/RebuildSpec.hs @@ -1,18 +1,18 @@ module Language.PureScript.Ide.RebuildSpec where -import Protolude +import Protolude -import qualified Data.Set as Set -import qualified Language.PureScript as P -import Language.PureScript.AST.SourcePos (spanName) -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Types -import qualified Language.PureScript.Ide.Test as Test -import System.FilePath -import System.Directory (doesFileExist, removePathForcibly) -import Test.Hspec +import Data.Set qualified as Set +import Language.PureScript qualified as P +import Language.PureScript.AST.SourcePos (spanName) +import Language.PureScript.Ide.Command +import Language.PureScript.Ide.Completion +import Language.PureScript.Ide.Matcher +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Test qualified as Test +import System.FilePath +import System.Directory (doesFileExist, removePathForcibly) +import Test.Hspec defaultTarget :: Set P.CodegenTarget defaultTarget = Set.singleton P.JS diff --git a/tests/Language/PureScript/Ide/ReexportsSpec.hs b/tests/Language/PureScript/Ide/ReexportsSpec.hs index cbc2e6e88d..fced678692 100644 --- a/tests/Language/PureScript/Ide/ReexportsSpec.hs +++ b/tests/Language/PureScript/Ide/ReexportsSpec.hs @@ -1,13 +1,13 @@ module Language.PureScript.Ide.ReexportsSpec where -import Protolude - -import qualified Data.Map as Map -import Language.PureScript.Ide.Reexports -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Test -import qualified Language.PureScript as P -import Test.Hspec +import Protolude + +import Data.Map qualified as Map +import Language.PureScript.Ide.Reexports +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Test +import Language.PureScript qualified as P +import Test.Hspec valueA, typeA, synonymA, classA, dtorA1, dtorA2, kindA :: IdeDeclarationAnn valueA = ideValue "valueA" Nothing diff --git a/tests/Language/PureScript/Ide/SourceFileSpec.hs b/tests/Language/PureScript/Ide/SourceFileSpec.hs index a196f50484..12c8e8d234 100644 --- a/tests/Language/PureScript/Ide/SourceFileSpec.hs +++ b/tests/Language/PureScript/Ide/SourceFileSpec.hs @@ -1,13 +1,13 @@ module Language.PureScript.Ide.SourceFileSpec where -import Protolude +import Protolude -import qualified Language.PureScript as P -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.SourceFile -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Test -import Test.Hspec +import Language.PureScript qualified as P +import Language.PureScript.Ide.Command +import Language.PureScript.Ide.SourceFile +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Test +import Test.Hspec span1, span2 :: P.SourceSpan span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2) diff --git a/tests/Language/PureScript/Ide/StateSpec.hs b/tests/Language/PureScript/Ide/StateSpec.hs index 9ba778650b..2c28dc22d3 100644 --- a/tests/Language/PureScript/Ide/StateSpec.hs +++ b/tests/Language/PureScript/Ide/StateSpec.hs @@ -1,13 +1,13 @@ 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 Test.Hspec -import qualified Data.Map as Map +import Protolude +import Control.Lens hiding (anyOf, (&)) +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.State +import Language.PureScript.Ide.Test +import Language.PureScript qualified as P +import Test.Hspec +import Data.Map qualified as Map valueOperator :: Maybe P.SourceType -> IdeDeclarationAnn valueOperator = diff --git a/tests/Language/PureScript/Ide/Test.hs b/tests/Language/PureScript/Ide/Test.hs index 923bc38bf8..d9b58ca091 100644 --- a/tests/Language/PureScript/Ide/Test.hs +++ b/tests/Language/PureScript/Ide/Test.hs @@ -1,20 +1,20 @@ {-# LANGUAGE PackageImports #-} module Language.PureScript.Ide.Test where -import Control.Concurrent.STM -import "monad-logger" Control.Monad.Logger -import Data.IORef -import qualified Data.Map as Map -import Language.PureScript.Ide -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Types -import Protolude -import System.Directory -import System.FilePath -import System.Process - -import qualified Language.PureScript as P +import Control.Concurrent.STM +import "monad-logger" Control.Monad.Logger +import Data.IORef +import Data.Map qualified as Map +import Language.PureScript.Ide +import Language.PureScript.Ide.Command +import Language.PureScript.Ide.Error +import Language.PureScript.Ide.Types +import Protolude +import System.Directory +import System.FilePath +import System.Process + +import Language.PureScript qualified as P defConfig :: IdeConfiguration defConfig = diff --git a/tests/Language/PureScript/Ide/UsageSpec.hs b/tests/Language/PureScript/Ide/UsageSpec.hs index 51f3f7ac63..97c5c379d7 100644 --- a/tests/Language/PureScript/Ide/UsageSpec.hs +++ b/tests/Language/PureScript/Ide/UsageSpec.hs @@ -1,15 +1,15 @@ module Language.PureScript.Ide.UsageSpec where -import Protolude +import Protolude -import qualified Data.Text as Text -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Types -import qualified Language.PureScript.Ide.Test as Test -import qualified Language.PureScript as P -import Test.Hspec -import Data.Text.Read (decimal) -import System.FilePath +import Data.Text qualified as Text +import Language.PureScript.Ide.Command +import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Test qualified as Test +import Language.PureScript qualified as P +import Test.Hspec +import Data.Text.Read (decimal) +import System.FilePath load :: [Text] -> Command load = LoadSync . map Test.mn diff --git a/tests/Main.hs b/tests/Main.hs index 4063bab544..b8f6ea979e 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -6,21 +6,21 @@ import Prelude import Test.Hspec -import qualified TestAst -import qualified TestCompiler -import qualified TestCoreFn -import qualified TestCst -import qualified TestDocs -import qualified TestHierarchy -import qualified TestPrimDocs -import qualified TestPsci -import qualified TestIde -import qualified TestPscPublish -import qualified TestSourceMaps --- import qualified TestBundle -import qualified TestMake -import qualified TestUtils -import qualified TestGraph +import TestAst qualified +import TestCompiler qualified +import TestCoreFn qualified +import TestCst qualified +import TestDocs qualified +import TestHierarchy qualified +import TestPrimDocs qualified +import TestPsci qualified +import TestIde qualified +import TestPscPublish qualified +import TestSourceMaps qualified +-- import TestBundle qualified +import TestMake qualified +import TestUtils qualified +import TestGraph qualified import System.IO (hSetEncoding, stdout, stderr, utf8) diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs index 484bc8c3c3..8a08024ceb 100644 --- a/tests/TestCompiler.hs +++ b/tests/TestCompiler.hs @@ -24,16 +24,16 @@ module TestCompiler where import Prelude -import qualified Language.PureScript as P +import Language.PureScript qualified as P import Language.PureScript.Interactive.IO (readNodeProcessWithExitCode) import Control.Arrow ((>>>)) -import qualified Data.ByteString as BS +import Data.ByteString qualified as BS import Data.Function (on) import Data.List (sort, stripPrefix, minimumBy) import Data.Maybe (mapMaybe) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Control.Monad diff --git a/tests/TestCst.hs b/tests/TestCst.hs index fb62f768e7..b051d540a0 100644 --- a/tests/TestCst.hs +++ b/tests/TestCst.hs @@ -5,9 +5,9 @@ import Prelude import Control.Monad (when, forM_) import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.Text.IO as Text +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text +import Data.Text.IO qualified as Text import Test.Hspec import Test.QuickCheck import TestUtils diff --git a/tests/TestDocs.hs b/tests/TestDocs.hs index cecd6c0e8f..4e9dcad8e4 100644 --- a/tests/TestDocs.hs +++ b/tests/TestDocs.hs @@ -6,17 +6,17 @@ import Data.Bifunctor (first) import Data.List (findIndex) import Data.Foldable import Safe (headMay) -import qualified Data.Map as Map +import Data.Map qualified as Map import Data.Maybe (fromMaybe, isNothing, mapMaybe) import Data.Monoid import Data.Text (Text) -import qualified Data.Text as T -import qualified Text.PrettyPrint.Boxes as Boxes +import Data.Text qualified as T +import Text.PrettyPrint.Boxes qualified as Boxes -import qualified Language.PureScript as P -import qualified Language.PureScript.Docs as Docs +import Language.PureScript qualified as P +import Language.PureScript.Docs qualified as Docs import Language.PureScript.Docs.AsMarkdown (codeToString) -import qualified Language.PureScript.Publish.ErrorsWarnings as Publish +import Language.PureScript.Publish.ErrorsWarnings qualified as Publish import Web.Bower.PackageMeta (parsePackageName, runPackageName) diff --git a/tests/TestGraph.hs b/tests/TestGraph.hs index 8e7d6cb0f6..92233b439a 100644 --- a/tests/TestGraph.hs +++ b/tests/TestGraph.hs @@ -5,8 +5,8 @@ import Prelude import Test.Hspec import Data.Either (isLeft) -import qualified Data.Aeson as Json -import qualified Language.PureScript as P +import Data.Aeson qualified as Json +import Language.PureScript qualified as P spec :: Spec spec = do diff --git a/tests/TestHierarchy.hs b/tests/TestHierarchy.hs index 7d6559bf2a..18832a8d7c 100644 --- a/tests/TestHierarchy.hs +++ b/tests/TestHierarchy.hs @@ -3,7 +3,7 @@ module TestHierarchy where import Prelude import Language.PureScript.Hierarchy -import qualified Language.PureScript as P +import Language.PureScript qualified as P import Test.Hspec diff --git a/tests/TestIde.hs b/tests/TestIde.hs index 2ed41af7ff..1d505456c9 100644 --- a/tests/TestIde.hs +++ b/tests/TestIde.hs @@ -1,11 +1,11 @@ module TestIde where -import Prelude +import Prelude -import Control.Monad (unless) -import Language.PureScript.Ide.Test -import qualified PscIdeSpec -import Test.Hspec +import Control.Monad (unless) +import Language.PureScript.Ide.Test +import PscIdeSpec qualified +import Test.Hspec spec :: Spec spec = diff --git a/tests/TestMake.hs b/tests/TestMake.hs index 7e41411e95..051abb373d 100644 --- a/tests/TestMake.hs +++ b/tests/TestMake.hs @@ -5,8 +5,8 @@ module TestMake where import Prelude -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST import Control.Concurrent (threadDelay) import Control.Monad @@ -15,10 +15,10 @@ import Control.Monad.IO.Class (liftIO) import Control.Concurrent.MVar (readMVar, newMVar, modifyMVar_) import Data.Time.Calendar import Data.Time.Clock -import qualified Data.Text as T +import Data.Text qualified as T import Data.Set (Set) -import qualified Data.Set as Set -import qualified Data.Map as M +import Data.Set qualified as Set +import Data.Map qualified as M import System.FilePath import System.Directory diff --git a/tests/TestPrimDocs.hs b/tests/TestPrimDocs.hs index 4a4eeee53d..d59232f6b6 100644 --- a/tests/TestPrimDocs.hs +++ b/tests/TestPrimDocs.hs @@ -5,10 +5,10 @@ import Prelude import Data.List (sort) import Control.Exception (evaluate) import Control.DeepSeq (force) -import qualified Data.Map as Map -import qualified Data.Text as Text -import qualified Language.PureScript as P -import qualified Language.PureScript.Docs as D +import Data.Map qualified as Map +import Data.Text qualified as Text +import Language.PureScript qualified as P +import Language.PureScript.Docs qualified as D import Test.Hspec diff --git a/tests/TestPscPublish.hs b/tests/TestPscPublish.hs index 86c5b3b116..dcd621946e 100644 --- a/tests/TestPscPublish.hs +++ b/tests/TestPscPublish.hs @@ -7,18 +7,18 @@ import Control.Monad (void, guard) import Control.Monad.IO.Class (liftIO) import Data.ByteString.Lazy (ByteString) import Data.Time.Clock (getCurrentTime) -import qualified Data.Aeson as A +import Data.Aeson qualified as A import Data.Version import Data.Foldable (forM_) -import qualified Text.PrettyPrint.Boxes as Boxes +import Text.PrettyPrint.Boxes qualified as Boxes import System.Directory (listDirectory, removeDirectoryRecursive) import System.FilePath (()) import System.IO.Error (isDoesNotExistError) import Language.PureScript.Docs import Language.PureScript.Publish (PublishOptions(..), defaultPublishOptions) -import qualified Language.PureScript.Publish as Publish -import qualified Language.PureScript.Publish.ErrorsWarnings as Publish +import Language.PureScript.Publish qualified as Publish +import Language.PureScript.Publish.ErrorsWarnings qualified as Publish import Test.Hspec import TestUtils hiding (inferForeignModules, makeActions) diff --git a/tests/TestPsci/CompletionTest.hs b/tests/TestPsci/CompletionTest.hs index 20bc64c843..0305d703fa 100644 --- a/tests/TestPsci/CompletionTest.hs +++ b/tests/TestPsci/CompletionTest.hs @@ -4,14 +4,14 @@ import Prelude import Test.Hspec -import Control.Monad.Trans.State.Strict (evalStateT) -import Data.Functor ((<&>)) -import Data.List (sort) -import qualified Data.Text as T -import qualified Language.PureScript as P -import Language.PureScript.Interactive -import TestPsci.TestEnv (initTestPSCiEnv) -import TestUtils (getSupportModuleNames) +import Control.Monad.Trans.State.Strict (evalStateT) +import Data.Functor ((<&>)) +import Data.List (sort) +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.Interactive +import TestPsci.TestEnv (initTestPSCiEnv) +import TestUtils (getSupportModuleNames) completionTests :: Spec completionTests = context "completionTests" $ diff --git a/tests/TestPsci/EvalTest.hs b/tests/TestPsci/EvalTest.hs index 622208d9c5..61323ec6ea 100644 --- a/tests/TestPsci/EvalTest.hs +++ b/tests/TestPsci/EvalTest.hs @@ -2,17 +2,17 @@ module TestPsci.EvalTest where import Prelude -import Control.Monad (forM_, foldM_) -import Control.Monad.IO.Class (liftIO) -import Data.List (stripPrefix, intercalate) -import Data.List.Split (splitOn) -import System.Directory (getCurrentDirectory) -import System.Exit (exitFailure) -import System.FilePath ((), takeFileName) -import qualified System.FilePath.Glob as Glob -import System.IO.UTF8 (readUTF8File) -import Test.Hspec -import TestPsci.TestEnv +import Control.Monad (forM_, foldM_) +import Control.Monad.IO.Class (liftIO) +import Data.List (stripPrefix, intercalate) +import Data.List.Split (splitOn) +import System.Directory (getCurrentDirectory) +import System.Exit (exitFailure) +import System.FilePath ((), takeFileName) +import System.FilePath.Glob qualified as Glob +import System.IO.UTF8 (readUTF8File) +import Test.Hspec +import TestPsci.TestEnv evalTests :: Spec evalTests = context "evalTests" $ do diff --git a/tests/TestPsci/TestEnv.hs b/tests/TestPsci/TestEnv.hs index bf0ccf8a70..b255052656 100644 --- a/tests/TestPsci/TestEnv.hs +++ b/tests/TestPsci/TestEnv.hs @@ -2,21 +2,21 @@ module TestPsci.TestEnv where import Prelude -import Control.Exception.Lifted (bracket_) -import Control.Monad (void, when) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.RWS.Strict (evalRWST, asks, local, RWST) -import Data.Foldable (traverse_) -import Data.List (isSuffixOf) -import qualified Data.Text as T -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import Language.PureScript.Interactive -import System.Directory (getCurrentDirectory, doesPathExist, removeFile) -import System.Exit -import System.FilePath ((), pathSeparator) -import qualified System.FilePath.Glob as Glob -import Test.Hspec (shouldBe, Expectation) +import Control.Exception.Lifted (bracket_) +import Control.Monad (void, when) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.RWS.Strict (evalRWST, asks, local, RWST) +import Data.Foldable (traverse_) +import Data.List (isSuffixOf) +import Data.Text qualified as T +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.Interactive +import System.Directory (getCurrentDirectory, doesPathExist, removeFile) +import System.Exit +import System.FilePath ((), pathSeparator) +import System.FilePath.Glob qualified as Glob +import Test.Hspec (shouldBe, Expectation) -- | A monad transformer for handle PSCi actions in tests type TestPSCi a = RWST PSCiConfig () PSCiState IO a diff --git a/tests/TestSourceMaps.hs b/tests/TestSourceMaps.hs index ff8e7f26be..178680a4db 100644 --- a/tests/TestSourceMaps.hs +++ b/tests/TestSourceMaps.hs @@ -6,12 +6,12 @@ import Control.Monad (void, forM_) import Data.Aeson as Json import Test.Hspec import System.FilePath (replaceExtension, takeFileName, (), (<.>)) -import qualified Language.PureScript as P -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS +import Language.PureScript qualified as P +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as LBS import Data.Foldable (fold) import TestUtils (getTestFiles, SupportModules (..), compile', ExpectedModuleName (IsSourceMap)) -import qualified Data.Set as Set +import Data.Set qualified as Set import TestCompiler (getTestMain) import System.Process.Typed (proc, readProcess_) diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs index 896c42866c..6a313c1a47 100644 --- a/tests/TestUtils.hs +++ b/tests/TestUtils.hs @@ -2,10 +2,10 @@ module TestUtils where import Prelude -import qualified Language.PureScript as P -import qualified Language.PureScript.CST as CST -import qualified Language.PureScript.AST as AST -import qualified Language.PureScript.Names as N +import Language.PureScript qualified as P +import Language.PureScript.CST qualified as CST +import Language.PureScript.AST qualified as AST +import Language.PureScript.Names qualified as N import Language.PureScript.Interactive.IO (findNodeProcess) import Control.Arrow ((***), (>>>)) @@ -16,14 +16,14 @@ import Control.Monad.Trans.Maybe import Control.Monad.Writer.Class (tell) import Control.Exception import Data.ByteString (ByteString) -import qualified Data.ByteString as BS +import Data.ByteString qualified as BS import Data.Char (isSpace) import Data.Function (on) import Data.List (sort, sortBy, stripPrefix, groupBy, find) -import qualified Data.Map as M +import Data.Map qualified as M import Data.Maybe (isJust) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Data.Time.Clock (UTCTime(), diffUTCTime, getCurrentTime, nominalDay) import Data.Tuple (swap) import System.Directory @@ -33,7 +33,7 @@ import System.FilePath import System.IO.Error (isDoesNotExistError) import System.IO.UTF8 (readUTF8FileT) import System.Process hiding (cwd) -import qualified System.FilePath.Glob as Glob +import System.FilePath.Glob qualified as Glob import System.IO import Test.Hspec From 4754e8c9e4a50c643910d09ba2a5716a5e33ca2b Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Tue, 21 Mar 2023 07:25:54 +0200 Subject: [PATCH 23/68] Add ARM64 builds/releases for Linux and macOS (#4455) --- .github/workflows/ci.yml | 54 +++++++++++++++++++++++-------- CHANGELOG.d/feature_arm_builds.md | 1 + 2 files changed, 41 insertions(+), 14 deletions(-) create mode 100644 CHANGELOG.d/feature_arm_builds.md diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 6500158fa6..6cee437bc1 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,7 +13,7 @@ defaults: shell: "bash" env: - CI_PRERELEASE: "${{ github.event_name == 'push' }}" + CI_PRERELEASE: "${{ github.event_name == 'push' && github.ref == 'refs/heads/master' }}" CI_RELEASE: "${{ github.event_name == 'release' }}" STACK_VERSION: "2.9.3" @@ -37,10 +37,12 @@ jobs: matrix: include: - # If upgrading the Haskell image, also upgrade it in the lint job below - os: "ubuntu-latest" + os: ["ubuntu-latest"] image: haskell:9.2.5@sha256:2597b0e2458165a6635906204f7fac43c22e7d2a46aca1235a811194bb6cd419 - - os: "macOS-11" - - os: "windows-2019" + - os: ["macOS-11"] + - os: ["windows-2019"] + - os: ["self-hosted", "macos", "ARM64"] + - os: ["self-hosted", "Linux", "ARM64"] runs-on: "${{ matrix.os }}" container: "${{ matrix.image }}" @@ -53,20 +55,22 @@ jobs: - # We need a proper Git repository, but the checkout step will unpack a tarball instead of doing a clone # if the Git version is less than 2.18. name: "(Linux only) Install a newer version of Git" - if: "${{ runner.os == 'Linux' }}" + if: "contains(matrix.os, 'ubuntu-latest')" run: | . /etc/os-release echo deb http://deb.debian.org/debian "$VERSION_CODENAME"-backports main >> /etc/apt/sources.list apt-get update && apt-get install -y git/"$VERSION_CODENAME"-backports - uses: "actions/checkout@v2" - - uses: "actions/setup-node@v2" with: - node-version: "14" + node-version: "16" - id: "haskell" name: "(Non-Linux only) Install Haskell" - if: "${{ runner.os != 'Linux' }}" + # Note: here we exclude the self-hosted runners because this action does not work on ARM + # and their Haskell environment is instead provided by a nix-shell + # See https://github.com/purescript/purescript/pulls/4455 + if: "!contains(matrix.os, 'ubuntu-latest') && !contains(matrix.os, 'self-hosted')" uses: "haskell/actions/setup@v1" with: enable-stack: true @@ -74,7 +78,7 @@ jobs: stack-no-global: true - name: "(Linux only) Check Stack version and fix working directory ownership" - if: "${{ runner.os == 'Linux' }}" + if: "contains(matrix.os, 'ubuntu-latest')" run: | [ "$(stack --numeric-version)" = "$STACK_VERSION" ] chown root:root . @@ -99,7 +103,7 @@ jobs: run: "ci/fix-home ci/build.sh" - name: "(Linux only) Build the entire package set" - if: "${{ runner.os == 'Linux' }}" + if: "contains(matrix.os, 'ubuntu-latest')" # We build in this directory in build.sh, so this is where we need to # launch `stack exec`. The actual package-set building happens in a # temporary directory. @@ -116,7 +120,7 @@ jobs: ../ci/fix-home stack --haddock exec ../ci/build-package-set.sh - name: Verify that 'libtinfo' isn't in binary - if: runner.os == 'Linux' + if: "runner.os == 'Linux'" working-directory: "sdist-test" run: | if [ $(ldd $(../ci/fix-home stack path --local-doc-root)/../bin/purs | grep 'libtinfo' | wc -l) -ge 1 ]; then @@ -125,15 +129,37 @@ jobs: exit 1 fi + - name: "(Self-hosted Linux ARM64 only) Patch the binary to work on non-Nix systems" + if: "runner.os == 'Linux' && runner.arch == 'ARM64'" + working-directory: "sdist-test" + # The self-hosted build happens inside a nix-shell that provides a working stack binary + # on ARM systems, and while the macOS binary is fine - because macOS binaries are almost + # statically linked), the linux ones are all pointing at the nix store. + # So here we first point the binary to the right linker that should work on a generic linux, + # and then fix the RUNPATH with the right location to load the shared libraries from + run: | + patchelf --set-interpreter /usr/lib/ld-linux-aarch64.so.1 --set-rpath /usr/lib/aarch64-linux-gnu $(stack path --local-doc-root)/../bin/purs + - name: "(Release/prerelease only) Create bundle" if: "${{ env.CI_RELEASE == 'true' || env.CI_PRERELEASE == 'true' && steps.build.outputs.do-not-prerelease != 'true' }}" run: | os_name="${{ runner.os }}" + os_arch="${{ runner.arch }}" case "$os_name" in Linux) - bundle_os=linux64;; + case "$os_arch" in + ARM64) + bundle_os=linux-arm64;; + *) + bundle_os=linux64;; + esac;; macOS) - bundle_os=macos;; + case "$os_arch" in + ARM64) + bundle_os=macos-arm64;; + *) + bundle_os=macos;; + esac;; Windows) bundle_os=win64;; *) @@ -147,7 +173,7 @@ jobs: if: "${{ env.CI_PRERELEASE == 'true' && steps.build.outputs.do-not-prerelease != 'true' }}" uses: "actions/upload-artifact@v3" with: - name: "${{ runner.os }}-bundle" + name: "${{ runner.os }}-${{ runner.arch }}-bundle" path: | sdist-test/bundle/*.sha sdist-test/bundle/*.tar.gz diff --git a/CHANGELOG.d/feature_arm_builds.md b/CHANGELOG.d/feature_arm_builds.md new file mode 100644 index 0000000000..7429fe3445 --- /dev/null +++ b/CHANGELOG.d/feature_arm_builds.md @@ -0,0 +1 @@ +* Add release artifacts for Linux and macOS running on the ARM64 architecture. From 94ef29e853a0f5ba22a1b0c10be4e14e47da14c0 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Tue, 21 Mar 2023 04:31:54 -0400 Subject: [PATCH 24/68] Require comments not to cause Haddock warnings (#4456) --- CHANGELOG.d/internal_no-haddock-warnings.md | 1 + ci/build.sh | 4 ++- src/Language/PureScript/AST/Declarations.hs | 4 +-- src/Language/PureScript/CodeGen/JS.hs | 36 +++++++++---------- src/Language/PureScript/CoreFn/Desugar.hs | 18 +++++----- .../PureScript/CoreImp/Optimizer/TCO.hs | 4 +-- src/Language/PureScript/Docs/Convert.hs | 4 --- src/Language/PureScript/Errors.hs | 8 ++--- .../PureScript/Ide/Imports/Actions.hs | 2 +- src/Language/PureScript/Linter/Exhaustive.hs | 2 +- src/Language/PureScript/Pretty/Common.hs | 4 --- .../PureScript/Sugar/BindingGroups.hs | 2 -- src/Language/PureScript/Sugar/LetPattern.hs | 6 ++-- src/Language/PureScript/Sugar/Operators.hs | 2 +- src/Language/PureScript/Sugar/TypeClasses.hs | 1 - src/Language/PureScript/TypeChecker.hs | 1 - .../PureScript/TypeChecker/Deriving.hs | 8 ++--- .../PureScript/TypeChecker/Entailment.hs | 25 +++++++------ src/Language/PureScript/TypeChecker/Types.hs | 10 +++--- 19 files changed, 65 insertions(+), 77 deletions(-) create mode 100644 CHANGELOG.d/internal_no-haddock-warnings.md diff --git a/CHANGELOG.d/internal_no-haddock-warnings.md b/CHANGELOG.d/internal_no-haddock-warnings.md new file mode 100644 index 0000000000..8d661b6cf6 --- /dev/null +++ b/CHANGELOG.d/internal_no-haddock-warnings.md @@ -0,0 +1 @@ +* Require comments not to cause Haddock warnings diff --git a/ci/build.sh b/ci/build.sh index a01c953c30..5bcb7d4950 100755 --- a/ci/build.sh +++ b/ci/build.sh @@ -162,7 +162,9 @@ tar -xzf sdist-test/purescript-*.tar.gz -C sdist-test --strip-components=1 (echo "::endgroup::"; echo "::group::Build and test PureScript") 2>/dev/null pushd sdist-test -$STACK build $STACK_OPTS +# Haddock -Werror goes here to keep us honest but prevent failing on +# documentation errors in dependencies +$STACK build $STACK_OPTS --haddock-arguments --optghc=-Werror popd (echo "::endgroup::") 2>/dev/null diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs index 22ee15ed26..8112521acd 100644 --- a/src/Language/PureScript/AST/Declarations.hs +++ b/src/Language/PureScript/AST/Declarations.hs @@ -42,14 +42,14 @@ data TypeSearch = TSBefore Environment -- ^ An Environment captured for later consumption by type directed search | TSAfter + -- ^ Results of applying type directed search to the previously captured + -- Environment { tsAfterIdentifiers :: [(Qualified Text, SourceType)] -- ^ The identifiers that fully satisfy the subsumption check , tsAfterRecordFields :: Maybe [(Label, SourceType)] -- ^ Record fields that are available on the first argument to the typed -- hole } - -- ^ Results of applying type directed search to the previously captured - -- Environment deriving Show onTypeSearchTypes :: (SourceType -> SourceType) -> TypeSearch -> TypeSearch diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index c801dc22d8..dae389474a 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -83,7 +83,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = return $ AST.Module header (foreign' ++ jsImports) renamedModuleBody jsExports where - -- | Adds purity annotations to top-level values for bundlers. + -- 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. @@ -92,14 +92,14 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = where annotateOrWrap = liftA2 fromMaybe pureIife maybePure - -- | If the JS is potentially effectful (in the eyes of a bundler that + -- If the JS is potentially effectful (in the eyes of a bundler that -- doesn't know about PureScript), return Nothing. Otherwise, return Just -- the JS with any needed pure annotations added, and, in the case of a -- variable declaration, an IIFE to be annotated. maybePure :: AST -> Maybe AST maybePure = maybePureGen False - -- | Like maybePure, but doesn't add a pure annotation to App. This exists + -- Like maybePure, but doesn't add a pure annotation to App. This exists -- to prevent from doubling up on annotation comments on curried -- applications; from experimentation, it turns out that a comment on the -- outermost App is sufficient for the entire curried chain to be @@ -131,12 +131,12 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = pureApp :: Maybe SourceSpan -> AST -> [AST] -> AST pureApp ss f = AST.Comment AST.PureAnnotation . AST.App ss f - -- | Extracts all declaration names from a binding group. + -- Extracts all declaration names from a binding group. getNames :: Bind Ann -> [Ident] getNames (NonRec _ ident _) = [ident] getNames (Rec vals) = map (snd . fst) vals - -- | Creates alternative names for each module to ensure they don't collide + -- Creates alternative names for each module to ensure they don't collide -- with declaration names. renameImports :: [Ident] -> [ModuleName] -> M.Map ModuleName Text renameImports = go M.empty @@ -157,19 +157,19 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = then freshModuleName (i + 1) mn' used else newName - -- | Generates JavaScript code for a module import, binding the required module + -- Generates JavaScript code for a module import, binding the required module -- to the alternative 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 mnSafe (moduleImportPath mn') - -- | Generates JavaScript code for exporting at least one identifier, + -- Generates JavaScript code for exporting at least one identifier, -- eventually from another module. exportsToJs :: Maybe PSString -> [Ident] -> Maybe AST.Export exportsToJs from = fmap (flip AST.Export from) . NEL.nonEmpty . fmap runIdent - -- | Generates JavaScript code for re-exporting at least one identifier from + -- Generates JavaScript code for re-exporting at least one identifier from -- from another module. reExportsToJs :: (ModuleName, [Ident]) -> Maybe AST.Export reExportsToJs = uncurry exportsToJs . first (Just . moduleImportPath) @@ -177,7 +177,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = moduleImportPath :: ModuleName -> PSString moduleImportPath mn' = fromString (".." T.unpack (runModuleName mn') "index.js") - -- | Replaces the `ModuleAccessor`s in the AST with `Indexer`s, ensuring that + -- 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) @@ -238,9 +238,7 @@ moduleBindToJs -> m [AST] moduleBindToJs mn = bindToJs where - -- | -- Generate code in the simplified JavaScript intermediate representation for a declaration - -- bindToJs :: Bind Ann -> m [AST] bindToJs (NonRec (_, _, _, Just IsTypeClassConstructor) _ _) = pure [] -- Unlike other newtype constructors, type class constructors are only @@ -249,7 +247,7 @@ moduleBindToJs mn = bindToJs bindToJs (NonRec ann ident val) = return <$> nonRecToJS ann ident val bindToJs (Rec vals) = writer (applyLazinessTransform mn vals) >>= traverse (uncurry . uncurry $ nonRecToJS) - -- | Generate code in the simplified JavaScript intermediate representation for a single non-recursive + -- Generate code in the simplified JavaScript intermediate representation for a single non-recursive -- declaration. -- -- The main purpose of this function is to handle code generation for comments. @@ -276,12 +274,12 @@ moduleBindToJs mn = bindToJs then withSourceSpan ss js else js - -- | Generate code in the simplified JavaScript intermediate representation for a variable based on a + -- Generate code in the simplified JavaScript intermediate representation for a variable based on a -- PureScript identifier. var :: Ident -> AST var = AST.Var Nothing . identToJs - -- | Generate code in the simplified JavaScript intermediate representation for a value or expression. + -- Generate code in the simplified JavaScript intermediate representation for a value or expression. valueToJs :: Expr Ann -> m AST valueToJs e = let (ss, _, _, _) = extractAnn e in @@ -364,7 +362,7 @@ moduleBindToJs mn = bindToJs literalToValueJS ss (ArrayLiteral xs) = AST.ArrayLiteral (Just ss) <$> mapM valueToJs xs literalToValueJS ss (ObjectLiteral ps) = AST.ObjectLiteral (Just ss) <$> mapM (sndM valueToJs) ps - -- | Shallow copy an object. + -- Shallow copy an object. extendObj :: AST -> [(PSString, AST)] -> m AST extendObj obj sts = do newObj <- freshName @@ -384,13 +382,13 @@ moduleBindToJs mn = bindToJs extend = map stToAssign sts return $ AST.App Nothing (AST.Function Nothing Nothing [] block) [] - -- | Generate code in the simplified JavaScript intermediate representation for a reference to a + -- Generate code in the simplified JavaScript intermediate representation for a reference to a -- variable. varToJs :: Qualified Ident -> AST varToJs (Qualified (BySourcePos _) ident) = var ident varToJs qual = qualifiedToJS id qual - -- | Generate code in the simplified JavaScript intermediate representation for a reference to a + -- Generate code in the simplified JavaScript intermediate representation for a reference to a -- variable that may have a qualified name. qualifiedToJS :: (a -> Ident) -> Qualified a -> AST qualifiedToJS f (Qualified (ByModuleName C.M_Prim) a) = AST.Var Nothing . runIdent $ f a @@ -400,7 +398,7 @@ moduleBindToJs mn = bindToJs foreignIdent :: Ident -> AST foreignIdent ident = accessorString (mkString $ runIdent ident) (AST.Var Nothing FFINamespace) - -- | Generate code in the simplified JavaScript intermediate representation for pattern match binders + -- Generate code in the simplified JavaScript intermediate representation for pattern match binders -- and guards. bindersToJs :: SourceSpan -> [CaseAlternative Ann] -> [AST] -> m AST bindersToJs ss binders vals = do @@ -447,7 +445,7 @@ moduleBindToJs mn = bindToJs let (ss, _, _, _) = extractBinderAnn binder in traverse (withPos ss) =<< binderToJs' s done binder - -- | Generate code in the simplified JavaScript intermediate representation for a pattern match + -- Generate code in the simplified JavaScript intermediate representation for a pattern match -- binder. binderToJs' :: Text -> [AST] -> Binder Ann -> m [AST] binderToJs' _ done NullBinder{} = return done diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs index 29303e05c4..c5edfd6151 100644 --- a/src/Language/PureScript/CoreFn/Desugar.hs +++ b/src/Language/PureScript/CoreFn/Desugar.hs @@ -40,7 +40,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = decls' = concatMap declToCoreFn decls in Module modSS coms mn (spanName modSS) imports' exps' reExps externs decls' where - -- | Creates a map from a module name to the re-export references defined in + -- Creates a map from a module name to the re-export references defined in -- that module. reExportsToCoreFn :: (ModuleName, A.DeclarationRef) -> M.Map ModuleName [Ident] reExportsToCoreFn (mn', ref') = M.singleton mn' (exportToCoreFn ref') @@ -52,14 +52,14 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = (A.exportSourceImportedFrom src) toReExportRef _ = Nothing - -- | Remove duplicate imports + -- Remove duplicate imports dedupeImports :: [(Ann, ModuleName)] -> [(Ann, ModuleName)] dedupeImports = fmap swap . M.toList . M.fromListWith const . fmap swap ssA :: SourceSpan -> Ann ssA ss = (ss, [], Nothing, Nothing) - -- | Desugars member declarations from AST to CoreFn representation. + -- Desugars member declarations from AST to CoreFn representation. declToCoreFn :: A.Declaration -> [Bind Ann] declToCoreFn (A.DataDeclaration (ss, com) Newtype _ _ [ctor]) = [NonRec (ss, [], Nothing, declMeta) (properToIdent $ A.dataCtorName ctor) $ @@ -82,7 +82,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = [Rec . NEL.toList $ fmap (\(((ss, com), name), _, e) -> ((ssA ss, name), exprToCoreFn ss com Nothing e)) ds] declToCoreFn _ = [] - -- | Desugars expressions from AST to CoreFn representation. + -- Desugars expressions from AST to CoreFn representation. exprToCoreFn :: SourceSpan -> [Comment] -> Maybe SourceType -> A.Expr -> Expr Ann exprToCoreFn _ com ty (A.Literal ss lit) = Literal (ss, com, ty, Nothing) (fmap (exprToCoreFn ss com Nothing) lit) @@ -131,7 +131,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = exprToCoreFn _ _ _ e = error $ "Unexpected value in exprToCoreFn mn: " ++ show e - -- | Desugars case alternatives from AST to CoreFn representation. + -- Desugars case alternatives from AST to CoreFn representation. altToCoreFn :: SourceSpan -> A.CaseAlternative -> CaseAlternative Ann altToCoreFn ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn ss []) bs) (go vs) where @@ -147,7 +147,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = guardToExpr [A.ConditionGuard cond] = cond guardToExpr _ = internalError "Guard not correctly desugared" - -- | Desugars case binders from AST to CoreFn representation. + -- Desugars case binders from AST to CoreFn representation. binderToCoreFn :: SourceSpan -> [Comment] -> A.Binder -> Binder Ann binderToCoreFn _ com (A.LiteralBinder ss lit) = LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit) @@ -171,19 +171,19 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = binderToCoreFn _ _ A.ParensInBinder{} = internalError "ParensInBinder should have been desugared before binderToCoreFn" - -- | Gets metadata for let bindings. + -- Gets metadata for let bindings. getLetMeta :: A.WhereProvenance -> Maybe Meta getLetMeta A.FromWhere = Just IsWhere getLetMeta A.FromLet = Nothing - -- | Gets metadata for values. + -- Gets metadata for values. getValueMeta :: Qualified Ident -> Maybe Meta getValueMeta name = case lookupValue env name of Just (_, External, _) -> Just IsForeign _ -> Nothing - -- | Gets metadata for data constructors. + -- Gets metadata for data constructors. getConstructorMeta :: Qualified (ProperName 'ConstructorName) -> Meta getConstructorMeta ctor = case lookupConstructor env ctor of diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs index bd85924eae..7defbe66c3 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs @@ -40,8 +40,8 @@ tco = flip evalState 0 . everywhereTopDownM convert where innerArgs = headDef [] argss outerArgs = concat . reverse $ tailSafe argss arity = length argss - -- ^ this is the number of calls, not the number of arguments, if there's - -- ever a practical difference. + -- this is the number of calls, not the number of arguments, if there's + -- ever a practical difference. (argss, body', replace) = topCollectAllFunctionArgs [] id fn convert js = pure js diff --git a/src/Language/PureScript/Docs/Convert.hs b/src/Language/PureScript/Docs/Convert.hs index ce25a9102b..094577f80a 100644 --- a/src/Language/PureScript/Docs/Convert.hs +++ b/src/Language/PureScript/Docs/Convert.hs @@ -66,7 +66,6 @@ insertValueTypesAndAdjustKinds :: insertValueTypesAndAdjustKinds env m = m { modDeclarations = map (go . insertInferredRoles . convertFFIDecl) (modDeclarations m) } where - -- | -- Convert FFI declarations into data declaration -- by generating the type parameters' names based on its kind signature. -- Note: `Prim` modules' docs don't go through this conversion process @@ -99,7 +98,6 @@ insertValueTypesAndAdjustKinds env m = insertInferredRoles other = other - -- | -- Given an FFI declaration like this -- ``` -- foreign import data Foo @@ -171,7 +169,6 @@ insertValueTypesAndAdjustKinds env m = Nothing -> err ("name not found: " ++ show key) - -- | -- Extracts the keyword for a declaration (if there is one) extractKeyword :: DeclarationInfo -> Maybe P.KindSignatureFor extractKeyword = \case @@ -182,7 +179,6 @@ insertValueTypesAndAdjustKinds env m = TypeClassDeclaration _ _ _ -> Just P.ClassSig _ -> Nothing - -- | -- Returns True if the kind signature is "uninteresting", which -- is a kind that follows this form: -- - `Type` diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 49a4348a3b..bcdfee61d2 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -1676,7 +1676,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon paras :: forall f. Foldable f => f Box.Box -> Box.Box paras = Box.vcat Box.left - -- | Simplify an error message + -- Simplify an error message simplifyErrorMessage :: ErrorMessage -> ErrorMessage simplifyErrorMessage (ErrorMessage hints simple) = ErrorMessage (simplifyHints hints) simple where @@ -1692,7 +1692,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon (_, OtherHint) -> False (c1, c2) -> c1 == c2 - -- | See https://github.com/purescript/purescript/issues/1802 + -- See https://github.com/purescript/purescript/issues/1802 stripRedundantHints :: SimpleErrorMessage -> [ErrorMessageHint] -> [ErrorMessageHint] stripRedundantHints ExprDoesNotHaveType{} = stripFirst isCheckHint where @@ -1764,7 +1764,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon Box.<> (line . displayStartEndPos . fst $ getAnnForType ty) Qualified mn (Right inst) -> line . markCode . showQualified showIdent $ Qualified mn inst - -- | As of this writing, this function assumes that all provided SourceSpans + -- As of this writing, this function assumes that all provided SourceSpans -- are non-overlapping (except for exact duplicates) and span no line breaks. A -- more sophisticated implementation without this limitation would be possible -- but isn't yet needed. @@ -1845,7 +1845,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon lineNumberStyle :: String -> Box.Box lineNumberStyle = colorCodeBox (codeColor $> (ANSI.Vivid, ANSI.Black)) . Box.alignHoriz Box.right 5 . lineS - -- | Lookup the nth element of a list, but without retraversing the list every + -- Lookup the nth element of a list, but without retraversing the list every -- time, by instead keeping a tail of the list and the current element number -- in State. Only works if the argument provided is strictly ascending over -- the life of the State. diff --git a/src/Language/PureScript/Ide/Imports/Actions.hs b/src/Language/PureScript/Ide/Imports/Actions.hs index af48677df7..38d80148bc 100644 --- a/src/Language/PureScript/Ide/Imports/Actions.hs +++ b/src/Language/PureScript/Ide/Imports/Actions.hs @@ -118,7 +118,7 @@ addExplicitImport' decl moduleName qualifier imports = refFromDeclaration d = P.ValueRef ideSpan (P.Ident (identifierFromIdeDeclaration d)) - -- | Adds a declaration to an import: + -- Adds a declaration to an import: -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe) insertDeclIntoImport :: IdeDeclaration -> Import -> Import insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) = diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs index 60a20ff3cf..43dc0f80e9 100644 --- a/src/Language/PureScript/Linter/Exhaustive.hs +++ b/src/Language/PureScript/Linter/Exhaustive.hs @@ -273,7 +273,7 @@ checkExhaustive ss env mn numArgs cas expr = makeResult . first ordNub $ foldl' tellRedundant = tell . errorMessage' ss . uncurry OverlappingPattern . second null . splitAt 5 $ bss' tellIncomplete = tell . errorMessage' ss $ IncompleteExhaustivityCheck - -- | We add a Partial constraint by annotating the expression to have type `Partial => _`. + -- We add a Partial constraint by annotating the expression to have type `Partial => _`. -- -- The binder information is provided so that it can be embedded in the constraint, -- and then included in the error message. diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs index 2f32e7bcbc..6a30adb4e5 100644 --- a/src/Language/PureScript/Pretty/Common.hs +++ b/src/Language/PureScript/Pretty/Common.hs @@ -61,9 +61,7 @@ instance Monoid StrPos where plus (a, c) (StrPos (a', _, c')) = (a `addPos` a', (bumpPos a <$> c') : c) instance Emit StrPos where - -- | -- Augment a string with its length (rows/column) - -- emit str = -- TODO(Christoph): get rid of T.unpack let newlines = elemIndices '\n' (T.unpack str) @@ -71,9 +69,7 @@ instance Emit StrPos where in StrPos (SourcePos { sourcePosLine = length newlines, sourcePosColumn = T.length str - index }, str, []) - -- | -- Add a new mapping entry for given source position with initially zero generated position - -- addMapping ss@SourceSpan { spanName = file, spanStart = startPos } = StrPos (zeroPos, mempty, [ mapping | ss /= nullSourceSpan ]) where mapping = SMap (T.pack file) startPos zeroPos diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs index 61de1090ca..6298e2eefe 100644 --- a/src/Language/PureScript/Sugar/BindingGroups.hs +++ b/src/Language/PureScript/Sugar/BindingGroups.hs @@ -62,9 +62,7 @@ createBindingGroups moduleName = mapM f <=< handleDecls handleExprs (Let w ds val) = (\ds' -> Let w ds' val) <$> handleDecls ds handleExprs other = return other - -- | -- Replace all sets of mutually-recursive declarations with binding groups - -- handleDecls :: [Declaration] -> m [Declaration] handleDecls ds = do let values = mapMaybe (fmap (fmap extractGuardedExpr) . getValueDeclaration) ds diff --git a/src/Language/PureScript/Sugar/LetPattern.hs b/src/Language/PureScript/Sugar/LetPattern.hs index b9b23575a8..2d4b01d8f3 100644 --- a/src/Language/PureScript/Sugar/LetPattern.hs +++ b/src/Language/PureScript/Sugar/LetPattern.hs @@ -28,11 +28,11 @@ desugarLetPattern decl = replace other = other go :: WhereProvenance - -- ^ Metadata about whether the let-in was a where clause + -- Metadata about whether the let-in was a where clause -> [Either [Declaration] (SourceAnn, Binder, Expr)] - -- ^ Declarations to desugar + -- Declarations to desugar -> Expr - -- ^ The original let-in result expression + -- The original let-in result expression -> Expr go _ [] e = e go w (Right ((pos, com), binder, boundE) : ds) e = diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs index 6b807d344b..3531380ed0 100644 --- a/src/Language/PureScript/Sugar/Operators.hs +++ b/src/Language/PureScript/Sugar/Operators.hs @@ -212,7 +212,7 @@ rebracketModule !caller pred_ valueOpTable typeOpTable (Module ss coms mn ds ext fmap (map (\d -> if pred_ d then removeParens d else d)) . flip parU (usingPredicate pred_ h) - -- | The AST will run through all the desugar passes when compiling + -- The AST will run through all the desugar passes when compiling -- and only some of the desugar passes when generating docs. -- When generating docs, `case _ of` syntax used in an instance declaration -- can trigger the `IncorrectAnonymousArgument` error because it does not diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs index 9a279ba375..b5ed36bb14 100644 --- a/src/Language/PureScript/Sugar/TypeClasses.hs +++ b/src/Language/PureScript/Sugar/TypeClasses.hs @@ -229,7 +229,6 @@ desugarDecl mn exps = go return (expRef name' className tys, [d, dictDecl]) go other = return (Nothing, [other]) - -- | -- Completes the name generation for type class instances that do not have -- a unique name defined in source code. desugarInstName :: MonadSupply m => Either Text Ident -> Desugar m Ident diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index dec85ada99..8d210bac86 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -561,7 +561,6 @@ typeCheckAll moduleName = traverse go | moduleName `S.member` nonOrphanModules = return () | otherwise = throwError . errorMessage $ OrphanInstance dictName className nonOrphanModules tys' - -- | -- This function adds the argument kinds for a type constructor so that they may appear in the externs file, -- extracted from the kind of the type constructor itself. -- diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index 3381cd649f..533910bb14 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -533,10 +533,10 @@ validateParamsInTypeConstructors derivingClass utc isBi CovariantClasses{..} con where tcdAppliesToType tcd = case tcdInstanceTypes tcd of [headOfType -> ht'] -> ht == ht' - -- ^ It's possible that, if ht and ht' are Lefts, this might require - -- verifying that the name isn't shadowed by something in tcdForAll. I - -- can't devise a legal program that causes this issue, but if in the - -- future it seems like a good idea, it probably is. + -- It's possible that, if ht and ht' are Lefts, this might require + -- verifying that the name isn't shadowed by something in tcdForAll. I + -- can't devise a legal program that causes this issue, but if in the + -- future it seems like a good idea, it probably is. _ -> False headOfType :: SourceType -> Qualified (Either Text (ProperName 'TypeName)) diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index bf775042c7..5774f578f2 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -321,7 +321,7 @@ entails SolverOptions{..} constraint context hints = -- with no unsolved constraints. Hopefully, we can solve this later. return (TypeClassDictionary (srcConstraint className' kinds'' tys'' conInfo) context hints') where - -- | When checking functional dependencies, we need to use unification to make + -- When checking functional dependencies, we need to use unification to make -- sure it is safe to use the selected instance. We will unify the solved type with -- the type in the instance head under the substitution inferred from its instantiation. -- As an example, when solving MonadState t0 (State Int), we choose the @@ -380,7 +380,6 @@ entails SolverOptions{..} constraint context hints = canBeGeneralized (KindedType _ t _) = canBeGeneralized t canBeGeneralized _ = False - -- | -- Check if two dictionaries are overlapping -- -- Dictionaries which are subclass dictionaries cannot overlap, since otherwise the overlap would have @@ -475,7 +474,7 @@ entails SolverOptions{..} constraint context hints = pure [TypeClassDictionaryInScope Nothing 0 EmptyClassInstance [] C.SymbolAppend [] [] args' Nothing Nothing] solveSymbolAppend _ = Nothing - -- | Append type level symbols, or, run backwards, strip a prefix or suffix + -- Append type level symbols, or, run backwards, strip a prefix or suffix appendSymbols :: SourceType -> SourceType -> SourceType -> Maybe (SourceType, SourceType, SourceType) appendSymbols arg0@(TypeLevelString _ lhs) arg1@(TypeLevelString _ rhs) _ = Just (arg0, arg1, srcTypeLevelString (lhs <> rhs)) appendSymbols arg0@(TypeLevelString _ lhs) _ arg2@(TypeLevelString _ out) = do @@ -544,11 +543,11 @@ entails SolverOptions{..} constraint context hints = solveIntAdd _ = Nothing addInts :: SourceType -> SourceType -> SourceType -> Maybe (SourceType, SourceType, SourceType) - -- | l r -> o, l + r = o + -- l r -> o, l + r = o addInts arg0@(TypeLevelInt _ l) arg1@(TypeLevelInt _ r) _ = pure (arg0, arg1, srcTypeLevelInt (l + r)) - -- | l o -> r, o - l = r + -- l o -> r, o - l = r addInts arg0@(TypeLevelInt _ l) _ arg2@(TypeLevelInt _ o) = pure (arg0, srcTypeLevelInt (o - l), arg2) - -- | r o -> l, o - r = l + -- r o -> l, o - r = l addInts _ arg1@(TypeLevelInt _ r) arg2@(TypeLevelInt _ o) = pure (srcTypeLevelInt (o - r), arg1, arg2) addInts _ _ _ = Nothing @@ -582,7 +581,7 @@ entails SolverOptions{..} constraint context hints = pure [ TypeClassDictionaryInScope Nothing 0 EmptyClassInstance [] C.RowUnion vars kinds [lOut, rOut, uOut] cst Nothing ] solveUnion _ _ = Nothing - -- | Left biased union of two row types + -- Left biased union of two row types unionRows :: [SourceType] -> SourceType -> SourceType -> SourceType -> Maybe (SourceType, SourceType, SourceType, Maybe [SourceConstraint], [(Text, SourceType)]) unionRows kinds l r u = @@ -643,7 +642,7 @@ entails SolverOptions{..} constraint context hints = pure [ TypeClassDictionaryInScope Nothing 0 EmptyClassInstance [] C.RowToList [] [kind] [r, entries] Nothing Nothing ] solveRowToList _ _ = Nothing - -- | Convert a closed row to a sorted list of entries + -- Convert a closed row to a sorted list of entries rowToRowList :: SourceType -> SourceType -> Maybe SourceType rowToRowList kind r = guard (isREmpty rest) $> @@ -705,7 +704,7 @@ matches deps TypeClassDictionaryInScope{..} tys = solved = map snd . filter ((`S.notMember` determinedSet) . fst) $ zipWith (\(_, ts) i -> (i, ts)) matched [0..] in verifySubstitution (M.unionsWith (++) solved) where - -- | Find the closure of a set of functional dependencies. + -- Find the closure of a set of functional dependencies. covers :: [(Matched (), subst)] -> Bool covers ms = finalSet == S.fromList [0..length ms - 1] where @@ -875,10 +874,10 @@ pairwiseM p (x : xs) = traverse (p x) xs *> pairwiseM p xs tails1 :: NonEmpty a -> NonEmpty (NonEmpty a) tails1 = -- NEL.fromList is an unsafe function, but this usage should be safe, since: - -- * `tails xs = [xs, tail xs, tail (tail xs), ..., []]` - -- * If `xs` is nonempty, it follows that `tails xs` contains at least one nonempty + -- - `tails xs = [xs, tail xs, tail (tail xs), ..., []]` + -- - If `xs` is nonempty, it follows that `tails xs` contains at least one nonempty -- list, since `head (tails xs) = xs`. - -- * The only empty element of `tails xs` is the last one (by the definition of `tails`) - -- * Therefore, if we take all but the last element of `tails xs` i.e. + -- - The only empty element of `tails xs` is the last one (by the definition of `tails`) + -- - Therefore, if we take all but the last element of `tails xs` i.e. -- `init (tails xs)`, we have a nonempty list of nonempty lists NEL.fromList . map NEL.fromList . init . tails . NEL.toList diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs index 7947a4d2f2..7a82f22214 100644 --- a/src/Language/PureScript/TypeChecker/Types.hs +++ b/src/Language/PureScript/TypeChecker/Types.hs @@ -197,12 +197,12 @@ typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do -> ErrorMessage replaceTypes subst = onTypesInErrorMessage (substituteType subst) - -- | Run type search to complete any typed hole error messages + -- Run type search to complete any typed hole error messages runTypeSearch :: Maybe [(Ident, InstanceContext, SourceConstraint)] - -- ^ Any unsolved constraints which we need to continue to satisfy + -- Any unsolved constraints which we need to continue to satisfy -> CheckState - -- ^ The final type checker state + -- The final type checker state -> ErrorMessage -> ErrorMessage runTypeSearch cons st = \case @@ -214,7 +214,7 @@ typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do in ErrorMessage hints (HoleInferredType x ty y (Just searchResult)) other -> other - -- | Add any unsolved constraints + -- Add any unsolved constraints constrain cs ty = foldr srcConstrainedType ty (map (\(_, _, x) -> x) cs) -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values @@ -271,7 +271,7 @@ typeDictionaryForBindingGroup moduleName vals = do ] return (SplitBindingGroup untyped' typed' dict) where - -- | Check if a value contains a type annotation, and if so, separate it + -- Check if a value contains a type annotation, and if so, separate it -- from the value itself. splitTypeAnnotation :: (a, Expr) -> Either (a, Expr) (a, (Expr, SourceType, Bool)) splitTypeAnnotation (a, TypedValue checkType value ty) = Right (a, (value, ty, checkType)) From be8e32f27255fd689f858be9e9eb2d3c86d03bbd Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Thu, 23 Mar 2023 21:41:33 -0400 Subject: [PATCH 25/68] Make unqualified imports explicit (#4454) This applies only to import lists with fewer than fifteen items. This also skips imports that have any `as` clause whatsoever, some of which still introduce implicit identifiers into the namespace. --- app/Command/Compile.hs | 8 ++-- app/Command/Docs.hs | 8 ++-- app/Command/Docs/Html.hs | 4 +- app/Command/Graph.hs | 2 +- app/Command/Ide.hs | 22 +++++----- app/Command/Publish.hs | 4 +- app/Command/REPL.hs | 8 ++-- src/Control/Monad/Logger.hs | 6 +-- src/Control/Monad/Supply.hs | 10 ++--- src/Control/Monad/Supply/Class.hs | 8 ++-- src/Language/PureScript/AST/Binders.hs | 10 ++--- src/Language/PureScript/AST/Declarations.hs | 24 +++++----- src/Language/PureScript/AST/Exported.hs | 6 +-- src/Language/PureScript/AST/Operators.hs | 2 +- src/Language/PureScript/AST/SourcePos.hs | 2 +- src/Language/PureScript/AST/Traversals.hs | 16 +++---- src/Language/PureScript/AST/Utils.hs | 6 +-- src/Language/PureScript/Bundle.hs | 8 ++-- src/Language/PureScript/CST/Errors.hs | 6 +-- src/Language/PureScript/CST/Flatten.hs | 2 +- src/Language/PureScript/CST/Layout.hs | 2 +- src/Language/PureScript/CST/Lexer.hs | 10 ++--- src/Language/PureScript/CST/Monad.hs | 8 ++-- src/Language/PureScript/CST/Print.hs | 2 +- src/Language/PureScript/CST/Traversals.hs | 2 +- .../PureScript/CST/Traversals/Type.hs | 4 +- src/Language/PureScript/CST/Utils.hs | 8 ++-- src/Language/PureScript/CodeGen/JS.hs | 14 +++--- src/Language/PureScript/CodeGen/JS/Common.hs | 6 +-- src/Language/PureScript/CodeGen/JS/Printer.hs | 14 +++--- src/Language/PureScript/Comments.hs | 2 +- src/Language/PureScript/Constants/Prim.hs | 2 +- src/Language/PureScript/Constants/TH.hs | 4 +- src/Language/PureScript/CoreFn/Ann.hs | 8 ++-- src/Language/PureScript/CoreFn/Binders.hs | 4 +- src/Language/PureScript/CoreFn/CSE.hs | 12 ++--- src/Language/PureScript/CoreFn/Desugar.hs | 26 +++++------ src/Language/PureScript/CoreFn/Expr.hs | 6 +-- src/Language/PureScript/CoreFn/FromJSON.hs | 10 ++--- src/Language/PureScript/CoreFn/Laziness.hs | 8 ++-- src/Language/PureScript/CoreFn/Meta.hs | 2 +- src/Language/PureScript/CoreFn/Module.hs | 8 ++-- src/Language/PureScript/CoreFn/Optimizer.hs | 18 ++++---- src/Language/PureScript/CoreFn/ToJSON.hs | 8 ++-- src/Language/PureScript/CoreFn/Traversals.hs | 6 +-- src/Language/PureScript/CoreImp/AST.hs | 4 +- src/Language/PureScript/CoreImp/Module.hs | 4 +- src/Language/PureScript/CoreImp/Optimizer.hs | 14 +++--- .../PureScript/CoreImp/Optimizer/Blocks.hs | 2 +- .../PureScript/CoreImp/Optimizer/Common.hs | 4 +- .../PureScript/CoreImp/Optimizer/Inliner.hs | 4 +- .../PureScript/CoreImp/Optimizer/MagicDo.hs | 4 +- .../PureScript/CoreImp/Optimizer/TCO.hs | 2 +- .../PureScript/CoreImp/Optimizer/Unused.hs | 4 +- src/Language/PureScript/Docs/AsHtml.hs | 2 +- src/Language/PureScript/Docs/AsMarkdown.hs | 4 +- src/Language/PureScript/Docs/Collect.hs | 2 +- src/Language/PureScript/Docs/Convert.hs | 2 +- .../PureScript/Docs/Convert/ReExports.hs | 4 +- .../PureScript/Docs/Convert/Single.hs | 2 +- src/Language/PureScript/Docs/Prim.hs | 2 +- src/Language/PureScript/Docs/Render.hs | 4 +- .../Docs/RenderedCode/RenderType.hs | 16 +++---- .../PureScript/Docs/RenderedCode/Types.hs | 2 +- src/Language/PureScript/Docs/Tags.hs | 2 +- src/Language/PureScript/Docs/Types.hs | 4 +- .../PureScript/Docs/Utils/MonoidExtras.hs | 2 +- src/Language/PureScript/Environment.hs | 12 ++--- src/Language/PureScript/Errors.hs | 16 +++---- src/Language/PureScript/Externs.hs | 12 ++--- src/Language/PureScript/Ide.hs | 30 ++++++------- src/Language/PureScript/Ide/CaseSplit.hs | 8 ++-- src/Language/PureScript/Ide/Command.hs | 12 ++--- src/Language/PureScript/Ide/Completion.hs | 10 ++--- src/Language/PureScript/Ide/Error.hs | 4 +- src/Language/PureScript/Ide/Externs.hs | 6 +-- src/Language/PureScript/Ide/Filter.hs | 10 ++--- .../PureScript/Ide/Filter/Declaration.hs | 2 +- src/Language/PureScript/Ide/Filter/Imports.hs | 4 +- src/Language/PureScript/Ide/Imports.hs | 4 +- .../PureScript/Ide/Imports/Actions.hs | 16 +++---- src/Language/PureScript/Ide/Logging.hs | 8 ++-- src/Language/PureScript/Ide/Matcher.hs | 8 ++-- src/Language/PureScript/Ide/Prim.hs | 2 +- src/Language/PureScript/Ide/Rebuild.hs | 12 ++--- src/Language/PureScript/Ide/Reexports.hs | 4 +- src/Language/PureScript/Ide/SourceFile.hs | 6 +-- src/Language/PureScript/Ide/State.hs | 18 ++++---- src/Language/PureScript/Ide/Types.hs | 2 +- src/Language/PureScript/Ide/Usage.hs | 2 +- src/Language/PureScript/Ide/Util.hs | 6 +-- src/Language/PureScript/Interactive.hs | 4 +- .../PureScript/Interactive/Completion.hs | 4 +- .../PureScript/Interactive/Directive.hs | 2 +- .../PureScript/Interactive/Message.hs | 2 +- src/Language/PureScript/Interactive/Module.hs | 2 +- src/Language/PureScript/Interactive/Parser.hs | 2 +- src/Language/PureScript/Linter.hs | 8 ++-- src/Language/PureScript/Linter/Exhaustive.hs | 18 ++++---- src/Language/PureScript/Linter/Imports.hs | 14 +++--- src/Language/PureScript/Linter/Wildcards.hs | 4 +- src/Language/PureScript/Make.hs | 30 ++++++------- src/Language/PureScript/Make/Actions.hs | 26 +++++------ src/Language/PureScript/Make/BuildPlan.hs | 14 +++--- src/Language/PureScript/Make/Monad.hs | 10 ++--- src/Language/PureScript/ModuleDependencies.hs | 10 ++--- src/Language/PureScript/Names.hs | 6 +-- src/Language/PureScript/Pretty/Common.hs | 2 +- src/Language/PureScript/Pretty/Types.hs | 15 +++---- src/Language/PureScript/Pretty/Values.hs | 10 ++--- src/Language/PureScript/Publish.hs | 8 ++-- .../PureScript/Publish/ErrorsWarnings.hs | 8 ++-- src/Language/PureScript/Publish/Utils.hs | 2 +- src/Language/PureScript/Renamer.hs | 8 ++-- src/Language/PureScript/Sugar.hs | 10 ++--- src/Language/PureScript/Sugar/AdoNotation.hs | 8 ++-- .../PureScript/Sugar/BindingGroups.hs | 12 ++--- .../PureScript/Sugar/CaseDeclarations.hs | 10 ++--- src/Language/PureScript/Sugar/DoNotation.hs | 10 ++--- src/Language/PureScript/Sugar/LetPattern.hs | 4 +- src/Language/PureScript/Sugar/Names.hs | 24 +++++----- src/Language/PureScript/Sugar/Names/Common.hs | 6 +-- src/Language/PureScript/Sugar/Names/Env.hs | 10 ++--- .../PureScript/Sugar/Names/Exports.hs | 10 ++--- .../PureScript/Sugar/Names/Imports.hs | 12 ++--- .../PureScript/Sugar/ObjectWildcards.hs | 6 +-- src/Language/PureScript/Sugar/Operators.hs | 16 +++---- .../PureScript/Sugar/Operators/Binders.hs | 10 ++--- .../PureScript/Sugar/Operators/Common.hs | 14 +++--- .../PureScript/Sugar/Operators/Expr.hs | 12 ++--- .../PureScript/Sugar/Operators/Types.hs | 12 ++--- src/Language/PureScript/Sugar/TypeClasses.hs | 16 +++---- .../PureScript/Sugar/TypeClasses/Deriving.hs | 14 +++--- .../PureScript/Sugar/TypeDeclarations.hs | 8 ++-- src/Language/PureScript/TypeChecker.hs | 20 ++++----- .../PureScript/TypeChecker/Deriving.hs | 28 ++++++------ .../PureScript/TypeChecker/Entailment.hs | 24 +++++----- .../TypeChecker/Entailment/Coercible.hs | 22 +++++----- src/Language/PureScript/TypeChecker/Kinds.hs | 16 +++---- src/Language/PureScript/TypeChecker/Monad.hs | 18 ++++---- src/Language/PureScript/TypeChecker/Roles.hs | 10 ++--- .../PureScript/TypeChecker/Skolems.hs | 10 ++--- .../PureScript/TypeChecker/Subsumption.hs | 16 +++---- .../PureScript/TypeChecker/Synonyms.hs | 12 ++--- .../PureScript/TypeChecker/TypeSearch.hs | 4 +- src/Language/PureScript/TypeChecker/Types.hs | 26 +++++------ src/Language/PureScript/TypeChecker/Unify.hs | 12 ++--- .../PureScript/TypeClassDictionaries.hs | 4 +- src/Language/PureScript/Types.hs | 4 +- .../Language/PureScript/Ide/CompletionSpec.hs | 6 +-- tests/Language/PureScript/Ide/FilterSpec.hs | 8 ++-- tests/Language/PureScript/Ide/ImportsSpec.hs | 12 ++--- tests/Language/PureScript/Ide/MatcherSpec.hs | 8 ++-- tests/Language/PureScript/Ide/RebuildSpec.hs | 12 ++--- .../Language/PureScript/Ide/ReexportsSpec.hs | 8 ++-- .../Language/PureScript/Ide/SourceFileSpec.hs | 8 ++-- tests/Language/PureScript/Ide/StateSpec.hs | 10 ++--- tests/Language/PureScript/Ide/Test.hs | 18 ++++---- tests/Language/PureScript/Ide/UsageSpec.hs | 8 ++-- tests/TestAst.hs | 16 +++---- tests/TestCompiler.hs | 14 +++--- tests/TestCoreFn.hs | 44 +++++++++---------- tests/TestCst.hs | 8 ++-- tests/TestDocs.hs | 6 +-- tests/TestGraph.hs | 2 +- tests/TestHierarchy.hs | 4 +- tests/TestMake.hs | 12 ++--- tests/TestPrimDocs.hs | 2 +- tests/TestPscPublish.hs | 8 ++-- tests/TestPsci.hs | 2 +- tests/TestPsci/CommandTest.hs | 6 +-- tests/TestPsci/CompletionTest.hs | 4 +- tests/TestPsci/EvalTest.hs | 4 +- tests/TestPsci/TestEnv.hs | 2 +- tests/TestSourceMaps.hs | 2 +- tests/TestUtils.hs | 20 ++++----- 176 files changed, 785 insertions(+), 788 deletions(-) diff --git a/app/Command/Compile.hs b/app/Command/Compile.hs index f5c82186e2..27fbb39d01 100644 --- a/app/Command/Compile.hs +++ b/app/Command/Compile.hs @@ -2,8 +2,8 @@ module Command.Compile (command) where import Prelude -import Control.Applicative -import Control.Monad +import Control.Applicative (Alternative(..)) +import Control.Monad (when) import Data.Aeson qualified as A import Data.Bool (bool) import Data.ByteString.Lazy.UTF8 qualified as LBU8 @@ -14,8 +14,8 @@ import Data.Text qualified as T import Data.Traversable (for) import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST -import Language.PureScript.Errors.JSON -import Language.PureScript.Make +import Language.PureScript.Errors.JSON (JSONResult(..), toJSONErrors) +import Language.PureScript.Make (buildMakeActions, inferForeignModules, runMake) import Options.Applicative qualified as Opts import System.Console.ANSI qualified as ANSI import System.Exit (exitSuccess, exitFailure) diff --git a/app/Command/Docs.hs b/app/Command/Docs.hs index bb30171afb..38c875083c 100644 --- a/app/Command/Docs.hs +++ b/app/Command/Docs.hs @@ -3,10 +3,10 @@ module Command.Docs (command, infoModList) where import Prelude -import Command.Docs.Html -import Command.Docs.Markdown -import Control.Applicative -import Control.Monad.Writer +import Command.Docs.Html (asHtml, writeHtmlModules) +import Command.Docs.Markdown (asMarkdown, writeMarkdownModules) +import Control.Applicative (Alternative(..), optional) +import Control.Monad.Writer (when) import Control.Monad.Trans.Except (runExceptT) import Data.Maybe (fromMaybe) import Data.Text qualified as T diff --git a/app/Command/Docs/Html.hs b/app/Command/Docs/Html.hs index 18fcb93720..6ad51041f3 100644 --- a/app/Command/Docs/Html.hs +++ b/app/Command/Docs/Html.hs @@ -7,9 +7,9 @@ module Command.Docs.Html import Prelude -import Control.Applicative +import Control.Applicative (Alternative(..)) import Control.Arrow ((&&&)) -import Control.Monad.Writer +import Control.Monad.Writer (guard) import Data.List (sort) import Data.Text (Text) import Data.Text.Lazy (toStrict) diff --git a/app/Command/Graph.hs b/app/Command/Graph.hs index 338a303c8e..4e3c905d9b 100644 --- a/app/Command/Graph.hs +++ b/app/Command/Graph.hs @@ -9,7 +9,7 @@ import Data.Bool (bool) import Data.ByteString.Lazy qualified as LB import Data.ByteString.Lazy.UTF8 qualified as LBU8 import Language.PureScript qualified as P -import Language.PureScript.Errors.JSON +import Language.PureScript.Errors.JSON (JSONResult(..), toJSONErrors) import Options.Applicative qualified as Opts import System.Console.ANSI qualified as ANSI import System.Exit (exitFailure) diff --git a/app/Command/Ide.hs b/app/Command/Ide.hs index cbb5270a9b..cfb563be4e 100644 --- a/app/Command/Ide.hs +++ b/app/Command/Ide.hs @@ -20,24 +20,24 @@ module Command.Ide (command) where import Protolude import Data.Aeson qualified as Aeson -import Control.Concurrent.STM -import "monad-logger" Control.Monad.Logger -import Data.IORef +import Control.Concurrent.STM (newTVarIO) +import "monad-logger" Control.Monad.Logger (MonadLogger, logDebug, logError, logInfo) +import Data.IORef (newIORef) import Data.Text.IO qualified as T import Data.ByteString.Char8 qualified as BS8 import Data.ByteString.Lazy.Char8 qualified as BSL8 import GHC.IO.Exception (IOErrorType(..), IOException(..)) -import Language.PureScript.Ide -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Util -import Language.PureScript.Ide.Error +import Language.PureScript.Ide (handleCommand) +import Language.PureScript.Ide.Command (Command(..), commandName) +import Language.PureScript.Ide.Util (decodeT, displayTimeSpec, encodeT, logPerf, runLogger) +import Language.PureScript.Ide.Error (IdeError(..)) import Language.PureScript.Ide.State (updateCacheTimestamp) -import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Types (Ide, IdeConfiguration(..), IdeEnvironment(..), IdeLogLevel(..), emptyIdeState) import Network.Socket qualified as Network import Options.Applicative qualified as Opts -import System.Directory -import System.FilePath -import System.IO hiding (putStrLn, print) +import System.Directory (doesDirectoryExist, getCurrentDirectory, setCurrentDirectory) +import System.FilePath (()) +import System.IO (BufferMode(..), hClose, hFlush, hSetBuffering, hSetEncoding, utf8) import System.IO.Error (isEOFError) listenOnLocalhost :: Network.PortNumber -> IO Network.Socket diff --git a/app/Command/Publish.hs b/app/Command/Publish.hs index 95e5f42ca0..b63d366c91 100644 --- a/app/Command/Publish.hs +++ b/app/Command/Publish.hs @@ -7,8 +7,8 @@ import Data.Aeson qualified as A import Data.ByteString.Lazy.Char8 qualified as BL import Data.Time.Clock (getCurrentTime) import Data.Version (Version(..)) -import Language.PureScript.Publish -import Language.PureScript.Publish.ErrorsWarnings +import Language.PureScript.Publish (PublishOptions(..), defaultPublishOptions, unsafePreparePackage, warn) +import Language.PureScript.Publish.ErrorsWarnings (PackageWarning(..)) import Options.Applicative (Parser) import Options.Applicative qualified as Opts diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index 194e2cc236..eb254be45c 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -5,10 +5,10 @@ module Command.REPL (command) where import Prelude import Control.Applicative (many, (<|>)) -import Control.Monad +import Control.Monad (unless, when) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class (liftIO, MonadIO) -import Control.Monad.Trans.Class +import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Except (ExceptT(..), runExceptT) import Control.Monad.Trans.State.Strict (StateT, evalStateT) import Control.Monad.Trans.Reader (ReaderT, runReaderT) @@ -17,9 +17,9 @@ import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST import Language.PureScript.Interactive import Options.Applicative qualified as Opts -import System.Console.Haskeline +import System.Console.Haskeline (InputT, Settings(..), defaultSettings, getInputLine, handleInterrupt, outputStrLn, runInputT, setComplete, withInterrupt) import System.IO.UTF8 (readUTF8File) -import System.Exit +import System.Exit (ExitCode(..), exitFailure) import System.Directory (doesFileExist, getCurrentDirectory) import System.FilePath (()) import System.FilePath.Glob qualified as Glob diff --git a/src/Control/Monad/Logger.hs b/src/Control/Monad/Logger.hs index 23469082a3..a3ed57b0da 100644 --- a/src/Control/Monad/Logger.hs +++ b/src/Control/Monad/Logger.hs @@ -7,11 +7,11 @@ import Prelude import Control.Monad (ap) import Control.Monad.Base (MonadBase(..)) -import Control.Monad.IO.Class +import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Control (MonadBaseControl(..)) -import Control.Monad.Writer.Class +import Control.Monad.Writer.Class (MonadWriter(..)) -import Data.IORef +import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) -- | A replacement for WriterT IO which uses mutable references. newtype Logger w a = Logger { runLogger :: IORef w -> IO a } diff --git a/src/Control/Monad/Supply.hs b/src/Control/Monad/Supply.hs index 1941fcf9b8..8c64fd2524 100644 --- a/src/Control/Monad/Supply.hs +++ b/src/Control/Monad/Supply.hs @@ -5,13 +5,13 @@ module Control.Monad.Supply where import Prelude -import Control.Applicative +import Control.Applicative (Alternative) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Reader -import Control.Monad.State -import Control.Monad.Writer +import Control.Monad.Reader (MonadPlus, MonadReader, MonadTrans) +import Control.Monad.State (StateT(..)) +import Control.Monad.Writer (MonadWriter) -import Data.Functor.Identity +import Data.Functor.Identity (Identity(..)) newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a } deriving (Functor, Applicative, Monad, MonadTrans, MonadError e, MonadWriter w, MonadReader r, Alternative, MonadPlus) diff --git a/src/Control/Monad/Supply/Class.hs b/src/Control/Monad/Supply/Class.hs index ff80893b31..e8656f0c69 100644 --- a/src/Control/Monad/Supply/Class.hs +++ b/src/Control/Monad/Supply/Class.hs @@ -6,10 +6,10 @@ module Control.Monad.Supply.Class where import Prelude -import Control.Monad.RWS -import Control.Monad.State -import Control.Monad.Supply -import Control.Monad.Writer +import Control.Monad.RWS (MonadState(..), MonadTrans(..), RWST) +import Control.Monad.State (StateT) +import Control.Monad.Supply (SupplyT(..)) +import Control.Monad.Writer (WriterT) import Data.Text (Text, pack) class Monad m => MonadSupply m where diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs index 748bb64bfb..6d88ff3d97 100644 --- a/src/Language/PureScript/AST/Binders.hs +++ b/src/Language/PureScript/AST/Binders.hs @@ -5,11 +5,11 @@ module Language.PureScript.AST.Binders where import Prelude -import Language.PureScript.AST.SourcePos -import Language.PureScript.AST.Literals -import Language.PureScript.Names -import Language.PureScript.Comments -import Language.PureScript.Types +import Language.PureScript.AST.SourcePos (SourceSpan) +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.Names (Ident, OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified) +import Language.PureScript.Comments (Comment) +import Language.PureScript.Types (SourceType) -- | -- Data type for binders diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs index 8112521acd..5d8555cdbd 100644 --- a/src/Language/PureScript/AST/Declarations.hs +++ b/src/Language/PureScript/AST/Declarations.hs @@ -11,27 +11,27 @@ import Protolude.Exceptions (hush) import Codec.Serialise (Serialise) import Control.DeepSeq (NFData) -import Data.Functor.Identity +import Data.Functor.Identity (Identity(..)) -import Data.Aeson.TH +import Data.Aeson.TH (Options(..), SumEncoding(..), defaultOptions, deriveJSON) import Data.Map qualified as M import Data.Text (Text) import Data.List.NonEmpty qualified as NEL import GHC.Generics (Generic) -import Language.PureScript.AST.Binders -import Language.PureScript.AST.Literals -import Language.PureScript.AST.Operators -import Language.PureScript.AST.SourcePos +import Language.PureScript.AST.Binders (Binder) +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.AST.Operators (Fixity) +import Language.PureScript.AST.SourcePos (SourceAnn, SourceSpan) import Language.PureScript.AST.Declarations.ChainId (ChainId) -import Language.PureScript.Types +import Language.PureScript.Types (SourceConstraint, SourceType) import Language.PureScript.PSString (PSString) import Language.PureScript.Label (Label) -import Language.PureScript.Names -import Language.PureScript.Roles -import Language.PureScript.TypeClassDictionaries -import Language.PureScript.Comments -import Language.PureScript.Environment +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName(..), Name(..), OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), toMaybeModuleName) +import Language.PureScript.Roles (Role) +import Language.PureScript.TypeClassDictionaries (NamedDict) +import Language.PureScript.Comments (Comment) +import Language.PureScript.Environment (DataDeclType, Environment, FunctionalDependency, NameKind) import Language.PureScript.Constants.Prim qualified as C -- | A map of locally-bound names in scope. diff --git a/src/Language/PureScript/AST/Exported.hs b/src/Language/PureScript/AST/Exported.hs index 20f963ee06..8ca960bb95 100644 --- a/src/Language/PureScript/AST/Exported.hs +++ b/src/Language/PureScript/AST/Exported.hs @@ -12,9 +12,9 @@ import Control.Applicative ((<|>)) import Data.Maybe (mapMaybe) import Data.Map qualified as M -import Language.PureScript.AST.Declarations -import Language.PureScript.Types -import Language.PureScript.Names +import Language.PureScript.AST.Declarations (DataConstructorDeclaration(..), Declaration(..), DeclarationRef(..), Module(..), declName, declRefName, flattenDecls) +import Language.PureScript.Types (Constraint(..), Type(..), everythingOnTypes) +import Language.PureScript.Names (ModuleName, Name(..), ProperName, ProperNameType(..), Qualified, coerceProperName, disqualify, isQualified, isQualifiedWith) -- | -- Return a list of all declarations which are exported from a module. diff --git a/src/Language/PureScript/AST/Operators.hs b/src/Language/PureScript/AST/Operators.hs index 9d3364f681..eb217a2444 100644 --- a/src/Language/PureScript/AST/Operators.hs +++ b/src/Language/PureScript/AST/Operators.hs @@ -11,7 +11,7 @@ import Control.DeepSeq (NFData) import Data.Aeson ((.=)) import Data.Aeson qualified as A -import Language.PureScript.Crash +import Language.PureScript.Crash (internalError) -- | -- A precedence level for an infix operator diff --git a/src/Language/PureScript/AST/SourcePos.hs b/src/Language/PureScript/AST/SourcePos.hs index 31811d8cb7..262d44b6a1 100644 --- a/src/Language/PureScript/AST/SourcePos.hs +++ b/src/Language/PureScript/AST/SourcePos.hs @@ -11,7 +11,7 @@ import Control.DeepSeq (NFData) import Data.Aeson ((.=), (.:)) import Data.Text (Text) import GHC.Generics (Generic) -import Language.PureScript.Comments +import Language.PureScript.Comments (Comment) import Data.Aeson qualified as A import Data.Text qualified as T import System.FilePath (makeRelative) diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs index cda37d8e7b..8aa8808a85 100644 --- a/src/Language/PureScript/AST/Traversals.hs +++ b/src/Language/PureScript/AST/Traversals.hs @@ -6,8 +6,8 @@ module Language.PureScript.AST.Traversals where import Prelude import Protolude (swap) -import Control.Monad -import Control.Monad.Trans.State +import Control.Monad ((<=<), (>=>)) +import Control.Monad.Trans.State (StateT(..)) import Data.Foldable (fold) import Data.Functor.Identity (runIdentity) @@ -17,13 +17,13 @@ import Data.List.NonEmpty qualified as NEL import Data.Map qualified as M import Data.Set qualified as S -import Language.PureScript.AST.Binders -import Language.PureScript.AST.Declarations -import Language.PureScript.AST.Literals -import Language.PureScript.Names -import Language.PureScript.Traversals +import Language.PureScript.AST.Binders (Binder(..), binderNames) +import Language.PureScript.AST.Declarations (CaseAlternative(..), DataConstructorDeclaration(..), Declaration(..), DoNotationElement(..), Expr(..), Guard(..), GuardedExpr(..), TypeDeclarationData(..), TypeInstanceBody(..), pattern ValueDecl, ValueDeclarationData(..), mapTypeInstanceBody, traverseTypeInstanceBody) +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident) +import Language.PureScript.Traversals (sndM, sndM', thirdM) import Language.PureScript.TypeClassDictionaries (TypeClassDictionaryInScope(..)) -import Language.PureScript.Types +import Language.PureScript.Types (Constraint(..), SourceType, mapConstraintArgs) guardedExprM :: Applicative m => (Guard -> m Guard) diff --git a/src/Language/PureScript/AST/Utils.hs b/src/Language/PureScript/AST/Utils.hs index a62ed5593e..d768a884fd 100644 --- a/src/Language/PureScript/AST/Utils.hs +++ b/src/Language/PureScript/AST/Utils.hs @@ -2,9 +2,9 @@ module Language.PureScript.AST.Utils where import Protolude -import Language.PureScript.AST -import Language.PureScript.Names -import Language.PureScript.Types +import Language.PureScript.AST (Binder(..), CaseAlternative, Expr(..), GuardedExpr, Literal, pattern MkUnguarded, nullSourceSpan) +import Language.PureScript.Names (Ident, ModuleName, ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName) +import Language.PureScript.Types (SourceType, Type(..)) lam :: Ident -> Expr -> Expr lam = Abs . mkBinder diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 3f612e7b9b..26b932323f 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -18,7 +18,7 @@ module Language.PureScript.Bundle import Prelude -import Control.Monad.Error.Class +import Control.Monad.Error.Class (MonadError(..)) import Data.Aeson ((.=)) import Data.Char (chr, digitToInt) @@ -27,9 +27,9 @@ import Data.Maybe (mapMaybe, maybeToList) import Data.Aeson qualified as A import Data.Text.Lazy qualified as LT -import Language.JavaScript.Parser -import Language.JavaScript.Parser.AST -import Language.JavaScript.Process.Minify +import Language.JavaScript.Parser (JSAST(..), JSAnnot(..), JSAssignOp(..), JSExpression(..), JSStatement(..), renderToText) +import Language.JavaScript.Parser.AST (JSCommaList(..), JSCommaTrailingList(..), JSExportClause(..), JSExportDeclaration(..), JSExportSpecifier(..), JSFromClause(..), JSIdent(..), JSImportDeclaration(..), JSModuleItem(..), JSObjectProperty(..), JSObjectPropertyList, JSPropertyName(..), JSVarInitializer(..)) +import Language.JavaScript.Process.Minify (minifyJS) -- | The type of error messages. We separate generation and rendering of errors using a data -- type, in case we need to match on error types later. diff --git a/src/Language/PureScript/CST/Errors.hs b/src/Language/PureScript/CST/Errors.hs index fdea6dcefa..5cdea343ef 100644 --- a/src/Language/PureScript/CST/Errors.hs +++ b/src/Language/PureScript/CST/Errors.hs @@ -13,9 +13,9 @@ import Prelude import Data.Text qualified as Text import Data.Char (isSpace, toUpper) -import Language.PureScript.CST.Layout -import Language.PureScript.CST.Print -import Language.PureScript.CST.Types +import Language.PureScript.CST.Layout (LayoutStack) +import Language.PureScript.CST.Print (printToken) +import Language.PureScript.CST.Types (SourcePos(..), SourceRange(..), SourceToken(..), Token(..)) import Text.Printf (printf) data ParserErrorType diff --git a/src/Language/PureScript/CST/Flatten.hs b/src/Language/PureScript/CST/Flatten.hs index fe20adecd3..c6e1b8c80a 100644 --- a/src/Language/PureScript/CST/Flatten.hs +++ b/src/Language/PureScript/CST/Flatten.hs @@ -4,7 +4,7 @@ import Prelude import Data.DList (DList) import Language.PureScript.CST.Types -import Language.PureScript.CST.Positions +import Language.PureScript.CST.Positions (advanceLeading, moduleRange, srcRange) flattenModule :: Module a -> DList SourceToken flattenModule m@(Module _ a b c d e f g) = diff --git a/src/Language/PureScript/CST/Layout.hs b/src/Language/PureScript/CST/Layout.hs index 6ab82153ec..989cf1563d 100644 --- a/src/Language/PureScript/CST/Layout.hs +++ b/src/Language/PureScript/CST/Layout.hs @@ -174,7 +174,7 @@ import Data.DList (snoc) import Data.DList qualified as DList import Data.Foldable (find) import Data.Function ((&)) -import Language.PureScript.CST.Types +import Language.PureScript.CST.Types (Comment, LineFeed, SourcePos(..), SourceRange(..), SourceToken(..), Token(..), TokenAnn(..)) type LayoutStack = [(SourcePos, LayoutDelim)] diff --git a/src/Language/PureScript/CST/Lexer.hs b/src/Language/PureScript/CST/Lexer.hs index bb8ec99571..726a76f26a 100644 --- a/src/Language/PureScript/CST/Lexer.hs +++ b/src/Language/PureScript/CST/Lexer.hs @@ -19,11 +19,11 @@ import Data.String (fromString) import Data.Text (Text) import Data.Text qualified as Text import Data.Text.PureScript qualified as Text -import Language.PureScript.CST.Errors -import Language.PureScript.CST.Monad hiding (token) -import Language.PureScript.CST.Layout -import Language.PureScript.CST.Positions -import Language.PureScript.CST.Types +import Language.PureScript.CST.Errors (ParserErrorInfo(..), ParserErrorType(..)) +import Language.PureScript.CST.Monad (LexResult, LexState(..), ParserM(..), throw) +import Language.PureScript.CST.Layout (LayoutDelim(..), insertLayout, lytToken, unwindLayout) +import Language.PureScript.CST.Positions (advanceLeading, advanceToken, advanceTrailing, applyDelta, textDelta) +import Language.PureScript.CST.Types (Comment(..), LineFeed(..), SourcePos(..), SourceRange(..), SourceStyle(..), SourceToken(..), Token(..), TokenAnn(..)) -- | Stops at the first lexing error and replaces it with TokEof. Otherwise, -- the parser will fail when it attempts to draw a lookahead token. diff --git a/src/Language/PureScript/CST/Monad.hs b/src/Language/PureScript/CST/Monad.hs index 9245c59dff..31887c890a 100644 --- a/src/Language/PureScript/CST/Monad.hs +++ b/src/Language/PureScript/CST/Monad.hs @@ -6,10 +6,10 @@ import Data.List (sortOn) import Data.List.NonEmpty qualified as NE import Data.Ord (comparing) import Data.Text (Text) -import Language.PureScript.CST.Errors -import Language.PureScript.CST.Layout -import Language.PureScript.CST.Positions -import Language.PureScript.CST.Types +import Language.PureScript.CST.Errors (ParserError, ParserErrorInfo(..), ParserErrorType(..), ParserWarning, ParserWarningType) +import Language.PureScript.CST.Layout (LayoutStack) +import Language.PureScript.CST.Positions (widen) +import Language.PureScript.CST.Types (Comment, LineFeed, SourcePos(..), SourceRange(..), SourceToken(..), Token, TokenAnn(..)) type LexResult = Either (LexState, ParserError) SourceToken diff --git a/src/Language/PureScript/CST/Print.hs b/src/Language/PureScript/CST/Print.hs index 9becaaf24c..f6d300ab67 100644 --- a/src/Language/PureScript/CST/Print.hs +++ b/src/Language/PureScript/CST/Print.hs @@ -15,7 +15,7 @@ import Prelude import Data.DList qualified as DList import Data.Text (Text) import Data.Text qualified as Text -import Language.PureScript.CST.Types +import Language.PureScript.CST.Types (Comment(..), LineFeed(..), Module, SourceStyle(..), SourceToken(..), Token(..), TokenAnn(..)) import Language.PureScript.CST.Flatten (flattenModule) printToken :: Token -> Text diff --git a/src/Language/PureScript/CST/Traversals.hs b/src/Language/PureScript/CST/Traversals.hs index 6d5627f8ac..23532915f1 100644 --- a/src/Language/PureScript/CST/Traversals.hs +++ b/src/Language/PureScript/CST/Traversals.hs @@ -2,7 +2,7 @@ module Language.PureScript.CST.Traversals where import Prelude -import Language.PureScript.CST.Types +import Language.PureScript.CST.Types (Separated(..)) everythingOnSeparated :: (r -> r -> r) -> (a -> r) -> Separated a -> r everythingOnSeparated op k (Separated hd tl) = go hd tl diff --git a/src/Language/PureScript/CST/Traversals/Type.hs b/src/Language/PureScript/CST/Traversals/Type.hs index c3e6c97ef4..c61e65ca3e 100644 --- a/src/Language/PureScript/CST/Traversals/Type.hs +++ b/src/Language/PureScript/CST/Traversals/Type.hs @@ -2,8 +2,8 @@ module Language.PureScript.CST.Traversals.Type where import Prelude -import Language.PureScript.CST.Types -import Language.PureScript.CST.Traversals +import Language.PureScript.CST.Types (Constraint(..), Labeled(..), Row(..), Type(..), Wrapped(..)) +import Language.PureScript.CST.Traversals (everythingOnSeparated) everythingOnTypes :: (r -> r -> r) -> (Type a -> r) -> Type a -> r everythingOnTypes op k = goTy diff --git a/src/Language/PureScript/CST/Utils.hs b/src/Language/PureScript/CST/Utils.hs index 2d7a152e2f..3d17a03ea2 100644 --- a/src/Language/PureScript/CST/Utils.hs +++ b/src/Language/PureScript/CST/Utils.hs @@ -11,10 +11,10 @@ import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text -import Language.PureScript.CST.Errors -import Language.PureScript.CST.Monad -import Language.PureScript.CST.Positions -import Language.PureScript.CST.Traversals.Type +import Language.PureScript.CST.Errors (ParserErrorType(..)) +import Language.PureScript.CST.Monad (Parser, addFailure, parseFail, pushBack) +import Language.PureScript.CST.Positions (TokenRange, binderRange, importDeclRange, recordUpdateRange, typeRange) +import Language.PureScript.CST.Traversals.Type (everythingOnTypes) import Language.PureScript.CST.Types import Language.PureScript.Names qualified as N import Language.PureScript.PSString (PSString, mkString) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index dae389474a..14d3e66610 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -13,7 +13,7 @@ import Control.Applicative (liftA2) import Control.Monad (forM, replicateM, void) import Control.Monad.Except (MonadError, throwError) import Control.Monad.Reader (MonadReader, asks) -import Control.Monad.Supply.Class +import Control.Monad.Supply.Class (MonadSupply, freshName) import Control.Monad.Writer (MonadWriter, runWriterT, writer) import Data.Bifunctor (first) @@ -28,20 +28,20 @@ import Data.String (fromString) import Data.Text (Text) import Data.Text qualified as T -import Language.PureScript.AST.SourcePos +import Language.PureScript.AST.SourcePos (SourceSpan, displayStartEndPos) import Language.PureScript.CodeGen.JS.Common as Common import Language.PureScript.CoreImp.AST (AST, InitializerEffects(..), everywhere, everywhereTopDownM, withSourceSpan) import Language.PureScript.CoreImp.AST qualified as AST import Language.PureScript.CoreImp.Module qualified as AST -import Language.PureScript.CoreImp.Optimizer -import Language.PureScript.CoreFn +import Language.PureScript.CoreImp.Optimizer (optimize) +import Language.PureScript.CoreFn (Ann, Bind(..), Binder(..), CaseAlternative(..), ConstructorType(..), Expr(..), Guard, Literal(..), Meta(..), Module(..), extractAnn, extractBinderAnn, modifyAnn, removeComments) import Language.PureScript.CoreFn.Laziness (applyLazinessTransform) -import Language.PureScript.Crash +import Language.PureScript.Crash (internalError) import Language.PureScript.Errors (ErrorMessageHint(..), SimpleErrorMessage(..), MultipleErrors(..), rethrow, errorMessage, errorMessage', rethrowWithPosition, addHint) -import Language.PureScript.Names -import Language.PureScript.Options +import Language.PureScript.Names (Ident(..), ModuleName, ProperName(..), Qualified(..), QualifiedBy(..), runIdent, runModuleName, showIdent, showQualified) +import Language.PureScript.Options (CodegenTarget(..), Options(..)) import Language.PureScript.PSString (PSString, mkString) import Language.PureScript.Traversals (sndM) import Language.PureScript.Constants.Prim qualified as C diff --git a/src/Language/PureScript/CodeGen/JS/Common.hs b/src/Language/PureScript/CodeGen/JS/Common.hs index 2e17518e2e..e029468908 100644 --- a/src/Language/PureScript/CodeGen/JS/Common.hs +++ b/src/Language/PureScript/CodeGen/JS/Common.hs @@ -3,12 +3,12 @@ module Language.PureScript.CodeGen.JS.Common where import Prelude -import Data.Char +import Data.Char (isAlpha, isAlphaNum, isDigit, ord) import Data.Text (Text) import Data.Text qualified as T -import Language.PureScript.Crash -import Language.PureScript.Names +import Language.PureScript.Crash (internalError) +import Language.PureScript.Names (Ident(..), InternalIdentData(..), ModuleName(..), ProperName(..), unusedIdent) moduleNameToJs :: ModuleName -> Text moduleNameToJs (ModuleName mn) = diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index 905cc34b63..6740e2a7a1 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -9,7 +9,7 @@ import Prelude import Control.Arrow ((<+>)) import Control.Monad (forM, mzero) import Control.Monad.State (StateT, evalStateT) -import Control.PatternArrows +import Control.PatternArrows (Operator(..), OperatorTable(..), Pattern(..), buildPrettyPrinter, mkPattern, mkPattern') import Control.Arrow qualified as A import Data.Maybe (fromMaybe) @@ -18,12 +18,12 @@ import Data.Text qualified as T import Data.List.NonEmpty qualified as NEL (toList) import Language.PureScript.AST (SourceSpan(..)) -import Language.PureScript.CodeGen.JS.Common -import Language.PureScript.CoreImp.AST -import Language.PureScript.CoreImp.Module -import Language.PureScript.Comments -import Language.PureScript.Crash -import Language.PureScript.Pretty.Common +import Language.PureScript.CodeGen.JS.Common (identCharToText, isValidJsIdentifier, nameIsJsBuiltIn, nameIsJsReserved) +import Language.PureScript.CoreImp.AST (AST(..), BinaryOperator(..), CIComments(..), UnaryOperator(..), getSourceSpan) +import Language.PureScript.CoreImp.Module (Export(..), Import(..), Module(..)) +import Language.PureScript.Comments (Comment(..)) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Pretty.Common (Emit(..), PrinterState(..), SMap, StrPos(..), addMapping', currentIndent, intercalate, parensPos, runPlainString, withIndent) import Language.PureScript.PSString (PSString, decodeString, prettyPrintStringJS) -- TODO (Christoph): Get rid of T.unpack / pack diff --git a/src/Language/PureScript/Comments.hs b/src/Language/PureScript/Comments.hs index b53b06774a..ee05cd9c31 100644 --- a/src/Language/PureScript/Comments.hs +++ b/src/Language/PureScript/Comments.hs @@ -11,7 +11,7 @@ import Control.DeepSeq (NFData) import Data.Text (Text) import GHC.Generics (Generic) -import Data.Aeson.TH +import Data.Aeson.TH (Options(..), SumEncoding(..), defaultOptions, deriveJSON) data Comment = LineComment Text diff --git a/src/Language/PureScript/Constants/Prim.hs b/src/Language/PureScript/Constants/Prim.hs index bd8580e748..08391155da 100644 --- a/src/Language/PureScript/Constants/Prim.hs +++ b/src/Language/PureScript/Constants/Prim.hs @@ -3,7 +3,7 @@ -- | Various constants which refer to things in Prim module Language.PureScript.Constants.Prim where -import Language.PureScript.Names +import Language.PureScript.Names (ModuleName) import Language.PureScript.Constants.TH qualified as TH $(TH.declare do diff --git a/src/Language/PureScript/Constants/TH.hs b/src/Language/PureScript/Constants/TH.hs index 10ded13093..2bc8a56d84 100644 --- a/src/Language/PureScript/Constants/TH.hs +++ b/src/Language/PureScript/Constants/TH.hs @@ -74,8 +74,8 @@ import Control.Monad.Trans.RWS (RWS, execRWS) import Control.Monad.Trans.Writer (Writer, execWriter) import Control.Monad.Writer.Class (tell) import Data.String (String) -import Language.Haskell.TH -import Language.PureScript.Names hiding (Name) +import Language.Haskell.TH (Dec, Name, Pat, Q, Type, conP, implBidir, litP, mkName, patSynD, patSynSigD, prefixPatSyn, stringL) +import Language.PureScript.Names (Ident(..), ModuleName(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..)) -- | Generate pattern synonyms corresponding to the provided PureScript -- declarations. diff --git a/src/Language/PureScript/CoreFn/Ann.hs b/src/Language/PureScript/CoreFn/Ann.hs index f6e70bd6e4..851f0da376 100644 --- a/src/Language/PureScript/CoreFn/Ann.hs +++ b/src/Language/PureScript/CoreFn/Ann.hs @@ -2,10 +2,10 @@ module Language.PureScript.CoreFn.Ann where import Prelude -import Language.PureScript.AST.SourcePos -import Language.PureScript.Comments -import Language.PureScript.CoreFn.Meta -import Language.PureScript.Types +import Language.PureScript.AST.SourcePos (SourceSpan) +import Language.PureScript.Comments (Comment) +import Language.PureScript.CoreFn.Meta (Meta) +import Language.PureScript.Types (SourceType) -- | -- Type alias for basic annotations diff --git a/src/Language/PureScript/CoreFn/Binders.hs b/src/Language/PureScript/CoreFn/Binders.hs index 997fff50a9..4b64b97c49 100644 --- a/src/Language/PureScript/CoreFn/Binders.hs +++ b/src/Language/PureScript/CoreFn/Binders.hs @@ -5,8 +5,8 @@ module Language.PureScript.CoreFn.Binders where import Prelude -import Language.PureScript.AST.Literals -import Language.PureScript.Names +import Language.PureScript.AST.Literals (Literal) +import Language.PureScript.Names (Ident, ProperName, ProperNameType(..), Qualified) -- | -- Data type for binders diff --git a/src/Language/PureScript/CoreFn/CSE.hs b/src/Language/PureScript/CoreFn/CSE.hs index 225f7a616e..6b339f7911 100644 --- a/src/Language/PureScript/CoreFn/CSE.hs +++ b/src/Language/PureScript/CoreFn/CSE.hs @@ -4,7 +4,7 @@ module Language.PureScript.CoreFn.CSE (optimizeCommonSubexpressions) where import Protolude hiding (pass) -import Control.Lens +import Control.Lens (At(..), makeLenses, non, view, (%~), (.=), (.~), (<>~), (^.)) import Control.Monad.Supply (Supply) import Control.Monad.Supply.Class (MonadSupply) import Control.Monad.RWS (MonadWriter, RWST, censor, evalRWST, listen, pass, tell) @@ -17,16 +17,16 @@ import Data.Maybe (fromJust) import Data.Semigroup (Min(..)) import Data.Semigroup.Generic (GenericSemigroupMonoid(..)) -import Language.PureScript.AST.Literals +import Language.PureScript.AST.Literals (Literal(..)) import Language.PureScript.AST.SourcePos (nullSourceSpan) import Language.PureScript.Constants.Libs qualified as C import Language.PureScript.CoreFn.Ann (Ann) -import Language.PureScript.CoreFn.Binders -import Language.PureScript.CoreFn.Expr +import Language.PureScript.CoreFn.Binders (Binder(..)) +import Language.PureScript.CoreFn.Expr (Bind(..), CaseAlternative(..), Expr(..)) import Language.PureScript.CoreFn.Meta (Meta(IsSyntheticApp)) -import Language.PureScript.CoreFn.Traversals +import Language.PureScript.CoreFn.Traversals (everywhereOnValues, traverseCoreFn) import Language.PureScript.Environment (dictTypeName) -import Language.PureScript.Names +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), Qualified(..), QualifiedBy(..), freshIdent, runIdent, toMaybeModuleName) import Language.PureScript.PSString (decodeString) -- | diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs index c5edfd6151..5b0f821be4 100644 --- a/src/Language/PureScript/CoreFn/Desugar.hs +++ b/src/Language/PureScript/CoreFn/Desugar.hs @@ -11,19 +11,19 @@ import Data.Tuple (swap) import Data.List.NonEmpty qualified as NEL import Data.Map qualified as M -import Language.PureScript.AST.Literals -import Language.PureScript.AST.SourcePos -import Language.PureScript.AST.Traversals -import Language.PureScript.Comments -import Language.PureScript.CoreFn.Ann -import Language.PureScript.CoreFn.Binders -import Language.PureScript.CoreFn.Expr -import Language.PureScript.CoreFn.Meta -import Language.PureScript.CoreFn.Module -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Names -import Language.PureScript.Types +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.AST.SourcePos (pattern NullSourceSpan, SourceSpan(..)) +import Language.PureScript.AST.Traversals (everythingOnValues) +import Language.PureScript.Comments (Comment) +import Language.PureScript.CoreFn.Ann (Ann, ssAnn) +import Language.PureScript.CoreFn.Binders (Binder(..)) +import Language.PureScript.CoreFn.Expr (Bind(..), CaseAlternative(..), Expr(..), Guard) +import Language.PureScript.CoreFn.Meta (ConstructorType(..), Meta(..)) +import Language.PureScript.CoreFn.Module (Module(..)) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (DataDeclType(..), Environment(..), NameKind(..), isDictTypeName, lookupConstructor, lookupValue) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), getQual) +import Language.PureScript.Types (SourceType) import Language.PureScript.AST qualified as A import Language.PureScript.Constants.Prim qualified as C diff --git a/src/Language/PureScript/CoreFn/Expr.hs b/src/Language/PureScript/CoreFn/Expr.hs index b2bb3441e7..aa8b13b942 100644 --- a/src/Language/PureScript/CoreFn/Expr.hs +++ b/src/Language/PureScript/CoreFn/Expr.hs @@ -7,9 +7,9 @@ import Prelude import Control.Arrow ((***)) -import Language.PureScript.AST.Literals -import Language.PureScript.CoreFn.Binders -import Language.PureScript.Names +import Language.PureScript.AST.Literals (Literal) +import Language.PureScript.CoreFn.Binders (Binder) +import Language.PureScript.Names (Ident, ProperName, ProperNameType(..), Qualified) import Language.PureScript.PSString (PSString) -- | diff --git a/src/Language/PureScript/CoreFn/FromJSON.hs b/src/Language/PureScript/CoreFn/FromJSON.hs index 50b5010259..04b4eda425 100644 --- a/src/Language/PureScript/CoreFn/FromJSON.hs +++ b/src/Language/PureScript/CoreFn/FromJSON.hs @@ -11,7 +11,7 @@ import Prelude import Control.Applicative ((<|>)) -import Data.Aeson +import Data.Aeson (FromJSON(..), Object, Value(..), withObject, withText, (.:)) import Data.Aeson.Types (Parser, listParser) import Data.Map.Strict qualified as M import Data.Text (Text) @@ -20,10 +20,10 @@ import Data.Vector qualified as V import Data.Version (Version, parseVersion) import Language.PureScript.AST.SourcePos (SourceSpan(..)) -import Language.PureScript.AST.Literals -import Language.PureScript.CoreFn.Ann -import Language.PureScript.CoreFn -import Language.PureScript.Names +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.CoreFn.Ann (Ann) +import Language.PureScript.CoreFn (Bind(..), Binder(..), CaseAlternative(..), ConstructorType(..), Expr(..), Guard, Meta(..), Module(..)) +import Language.PureScript.Names (Ident(..), ModuleName(..), ProperName(..), Qualified(..), QualifiedBy(..), unusedIdent) import Language.PureScript.PSString (PSString) import Text.ParserCombinators.ReadP (readP_to_S) diff --git a/src/Language/PureScript/CoreFn/Laziness.hs b/src/Language/PureScript/CoreFn/Laziness.hs index 24d7290108..42197f88d2 100644 --- a/src/Language/PureScript/CoreFn/Laziness.hs +++ b/src/Language/PureScript/CoreFn/Laziness.hs @@ -16,11 +16,11 @@ import Data.Map.Monoidal qualified as M import Data.Semigroup (Max(..)) import Data.Set qualified as S -import Language.PureScript.AST.SourcePos +import Language.PureScript.AST.SourcePos (SourcePos(..), SourceSpan(..), nullSourceSpan) import Language.PureScript.Constants.Libs qualified as C -import Language.PureScript.CoreFn -import Language.PureScript.Crash -import Language.PureScript.Names +import Language.PureScript.CoreFn (Ann, Bind, Expr(..), Literal(..), Meta(..), ssAnn, traverseCoreFn) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), InternalIdentData(..), ModuleName, Qualified(..), QualifiedBy(..), runIdent, runModuleName, toMaybeModuleName) import Language.PureScript.PSString (mkString) -- This module is responsible for ensuring that the bindings in recursive diff --git a/src/Language/PureScript/CoreFn/Meta.hs b/src/Language/PureScript/CoreFn/Meta.hs index cc70425e03..0baddca29b 100644 --- a/src/Language/PureScript/CoreFn/Meta.hs +++ b/src/Language/PureScript/CoreFn/Meta.hs @@ -5,7 +5,7 @@ module Language.PureScript.CoreFn.Meta where import Prelude -import Language.PureScript.Names +import Language.PureScript.Names (Ident) -- | -- Metadata annotations diff --git a/src/Language/PureScript/CoreFn/Module.hs b/src/Language/PureScript/CoreFn/Module.hs index ee6feff8d3..09f5189c4a 100644 --- a/src/Language/PureScript/CoreFn/Module.hs +++ b/src/Language/PureScript/CoreFn/Module.hs @@ -4,10 +4,10 @@ import Prelude import Data.Map.Strict (Map) -import Language.PureScript.AST.SourcePos -import Language.PureScript.Comments -import Language.PureScript.CoreFn.Expr -import Language.PureScript.Names +import Language.PureScript.AST.SourcePos (SourceSpan) +import Language.PureScript.Comments (Comment) +import Language.PureScript.CoreFn.Expr (Bind) +import Language.PureScript.Names (Ident, ModuleName) -- | -- The CoreFn module representation diff --git a/src/Language/PureScript/CoreFn/Optimizer.hs b/src/Language/PureScript/CoreFn/Optimizer.hs index 40a31ed3dc..340815be32 100644 --- a/src/Language/PureScript/CoreFn/Optimizer.hs +++ b/src/Language/PureScript/CoreFn/Optimizer.hs @@ -4,15 +4,15 @@ import Protolude hiding (Type, moduleName) import Control.Monad.Supply (Supply) import Data.List (lookup) -import Language.PureScript.AST.Literals -import Language.PureScript.AST.SourcePos -import Language.PureScript.CoreFn.Ann -import Language.PureScript.CoreFn.CSE -import Language.PureScript.CoreFn.Expr -import Language.PureScript.CoreFn.Module -import Language.PureScript.CoreFn.Traversals -import Language.PureScript.Label -import Language.PureScript.Types +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.AST.SourcePos (nullSourceSpan) +import Language.PureScript.CoreFn.Ann (Ann) +import Language.PureScript.CoreFn.CSE (optimizeCommonSubexpressions) +import Language.PureScript.CoreFn.Expr (Bind, Expr(..)) +import Language.PureScript.CoreFn.Module (Module(..)) +import Language.PureScript.CoreFn.Traversals (everywhereOnValues) +import Language.PureScript.Label (Label(..)) +import Language.PureScript.Types (pattern REmptyKinded, Type(..)) import Language.PureScript.Constants.Libs qualified as C import Language.PureScript.Constants.Prim qualified as C diff --git a/src/Language/PureScript/CoreFn/ToJSON.hs b/src/Language/PureScript/CoreFn/ToJSON.hs index ea71162176..cae56cd016 100644 --- a/src/Language/PureScript/CoreFn/ToJSON.hs +++ b/src/Language/PureScript/CoreFn/ToJSON.hs @@ -12,7 +12,7 @@ import Prelude import Control.Arrow ((***)) import Data.Either (isLeft) import Data.Map.Strict qualified as M -import Data.Aeson hiding ((.=)) +import Data.Aeson (ToJSON(..), Value(..), object) import Data.Aeson qualified import Data.Aeson.Key qualified import Data.Aeson.Types (Pair) @@ -20,10 +20,10 @@ import Data.Version (Version, showVersion) import Data.Text (Text) import Data.Text qualified as T -import Language.PureScript.AST.Literals +import Language.PureScript.AST.Literals (Literal(..)) import Language.PureScript.AST.SourcePos (SourceSpan(..)) -import Language.PureScript.CoreFn -import Language.PureScript.Names +import Language.PureScript.CoreFn (Ann, Bind(..), Binder(..), CaseAlternative(..), ConstructorType(..), Expr(..), Meta(..), Module(..)) +import Language.PureScript.Names (Ident, ModuleName(..), ProperName(..), Qualified(..), QualifiedBy(..), runIdent) import Language.PureScript.PSString (PSString) constructorTypeToJSON :: ConstructorType -> Value diff --git a/src/Language/PureScript/CoreFn/Traversals.hs b/src/Language/PureScript/CoreFn/Traversals.hs index c223e37adc..16d6a34003 100644 --- a/src/Language/PureScript/CoreFn/Traversals.hs +++ b/src/Language/PureScript/CoreFn/Traversals.hs @@ -8,9 +8,9 @@ import Prelude import Control.Arrow (second, (***), (+++)) import Data.Bitraversable (bitraverse) -import Language.PureScript.AST.Literals -import Language.PureScript.CoreFn.Binders -import Language.PureScript.CoreFn.Expr +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.CoreFn.Binders (Binder(..)) +import Language.PureScript.CoreFn.Expr (Bind(..), CaseAlternative(..), Expr(..)) everywhereOnValues :: (Bind a -> Bind a) -> (Expr a -> Expr a) -> diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs index 5812bfd284..9711890a3e 100644 --- a/src/Language/PureScript/CoreImp/AST.hs +++ b/src/Language/PureScript/CoreImp/AST.hs @@ -8,10 +8,10 @@ import Control.Monad.Identity (Identity(..), runIdentity) import Data.Text (Text) import Language.PureScript.AST (SourceSpan(..)) -import Language.PureScript.Comments +import Language.PureScript.Comments (Comment) import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (PSString) -import Language.PureScript.Traversals +import Language.PureScript.Traversals (sndM) -- | Built-in unary operators data UnaryOperator diff --git a/src/Language/PureScript/CoreImp/Module.hs b/src/Language/PureScript/CoreImp/Module.hs index 5460a012cd..bdf4b8185d 100644 --- a/src/Language/PureScript/CoreImp/Module.hs +++ b/src/Language/PureScript/CoreImp/Module.hs @@ -3,8 +3,8 @@ module Language.PureScript.CoreImp.Module where import Protolude import Data.List.NonEmpty qualified as NEL (NonEmpty) -import Language.PureScript.Comments -import Language.PureScript.CoreImp.AST +import Language.PureScript.Comments (Comment) +import Language.PureScript.CoreImp.AST (AST) import Language.PureScript.PSString (PSString) data Module = Module diff --git a/src/Language/PureScript/CoreImp/Optimizer.hs b/src/Language/PureScript/CoreImp/Optimizer.hs index 4892df9b20..e59738df76 100644 --- a/src/Language/PureScript/CoreImp/Optimizer.hs +++ b/src/Language/PureScript/CoreImp/Optimizer.hs @@ -24,13 +24,13 @@ import Prelude import Data.Text (Text) import Control.Monad.Supply.Class (MonadSupply) -import Language.PureScript.CoreImp.AST -import Language.PureScript.CoreImp.Optimizer.Blocks -import Language.PureScript.CoreImp.Optimizer.Common -import Language.PureScript.CoreImp.Optimizer.Inliner -import Language.PureScript.CoreImp.Optimizer.MagicDo -import Language.PureScript.CoreImp.Optimizer.TCO -import Language.PureScript.CoreImp.Optimizer.Unused +import Language.PureScript.CoreImp.AST (AST(..), InitializerEffects(..)) +import Language.PureScript.CoreImp.Optimizer.Blocks (collapseNestedBlocks, collapseNestedIfs) +import Language.PureScript.CoreImp.Optimizer.Common (applyAll, replaceIdents) +import Language.PureScript.CoreImp.Optimizer.Inliner (etaConvert, evaluateIifes, inlineCommonOperators, inlineCommonValues, inlineFnComposition, inlineFnIdentity, inlineUnsafeCoerce, inlineUnsafePartial, inlineVariables, unThunk) +import Language.PureScript.CoreImp.Optimizer.MagicDo (inlineST, magicDoEff, magicDoEffect, magicDoST) +import Language.PureScript.CoreImp.Optimizer.TCO (tco) +import Language.PureScript.CoreImp.Optimizer.Unused (removeCodeAfterReturnStatements, removeUndefinedApp, removeUnusedEffectFreeVars) -- | Apply a series of optimizer passes to simplified JavaScript code optimize :: forall m. MonadSupply m => [Text] -> [[AST]] -> m [[AST]] diff --git a/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs b/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs index c4e8c40af9..add5d7c953 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs @@ -6,7 +6,7 @@ module Language.PureScript.CoreImp.Optimizer.Blocks import Prelude -import Language.PureScript.CoreImp.AST +import Language.PureScript.CoreImp.AST (AST(..), BinaryOperator(..), everywhere) -- | Collapse blocks which appear nested directly below another block collapseNestedBlocks :: AST -> AST diff --git a/src/Language/PureScript/CoreImp/Optimizer/Common.hs b/src/Language/PureScript/CoreImp/Optimizer/Common.hs index b984fcf0a5..ac63f6a2bb 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Common.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Common.hs @@ -7,8 +7,8 @@ import Data.Text (Text) import Data.List (foldl') import Data.Maybe (fromMaybe) -import Language.PureScript.Crash -import Language.PureScript.CoreImp.AST +import Language.PureScript.Crash (internalError) +import Language.PureScript.CoreImp.AST (AST(..), everything, everywhere) import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (PSString) diff --git a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs index 0e3dd5a8c5..e7314df971 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs @@ -23,8 +23,8 @@ import Data.Text qualified as T import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (PSString, mkString) -import Language.PureScript.CoreImp.AST -import Language.PureScript.CoreImp.Optimizer.Common +import Language.PureScript.CoreImp.AST (AST(..), BinaryOperator(..), InitializerEffects(..), UnaryOperator(..), everywhere, everywhereTopDown, everywhereTopDownM, getSourceSpan) +import Language.PureScript.CoreImp.Optimizer.Common (pattern Ref, applyAll, isReassigned, isRebound, isUpdated, removeFromBlock, replaceIdent, replaceIdents) import Language.PureScript.AST (SourceSpan(..)) import Language.PureScript.Constants.Libs qualified as C import Language.PureScript.Constants.Prim qualified as C diff --git a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs index 5b933c2cdb..b591675793 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs @@ -7,8 +7,8 @@ import Protolude (ordNub) import Data.Maybe (fromJust, isJust) -import Language.PureScript.CoreImp.AST -import Language.PureScript.CoreImp.Optimizer.Common +import Language.PureScript.CoreImp.AST (AST(..), InitializerEffects(..), UnaryOperator(..), everything, everywhere, everywhereTopDown) +import Language.PureScript.CoreImp.Optimizer.Common (pattern Ref) import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (mkString) import Language.PureScript.Constants.Libs qualified as C diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs index 7defbe66c3..34746ae3db 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs @@ -9,7 +9,7 @@ import Control.Monad.State (State, evalState, get, modify) import Data.Functor (($>), (<&>)) import Data.Set qualified as S import Data.Text (Text, pack) -import Language.PureScript.CoreImp.AST +import Language.PureScript.CoreImp.AST (AST(..), InitializerEffects(..), UnaryOperator(..), everything, everywhereTopDownM) import Language.PureScript.AST.SourcePos (SourceSpan) import Safe (headDef, tailSafe) diff --git a/src/Language/PureScript/CoreImp/Optimizer/Unused.hs b/src/Language/PureScript/CoreImp/Optimizer/Unused.hs index a06eaf5660..7b7acd1279 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/Unused.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/Unused.hs @@ -12,8 +12,8 @@ import Data.Monoid (Any(..)) import Data.Set qualified as S import Data.Text (Text) -import Language.PureScript.CoreImp.AST -import Language.PureScript.CoreImp.Optimizer.Common +import Language.PureScript.CoreImp.AST (AST(..), InitializerEffects(..), everything, everywhere) +import Language.PureScript.CoreImp.Optimizer.Common (removeFromBlock) import Language.PureScript.Constants.Prim qualified as C removeCodeAfterReturnStatements :: AST -> AST diff --git a/src/Language/PureScript/Docs/AsHtml.hs b/src/Language/PureScript/Docs/AsHtml.hs index e05cf220aa..e4460183af 100644 --- a/src/Language/PureScript/Docs/AsHtml.hs +++ b/src/Language/PureScript/Docs/AsHtml.hs @@ -34,7 +34,7 @@ import Cheapskate qualified import Language.PureScript qualified as P import Language.PureScript.Docs.Types -import Language.PureScript.Docs.RenderedCode hiding (sp) +import Language.PureScript.Docs.RenderedCode (Link(..), outputWith) import Language.PureScript.Docs.Render qualified as Render import Language.PureScript.CST qualified as CST diff --git a/src/Language/PureScript/Docs/AsMarkdown.hs b/src/Language/PureScript/Docs/AsMarkdown.hs index 530feba933..82139ccbe4 100644 --- a/src/Language/PureScript/Docs/AsMarkdown.hs +++ b/src/Language/PureScript/Docs/AsMarkdown.hs @@ -15,8 +15,8 @@ import Data.List (partition) import Data.Text (Text) import Data.Text qualified as T -import Language.PureScript.Docs.RenderedCode -import Language.PureScript.Docs.Types +import Language.PureScript.Docs.RenderedCode (RenderedCode, RenderedCodeElement(..), outputWith) +import Language.PureScript.Docs.Types (ChildDeclaration(..), ChildDeclarationInfo(..), Declaration(..), Module(..), ignorePackage) import Language.PureScript qualified as P import Language.PureScript.Docs.Render qualified as Render diff --git a/src/Language/PureScript/Docs/Collect.hs b/src/Language/PureScript/Docs/Collect.hs index 3570ecf2fe..0da65d2251 100644 --- a/src/Language/PureScript/Docs/Collect.hs +++ b/src/Language/PureScript/Docs/Collect.hs @@ -17,7 +17,7 @@ import System.IO.UTF8 (readUTF8FileT, readUTF8FilesT) import Language.PureScript.Docs.Convert.ReExports (updateReExports) import Language.PureScript.Docs.Prim (primModules) -import Language.PureScript.Docs.Types +import Language.PureScript.Docs.Types (InPackage(..), Module(..), asModule, displayPackageError, ignorePackage) import Language.PureScript.AST qualified as P import Language.PureScript.CST qualified as P diff --git a/src/Language/PureScript/Docs/Convert.hs b/src/Language/PureScript/Docs/Convert.hs index 094577f80a..9e3ff10cf6 100644 --- a/src/Language/PureScript/Docs/Convert.hs +++ b/src/Language/PureScript/Docs/Convert.hs @@ -16,7 +16,7 @@ import Data.String (String) import Data.Text qualified as T import Language.PureScript.Docs.Convert.Single (convertSingleModule) -import Language.PureScript.Docs.Types +import Language.PureScript.Docs.Types (Declaration(..), DeclarationInfo(..), KindInfo(..), Module(..), Type') import Language.PureScript.CST qualified as CST import Language.PureScript.AST qualified as P import Language.PureScript.Crash qualified as P diff --git a/src/Language/PureScript/Docs/Convert/ReExports.hs b/src/Language/PureScript/Docs/Convert/ReExports.hs index 9ce51d4433..9574f0fe7d 100644 --- a/src/Language/PureScript/Docs/Convert/ReExports.hs +++ b/src/Language/PureScript/Docs/Convert/ReExports.hs @@ -5,13 +5,13 @@ module Language.PureScript.Docs.Convert.ReExports import Prelude import Control.Arrow ((&&&), first, second) -import Control.Monad +import Control.Monad (foldM, (<=<)) import Control.Monad.Reader.Class (MonadReader, ask) import Control.Monad.State.Class (MonadState, gets, modify) import Control.Monad.Trans.Reader (runReaderT) import Control.Monad.Trans.State.Strict (execState) -import Data.Either +import Data.Either (partitionEithers) import Data.Foldable (fold, traverse_) import Data.Map (Map) import Data.Maybe (mapMaybe) diff --git a/src/Language/PureScript/Docs/Convert/Single.hs b/src/Language/PureScript/Docs/Convert/Single.hs index 50a6fe0c88..b3b15e7b4f 100644 --- a/src/Language/PureScript/Docs/Convert/Single.hs +++ b/src/Language/PureScript/Docs/Convert/Single.hs @@ -9,7 +9,7 @@ import Control.Category ((>>>)) import Data.Text qualified as T -import Language.PureScript.Docs.Types +import Language.PureScript.Docs.Types (ChildDeclaration(..), ChildDeclarationInfo(..), Declaration(..), DeclarationInfo(..), KindInfo(..), Module(..), Type', convertFundepsToStrings, isType, isTypeClass) import Language.PureScript.AST qualified as P import Language.PureScript.Comments qualified as P diff --git a/src/Language/PureScript/Docs/Prim.hs b/src/Language/PureScript/Docs/Prim.hs index 4b19adbac3..801a64bc6f 100644 --- a/src/Language/PureScript/Docs/Prim.hs +++ b/src/Language/PureScript/Docs/Prim.hs @@ -11,7 +11,7 @@ import Data.Functor (($>)) import Data.Text (Text) import Data.Text qualified as T import Data.Map qualified as Map -import Language.PureScript.Docs.Types +import Language.PureScript.Docs.Types (Declaration(..), DeclarationInfo(..), Module(..), Type', convertFundepsToStrings) import Language.PureScript.Constants.Prim qualified as P import Language.PureScript.Crash qualified as P diff --git a/src/Language/PureScript/Docs/Render.hs b/src/Language/PureScript/Docs/Render.hs index 31629d0fe8..3a0038d989 100644 --- a/src/Language/PureScript/Docs/Render.hs +++ b/src/Language/PureScript/Docs/Render.hs @@ -16,8 +16,8 @@ import Data.Text (Text) import Data.Text qualified as T import Language.PureScript.Docs.RenderedCode -import Language.PureScript.Docs.Types -import Language.PureScript.Docs.Utils.MonoidExtras +import Language.PureScript.Docs.Types (ChildDeclaration(..), ChildDeclarationInfo(..), Constraint', Declaration(..), DeclarationInfo(..), KindInfo(..), Type', isTypeClassMember, kindSignatureForKeyword) +import Language.PureScript.Docs.Utils.MonoidExtras (mintersperse) import Language.PureScript.AST qualified as P import Language.PureScript.Environment qualified as P diff --git a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs index 7234778bc0..a0d55988d9 100644 --- a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs +++ b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs @@ -21,16 +21,16 @@ import Data.List (uncons) import Control.Arrow ((<+>)) import Control.PatternArrows as PA -import Language.PureScript.Crash -import Language.PureScript.Label -import Language.PureScript.Names -import Language.PureScript.Pretty.Types -import Language.PureScript.Roles -import Language.PureScript.Types +import Language.PureScript.Crash (internalError) +import Language.PureScript.Label (Label) +import Language.PureScript.Names (coerceProperName) +import Language.PureScript.Pretty.Types (PrettyPrintConstraint, PrettyPrintType(..), convertPrettyPrintType, prettyPrintLabel) +import Language.PureScript.Roles (Role, displayRole) +import Language.PureScript.Types (Type) import Language.PureScript.PSString (prettyPrintString) -import Language.PureScript.Docs.RenderedCode.Types -import Language.PureScript.Docs.Utils.MonoidExtras +import Language.PureScript.Docs.RenderedCode.Types (RenderedCode, keywordForall, roleAnn, sp, syntax, typeCtor, typeOp, typeVar) +import Language.PureScript.Docs.Utils.MonoidExtras (mintersperse) typeLiterals :: Pattern () PrettyPrintType RenderedCode typeLiterals = mkPattern match diff --git a/src/Language/PureScript/Docs/RenderedCode/Types.hs b/src/Language/PureScript/Docs/RenderedCode/Types.hs index 9b8c6f9b5b..c1374899f5 100644 --- a/src/Language/PureScript/Docs/RenderedCode/Types.hs +++ b/src/Language/PureScript/Docs/RenderedCode/Types.hs @@ -45,7 +45,7 @@ import Data.Text qualified as T import Data.ByteString.Lazy qualified as BS import Data.Text.Encoding qualified as TE -import Language.PureScript.Names +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, OpName(..), OpNameType(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), moduleNameFromString, runIdent, runModuleName) import Language.PureScript.AST (Associativity(..)) -- | Given a list of actions, attempt them all, returning the first success. diff --git a/src/Language/PureScript/Docs/Tags.hs b/src/Language/PureScript/Docs/Tags.hs index 2b9a2b0172..e3651c9fa0 100644 --- a/src/Language/PureScript/Docs/Tags.hs +++ b/src/Language/PureScript/Docs/Tags.hs @@ -11,7 +11,7 @@ import Data.List (sort) import Data.Maybe (mapMaybe) import Data.Text qualified as T import Language.PureScript.AST (SourceSpan, sourcePosLine, spanStart) -import Language.PureScript.Docs.Types +import Language.PureScript.Docs.Types (ChildDeclaration(..), Declaration(..), Module(..)) tags :: Module -> [(String, Int)] tags = map (first T.unpack) . concatMap dtags . modDeclarations diff --git a/src/Language/PureScript/Docs/Types.hs b/src/Language/PureScript/Docs/Types.hs index d9ac6ab849..c4e6cbecaa 100644 --- a/src/Language/PureScript/Docs/Types.hs +++ b/src/Language/PureScript/Docs/Types.hs @@ -19,7 +19,7 @@ import Data.Aeson.BetterErrors import Data.Map qualified as Map import Data.Time.Clock (UTCTime) import Data.Time.Format qualified as TimeFormat -import Data.Version +import Data.Version (Version(..), showVersion) import Data.Aeson qualified as A import Data.Text qualified as T import Data.Vector qualified as V @@ -33,7 +33,7 @@ import Language.PureScript.Roles qualified as P import Language.PureScript.Types qualified as P import Paths_purescript qualified as Paths -import Web.Bower.PackageMeta hiding (Version, displayError) +import Web.Bower.PackageMeta (BowerError, PackageMeta(..), PackageName, asPackageMeta, parsePackageName, runPackageName, showBowerError) import Language.PureScript.Docs.RenderedCode as ReExports (RenderedCode, diff --git a/src/Language/PureScript/Docs/Utils/MonoidExtras.hs b/src/Language/PureScript/Docs/Utils/MonoidExtras.hs index 0d4d0bfd7f..6f2bf370e7 100644 --- a/src/Language/PureScript/Docs/Utils/MonoidExtras.hs +++ b/src/Language/PureScript/Docs/Utils/MonoidExtras.hs @@ -1,6 +1,6 @@ module Language.PureScript.Docs.Utils.MonoidExtras where -import Data.Monoid +import Data.Monoid (Monoid(..), (<>)) mintersperse :: (Monoid m) => m -> [m] -> m mintersperse _ [] = mempty diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs index ab995eb12e..a1ef8c3fbe 100644 --- a/src/Language/PureScript/Environment.hs +++ b/src/Language/PureScript/Environment.hs @@ -20,12 +20,12 @@ import Data.Text (Text) import Data.Text qualified as T import Data.List.NonEmpty qualified as NEL -import Language.PureScript.AST.SourcePos -import Language.PureScript.Crash -import Language.PureScript.Names -import Language.PureScript.Roles -import Language.PureScript.TypeClassDictionaries -import Language.PureScript.Types +import Language.PureScript.AST.SourcePos (nullSourceAnn) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Names (Ident, ProperName(..), ProperNameType(..), Qualified, QualifiedBy, coerceProperName) +import Language.PureScript.Roles (Role(..)) +import Language.PureScript.TypeClassDictionaries (NamedDict) +import Language.PureScript.Types (SourceConstraint, SourceType, Type(..), eqType, srcTypeConstructor) import Language.PureScript.Constants.Prim qualified as C -- | The @Environment@ defines all values and types which are currently in scope: diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index bcdfee61d2..4fc63d4419 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -9,10 +9,10 @@ import Protolude (unsnoc) import Control.Arrow ((&&&)) import Control.Exception (displayException) import Control.Lens (both, head1, over) -import Control.Monad +import Control.Monad (forM, unless) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Trans.State.Lazy -import Control.Monad.Writer +import Control.Monad.Trans.State.Lazy (State, evalState, get, put) +import Control.Monad.Writer (Last(..), MonadWriter(..), censor) import Data.Bifunctor (first, second) import Data.Bitraversable (bitraverse) import Data.Char (isSpace) @@ -37,17 +37,17 @@ import Language.PureScript.AST import Language.PureScript.Bundle qualified as Bundle import Language.PureScript.Constants.Libs qualified as C import Language.PureScript.Constants.Prim qualified as C -import Language.PureScript.Crash +import Language.PureScript.Crash (internalError) import Language.PureScript.CST.Errors qualified as CST import Language.PureScript.CST.Print qualified as CST import Language.PureScript.Label (Label(..)) import Language.PureScript.Names -import Language.PureScript.Pretty +import Language.PureScript.Pretty (prettyPrintBinderAtom, prettyPrintLabel, prettyPrintObjectKey, prettyPrintSuggestedType, prettyPrintValue, typeAsBox, typeAtomAsBox, typeDiffAsBox) import Language.PureScript.Pretty.Common (endWith) import Language.PureScript.PSString (decodeStringWithReplacement) -import Language.PureScript.Roles -import Language.PureScript.Traversals -import Language.PureScript.Types +import Language.PureScript.Roles (Role, displayRole) +import Language.PureScript.Traversals (sndM) +import Language.PureScript.Types (Constraint(..), ConstraintData(..), RowListItem(..), SourceConstraint, SourceType, Type(..), eraseForAllKindAnnotations, eraseKindApps, everywhereOnTypesTopDownM, getAnnForType, overConstraintArgs, rowFromList, rowToList, srcTUnknown) import Language.PureScript.Publish.BoxesHelpers qualified as BoxHelpers import System.Console.ANSI qualified as ANSI import System.FilePath (makeRelative) diff --git a/src/Language/PureScript/Externs.hs b/src/Language/PureScript/Externs.hs index 83cd88147f..12838a1bcd 100644 --- a/src/Language/PureScript/Externs.hs +++ b/src/Language/PureScript/Externs.hs @@ -28,13 +28,13 @@ import Data.Version (showVersion) import Data.Map qualified as M import Data.List.NonEmpty qualified as NEL -import Language.PureScript.AST +import Language.PureScript.AST (Associativity, Declaration(..), DeclarationRef(..), Fixity(..), ImportDeclarationType, Module(..), NameSource(..), Precedence, SourceSpan, pattern TypeFixityDeclaration, pattern ValueFixityDeclaration, getTypeOpRef, getValueOpRef) import Language.PureScript.AST.Declarations.ChainId (ChainId) -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Names -import Language.PureScript.TypeClassDictionaries -import Language.PureScript.Types +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (DataDeclType, Environment(..), FunctionalDependency, NameKind(..), NameVisibility(..), TypeClassData(..), TypeKind(..), dictTypeName, makeTypeClassData) +import Language.PureScript.Names (Ident, ModuleName, OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, isPlainIdent) +import Language.PureScript.TypeClassDictionaries (NamedDict, TypeClassDictionaryInScope(..)) +import Language.PureScript.Types (SourceConstraint, SourceType, srcInstanceType) import Paths_purescript as Paths diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs index a7b4eb5095..746eec259b 100644 --- a/src/Language/PureScript/Ide.hs +++ b/src/Language/PureScript/Ide.hs @@ -20,25 +20,25 @@ module Language.PureScript.Ide import Protolude hiding (moduleName) -import "monad-logger" Control.Monad.Logger +import "monad-logger" Control.Monad.Logger (MonadLogger, logWarnN) import Data.Map qualified as Map import Data.Text qualified as T import Language.PureScript qualified as P import Language.PureScript.Ide.CaseSplit qualified as CS -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Externs -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Imports hiding (Import) -import Language.PureScript.Ide.Imports.Actions -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Prim -import Language.PureScript.Ide.Rebuild -import Language.PureScript.Ide.SourceFile -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Command (Command(..), ImportCommand(..), ListType(..)) +import Language.PureScript.Ide.Completion (CompletionOptions, completionFromMatch, getCompletions, getExactCompletions, simpleExport) +import Language.PureScript.Ide.Error (IdeError(..)) +import Language.PureScript.Ide.Externs (readExternFile) +import Language.PureScript.Ide.Filter (Filter) +import Language.PureScript.Ide.Imports (parseImportsFromFile) +import Language.PureScript.Ide.Imports.Actions (addImplicitImport, addImportForIdentifier, addQualifiedImport, answerRequest) +import Language.PureScript.Ide.Matcher (Matcher) +import Language.PureScript.Ide.Prim (idePrimDeclarations) +import Language.PureScript.Ide.Rebuild (rebuildFileAsync, rebuildFileSync) +import Language.PureScript.Ide.SourceFile (parseModulesFromFiles) +import Language.PureScript.Ide.State (getAllModules, getLoadedModulenames, insertExterns, insertModule, populateVolatileState, populateVolatileStateSync, resetIdeState) +import Language.PureScript.Ide.Types (Annotation(..), Ide, IdeConfiguration(..), IdeDeclarationAnn(..), IdeEnvironment(..), Success(..)) +import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration, namespaceForDeclaration, withEmptyAnn) import Language.PureScript.Ide.Usage (findUsages) import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist) import System.FilePath ((), normalise) diff --git a/src/Language/PureScript/Ide/CaseSplit.hs b/src/Language/PureScript/Ide/CaseSplit.hs index db2174ebe1..56cb464f05 100644 --- a/src/Language/PureScript/Ide/CaseSplit.hs +++ b/src/Language/PureScript/Ide/CaseSplit.hs @@ -29,10 +29,10 @@ import Data.Text qualified as T import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST -import Language.PureScript.Externs -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Types +import Language.PureScript.Externs (ExternsDeclaration(..), ExternsFile(..)) +import Language.PureScript.Ide.Error (IdeError(..)) +import Language.PureScript.Ide.State (cachedRebuild, getExternFiles) +import Language.PureScript.Ide.Types (Ide) type Constructor = (P.ProperName 'P.ConstructorName, [P.SourceType]) diff --git a/src/Language/PureScript/Ide/Command.hs b/src/Language/PureScript/Ide/Command.hs index ace3a05a1e..ae4b6c9d8e 100644 --- a/src/Language/PureScript/Ide/Command.hs +++ b/src/Language/PureScript/Ide/Command.hs @@ -17,15 +17,15 @@ module Language.PureScript.Ide.Command where import Protolude import Control.Monad.Fail (fail) -import Data.Aeson +import Data.Aeson (FromJSON(..), withObject, (.!=), (.:), (.:?)) import Data.Map qualified as Map import Data.Set qualified as Set import Language.PureScript qualified as P -import Language.PureScript.Ide.CaseSplit -import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Types +import Language.PureScript.Ide.CaseSplit (WildcardAnnotations, explicitAnnotations, noAnnotations) +import Language.PureScript.Ide.Completion (CompletionOptions, defaultCompletionOptions) +import Language.PureScript.Ide.Filter (Filter) +import Language.PureScript.Ide.Matcher (Matcher) +import Language.PureScript.Ide.Types (IdeDeclarationAnn, IdeNamespace) data Command = Load [P.ModuleName] diff --git a/src/Language/PureScript/Ide/Completion.hs b/src/Language/PureScript/Ide/Completion.hs index 78edbf6a96..87fe81de9b 100644 --- a/src/Language/PureScript/Ide/Completion.hs +++ b/src/Language/PureScript/Ide/Completion.hs @@ -11,16 +11,16 @@ module Language.PureScript.Ide.Completion import Protolude hiding ((<&>), moduleName) -import Control.Lens hiding (op, (&)) -import Data.Aeson +import Control.Lens ((.~), (<&>), (^.)) +import Data.Aeson (FromJSON(..), withObject, (.!=), (.:?)) import Data.Map qualified as Map import Data.Text qualified as T import Language.PureScript qualified as P import Language.PureScript.Ide.Error (prettyPrintTypeSingleLine) -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Matcher +import Language.PureScript.Ide.Filter (Filter, applyFilters, exactFilter) +import Language.PureScript.Ide.Matcher (Matcher, runMatcher) import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Util (identT, identifierFromIdeDeclaration, namespaceForDeclaration, properNameT, typeOperatorAliasT, valueOperatorAliasT) -- | Applies the CompletionFilters and the Matcher to the given Modules -- and sorts the found Completions according to the Matching Score diff --git a/src/Language/PureScript/Ide/Error.hs b/src/Language/PureScript/Ide/Error.hs index cb7105358d..8a23f574e0 100644 --- a/src/Language/PureScript/Ide/Error.hs +++ b/src/Language/PureScript/Ide/Error.hs @@ -17,12 +17,12 @@ module Language.PureScript.Ide.Error , prettyPrintTypeSingleLine ) where -import Data.Aeson +import Data.Aeson (KeyValue(..), ToJSON(..), Value, object) import Data.Aeson.Types qualified as Aeson import Data.Aeson.KeyMap qualified as KM import Data.Text qualified as T import Language.PureScript qualified as P -import Language.PureScript.Errors.JSON +import Language.PureScript.Errors.JSON (toJSONError) import Language.PureScript.Ide.Types (ModuleIdent, Completion(..)) import Protolude diff --git a/src/Language/PureScript/Ide/Externs.hs b/src/Language/PureScript/Ide/Externs.hs index df9edabcb1..120c2da4f6 100644 --- a/src/Language/PureScript/Ide/Externs.hs +++ b/src/Language/PureScript/Ide/Externs.hs @@ -8,14 +8,14 @@ module Language.PureScript.Ide.Externs import Protolude hiding (to, from, (&)) import Codec.CBOR.Term as Term -import Control.Lens hiding (anyOf) -import "monad-logger" Control.Monad.Logger +import Control.Lens (preview, view, (&), (^.)) +import "monad-logger" Control.Monad.Logger (MonadLogger, logErrorN) import Data.Version (showVersion) import Data.Text qualified as Text import Language.PureScript qualified as P import Language.PureScript.Make.Monad qualified as Make import Language.PureScript.Ide.Error (IdeError (..)) -import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Types (IdeDataConstructor(..), IdeDeclaration(..), IdeDeclarationAnn(..), IdeType(..), IdeTypeClass(..), IdeTypeOperator(..), IdeTypeSynonym(..), IdeValue(..), IdeValueOperator(..), _IdeDeclType, anyOf, emptyAnn, ideTypeKind, ideTypeName) import Language.PureScript.Ide.Util (properNameT) readExternFile diff --git a/src/Language/PureScript/Ide/Filter.hs b/src/Language/PureScript/Ide/Filter.hs index f3c693673c..9bb29d6e49 100644 --- a/src/Language/PureScript/Ide/Filter.hs +++ b/src/Language/PureScript/Ide/Filter.hs @@ -26,19 +26,19 @@ module Language.PureScript.Ide.Filter import Protolude hiding (isPrefixOf, Prefix) import Control.Monad.Fail (fail) -import Data.Aeson +import Data.Aeson (FromJSON(..), withObject, (.:), (.:?)) import Data.Text (isPrefixOf) import Data.Set qualified as Set import Data.Map qualified as Map import Language.PureScript.Ide.Filter.Declaration (DeclarationType) -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Imports -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Types (IdeDeclarationAnn, IdeNamespace, ModuleMap, declarationType) +import Language.PureScript.Ide.Imports (Import, sliceImportSection) +import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration, namespaceForDeclaration) import Language.PureScript qualified as P import Data.Text qualified as T -import Language.PureScript.Ide.Filter.Imports +import Language.PureScript.Ide.Filter.Imports (matchImport) newtype Filter = Filter (Either (Set P.ModuleName) DeclarationFilter) deriving Show diff --git a/src/Language/PureScript/Ide/Filter/Declaration.hs b/src/Language/PureScript/Ide/Filter/Declaration.hs index c3bd6fead3..7875f7851c 100644 --- a/src/Language/PureScript/Ide/Filter/Declaration.hs +++ b/src/Language/PureScript/Ide/Filter/Declaration.hs @@ -5,7 +5,7 @@ module Language.PureScript.Ide.Filter.Declaration import Protolude hiding (isPrefixOf) import Control.Monad.Fail (fail) -import Data.Aeson +import Data.Aeson (FromJSON(..), ToJSON(..), withText) data DeclarationType = Value diff --git a/src/Language/PureScript/Ide/Filter/Imports.hs b/src/Language/PureScript/Ide/Filter/Imports.hs index fcdf0fcab7..bd1d70065d 100644 --- a/src/Language/PureScript/Ide/Filter/Imports.hs +++ b/src/Language/PureScript/Ide/Filter/Imports.hs @@ -3,8 +3,8 @@ module Language.PureScript.Ide.Filter.Imports where import Protolude hiding (isPrefixOf) -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Imports +import Language.PureScript.Ide.Types (IdeDataConstructor(..), IdeDeclaration(..), IdeDeclarationAnn(..), IdeType(..), IdeTypeClass(..), IdeTypeOperator(..), IdeTypeSynonym(..), IdeValue(..), IdeValueOperator(..)) +import Language.PureScript.Ide.Imports (Import(..)) import Language.PureScript qualified as P diff --git a/src/Language/PureScript/Ide/Imports.hs b/src/Language/PureScript/Ide/Imports.hs index cc788308c4..b96f090a7f 100644 --- a/src/Language/PureScript/Ide/Imports.hs +++ b/src/Language/PureScript/Ide/Imports.hs @@ -32,8 +32,8 @@ import Data.List.NonEmpty qualified as NE import Data.Text qualified as T import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Error (IdeError(..)) +import Language.PureScript.Ide.Util (ideReadFile) data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName) deriving (Eq, Show) diff --git a/src/Language/PureScript/Ide/Imports/Actions.hs b/src/Language/PureScript/Ide/Imports/Actions.hs index 38d80148bc..bc79f2184d 100644 --- a/src/Language/PureScript/Ide/Imports/Actions.hs +++ b/src/Language/PureScript/Ide/Imports/Actions.hs @@ -19,14 +19,14 @@ import Data.Map qualified as Map import Data.Text qualified as T import Language.PureScript qualified as P import Language.PureScript.Constants.Prim qualified as C -import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Filter -import Language.PureScript.Ide.Imports -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Prim -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Completion (getExactMatches) +import Language.PureScript.Ide.Error (IdeError(..)) +import Language.PureScript.Ide.Filter (Filter) +import Language.PureScript.Ide.Imports (Import(..), parseImportsFromFile', prettyPrintImportSection) +import Language.PureScript.Ide.State (getAllModules) +import Language.PureScript.Ide.Prim (idePrimDeclarations) +import Language.PureScript.Ide.Types (Ide, IdeDeclaration(..), IdeType(..), Match(..), Success(..), _IdeDeclModule, ideDtorName, ideDtorTypeName, ideTCName, ideTypeName, ideTypeOpName, ideValueOpName) +import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration) import System.IO.UTF8 (writeUTF8FileT) -- | Adds an implicit import like @import Prelude@ to a Sourcefile. diff --git a/src/Language/PureScript/Ide/Logging.hs b/src/Language/PureScript/Ide/Logging.hs index 4b1159deb8..925881b2d0 100644 --- a/src/Language/PureScript/Ide/Logging.hs +++ b/src/Language/PureScript/Ide/Logging.hs @@ -9,11 +9,11 @@ module Language.PureScript.Ide.Logging import Protolude -import "monad-logger" Control.Monad.Logger +import "monad-logger" Control.Monad.Logger (LogLevel(..), LoggingT, MonadLogger, filterLogger, logOtherN, runStdoutLoggingT) import Data.Text qualified as T -import Language.PureScript.Ide.Types -import System.Clock -import Text.Printf +import Language.PureScript.Ide.Types (IdeLogLevel(..)) +import System.Clock (Clock(..), TimeSpec, diffTimeSpec, getTime, toNanoSecs) +import Text.Printf (printf) runLogger :: MonadIO m => IdeLogLevel -> LoggingT m a -> m a runLogger logLevel' = diff --git a/src/Language/PureScript/Ide/Matcher.hs b/src/Language/PureScript/Ide/Matcher.hs index a959c103dd..d77516bd32 100644 --- a/src/Language/PureScript/Ide/Matcher.hs +++ b/src/Language/PureScript/Ide/Matcher.hs @@ -22,12 +22,12 @@ module Language.PureScript.Ide.Matcher import Protolude import Control.Monad.Fail (fail) -import Data.Aeson +import Data.Aeson (FromJSON(..), withObject, (.:), (.:?)) import Data.Text qualified as T import Data.Text.Encoding qualified as TE -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util -import Text.EditDistance +import Language.PureScript.Ide.Types (IdeDeclarationAnn, Match) +import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration, unwrapMatch) +import Text.EditDistance (defaultEditCosts, levenshteinDistance) import Text.Regex.TDFA ((=~)) diff --git a/src/Language/PureScript/Ide/Prim.hs b/src/Language/PureScript/Ide/Prim.hs index ff60533d8f..398c013755 100644 --- a/src/Language/PureScript/Ide/Prim.hs +++ b/src/Language/PureScript/Ide/Prim.hs @@ -7,7 +7,7 @@ import Data.Map qualified as Map import Language.PureScript qualified as P import Language.PureScript.Constants.Prim qualified as C import Language.PureScript.Environment qualified as PEnv -import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Types (IdeDeclaration(..), IdeDeclarationAnn(..), IdeType(..), IdeTypeClass(..), ModuleMap, emptyAnn) idePrimDeclarations :: ModuleMap [IdeDeclarationAnn] idePrimDeclarations = Map.fromList diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs index d9eccc9d57..ebc34339eb 100644 --- a/src/Language/PureScript/Ide/Rebuild.hs +++ b/src/Language/PureScript/Ide/Rebuild.hs @@ -8,7 +8,7 @@ module Language.PureScript.Ide.Rebuild import Protolude hiding (moduleName) -import "monad-logger" Control.Monad.Logger +import "monad-logger" Control.Monad.Logger (LoggingT, MonadLogger, logDebug) import Data.List qualified as List import Data.Map.Lazy qualified as M import Data.Maybe (fromJust) @@ -20,11 +20,11 @@ import Language.PureScript.Make (ffiCodegen') import Language.PureScript.Make.Cache (CacheInfo(..), normaliseForCache) import Language.PureScript.CST qualified as CST -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Logging -import Language.PureScript.Ide.State -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Error (IdeError(..)) +import Language.PureScript.Ide.Logging (labelTimespec, logPerf, runLogger) +import Language.PureScript.Ide.State (cacheRebuild, getExternFiles, insertExterns, insertModule, populateVolatileState, updateCacheTimestamp) +import Language.PureScript.Ide.Types (Ide, IdeConfiguration(..), IdeEnvironment(..), ModuleMap, Success(..)) +import Language.PureScript.Ide.Util (ideReadFile) import System.Directory (getCurrentDirectory) -- | Given a filepath performs the following steps: diff --git a/src/Language/PureScript/Ide/Reexports.hs b/src/Language/PureScript/Ide/Reexports.hs index c862c63c87..a50b9de7a9 100644 --- a/src/Language/PureScript/Ide/Reexports.hs +++ b/src/Language/PureScript/Ide/Reexports.hs @@ -24,11 +24,11 @@ module Language.PureScript.Ide.Reexports import Protolude hiding (moduleName) -import Control.Lens hiding (anyOf, (&)) +import Control.Lens (set) import Data.Map qualified as Map import Language.PureScript qualified as P import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Util (discardAnn) -- | Contains the module with resolved reexports, and possible failures data ReexportResult a diff --git a/src/Language/PureScript/Ide/SourceFile.hs b/src/Language/PureScript/Ide/SourceFile.hs index 333101a025..ea49fd6a55 100644 --- a/src/Language/PureScript/Ide/SourceFile.hs +++ b/src/Language/PureScript/Ide/SourceFile.hs @@ -26,9 +26,9 @@ import Control.Parallel.Strategies (withStrategy, parList, rseq) import Data.Map qualified as Map import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Error (IdeError) +import Language.PureScript.Ide.Types (DefinitionSites, IdeNamespace(..), IdeNamespaced(..), TypeAnnotations) +import Language.PureScript.Ide.Util (ideReadFile) parseModule :: FilePath -> Text -> Either FilePath (FilePath, P.Module) parseModule path file = diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs index 03bb241d8d..06eed507e4 100644 --- a/src/Language/PureScript/Ide/State.hs +++ b/src/Language/PureScript/Ide/State.hs @@ -39,22 +39,22 @@ module Language.PureScript.Ide.State import Protolude hiding (moduleName, unzip) -import Control.Concurrent.STM -import Control.Lens hiding (anyOf, op, (&)) -import "monad-logger" Control.Monad.Logger -import Data.IORef +import Control.Concurrent.STM (TVar, modifyTVar, readTVar, readTVarIO, writeTVar) +import Control.Lens (Ixed(..), preview, view, (%~), (.~), (^.)) +import "monad-logger" Control.Monad.Logger (MonadLogger, logWarnN) +import Data.IORef (readIORef, writeIORef) import Data.Map.Lazy qualified as Map import Data.Time.Clock (UTCTime) import Data.Zip (unzip) import Language.PureScript qualified as P import Language.PureScript.Docs.Convert.Single (convertComments) -import Language.PureScript.Externs +import Language.PureScript.Externs (ExternsDeclaration(..), ExternsFile(..)) import Language.PureScript.Make.Actions (cacheDbFile) -import Language.PureScript.Ide.Externs -import Language.PureScript.Ide.Reexports -import Language.PureScript.Ide.SourceFile +import Language.PureScript.Ide.Externs (convertExterns) +import Language.PureScript.Ide.Reexports (ReexportResult(..), prettyPrintReexportResult, reexportHasFailures, resolveReexports) +import Language.PureScript.Ide.SourceFile (extractAstInformation) import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Util (discardAnn, displayTimeSpec, logPerf, opNameT, properNameT, runLogger) import System.Directory (getModificationTime) -- | Resets all State inside psc-ide diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs index b8fcda9dd5..db17094a29 100644 --- a/src/Language/PureScript/Ide/Types.hs +++ b/src/Language/PureScript/Ide/Types.hs @@ -8,7 +8,7 @@ module Language.PureScript.Ide.Types where import Protolude hiding (moduleName) import Control.Concurrent.STM (TVar) -import Control.Lens hiding (op, (.=)) +import Control.Lens (Getting, Traversal', makeLenses) import Control.Monad.Fail (fail) import Data.Aeson (ToJSON, FromJSON, (.=)) import Data.Aeson qualified as Aeson diff --git a/src/Language/PureScript/Ide/Usage.hs b/src/Language/PureScript/Ide/Usage.hs index 5d04654a3c..3e773efe5a 100644 --- a/src/Language/PureScript/Ide/Usage.hs +++ b/src/Language/PureScript/Ide/Usage.hs @@ -14,7 +14,7 @@ import Data.Set qualified as Set import Language.PureScript qualified as P import Language.PureScript.Ide.State (getAllModules, getFileState) import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util +import Language.PureScript.Ide.Util (identifierFromIdeDeclaration, namespaceForDeclaration) -- | -- How we find usages, given an IdeDeclaration and the module it was defined in: diff --git a/src/Language/PureScript/Ide/Util.hs b/src/Language/PureScript/Ide/Util.hs index f7f90f5236..854391dcae 100644 --- a/src/Language/PureScript/Ide/Util.hs +++ b/src/Language/PureScript/Ide/Util.hs @@ -32,15 +32,15 @@ module Language.PureScript.Ide.Util import Protolude hiding (decodeUtf8, encodeUtf8, to) -import Control.Lens hiding (op, (&)) -import Data.Aeson +import Control.Lens (Getting, to, (^.)) +import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode) import Data.Text qualified as T import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Encoding as TLE import Language.PureScript qualified as P import Language.PureScript.Ide.Error (IdeError(..)) import Language.PureScript.Ide.Logging -import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Types (IdeDeclaration(..), IdeDeclarationAnn(..), IdeNamespace(..), Match(..), emptyAnn, ideDtorName, ideSynonymName, ideTCName, ideTypeName, ideTypeOpName, ideValueIdent, ideValueOpName) import System.IO.UTF8 (readUTF8FileT) import System.Directory (makeAbsolute) diff --git a/src/Language/PureScript/Interactive.hs b/src/Language/PureScript/Interactive.hs index 820aefc080..5f88b079c3 100644 --- a/src/Language/PureScript/Interactive.hs +++ b/src/Language/PureScript/Interactive.hs @@ -20,8 +20,8 @@ import Data.Text (Text) import Data.Text qualified as T import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.State.Class -import Control.Monad.Reader.Class +import Control.Monad.State.Class (MonadState(..), gets, modify) +import Control.Monad.Reader.Class (MonadReader, asks) import Control.Monad.Trans.Except (ExceptT(..), runExceptT) import Control.Monad.Trans.State.Strict (StateT, runStateT, evalStateT) import Control.Monad.Writer.Strict (Writer(), runWriter) diff --git a/src/Language/PureScript/Interactive/Completion.hs b/src/Language/PureScript/Interactive/Completion.hs index d4fd68d770..d9e61e9cca 100644 --- a/src/Language/PureScript/Interactive/Completion.hs +++ b/src/Language/PureScript/Interactive/Completion.hs @@ -18,8 +18,8 @@ import Data.Maybe (mapMaybe) import Data.Text qualified as T import Language.PureScript qualified as P import Language.PureScript.Interactive.Directive qualified as D -import Language.PureScript.Interactive.Types -import System.Console.Haskeline +import Language.PureScript.Interactive.Types (Directive(..), PSCiState, psciExports, psciImports, psciLoadedExterns, replQueryStrings) +import System.Console.Haskeline (Completion(..), CompletionFunc, completeWordWithPrev, listFiles, simpleCompletion) -- Completions may read the state, but not modify it. type CompletionM = ReaderT PSCiState IO diff --git a/src/Language/PureScript/Interactive/Directive.hs b/src/Language/PureScript/Interactive/Directive.hs index 35c064001c..4a75f0f362 100644 --- a/src/Language/PureScript/Interactive/Directive.hs +++ b/src/Language/PureScript/Interactive/Directive.hs @@ -9,7 +9,7 @@ import Data.Maybe (fromJust) import Data.List (isPrefixOf) import Data.Tuple (swap) -import Language.PureScript.Interactive.Types +import Language.PureScript.Interactive.Types (Directive(..)) -- | -- A mapping of directives to the different strings that can be used to invoke diff --git a/src/Language/PureScript/Interactive/Message.hs b/src/Language/PureScript/Interactive/Message.hs index f99aabbe86..800b614758 100644 --- a/src/Language/PureScript/Interactive/Message.hs +++ b/src/Language/PureScript/Interactive/Message.hs @@ -6,7 +6,7 @@ import Data.List (intercalate) import Data.Version (showVersion) import Paths_purescript qualified as Paths import Language.PureScript.Interactive.Directive qualified as D -import Language.PureScript.Interactive.Types +import Language.PureScript.Interactive.Types (Directive) -- Messages diff --git a/src/Language/PureScript/Interactive/Module.hs b/src/Language/PureScript/Interactive/Module.hs index 3230a44321..61083eee2e 100644 --- a/src/Language/PureScript/Interactive/Module.hs +++ b/src/Language/PureScript/Interactive/Module.hs @@ -4,7 +4,7 @@ import Prelude import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST -import Language.PureScript.Interactive.Types +import Language.PureScript.Interactive.Types (ImportedModule, PSCiState, initialInteractivePrint, psciImportedModules, psciInteractivePrint, psciLetBindings) import System.Directory (getCurrentDirectory) import System.FilePath (pathSeparator, makeRelative) import System.IO.UTF8 (readUTF8FilesT) diff --git a/src/Language/PureScript/Interactive/Parser.hs b/src/Language/PureScript/Interactive/Parser.hs index 0347064dd7..d888683b6d 100644 --- a/src/Language/PureScript/Interactive/Parser.hs +++ b/src/Language/PureScript/Interactive/Parser.hs @@ -18,7 +18,7 @@ import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST import Language.PureScript.CST.Monad qualified as CSTM import Language.PureScript.Interactive.Directive qualified as D -import Language.PureScript.Interactive.Types +import Language.PureScript.Interactive.Types (Command(..), Directive(..), ReplQuery(..), parseReplQuery, replQueryStrings) -- | -- Parses a limited set of commands from from .purs-repl diff --git a/src/Language/PureScript/Linter.hs b/src/Language/PureScript/Linter.hs index bffde54883..c77d66c1d4 100644 --- a/src/Language/PureScript/Linter.hs +++ b/src/Language/PureScript/Linter.hs @@ -5,7 +5,7 @@ module Language.PureScript.Linter (lint, module L) where import Prelude -import Control.Monad.Writer.Class +import Control.Monad.Writer.Class (MonadWriter(..), censor) import Data.Maybe (mapMaybe) import Data.Set qualified as S @@ -14,11 +14,11 @@ import Data.Text qualified as Text import Control.Monad ((<=<)) import Language.PureScript.AST -import Language.PureScript.Errors +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage') import Language.PureScript.Linter.Exhaustive as L import Language.PureScript.Linter.Imports as L -import Language.PureScript.Names -import Language.PureScript.Types +import Language.PureScript.Names (Ident(..), Qualified(..), QualifiedBy(..), getIdentName, runIdent) +import Language.PureScript.Types (Constraint(..), SourceType, Type(..), everythingWithContextOnTypes) import Language.PureScript.Constants.Libs qualified as C -- | Lint the PureScript AST. diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs index 43dc0f80e9..0521eda985 100644 --- a/src/Language/PureScript/Linter/Exhaustive.hs +++ b/src/Language/PureScript/Linter/Exhaustive.hs @@ -11,25 +11,25 @@ module Language.PureScript.Linter.Exhaustive import Prelude import Protolude (ordNub) -import Control.Applicative +import Control.Applicative (Applicative(..)) import Control.Arrow (first, second) import Control.Monad (unless) -import Control.Monad.Writer.Class +import Control.Monad.Writer.Class (MonadWriter(..), censor) import Data.List (foldl', sortOn) import Data.Maybe (fromMaybe) import Data.Map qualified as M import Data.Text qualified as T -import Language.PureScript.AST.Binders -import Language.PureScript.AST.Declarations -import Language.PureScript.AST.Literals -import Language.PureScript.Crash -import Language.PureScript.Environment hiding (tyVar) -import Language.PureScript.Errors +import Language.PureScript.AST.Binders (Binder(..)) +import Language.PureScript.AST.Declarations (CaseAlternative(..), Declaration(..), ErrorMessageHint(..), Expr(..), Guard(..), GuardedExpr(..), pattern MkUnguarded, pattern ValueDecl, isTrueExpr) +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (DataDeclType, Environment(..), TypeKind(..)) +import Language.PureScript.Errors (MultipleErrors, pattern NullSourceAnn, SimpleErrorMessage(..), SourceSpan, addHint, errorMessage') import Language.PureScript.Names as P import Language.PureScript.Pretty.Values (prettyPrintBinderAtom) -import Language.PureScript.Traversals +import Language.PureScript.Traversals (sndM) import Language.PureScript.Types as P import Language.PureScript.Constants.Prim qualified as C diff --git a/src/Language/PureScript/Linter/Imports.hs b/src/Language/PureScript/Linter/Imports.hs index 9c88597978..e8a2eb0f2c 100644 --- a/src/Language/PureScript/Linter/Imports.hs +++ b/src/Language/PureScript/Linter/Imports.hs @@ -8,7 +8,7 @@ import Prelude import Protolude (ordNub) import Control.Monad (join, unless, foldM, (<=<)) -import Control.Monad.Writer.Class +import Control.Monad.Writer.Class (MonadWriter(..)) import Data.Function (on) import Data.Foldable (for_) @@ -19,14 +19,14 @@ import Data.Traversable (forM) import Data.Text qualified as T import Data.Map qualified as M -import Language.PureScript.AST.Declarations -import Language.PureScript.AST.SourcePos -import Language.PureScript.Crash -import Language.PureScript.Errors +import Language.PureScript.AST.Declarations (Declaration(..), DeclarationRef(..), ExportSource, ImportDeclarationType(..), Module(..), getTypeRef, isExplicit) +import Language.PureScript.AST.SourcePos (SourceSpan) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage') import Language.PureScript.Names import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs) -import Language.PureScript.Sugar.Names.Env -import Language.PureScript.Sugar.Names.Imports +import Language.PureScript.Sugar.Names.Env (Env, Exports(..), ImportRecord(..), Imports(..), envModuleExports, nullImports) +import Language.PureScript.Sugar.Names.Imports (ImportDef, findImports) import Language.PureScript.Constants.Prim qualified as C -- | diff --git a/src/Language/PureScript/Linter/Wildcards.hs b/src/Language/PureScript/Linter/Wildcards.hs index f224af6860..a8b5fcf23e 100644 --- a/src/Language/PureScript/Linter/Wildcards.hs +++ b/src/Language/PureScript/Linter/Wildcards.hs @@ -4,8 +4,8 @@ module Language.PureScript.Linter.Wildcards import Protolude hiding (Type) -import Language.PureScript.AST -import Language.PureScript.Types +import Language.PureScript.AST (Binder(..), Declaration, Expr(..), everywhereWithContextOnValues) +import Language.PureScript.Types (Type(..), WildcardData(..), everythingOnTypes, everywhereOnTypes) -- | -- Replaces `TypeWildcard _ UnnamedWildcard` with diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index ad361342c5..8340d77caa 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -13,10 +13,10 @@ import Prelude import Control.Concurrent.Lifted as C import Control.Exception.Base (onException) -import Control.Monad hiding (sequence) +import Control.Monad (foldM, unless, when) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.IO.Class -import Control.Monad.Supply +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Supply (evalSupplyT, runSupply, runSupplyT) import Control.Monad.Trans.Control (MonadBaseControl(..), control) import Control.Monad.Trans.State (runStateT) import Control.Monad.Writer.Class (MonadWriter(..), censor) @@ -29,20 +29,20 @@ import Data.Maybe (fromMaybe) import Data.Map qualified as M import Data.Set qualified as S import Data.Text qualified as T -import Language.PureScript.AST -import Language.PureScript.Crash +import Language.PureScript.AST (ErrorMessageHint(..), Module(..), SourceSpan(..), getModuleName, getModuleSourceSpan, importPrim) +import Language.PureScript.Crash (internalError) import Language.PureScript.CST qualified as CST import Language.PureScript.Docs.Convert qualified as Docs -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Externs -import Language.PureScript.Linter -import Language.PureScript.ModuleDependencies -import Language.PureScript.Names -import Language.PureScript.Renamer -import Language.PureScript.Sugar -import Language.PureScript.TypeChecker -import Language.PureScript.Make.BuildPlan +import Language.PureScript.Environment (initEnvironment) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, defaultPPEOptions, errorMessage', errorMessage'', prettyPrintMultipleErrors) +import Language.PureScript.Externs (ExternsFile, applyExternsFileToEnvironment, moduleToExternsFile) +import Language.PureScript.Linter (Name(..), lint, lintImports) +import Language.PureScript.ModuleDependencies (DependencyDepth(..), moduleSignature, sortModules) +import Language.PureScript.Names (ModuleName, isBuiltinModuleName, runModuleName) +import Language.PureScript.Renamer (renameInModule) +import Language.PureScript.Sugar (Env, collapseBindingGroups, createBindingGroups, desugar, desugarCaseGuards, externsEnv, primEnv) +import Language.PureScript.TypeChecker (CheckState(..), emptyCheckState, typeCheckModule) +import Language.PureScript.Make.BuildPlan (BuildJobResult(..), BuildPlan(..), getResult) import Language.PureScript.Make.BuildPlan qualified as BuildPlan import Language.PureScript.Make.Cache qualified as Cache import Language.PureScript.Make.Actions as Actions diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 6c6d251bae..f138327c8d 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -13,11 +13,11 @@ module Language.PureScript.Make.Actions import Prelude -import Control.Monad hiding (sequence) +import Control.Monad (unless, when) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.IO.Class +import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader (asks) -import Control.Monad.Supply +import Control.Monad.Supply (SupplyT) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Writer.Class (MonadWriter(..)) import Data.Aeson (Value(String), (.=), object) @@ -34,26 +34,26 @@ import Data.Text.Encoding qualified as TE import Data.Time.Clock (UTCTime) import Data.Version (showVersion) import Language.JavaScript.Parser qualified as JS -import Language.PureScript.AST +import Language.PureScript.AST (SourcePos(..)) import Language.PureScript.Bundle qualified as Bundle import Language.PureScript.CodeGen.JS qualified as J -import Language.PureScript.CodeGen.JS.Printer +import Language.PureScript.CodeGen.JS.Printer (prettyPrintJS, prettyPrintJSWithSourceMaps) import Language.PureScript.CoreFn qualified as CF import Language.PureScript.CoreFn.ToJSON qualified as CFJ -import Language.PureScript.Crash +import Language.PureScript.Crash (internalError) import Language.PureScript.CST qualified as CST import Language.PureScript.Docs.Prim qualified as Docs.Prim import Language.PureScript.Docs.Types qualified as Docs -import Language.PureScript.Errors +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage, errorMessage') import Language.PureScript.Externs (ExternsFile, externsFileName) -import Language.PureScript.Make.Monad -import Language.PureScript.Make.Cache -import Language.PureScript.Names -import Language.PureScript.Options hiding (codegenTargets) +import Language.PureScript.Make.Monad (Make, copyFile, getTimestamp, getTimestampMaybe, hashFile, makeIO, readExternsFile, readJSONFile, readTextFile, writeCborFile, writeJSONFile, writeTextFile) +import Language.PureScript.Make.Cache (CacheDb, ContentHash, normaliseForCache) +import Language.PureScript.Names (Ident(..), ModuleName, runModuleName) +import Language.PureScript.Options (CodegenTarget(..), Options(..)) import Language.PureScript.Pretty.Common (SMap(..)) import Paths_purescript qualified as Paths -import SourceMap -import SourceMap.Types +import SourceMap (generate) +import SourceMap.Types (Mapping(..), Pos(..), SourceMapping(..)) import System.Directory (getCurrentDirectory) import System.FilePath ((), makeRelative, splitPath, normalise, splitDirectories) import System.FilePath.Posix qualified as Posix diff --git a/src/Language/PureScript/Make/BuildPlan.hs b/src/Language/PureScript/Make/BuildPlan.hs index 7ac97532f1..3eba2359a3 100644 --- a/src/Language/PureScript/Make/BuildPlan.hs +++ b/src/Language/PureScript/Make/BuildPlan.hs @@ -14,22 +14,22 @@ import Prelude import Control.Concurrent.Async.Lifted as A import Control.Concurrent.Lifted as C import Control.Monad.Base (liftBase) -import Control.Monad hiding (sequence) +import Control.Monad (foldM) import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Data.Foldable (foldl') import Data.Map qualified as M import Data.Maybe (fromMaybe, mapMaybe) import Data.Time.Clock (UTCTime) -import Language.PureScript.AST -import Language.PureScript.Crash +import Language.PureScript.AST (Module, getModuleName) +import Language.PureScript.Crash (internalError) import Language.PureScript.CST qualified as CST -import Language.PureScript.Errors -import Language.PureScript.Externs +import Language.PureScript.Errors (MultipleErrors(..)) +import Language.PureScript.Externs (ExternsFile) import Language.PureScript.Make.Actions as Actions -import Language.PureScript.Make.Cache +import Language.PureScript.Make.Cache (CacheDb, CacheInfo, checkChanged) import Language.PureScript.Names (ModuleName) -import Language.PureScript.Sugar.Names.Env +import Language.PureScript.Sugar.Names.Env (Env, primEnv) import System.Directory (getCurrentDirectory) -- | The BuildPlan tracks information about our build progress, and holds all diff --git a/src/Language/PureScript/Make/Monad.hs b/src/Language/PureScript/Make/Monad.hs index dbb7c0607b..d8326ee129 100644 --- a/src/Language/PureScript/Make/Monad.hs +++ b/src/Language/PureScript/Make/Monad.hs @@ -27,21 +27,21 @@ import Control.Exception (fromException, tryJust) import Control.Monad (join, guard) import Control.Monad.Base (MonadBase(..)) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.IO.Class -import Control.Monad.Logger +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Logger (Logger, runLogger') import Control.Monad.Reader (MonadReader(..), ReaderT(..)) import Control.Monad.Trans.Control (MonadBaseControl(..)) -import Control.Monad.Trans.Except +import Control.Monad.Trans.Except (ExceptT, runExceptT) import Control.Monad.Writer.Class (MonadWriter(..)) import Data.Aeson qualified as Aeson import Data.ByteString qualified as B import Data.Text (Text) import Data.Text qualified as Text import Data.Time.Clock (UTCTime) -import Language.PureScript.Errors +import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors, SimpleErrorMessage(..), singleError) import Language.PureScript.Externs (ExternsFile, externsIsCurrentVersion) import Language.PureScript.Make.Cache (ContentHash, hash) -import Language.PureScript.Options +import Language.PureScript.Options (Options) import System.Directory (createDirectoryIfMissing, getModificationTime) import System.Directory qualified as Directory import System.FilePath (takeDirectory) diff --git a/src/Language/PureScript/ModuleDependencies.hs b/src/Language/PureScript/ModuleDependencies.hs index ae55e1138f..3bcb914fb6 100644 --- a/src/Language/PureScript/ModuleDependencies.hs +++ b/src/Language/PureScript/ModuleDependencies.hs @@ -10,13 +10,13 @@ module Language.PureScript.ModuleDependencies import Protolude hiding (head) import Data.Array ((!)) -import Data.Graph +import Data.Graph (SCC(..), graphFromEdges, reachable, stronglyConnComp) import Data.Set qualified as S -import Language.PureScript.AST +import Language.PureScript.AST (Declaration(..), ErrorMessageHint(..), Module(..), SourceSpan) import Language.PureScript.Constants.Prim qualified as C -import Language.PureScript.Crash -import Language.PureScript.Errors hiding (nonEmpty) -import Language.PureScript.Names +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage', errorMessage'', parU) +import Language.PureScript.Names (ModuleName) -- | A list of modules with their transitive dependencies type ModuleGraph = [(ModuleName, [ModuleName])] diff --git a/src/Language/PureScript/Names.hs b/src/Language/PureScript/Names.hs index 4783f4f165..e5df3610bf 100644 --- a/src/Language/PureScript/Names.hs +++ b/src/Language/PureScript/Names.hs @@ -9,14 +9,14 @@ import Prelude import Codec.Serialise (Serialise) import Control.Applicative ((<|>)) -import Control.Monad.Supply.Class +import Control.Monad.Supply.Class (MonadSupply(..)) import Control.DeepSeq (NFData) import Data.Functor.Contravariant (contramap) import Data.Vector qualified as V import GHC.Generics (Generic) -import Data.Aeson -import Data.Aeson.TH +import Data.Aeson (FromJSON(..), FromJSONKey(..), Options(..), SumEncoding(..), ToJSON(..), ToJSONKey(..), defaultOptions, parseJSON2, toJSON2, withArray) +import Data.Aeson.TH (deriveJSON) import Data.Text (Text) import Data.Text qualified as T diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs index 6a30adb4e5..a62e776cad 100644 --- a/src/Language/PureScript/Pretty/Common.hs +++ b/src/Language/PureScript/Pretty/Common.hs @@ -14,7 +14,7 @@ import Data.Text qualified as T import Language.PureScript.AST (SourcePos(..), SourceSpan(..), nullSourceSpan) import Language.PureScript.CST.Lexer (isUnquotedKey) -import Text.PrettyPrint.Boxes hiding ((<>)) +import Text.PrettyPrint.Boxes (Box(..), emptyBox, text, top, vcat, (//)) import Text.PrettyPrint.Boxes qualified as Box parensT :: Text -> Text diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs index e26f3cb131..e318d352f5 100644 --- a/src/Language/PureScript/Pretty/Types.hs +++ b/src/Language/PureScript/Pretty/Types.hs @@ -1,6 +1,3 @@ --- HLint is confused by the identifier `pattern` if PatternSynonyms is enabled. -{-# LANGUAGE NoPatternSynonyms #-} - -- | -- Pretty printer for Types -- @@ -29,15 +26,15 @@ import Data.Maybe (fromMaybe, catMaybes) import Data.Text (Text) import Data.Text qualified as T -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Names -import Language.PureScript.Pretty.Common -import Language.PureScript.Types +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (tyFunction, tyRecord) +import Language.PureScript.Names (OpName(..), OpNameType(..), ProperName(..), ProperNameType(..), Qualified, coerceProperName, disqualify, showQualified) +import Language.PureScript.Pretty.Common (before, objectKeyRequiresQuoting) +import Language.PureScript.Types (Constraint(..), pattern REmptyKinded, RowListItem(..), Type(..), WildcardData(..), eqType, rowToSortedList) import Language.PureScript.PSString (PSString, prettyPrintString, decodeString) import Language.PureScript.Label (Label(..)) -import Text.PrettyPrint.Boxes hiding ((<+>)) +import Text.PrettyPrint.Boxes (Box(..), hcat, hsep, left, moveRight, nullBox, render, text, top, vcat, (<>)) data PrettyPrintType = PPTUnknown Int diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs index d0b0f823f2..85b6638fdc 100644 --- a/src/Language/PureScript/Pretty/Values.hs +++ b/src/Language/PureScript/Pretty/Values.hs @@ -16,15 +16,15 @@ import Data.List.NonEmpty qualified as NEL import Data.Monoid qualified as Monoid ((<>)) import Data.Text qualified as T -import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Names -import Language.PureScript.Pretty.Common +import Language.PureScript.AST (AssocList(..), Binder(..), CaseAlternative(..), Declaration(..), DoNotationElement(..), Expr(..), Guard(..), GuardedExpr(..), Literal(..), PathNode(..), PathTree(..), TypeDeclarationData(..), pattern ValueDecl, WhereProvenance(..)) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Names (OpName(..), ProperName(..), Qualified(..), disqualify, runModuleName, showIdent) +import Language.PureScript.Pretty.Common (before, beforeWithSpace, parensT) import Language.PureScript.Pretty.Types (typeAsBox, typeAtomAsBox, prettyPrintObjectKey) import Language.PureScript.Types (Constraint(..)) import Language.PureScript.PSString (PSString, prettyPrintString) -import Text.PrettyPrint.Boxes +import Text.PrettyPrint.Boxes (Box, left, moveRight, text, vcat, vsep, (//), (<>)) -- TODO(Christoph): remove T.unpack s diff --git a/src/Language/PureScript/Publish.hs b/src/Language/PureScript/Publish.hs index 58b502cb84..ed3dd4aba6 100644 --- a/src/Language/PureScript/Publish.hs +++ b/src/Language/PureScript/Publish.hs @@ -29,7 +29,7 @@ import Data.List (stripPrefix, (\\)) import Data.Text qualified as T import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Data.Version +import Data.Version (Version) import Distribution.SPDX qualified as SPDX import Distribution.Parsec qualified as CabalParsec @@ -40,9 +40,9 @@ import System.Process (readProcess) import Web.Bower.PackageMeta (PackageMeta(..), PackageName, Repository(..)) import Web.Bower.PackageMeta qualified as Bower -import Language.PureScript.Publish.ErrorsWarnings -import Language.PureScript.Publish.Registry.Compat -import Language.PureScript.Publish.Utils +import Language.PureScript.Publish.ErrorsWarnings (InternalError(..), OtherError(..), PackageError(..), PackageWarning(..), RepositoryFieldError(..), UserError(..), printError, printWarnings) +import Language.PureScript.Publish.Registry.Compat (asPursJson, toBowerPackage) +import Language.PureScript.Publish.Utils (globRelative, purescriptSourceFiles) import Language.PureScript qualified as P (version, ModuleName) import Language.PureScript.CoreFn.FromJSON qualified as P import Language.PureScript.Docs qualified as D diff --git a/src/Language/PureScript/Publish/ErrorsWarnings.hs b/src/Language/PureScript/Publish/ErrorsWarnings.hs index ef08193b34..b855f68a41 100644 --- a/src/Language/PureScript/Publish/ErrorsWarnings.hs +++ b/src/Language/PureScript/Publish/ErrorsWarnings.hs @@ -19,16 +19,16 @@ import Control.Exception (IOException) import Data.Aeson.BetterErrors (ParseError, displayError) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty(..)) -import Data.Maybe -import Data.Monoid -import Data.Version +import Data.Maybe (catMaybes, fromMaybe) +import Data.Monoid (Any(..)) +import Data.Version (Version, showVersion) import Data.List.NonEmpty qualified as NonEmpty import Data.Text (Text) import Data.Text qualified as T import Language.PureScript.Docs.Types qualified as D import Language.PureScript qualified as P -import Language.PureScript.Publish.BoxesHelpers +import Language.PureScript.Publish.BoxesHelpers (Box, bulletedList, bulletedListT, indented, nullBox, para, printToStderr, spacer, successivelyIndented, vcat) import Web.Bower.PackageMeta (PackageName, runPackageName, showBowerError) import Web.Bower.PackageMeta qualified as Bower diff --git a/src/Language/PureScript/Publish/Utils.hs b/src/Language/PureScript/Publish/Utils.hs index 881af28904..3760729518 100644 --- a/src/Language/PureScript/Publish/Utils.hs +++ b/src/Language/PureScript/Publish/Utils.hs @@ -2,7 +2,7 @@ module Language.PureScript.Publish.Utils where import Prelude -import System.Directory +import System.Directory (getCurrentDirectory) import System.FilePath.Glob (Pattern, compile, globDir1) -- | Glob relative to the current directory, and produce relative pathnames. diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs index 369ba80486..780095d039 100644 --- a/src/Language/PureScript/Renamer.hs +++ b/src/Language/PureScript/Renamer.hs @@ -5,7 +5,7 @@ module Language.PureScript.Renamer (renameInModule) where import Prelude -import Control.Monad.State +import Control.Monad.State (MonadState(..), State, gets, modify, runState, (>=>)) import Data.Functor ((<&>)) import Data.List (find) @@ -14,9 +14,9 @@ import Data.Map qualified as M import Data.Set qualified as S import Data.Text qualified as T -import Language.PureScript.CoreFn -import Language.PureScript.Names -import Language.PureScript.Traversals +import Language.PureScript.CoreFn (Ann, Bind(..), Binder(..), CaseAlternative(..), Expr(..), Literal(..), Module(..)) +import Language.PureScript.Names (Ident(..), Qualified(..), isBySourcePos, isPlainIdent, runIdent, showIdent) +import Language.PureScript.Traversals (eitherM, pairM, sndM) -- | -- The state object used in this module diff --git a/src/Language/PureScript/Sugar.hs b/src/Language/PureScript/Sugar.hs index 91bbc4624e..4d713d5418 100644 --- a/src/Language/PureScript/Sugar.hs +++ b/src/Language/PureScript/Sugar.hs @@ -4,16 +4,16 @@ module Language.PureScript.Sugar (desugar, module S) where import Control.Category ((>>>)) -import Control.Monad +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 Language.PureScript.AST -import Language.PureScript.Errors -import Language.PureScript.Externs -import Language.PureScript.Linter.Imports +import Language.PureScript.AST (Module) +import Language.PureScript.Errors (MultipleErrors) +import Language.PureScript.Externs (ExternsFile) +import Language.PureScript.Linter.Imports (UsedImports) import Language.PureScript.Sugar.BindingGroups as S import Language.PureScript.Sugar.CaseDeclarations as S import Language.PureScript.Sugar.DoNotation as S diff --git a/src/Language/PureScript/Sugar/AdoNotation.hs b/src/Language/PureScript/Sugar/AdoNotation.hs index 047d413edb..3ac5373621 100644 --- a/src/Language/PureScript/Sugar/AdoNotation.hs +++ b/src/Language/PureScript/Sugar/AdoNotation.hs @@ -7,11 +7,11 @@ import Prelude hiding (abs) import Control.Monad (foldM) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Supply.Class +import Control.Monad.Supply.Class (MonadSupply) import Data.List (foldl') -import Language.PureScript.AST -import Language.PureScript.Errors -import Language.PureScript.Names +import Language.PureScript.AST (Binder(..), CaseAlternative(..), Declaration, DoNotationElement(..), Expr(..), pattern MkUnguarded, Module(..), SourceSpan, WhereProvenance(..), declSourceSpan, everywhereOnValuesM) +import Language.PureScript.Errors (MultipleErrors, parU, rethrowWithPosition) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Qualified(..), byMaybeModuleName, freshIdent') import Language.PureScript.Constants.Libs qualified as C -- | Replace all @AdoNotationBind@ and @AdoNotationValue@ constructors with diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs index 6298e2eefe..d2f9aebf2b 100644 --- a/src/Language/PureScript/Sugar/BindingGroups.hs +++ b/src/Language/PureScript/Sugar/BindingGroups.hs @@ -14,7 +14,7 @@ import Protolude (ordNub, swap) import Control.Monad ((<=<), guard) import Control.Monad.Error.Class (MonadError(..)) -import Data.Graph +import Data.Graph (SCC(..), stronglyConnComp, stronglyConnCompR) import Data.List (intersect, (\\)) import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty) import Data.Foldable (find) @@ -25,11 +25,11 @@ import Data.Map qualified as M import Data.Set qualified as S import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors hiding (nonEmpty) -import Language.PureScript.Names -import Language.PureScript.Types +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (NameKind) +import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors(..), SimpleErrorMessage(..), errorMessage', parU, positionedError) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident, ModuleName, ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName) +import Language.PureScript.Types (Constraint(..), SourceConstraint, SourceType, Type(..), everythingOnTypes) data VertexType = VertexDefinition diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs index 925bf3d484..bcae767715 100644 --- a/src/Language/PureScript/Sugar/CaseDeclarations.hs +++ b/src/Language/PureScript/Sugar/CaseDeclarations.hs @@ -16,13 +16,13 @@ import Data.Maybe (catMaybes, mapMaybe) import Control.Monad ((<=<), forM, replicateM, join, unless) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Supply.Class +import Control.Monad.Supply.Class (MonadSupply) import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (NameKind(..)) +import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors(..), SimpleErrorMessage(..), addHint, errorMessage', parU, rethrow, withPosition) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident, Qualified(..), freshIdent') import Language.PureScript.TypeChecker.Monad (guardWith) -- | diff --git a/src/Language/PureScript/Sugar/DoNotation.hs b/src/Language/PureScript/Sugar/DoNotation.hs index f6b9a819ec..8542a5a790 100644 --- a/src/Language/PureScript/Sugar/DoNotation.hs +++ b/src/Language/PureScript/Sugar/DoNotation.hs @@ -7,13 +7,13 @@ import Prelude import Control.Applicative ((<|>)) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Supply.Class +import Control.Monad.Supply.Class (MonadSupply) import Data.Maybe (fromMaybe) import Data.Monoid (First(..)) -import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Errors -import Language.PureScript.Names +import Language.PureScript.AST (Binder(..), CaseAlternative(..), Declaration, DoNotationElement(..), Expr(..), pattern MkUnguarded, Module(..), SourceSpan, pattern ValueDecl, WhereProvenance(..), binderNames, declSourceSpan, everywhereOnValuesM) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage, errorMessage', parU, rethrowWithPosition) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Qualified(..), byMaybeModuleName, freshIdent') import Language.PureScript.Constants.Libs qualified as C -- | Replace all @DoNotationBind@ and @DoNotationValue@ constructors with diff --git a/src/Language/PureScript/Sugar/LetPattern.hs b/src/Language/PureScript/Sugar/LetPattern.hs index 2d4b01d8f3..519487d912 100644 --- a/src/Language/PureScript/Sugar/LetPattern.hs +++ b/src/Language/PureScript/Sugar/LetPattern.hs @@ -9,8 +9,8 @@ import Prelude import Data.List (groupBy) import Data.Function (on) -import Language.PureScript.AST -import Language.PureScript.Crash +import Language.PureScript.AST (Binder, CaseAlternative(..), Declaration(..), Expr(..), pattern MkUnguarded, Module(..), SourceAnn, WhereProvenance, everywhereOnValues) +import Language.PureScript.Crash (internalError) -- | Replace every @BoundValueDeclaration@ in @Let@ expressions with @Case@ -- expressions. diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs index 2fc947c738..2202633667 100644 --- a/src/Language/PureScript/Sugar/Names.hs +++ b/src/Language/PureScript/Sugar/Names.hs @@ -13,9 +13,9 @@ import Prelude import Protolude (sortOn, swap, foldl') import Control.Arrow (first, second, (&&&)) -import Control.Monad +import Control.Monad (foldM, when, (>=>)) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State.Lazy +import Control.Monad.State.Lazy (MonadState, StateT(..), gets, modify) import Control.Monad.Writer (MonadWriter(..)) import Data.List.NonEmpty qualified as NEL @@ -24,16 +24,16 @@ import Data.Map qualified as M import Data.Set qualified as S import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Errors -import Language.PureScript.Externs -import Language.PureScript.Linter.Imports -import Language.PureScript.Names -import Language.PureScript.Sugar.Names.Env -import Language.PureScript.Sugar.Names.Exports -import Language.PureScript.Sugar.Names.Imports -import Language.PureScript.Traversals -import Language.PureScript.Types +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage, errorMessage'', nonEmpty, parU, warnAndRethrow, warnAndRethrowWithPosition) +import Language.PureScript.Externs (ExternsDeclaration(..), ExternsFile(..), ExternsImport(..)) +import Language.PureScript.Linter.Imports (Name(..), UsedImports) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident, OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..)) +import Language.PureScript.Sugar.Names.Env (Env, Exports(..), ImportProvenance(..), ImportRecord(..), Imports(..), checkImportConflicts, nullImports, primEnv) +import Language.PureScript.Sugar.Names.Exports (findExportable, resolveExports) +import Language.PureScript.Sugar.Names.Imports (resolveImports, resolveModuleImport) +import Language.PureScript.Traversals (defS, sndM) +import Language.PureScript.Types (Constraint(..), SourceConstraint, SourceType, Type(..), everywhereOnTypesM) -- | -- Replaces all local names with qualified names. diff --git a/src/Language/PureScript/Sugar/Names/Common.hs b/src/Language/PureScript/Sugar/Names/Common.hs index 9783d66dd3..572d35eb23 100644 --- a/src/Language/PureScript/Sugar/Names/Common.hs +++ b/src/Language/PureScript/Sugar/Names/Common.hs @@ -9,9 +9,9 @@ import Data.Foldable (for_) import Data.List (group, sort, (\\)) import Data.Maybe (mapMaybe) -import Language.PureScript.AST -import Language.PureScript.Errors -import Language.PureScript.Names +import Language.PureScript.AST (DeclarationRef(..), SourceSpan) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage, errorMessage, warnWithPosition) +import Language.PureScript.Names (Name(..)) -- | -- Warns about duplicate values in a list of declaration refs. diff --git a/src/Language/PureScript/Sugar/Names/Env.hs b/src/Language/PureScript/Sugar/Names/Env.hs index a83c555144..2ab8b00d5c 100644 --- a/src/Language/PureScript/Sugar/Names/Env.hs +++ b/src/Language/PureScript/Sugar/Names/Env.hs @@ -20,7 +20,7 @@ module Language.PureScript.Sugar.Names.Env import Prelude -import Control.Monad +import Control.Monad (forM_, when) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Writer.Class (MonadWriter(..)) @@ -33,11 +33,11 @@ import Data.Map qualified as M import Data.Set qualified as S import Language.PureScript.Constants.Prim qualified as C -import Language.PureScript.AST -import Language.PureScript.Crash +import Language.PureScript.AST (ExportSource(..), SourceSpan, internalModuleSourceSpan, nullSourceSpan) +import Language.PureScript.Crash (internalError) import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage, errorMessage') +import Language.PureScript.Names (Ident, ModuleName, Name(..), OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, disqualify, getQual) -- | -- The details for an import: the name of the thing that is being imported diff --git a/src/Language/PureScript/Sugar/Names/Exports.hs b/src/Language/PureScript/Sugar/Names/Exports.hs index 70f0402fcb..cbe273f828 100644 --- a/src/Language/PureScript/Sugar/Names/Exports.hs +++ b/src/Language/PureScript/Sugar/Names/Exports.hs @@ -5,7 +5,7 @@ module Language.PureScript.Sugar.Names.Exports import Prelude -import Control.Monad +import Control.Monad (filterM, foldM, liftM2, unless, void, when) import Control.Monad.Writer.Class (MonadWriter(..)) import Control.Monad.Error.Class (MonadError(..)) @@ -16,10 +16,10 @@ import Data.Maybe (fromMaybe, mapMaybe) import Data.Map qualified as M import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.Sugar.Names.Env +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage', rethrow, rethrowWithPosition, warnAndRethrow) +import Language.PureScript.Names (Ident, ModuleName, Name(..), OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), disqualifyFor, isQualifiedWith, isUnqualified) +import Language.PureScript.Sugar.Names.Env (Env, ExportMode(..), Exports(..), ImportRecord(..), Imports(..), checkImportConflicts, envModuleExports, exportType, exportTypeClass, exportTypeOp, exportValue, exportValueOp, nullExports) import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs) -- | diff --git a/src/Language/PureScript/Sugar/Names/Imports.hs b/src/Language/PureScript/Sugar/Names/Imports.hs index 91577f83af..3a43faf7fd 100644 --- a/src/Language/PureScript/Sugar/Names/Imports.hs +++ b/src/Language/PureScript/Sugar/Names/Imports.hs @@ -7,7 +7,7 @@ module Language.PureScript.Sugar.Names.Imports import Prelude -import Control.Monad +import Control.Monad (foldM, when) import Control.Monad.Error.Class (MonadError(..)) import Data.Foldable (for_, traverse_) @@ -15,11 +15,11 @@ import Data.Maybe (fromMaybe) import Data.Map qualified as M import Data.Set qualified as S -import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.Sugar.Names.Env +import Language.PureScript.AST (Declaration(..), DeclarationRef(..), ErrorMessageHint(..), ExportSource(..), ImportDeclarationType(..), Module(..), SourceSpan, internalModuleSourceSpan) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage', rethrow) +import Language.PureScript.Names (pattern ByNullSourcePos, ModuleName, Name(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName) +import Language.PureScript.Sugar.Names.Env (Env, Exports(..), ImportProvenance(..), ImportRecord(..), Imports(..), envModuleExports, nullImports) type ImportDef = (SourceSpan, ImportDeclarationType, Maybe ModuleName) diff --git a/src/Language/PureScript/Sugar/ObjectWildcards.hs b/src/Language/PureScript/Sugar/ObjectWildcards.hs index 01e46e74b9..88b93b899c 100644 --- a/src/Language/PureScript/Sugar/ObjectWildcards.hs +++ b/src/Language/PureScript/Sugar/ObjectWildcards.hs @@ -7,14 +7,14 @@ import Prelude import Control.Monad (forM) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Supply.Class +import Control.Monad.Supply.Class (MonadSupply) import Data.Foldable (toList) import Data.List (foldl') import Data.Maybe (catMaybes) import Language.PureScript.AST import Language.PureScript.Environment (NameKind(..)) -import Language.PureScript.Errors -import Language.PureScript.Names +import Language.PureScript.Errors (MultipleErrors, rethrowWithPosition) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident, Qualified(..), freshIdent') import Language.PureScript.PSString (PSString) diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs index 3531380ed0..bb06486e82 100644 --- a/src/Language/PureScript/Sugar/Operators.hs +++ b/src/Language/PureScript/Sugar/Operators.hs @@ -16,15 +16,15 @@ module Language.PureScript.Sugar.Operators import Prelude import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Errors -import Language.PureScript.Externs -import Language.PureScript.Names -import Language.PureScript.Sugar.Operators.Binders -import Language.PureScript.Sugar.Operators.Expr -import Language.PureScript.Sugar.Operators.Types +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage, errorMessage', parU, rethrow, rethrowWithPosition) +import Language.PureScript.Externs (ExternsFile(..), ExternsFixity(..), ExternsTypeFixity(..)) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), Name(..), OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), freshIdent') +import Language.PureScript.Sugar.Operators.Binders (matchBinderOperators) +import Language.PureScript.Sugar.Operators.Expr (matchExprOperators) +import Language.PureScript.Sugar.Operators.Types (matchTypeOperators) import Language.PureScript.Traversals (defS, sndM) -import Language.PureScript.Types +import Language.PureScript.Types (Constraint(..), SourceType, Type(..), everywhereOnTypesTopDownM, overConstraintArgs) import Control.Monad (unless, (<=<)) import Control.Monad.Error.Class (MonadError(..)) diff --git a/src/Language/PureScript/Sugar/Operators/Binders.hs b/src/Language/PureScript/Sugar/Operators/Binders.hs index 2b36230d8a..29725c711a 100644 --- a/src/Language/PureScript/Sugar/Operators/Binders.hs +++ b/src/Language/PureScript/Sugar/Operators/Binders.hs @@ -2,12 +2,12 @@ module Language.PureScript.Sugar.Operators.Binders where import Prelude -import Control.Monad.Except +import Control.Monad.Except (MonadError) -import Language.PureScript.AST -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.Sugar.Operators.Common +import Language.PureScript.AST (Associativity, Binder(..), SourceSpan) +import Language.PureScript.Errors (MultipleErrors) +import Language.PureScript.Names (OpName(..), OpNameType(..), Qualified(..)) +import Language.PureScript.Sugar.Operators.Common (matchOperators) matchBinderOperators :: MonadError MultipleErrors m diff --git a/src/Language/PureScript/Sugar/Operators/Common.hs b/src/Language/PureScript/Sugar/Operators/Common.hs index fe65bb342b..1a18f88014 100644 --- a/src/Language/PureScript/Sugar/Operators/Common.hs +++ b/src/Language/PureScript/Sugar/Operators/Common.hs @@ -2,11 +2,11 @@ module Language.PureScript.Sugar.Operators.Common where import Prelude -import Control.Monad.State -import Control.Monad.Except +import Control.Monad.State (guard, join) +import Control.Monad.Except (MonadError(..)) import Data.Either (rights) -import Data.Functor.Identity +import Data.Functor.Identity (Identity) import Data.List (sortOn) import Data.Maybe (mapMaybe, fromJust) import Data.List.NonEmpty qualified as NEL @@ -16,10 +16,10 @@ import Text.Parsec qualified as P import Text.Parsec.Pos qualified as P import Text.Parsec.Expr qualified as P -import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Errors -import Language.PureScript.Names +import Language.PureScript.AST (Associativity(..), ErrorMessageHint(..), SourceSpan) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors(..), SimpleErrorMessage(..)) +import Language.PureScript.Names (OpName, Qualified, eraseOpName) type Chain a = [Either a a] diff --git a/src/Language/PureScript/Sugar/Operators/Expr.hs b/src/Language/PureScript/Sugar/Operators/Expr.hs index efb3842bfd..0815eb1610 100644 --- a/src/Language/PureScript/Sugar/Operators/Expr.hs +++ b/src/Language/PureScript/Sugar/Operators/Expr.hs @@ -2,16 +2,16 @@ module Language.PureScript.Sugar.Operators.Expr where import Prelude -import Control.Monad.Except -import Data.Functor.Identity +import Control.Monad.Except (MonadError) +import Data.Functor.Identity (Identity) import Text.Parsec qualified as P import Text.Parsec.Expr qualified as P -import Language.PureScript.AST -import Language.PureScript.Names -import Language.PureScript.Sugar.Operators.Common -import Language.PureScript.Errors +import Language.PureScript.AST (Associativity, Expr(..), SourceSpan) +import Language.PureScript.Names (OpName(..), OpNameType(..), Qualified(..)) +import Language.PureScript.Sugar.Operators.Common (Chain, matchOperators, token) +import Language.PureScript.Errors (MultipleErrors) matchExprOperators :: MonadError MultipleErrors m diff --git a/src/Language/PureScript/Sugar/Operators/Types.hs b/src/Language/PureScript/Sugar/Operators/Types.hs index 2f9d242acb..81001511cb 100644 --- a/src/Language/PureScript/Sugar/Operators/Types.hs +++ b/src/Language/PureScript/Sugar/Operators/Types.hs @@ -2,12 +2,12 @@ module Language.PureScript.Sugar.Operators.Types where import Prelude -import Control.Monad.Except -import Language.PureScript.AST -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.Sugar.Operators.Common -import Language.PureScript.Types +import Control.Monad.Except (MonadError) +import Language.PureScript.AST (Associativity, SourceSpan) +import Language.PureScript.Errors (MultipleErrors) +import Language.PureScript.Names (OpName(..), OpNameType(..), Qualified(..)) +import Language.PureScript.Sugar.Operators.Common (matchOperators) +import Language.PureScript.Types (SourceType, Type(..), srcTypeApp) matchTypeOperators :: MonadError MultipleErrors m diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs index b5ed36bb14..a5bfa59b90 100644 --- a/src/Language/PureScript/Sugar/TypeClasses.hs +++ b/src/Language/PureScript/Sugar/TypeClasses.hs @@ -12,9 +12,9 @@ import Prelude import Control.Arrow (first, second) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State -import Control.Monad.Supply.Class -import Data.Graph +import Control.Monad.State (MonadState(..), StateT, evalStateT, modify) +import Control.Monad.Supply.Class (MonadSupply) +import Data.Graph (SCC(..), stronglyConnComp) import Data.List (find, partition) import Data.List.NonEmpty (nonEmpty) import Data.Map qualified as M @@ -24,14 +24,14 @@ import Data.Set qualified as S import Data.Text (Text) import Data.Traversable (for) import Language.PureScript.Constants.Prim qualified as C -import Language.PureScript.Crash -import Language.PureScript.Environment +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (DataDeclType(..), NameKind(..), TypeClassData(..), dictTypeName, function, makeTypeClassData, primClasses, primCoerceClasses, primIntClasses, primRowClasses, primRowListClasses, primSymbolClasses, primTypeErrorClasses, tyRecord) import Language.PureScript.Errors hiding (isExported, nonEmpty) -import Language.PureScript.Externs +import Language.PureScript.Externs (ExternsDeclaration(..), ExternsFile(..)) import Language.PureScript.Label (Label(..)) -import Language.PureScript.Names +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, freshIdent, qualify, runIdent) import Language.PureScript.PSString (mkString) -import Language.PureScript.Sugar.CaseDeclarations +import Language.PureScript.Sugar.CaseDeclarations (desugarCases) import Language.PureScript.TypeClassDictionaries (superclassName) import Language.PureScript.Types diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs index 622d872874..3b4c019521 100755 --- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs @@ -7,15 +7,15 @@ import Protolude (note) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Supply.Class (MonadSupply) import Data.List (foldl', find, unzip5) -import Language.PureScript.AST -import Language.PureScript.AST.Utils +import Language.PureScript.AST (Binder(..), CaseAlternative(..), DataConstructorDeclaration(..), Declaration(..), Expr(..), pattern MkUnguarded, Module(..), SourceSpan(..), TypeInstanceBody(..), pattern ValueDecl) +import Language.PureScript.AST.Utils (UnwrappedTypeConstructor(..), lamCase, unguarded, unwrapTypeConstructor) import Language.PureScript.Constants.Libs qualified as Libs -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (DataDeclType(..), NameKind(..)) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage') +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), freshIdent) import Language.PureScript.PSString (mkString) -import Language.PureScript.Types +import Language.PureScript.Types (SourceType, Type(..), WildcardData(..), replaceAllTypeVars, srcTypeApp, srcTypeConstructor, srcTypeLevelString) import Language.PureScript.TypeChecker (checkNewtype) -- | Elaborates deriving instance declarations by code generation. diff --git a/src/Language/PureScript/Sugar/TypeDeclarations.hs b/src/Language/PureScript/Sugar/TypeDeclarations.hs index 25e3f63910..ef00748d67 100644 --- a/src/Language/PureScript/Sugar/TypeDeclarations.hs +++ b/src/Language/PureScript/Sugar/TypeDeclarations.hs @@ -11,10 +11,10 @@ import Prelude import Control.Monad (unless) import Control.Monad.Error.Class (MonadError(..)) -import Language.PureScript.AST -import Language.PureScript.Names -import Language.PureScript.Environment -import Language.PureScript.Errors +import Language.PureScript.AST (Declaration(..), ErrorMessageHint(..), Expr(..), GuardedExpr(..), KindSignatureFor(..), pattern MkUnguarded, Module(..), RoleDeclarationData(..), TypeDeclarationData(..), TypeInstanceBody(..), pattern ValueDecl, declSourceSpan, everywhereOnValuesTopDownM) +import Language.PureScript.Names (Ident, coerceProperName) +import Language.PureScript.Environment (DataDeclType(..), NameKind) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage', rethrow) -- | -- Replace all top level type declarations in a module with type annotations diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index 8d210bac86..3f5043ad24 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -19,7 +19,7 @@ import Control.Monad.Writer.Class (MonadWriter, tell) import Data.Foldable (for_, traverse_, toList) import Data.List (nub, nubBy, (\\), sort, group) -import Data.Maybe +import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Either (partitionEithers) import Data.Text (Text) import Data.List.NonEmpty qualified as NEL @@ -30,13 +30,13 @@ import Data.Text qualified as T import Language.PureScript.AST import Language.PureScript.AST.Declarations.ChainId (ChainId) import Language.PureScript.Constants.Libs qualified as Libs -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Linter -import Language.PureScript.Linter.Wildcards -import Language.PureScript.Names -import Language.PureScript.Roles +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (DataDeclType(..), Environment(..), FunctionalDependency, NameKind(..), NameVisibility(..), TypeClassData(..), TypeKind(..), isDictTypeName, kindArity, makeTypeClassData, nominalRolesForKind, tyFunction) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage, errorMessage', positionedError, rethrow, warnAndRethrow) +import Language.PureScript.Linter (checkExhaustiveExpr) +import Language.PureScript.Linter.Wildcards (ignoreWildcardsUnderCompleteTypeSignatures) +import Language.PureScript.Names (Ident, ModuleName, ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, disqualify, isPlainIdent, mkQualified) +import Language.PureScript.Roles (Role) import Language.PureScript.Sugar.Names.Env (Exports(..)) import Language.PureScript.TypeChecker.Kinds as T import Language.PureScript.TypeChecker.Monad as T @@ -44,8 +44,8 @@ import Language.PureScript.TypeChecker.Roles as T import Language.PureScript.TypeChecker.Synonyms as T import Language.PureScript.TypeChecker.Types as T import Language.PureScript.TypeChecker.Unify (varIfUnknown) -import Language.PureScript.TypeClassDictionaries -import Language.PureScript.Types +import Language.PureScript.TypeClassDictionaries (NamedDict, TypeClassDictionaryInScope(..)) +import Language.PureScript.Types (Constraint(..), SourceConstraint, SourceType, Type(..), containsForAll, eqType, everythingOnTypes, freeTypeVariables, overConstraintArgs, srcInstanceType, unapplyTypes) addDataType :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index 533910bb14..b0114618bf 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -15,23 +15,23 @@ import Data.List (init, last, zipWith3, (!!)) import Data.Map qualified as M import Data.These (These(..), mergeTheseWith, these) -import Control.Monad.Supply.Class -import Language.PureScript.AST -import Language.PureScript.AST.Utils +import Control.Monad.Supply.Class (MonadSupply) +import Language.PureScript.AST (Binder(..), CaseAlternative(..), ErrorMessageHint(..), Expr(..), InstanceDerivationStrategy(..), Literal(..), SourceSpan, nullSourceSpan) +import Language.PureScript.AST.Utils (UnwrappedTypeConstructor(..), lam, lamCase, lamCase2, mkBinder, mkCtor, mkCtorBinder, mkLit, mkRef, mkVar, unguarded, unwrapTypeConstructor, utcQTyCon) import Language.PureScript.Constants.Libs qualified as Libs import Language.PureScript.Constants.Prim qualified as Prim -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors hiding (nonEmpty) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (DataDeclType(..), Environment(..), FunctionalDependency(..), TypeClassData(..), TypeKind(..), kindType, (-:>)) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage, internalCompilerError) import Language.PureScript.Label (Label(..)) -import Language.PureScript.Names -import Language.PureScript.PSString -import Language.PureScript.Sugar.TypeClasses -import Language.PureScript.TypeChecker.Entailment -import Language.PureScript.TypeChecker.Monad -import Language.PureScript.TypeChecker.Synonyms -import Language.PureScript.TypeClassDictionaries -import Language.PureScript.Types +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName(..), Name(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, freshIdent, qualify) +import Language.PureScript.PSString (PSString, mkString) +import Language.PureScript.Sugar.TypeClasses (superClassDictionaryNames) +import Language.PureScript.TypeChecker.Entailment (InstanceContext, findDicts) +import Language.PureScript.TypeChecker.Monad (CheckState, getEnv, getTypeClassDictionaries, unsafeCheckCurrentModule) +import Language.PureScript.TypeChecker.Synonyms (replaceAllTypeSynonyms) +import Language.PureScript.TypeClassDictionaries (TypeClassDictionaryInScope(..)) +import Language.PureScript.Types (Constraint(..), pattern REmptyKinded, SourceType, Type(..), completeBinderList, eqType, everythingOnTypes, replaceAllTypeVars, srcTypeVar, usedTypeVariables) -- | Extract the name of the newtype appearing in the last type argument of -- a derived newtype instance. diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index 5774f578f2..74d70a3aa7 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -15,9 +15,9 @@ import Protolude (ordNub) import Control.Arrow (second, (&&&)) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State +import Control.Monad.State (MonadState(..), MonadTrans(..), StateT(..), evalStateT, execStateT, foldM, gets, guard, join, modify, zipWithM, zipWithM_, (<=<)) import Control.Monad.Supply.Class (MonadSupply(..)) -import Control.Monad.Writer +import Control.Monad.Writer (Any(..), MonadWriter(..), WriterT(..)) import Data.Either (lefts, partitionEithers) import Data.Foldable (for_, fold, toList) @@ -33,18 +33,18 @@ import Data.Text qualified as T import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty qualified as NEL -import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.TypeChecker.Entailment.Coercible -import Language.PureScript.TypeChecker.Entailment.IntCompare +import Language.PureScript.AST (Binder(..), ErrorMessageHint(..), Expr(..), Literal(..), pattern NullSourceSpan, everywhereOnValuesTopDownM, nullSourceSpan) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (Environment(..), FunctionalDependency(..), TypeClassData(..), dictTypeName, kindRow, tyBoolean, tyInt, tyString) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, addHints, errorMessage, rethrow) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName, coerceProperName, disqualify, freshIdent, getQual) +import Language.PureScript.TypeChecker.Entailment.Coercible (GivenSolverState(..), WantedSolverState(..), initialGivenSolverState, initialWantedSolverState, insoluble, solveGivens, solveWanteds) +import Language.PureScript.TypeChecker.Entailment.IntCompare (mkFacts, mkRelation, solveRelation) import Language.PureScript.TypeChecker.Kinds (elaborateKind, unifyKinds') -import Language.PureScript.TypeChecker.Monad +import Language.PureScript.TypeChecker.Monad (CheckState(..), withErrorMessageHint) import Language.PureScript.TypeChecker.Synonyms (replaceAllTypeSynonyms) -import Language.PureScript.TypeChecker.Unify -import Language.PureScript.TypeClassDictionaries +import Language.PureScript.TypeChecker.Unify (freshTypeWithKind, substituteType, unifyTypes) +import Language.PureScript.TypeClassDictionaries (NamedDict, TypeClassDictionaryInScope(..), superclassName) import Language.PureScript.Types import Language.PureScript.Label (Label(..)) import Language.PureScript.PSString (PSString, mkString, decodeString) diff --git a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs index 648a3aa696..bbc0e49411 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs @@ -35,17 +35,17 @@ import Data.Text (Text) import Data.Map qualified as M import Data.Set qualified as S -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors hiding (inScope) -import Language.PureScript.Names -import Language.PureScript.TypeChecker.Kinds hiding (kindOf) -import Language.PureScript.TypeChecker.Monad -import Language.PureScript.TypeChecker.Roles -import Language.PureScript.TypeChecker.Synonyms -import Language.PureScript.TypeChecker.Unify -import Language.PureScript.Roles -import Language.PureScript.Types +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (DataDeclType(..), Environment(..), TypeKind(..), unapplyKinds) +import Language.PureScript.Errors (DeclarationRef(..), ErrorMessageHint(..), ExportSource, ImportDeclarationType(..), MultipleErrors, SimpleErrorMessage(..), SourceAnn, errorMessage) +import Language.PureScript.Names (ModuleName, ProperName, ProperNameType(..), Qualified(..), byMaybeModuleName, toMaybeModuleName) +import Language.PureScript.TypeChecker.Kinds (elaborateKind, freshKindWithKind, unifyKinds') +import Language.PureScript.TypeChecker.Monad (CheckState(..)) +import Language.PureScript.TypeChecker.Roles (lookupRoles) +import Language.PureScript.TypeChecker.Synonyms (replaceAllTypeSynonyms) +import Language.PureScript.TypeChecker.Unify (alignRowsWith, freshTypeWithKind, substituteType) +import Language.PureScript.Roles (Role(..)) +import Language.PureScript.Types (Constraint(..), SourceType, Type(..), completeBinderList, containsUnknowns, everythingOnTypes, isMonoType, replaceAllTypeVars, rowFromList, srcConstraint, srcTypeApp, unapplyTypes) import Language.PureScript.Constants.Prim qualified as Prim -- | State of the given constraints solver. diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs index fe1a582b4d..b39d980c3e 100644 --- a/src/Language/PureScript/TypeChecker/Kinds.hs +++ b/src/Language/PureScript/TypeChecker/Kinds.hs @@ -29,10 +29,10 @@ import Prelude import Control.Arrow ((***)) import Control.Lens ((^.), _1, _2, _3) -import Control.Monad +import Control.Monad (join, unless, void, when, (<=<)) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State -import Control.Monad.Supply.Class +import Control.Monad.State (MonadState, gets, modify) +import Control.Monad.Supply.Class (MonadSupply(..)) import Data.Bifunctor (first) import Data.Bitraversable (bitraverse) @@ -47,15 +47,15 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Traversable (for) -import Language.PureScript.Crash +import Language.PureScript.Crash (HasCallStack, internalError) import Language.PureScript.Environment qualified as E import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.TypeChecker.Monad +import Language.PureScript.Names (pattern ByNullSourcePos, ModuleName, Name(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, mkQualified) +import Language.PureScript.TypeChecker.Monad (CheckState(..), Substitution(..), UnkLevel(..), Unknown, bindLocalTypeVariables, debugType, getEnv, lookupTypeVariable, unsafeCheckCurrentModule, withErrorMessageHint, withFreshSubstitution) import Language.PureScript.TypeChecker.Skolems (newSkolemConstant, newSkolemScope, skolemize) -import Language.PureScript.TypeChecker.Synonyms +import Language.PureScript.TypeChecker.Synonyms (replaceAllTypeSynonyms) import Language.PureScript.Types -import Language.PureScript.Pretty.Types +import Language.PureScript.Pretty.Types (prettyPrintType) generalizeUnknowns :: [(Unknown, SourceType)] -> SourceType -> SourceType generalizeUnknowns unks ty = diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs index fb02264de5..ba27d0299b 100644 --- a/src/Language/PureScript/TypeChecker/Monad.hs +++ b/src/Language/PureScript/TypeChecker/Monad.hs @@ -9,23 +9,23 @@ import Prelude import Control.Arrow (second) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State +import Control.Monad.State (MonadState(..), StateT(..), forM_, gets, guard, join, modify, when, (<=<)) import Control.Monad.Writer.Class (MonadWriter(..), censor) -import Data.Maybe +import Data.Maybe (fromMaybe) import Data.Map qualified as M import Data.Set qualified as S import Data.Text (Text, isPrefixOf, unpack) import Data.List.NonEmpty qualified as NEL import Language.PureScript.Crash (internalError) -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.Pretty.Types -import Language.PureScript.Pretty.Values -import Language.PureScript.TypeClassDictionaries -import Language.PureScript.Types +import Language.PureScript.Environment (Environment(..), NameKind(..), NameVisibility(..), TypeClassData(..), TypeKind(..)) +import Language.PureScript.Errors (Context, ErrorMessageHint, ExportSource, Expr, ImportDeclarationType, MultipleErrors, SimpleErrorMessage(..), SourceAnn, SourceSpan(..), addHint, errorMessage, positionedError, rethrow, warnWithPosition) +import Language.PureScript.Names (Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, disqualify, runIdent, runModuleName, showQualified, toMaybeModuleName) +import Language.PureScript.Pretty.Types (prettyPrintType) +import Language.PureScript.Pretty.Values (prettyPrintValue) +import Language.PureScript.TypeClassDictionaries (NamedDict, TypeClassDictionaryInScope(..)) +import Language.PureScript.Types (Constraint(..), SourceType, Type(..), srcKindedType, srcTypeVar) import Text.PrettyPrint.Boxes (render) newtype UnkLevel = UnkLevel (NEL.NonEmpty Unknown) diff --git a/src/Language/PureScript/TypeChecker/Roles.hs b/src/Language/PureScript/TypeChecker/Roles.hs index 885d3f8c11..fb43b2e821 100644 --- a/src/Language/PureScript/TypeChecker/Roles.hs +++ b/src/Language/PureScript/TypeChecker/Roles.hs @@ -24,11 +24,11 @@ import Data.Set qualified as S import Data.Semigroup (Any(..)) import Data.Text (Text) -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.Roles -import Language.PureScript.Types +import Language.PureScript.Environment (Environment(..), TypeKind(..)) +import Language.PureScript.Errors (DataConstructorDeclaration(..), MultipleErrors, RoleDeclarationData(..), SimpleErrorMessage(..), errorMessage) +import Language.PureScript.Names (ModuleName, ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..)) +import Language.PureScript.Roles (Role(..)) +import Language.PureScript.Types (Constraint(..), SourceType, Type(..), freeTypeVariables, unapplyTypes) -- | -- A map of a type's formal parameter names to their roles. This type's diff --git a/src/Language/PureScript/TypeChecker/Skolems.hs b/src/Language/PureScript/TypeChecker/Skolems.hs index 2f5567ccf7..3c49d2bf36 100644 --- a/src/Language/PureScript/TypeChecker/Skolems.hs +++ b/src/Language/PureScript/TypeChecker/Skolems.hs @@ -16,12 +16,12 @@ import Data.Foldable (traverse_) import Data.Functor.Identity (Identity(), runIdentity) import Data.Set (Set, fromList, notMember) import Data.Text (Text) -import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Errors +import Language.PureScript.AST (Binder(..), ErrorMessageHint(..), Expr(..), SourceAnn, SourceSpan, everythingWithContextOnValues, everywhereWithContextOnValuesM, nonEmptySpan) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors, SimpleErrorMessage(..), positionedError, singleError) import Language.PureScript.Traversals (defS) -import Language.PureScript.TypeChecker.Monad -import Language.PureScript.Types +import Language.PureScript.TypeChecker.Monad (CheckState(..)) +import Language.PureScript.Types (SkolemScope(..), SourceType, Type(..), everythingOnTypes, everywhereOnTypesM, replaceTypeVars) -- | Generate a new skolem constant newSkolemConstant :: MonadState CheckState m => m Int diff --git a/src/Language/PureScript/TypeChecker/Subsumption.hs b/src/Language/PureScript/TypeChecker/Subsumption.hs index 8fdd798990..e99f1c829c 100644 --- a/src/Language/PureScript/TypeChecker/Subsumption.hs +++ b/src/Language/PureScript/TypeChecker/Subsumption.hs @@ -16,14 +16,14 @@ import Data.List (uncons) import Data.List.Ordered (minusBy') import Data.Ord (comparing) -import Language.PureScript.AST -import Language.PureScript.Crash -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.TypeChecker.Monad -import Language.PureScript.TypeChecker.Skolems -import Language.PureScript.TypeChecker.Unify -import Language.PureScript.Types +import Language.PureScript.AST (ErrorMessageHint(..), Expr(..), pattern NullSourceAnn) +import Language.PureScript.Crash (internalError) +import Language.PureScript.Environment (tyFunction, tyRecord) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage, internalCompilerError) +import Language.PureScript.TypeChecker.Monad (CheckState, getHints, getTypeClassDictionaries, withErrorMessageHint) +import Language.PureScript.TypeChecker.Skolems (newSkolemConstant, skolemize) +import Language.PureScript.TypeChecker.Unify (alignRowsWith, freshTypeWithKind, unifyTypes) +import Language.PureScript.Types (RowListItem(..), SourceType, Type(..), eqType, isREmpty, replaceTypeVars, rowFromList) -- | Subsumption can operate in two modes: -- diff --git a/src/Language/PureScript/TypeChecker/Synonyms.hs b/src/Language/PureScript/TypeChecker/Synonyms.hs index 90e6da28f6..dc7b0522d4 100644 --- a/src/Language/PureScript/TypeChecker/Synonyms.hs +++ b/src/Language/PureScript/TypeChecker/Synonyms.hs @@ -13,15 +13,15 @@ module Language.PureScript.TypeChecker.Synonyms import Prelude import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State +import Control.Monad.State (MonadState) import Data.Maybe (fromMaybe) import Data.Map qualified as M import Data.Text (Text) -import Language.PureScript.Environment -import Language.PureScript.Errors -import Language.PureScript.Names -import Language.PureScript.TypeChecker.Monad -import Language.PureScript.Types +import Language.PureScript.Environment (Environment(..), TypeKind) +import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), SourceSpan, errorMessage') +import Language.PureScript.Names (ProperName, ProperNameType(..), Qualified) +import Language.PureScript.TypeChecker.Monad (CheckState, getEnv) +import Language.PureScript.Types (SourceType, Type(..), completeBinderList, everywhereOnTypesTopDownM, getAnnForType, replaceAllTypeVars) -- | Type synonym information (arguments with kinds, aliased type), indexed by name type SynonymMap = M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceType)], SourceType) diff --git a/src/Language/PureScript/TypeChecker/TypeSearch.hs b/src/Language/PureScript/TypeChecker/TypeSearch.hs index 5b40636ece..6158f48a82 100644 --- a/src/Language/PureScript/TypeChecker/TypeSearch.hs +++ b/src/Language/PureScript/TypeChecker/TypeSearch.hs @@ -9,14 +9,14 @@ import Data.Map qualified as Map import Language.PureScript.TypeChecker.Entailment qualified as Entailment import Language.PureScript.TypeChecker.Monad qualified as TC -import Language.PureScript.TypeChecker.Subsumption +import Language.PureScript.TypeChecker.Subsumption (subsumes) import Language.PureScript.TypeChecker.Unify as P import Control.Monad.Supply as P import Language.PureScript.AST as P import Language.PureScript.Environment as P import Language.PureScript.Errors as P -import Language.PureScript.Label +import Language.PureScript.Label (Label) import Language.PureScript.Names as P import Language.PureScript.Pretty.Types as P import Language.PureScript.TypeChecker.Skolems as Skolem diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs index 7a82f22214..c8615e6b42 100644 --- a/src/Language/PureScript/TypeChecker/Types.hs +++ b/src/Language/PureScript/TypeChecker/Types.hs @@ -27,7 +27,7 @@ import Prelude import Protolude (ordNub, fold, atMay) import Control.Arrow (first, second, (***)) -import Control.Monad +import Control.Monad (forM, forM_, guard, replicateM, unless, when, zipWithM, (<=<)) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (MonadState(..), gets) import Control.Monad.Supply.Class (MonadSupply) @@ -46,20 +46,20 @@ import Data.Set qualified as S import Data.IntSet qualified as IS import Language.PureScript.AST -import Language.PureScript.Crash +import Language.PureScript.Crash (internalError) import Language.PureScript.Environment -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.Errors (ErrorMessage(..), MultipleErrors, SimpleErrorMessage(..), errorMessage, errorMessage', escalateWarningWhen, internalCompilerError, onErrorMessages, onTypesInErrorMessage, parU) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName, coerceProperName, freshIdent) +import Language.PureScript.Traversals (sndM) +import Language.PureScript.TypeChecker.Deriving (deriveInstance) +import Language.PureScript.TypeChecker.Entailment (InstanceContext, newDictionaries, replaceTypeClassDictionaries) +import Language.PureScript.TypeChecker.Kinds (checkConstraint, checkTypeKind, kindOf, kindOfWithScopedVars, unifyKinds', unknownsWithKinds) import Language.PureScript.TypeChecker.Monad -import Language.PureScript.TypeChecker.Skolems -import Language.PureScript.TypeChecker.Subsumption -import Language.PureScript.TypeChecker.Synonyms -import Language.PureScript.TypeChecker.TypeSearch -import Language.PureScript.TypeChecker.Unify +import Language.PureScript.TypeChecker.Skolems (introduceSkolemScope, newSkolemConstant, newSkolemScope, skolemEscapeCheck, skolemize, skolemizeTypesInValue) +import Language.PureScript.TypeChecker.Subsumption (subsumes) +import Language.PureScript.TypeChecker.Synonyms (replaceAllTypeSynonyms) +import Language.PureScript.TypeChecker.TypeSearch (typeSearch) +import Language.PureScript.TypeChecker.Unify (freshTypeWithKind, replaceTypeWildcards, substituteType, unifyTypes, unknownsInType, varIfUnknown) import Language.PureScript.Types import Language.PureScript.Label (Label(..)) import Language.PureScript.PSString (PSString) diff --git a/src/Language/PureScript/TypeChecker/Unify.hs b/src/Language/PureScript/TypeChecker/Unify.hs index 98af9804da..b58c8d78a7 100644 --- a/src/Language/PureScript/TypeChecker/Unify.hs +++ b/src/Language/PureScript/TypeChecker/Unify.hs @@ -16,7 +16,7 @@ module Language.PureScript.TypeChecker.Unify import Prelude -import Control.Monad +import Control.Monad (forM_, void) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (MonadState(..), gets, modify, state) import Control.Monad.Writer.Class (MonadWriter(..)) @@ -26,13 +26,13 @@ import Data.Maybe (fromMaybe) import Data.Map qualified as M import Data.Text qualified as T -import Language.PureScript.Crash +import Language.PureScript.Crash (internalError) import Language.PureScript.Environment qualified as E -import Language.PureScript.Errors +import Language.PureScript.Errors (ErrorMessageHint(..), MultipleErrors, SimpleErrorMessage(..), SourceAnn, errorMessage, internalCompilerError, onErrorMessages, rethrow, warnWithPosition, withoutPosition) import Language.PureScript.TypeChecker.Kinds (elaborateKind, instantiateKind, unifyKinds') -import Language.PureScript.TypeChecker.Monad -import Language.PureScript.TypeChecker.Skolems -import Language.PureScript.Types +import Language.PureScript.TypeChecker.Monad (CheckState(..), Substitution(..), UnkLevel(..), Unknown, getLocalContext, guardWith, lookupUnkName, withErrorMessageHint) +import Language.PureScript.TypeChecker.Skolems (newSkolemConstant, skolemize) +import Language.PureScript.Types (Constraint(..), pattern REmptyKinded, RowListItem(..), SourceType, Type(..), WildcardData(..), alignRowsWith, everythingOnTypes, everywhereOnTypes, everywhereOnTypesM, getAnnForType, mkForAll, rowFromList, srcTUnknown) -- | Generate a fresh type variable with an unknown kind. Avoid this if at all possible. freshType :: (MonadState CheckState m) => m SourceType diff --git a/src/Language/PureScript/TypeClassDictionaries.hs b/src/Language/PureScript/TypeClassDictionaries.hs index dc3bfad14f..593e8c1a8d 100644 --- a/src/Language/PureScript/TypeClassDictionaries.hs +++ b/src/Language/PureScript/TypeClassDictionaries.hs @@ -7,8 +7,8 @@ import Control.DeepSeq (NFData) import Data.Text (Text, pack) import Language.PureScript.AST.Declarations.ChainId (ChainId) -import Language.PureScript.Names -import Language.PureScript.Types +import Language.PureScript.Names (Ident, ProperName(..), ProperNameType(..), Qualified, disqualify) +import Language.PureScript.Types (SourceConstraint, SourceType) -- -- Data representing a type class dictionary which is in scope diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs index 2f11ea4062..6e7552521f 100644 --- a/src/Language/PureScript/Types.hs +++ b/src/Language/PureScript/Types.hs @@ -23,9 +23,9 @@ import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic) -import Language.PureScript.AST.SourcePos +import Language.PureScript.AST.SourcePos (pattern NullSourceAnn, SourceAnn, SourceSpan) import Language.PureScript.Constants.Prim qualified as C -import Language.PureScript.Names +import Language.PureScript.Names (OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified, coerceProperName) import Language.PureScript.Label (Label) import Language.PureScript.PSString (PSString) diff --git a/tests/Language/PureScript/Ide/CompletionSpec.hs b/tests/Language/PureScript/Ide/CompletionSpec.hs index 3b838badb7..6ab1d89585 100644 --- a/tests/Language/PureScript/Ide/CompletionSpec.hs +++ b/tests/Language/PureScript/Ide/CompletionSpec.hs @@ -5,10 +5,10 @@ import Protolude import Language.PureScript qualified as P import Language.PureScript.Ide.Test as Test import Language.PureScript.Ide.Command as Command -import Language.PureScript.Ide.Completion +import Language.PureScript.Ide.Completion (CompletionOptions(..), applyCompletionOptions, defaultCompletionOptions) import Language.PureScript.Ide.Filter.Declaration qualified as DeclarationType -import Language.PureScript.Ide.Types -import Test.Hspec +import Language.PureScript.Ide.Types (Completion(..), IdeDeclarationAnn, Match(..), Success(..)) +import Test.Hspec (Spec, describe, it, shouldBe, shouldMatchList, shouldSatisfy) reexportMatches :: [Match IdeDeclarationAnn] reexportMatches = diff --git a/tests/Language/PureScript/Ide/FilterSpec.hs b/tests/Language/PureScript/Ide/FilterSpec.hs index 2ead8749d8..80eb127bd8 100644 --- a/tests/Language/PureScript/Ide/FilterSpec.hs +++ b/tests/Language/PureScript/Ide/FilterSpec.hs @@ -3,13 +3,13 @@ module Language.PureScript.Ide.FilterSpec where import Protolude import Data.Map qualified as Map import Data.Set qualified as Set -import Language.PureScript.Ide.Filter +import Language.PureScript.Ide.Filter (applyFilters, declarationTypeFilter, dependencyFilter, exactFilter, moduleFilter, namespaceFilter, prefixFilter) import Language.PureScript.Ide.Filter.Declaration as D -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Imports +import Language.PureScript.Ide.Types (IdeDeclarationAnn, IdeNamespace(..), ModuleMap) +import Language.PureScript.Ide.Imports (Import, sliceImportSection) import Language.PureScript.Ide.Test as T import Language.PureScript qualified as P -import Test.Hspec +import Test.Hspec (Spec, describe, it, shouldBe) type Module = (P.ModuleName, [IdeDeclarationAnn]) diff --git a/tests/Language/PureScript/Ide/ImportsSpec.hs b/tests/Language/PureScript/Ide/ImportsSpec.hs index a060ca3edf..b12aeea352 100644 --- a/tests/Language/PureScript/Ide/ImportsSpec.hs +++ b/tests/Language/PureScript/Ide/ImportsSpec.hs @@ -6,14 +6,14 @@ import Data.Set qualified as Set import Language.PureScript qualified as P import Language.PureScript.Ide.Command as Command -import Language.PureScript.Ide.Error -import Language.PureScript.Ide.Imports -import Language.PureScript.Ide.Imports.Actions +import Language.PureScript.Ide.Error (IdeError) +import Language.PureScript.Ide.Imports (Import, parseImport, prettyPrintImport', prettyPrintImportSection, sliceImportSection) +import Language.PureScript.Ide.Imports.Actions (addExplicitImport', addImplicitImport', addQualifiedImport') import Language.PureScript.Ide.Filter (moduleFilter) import Language.PureScript.Ide.Test qualified as Test -import Language.PureScript.Ide.Types -import System.FilePath -import Test.Hspec +import Language.PureScript.Ide.Types (IdeDeclarationAnn(..), Success(..)) +import System.FilePath (()) +import Test.Hspec (Expectation, Spec, describe, it, shouldBe, shouldSatisfy) noImportsFile :: [Text] noImportsFile = diff --git a/tests/Language/PureScript/Ide/MatcherSpec.hs b/tests/Language/PureScript/Ide/MatcherSpec.hs index 90b1a8dd4d..306e3ca321 100644 --- a/tests/Language/PureScript/Ide/MatcherSpec.hs +++ b/tests/Language/PureScript/Ide/MatcherSpec.hs @@ -3,10 +3,10 @@ module Language.PureScript.Ide.MatcherSpec where import Protolude import Language.PureScript qualified as P -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util -import Test.Hspec +import Language.PureScript.Ide.Matcher (flexMatcher, runMatcher) +import Language.PureScript.Ide.Types (IdeDeclaration(..), IdeDeclarationAnn, IdeValue(..), Match(..)) +import Language.PureScript.Ide.Util (withEmptyAnn) +import Test.Hspec (Spec, describe, it, shouldBe) value :: Text -> IdeDeclarationAnn value s = withEmptyAnn (IdeDeclValue (IdeValue (P.Ident (toS s)) P.srcREmpty)) diff --git a/tests/Language/PureScript/Ide/RebuildSpec.hs b/tests/Language/PureScript/Ide/RebuildSpec.hs index 24364f2310..93a0cabe51 100644 --- a/tests/Language/PureScript/Ide/RebuildSpec.hs +++ b/tests/Language/PureScript/Ide/RebuildSpec.hs @@ -5,14 +5,14 @@ import Protolude import Data.Set qualified as Set import Language.PureScript qualified as P import Language.PureScript.AST.SourcePos (spanName) -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Matcher -import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Command (Command(..)) +import Language.PureScript.Ide.Completion (defaultCompletionOptions) +import Language.PureScript.Ide.Matcher (flexMatcher) +import Language.PureScript.Ide.Types (Completion(..), Success(..), emptyIdeState) import Language.PureScript.Ide.Test qualified as Test -import System.FilePath +import System.FilePath (()) import System.Directory (doesFileExist, removePathForcibly) -import Test.Hspec +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) defaultTarget :: Set P.CodegenTarget defaultTarget = Set.singleton P.JS diff --git a/tests/Language/PureScript/Ide/ReexportsSpec.hs b/tests/Language/PureScript/Ide/ReexportsSpec.hs index fced678692..77265987d1 100644 --- a/tests/Language/PureScript/Ide/ReexportsSpec.hs +++ b/tests/Language/PureScript/Ide/ReexportsSpec.hs @@ -3,11 +3,11 @@ module Language.PureScript.Ide.ReexportsSpec where import Protolude import Data.Map qualified as Map -import Language.PureScript.Ide.Reexports -import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Test +import Language.PureScript.Ide.Reexports (ReexportResult(..), reexportHasFailures, resolveReexports') +import Language.PureScript.Ide.Types (IdeDeclarationAnn, ModuleMap) +import Language.PureScript.Ide.Test (annExp, ideDtor, ideKind, ideSynonym, ideType, ideTypeClass, ideValue, mn) import Language.PureScript qualified as P -import Test.Hspec +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) valueA, typeA, synonymA, classA, dtorA1, dtorA2, kindA :: IdeDeclarationAnn valueA = ideValue "valueA" Nothing diff --git a/tests/Language/PureScript/Ide/SourceFileSpec.hs b/tests/Language/PureScript/Ide/SourceFileSpec.hs index 12c8e8d234..f7de445c0e 100644 --- a/tests/Language/PureScript/Ide/SourceFileSpec.hs +++ b/tests/Language/PureScript/Ide/SourceFileSpec.hs @@ -3,11 +3,11 @@ module Language.PureScript.Ide.SourceFileSpec where import Protolude import Language.PureScript qualified as P -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.SourceFile -import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Command (Command(..)) +import Language.PureScript.Ide.SourceFile (extractSpans, extractTypeAnnotations) +import Language.PureScript.Ide.Types (Completion(..), IdeNamespace(..), IdeNamespaced(..), Success(..), emptyIdeState) import Language.PureScript.Ide.Test -import Test.Hspec +import Test.Hspec (Spec, describe, it, shouldBe) span1, span2 :: P.SourceSpan span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2) diff --git a/tests/Language/PureScript/Ide/StateSpec.hs b/tests/Language/PureScript/Ide/StateSpec.hs index 2c28dc22d3..5ece522c34 100644 --- a/tests/Language/PureScript/Ide/StateSpec.hs +++ b/tests/Language/PureScript/Ide/StateSpec.hs @@ -1,12 +1,12 @@ 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 Control.Lens (Ixed(..), folded) +import Language.PureScript.Ide.Types (IdeDeclarationAnn, IdeInstance(..), ModuleMap, _IdeDeclTypeClass, anyOf, idaDeclaration, ideTCInstances) +import Language.PureScript.Ide.State (resolveDataConstructorsForModule, resolveInstances, resolveOperatorsForModule) +import Language.PureScript.Ide.Test (ideDtor, ideType, ideTypeClass, ideTypeOp, ideValue, ideValueOp, mn) import Language.PureScript qualified as P -import Test.Hspec +import Test.Hspec (Spec, describe, it, shouldSatisfy) import Data.Map qualified as Map valueOperator :: Maybe P.SourceType -> IdeDeclarationAnn diff --git a/tests/Language/PureScript/Ide/Test.hs b/tests/Language/PureScript/Ide/Test.hs index d9b58ca091..7092b1cf53 100644 --- a/tests/Language/PureScript/Ide/Test.hs +++ b/tests/Language/PureScript/Ide/Test.hs @@ -1,18 +1,18 @@ {-# LANGUAGE PackageImports #-} module Language.PureScript.Ide.Test where -import Control.Concurrent.STM -import "monad-logger" Control.Monad.Logger -import Data.IORef +import Control.Concurrent.STM (newTVarIO, readTVarIO) +import "monad-logger" Control.Monad.Logger (NoLoggingT(..)) +import Data.IORef (newIORef) import Data.Map qualified as Map -import Language.PureScript.Ide -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Error +import Language.PureScript.Ide (handleCommand) +import Language.PureScript.Ide.Command (Command) +import Language.PureScript.Ide.Error (IdeError) import Language.PureScript.Ide.Types import Protolude -import System.Directory -import System.FilePath -import System.Process +import System.Directory (doesDirectoryExist, getCurrentDirectory, makeAbsolute, removeDirectoryRecursive, setCurrentDirectory) +import System.FilePath (()) +import System.Process (createProcess, getProcessExitCode, shell) import Language.PureScript qualified as P diff --git a/tests/Language/PureScript/Ide/UsageSpec.hs b/tests/Language/PureScript/Ide/UsageSpec.hs index 97c5c379d7..0c399dfbf7 100644 --- a/tests/Language/PureScript/Ide/UsageSpec.hs +++ b/tests/Language/PureScript/Ide/UsageSpec.hs @@ -3,13 +3,13 @@ module Language.PureScript.Ide.UsageSpec where import Protolude import Data.Text qualified as Text -import Language.PureScript.Ide.Command -import Language.PureScript.Ide.Types +import Language.PureScript.Ide.Command (Command(..)) +import Language.PureScript.Ide.Types (IdeNamespace(..), Success(..)) import Language.PureScript.Ide.Test qualified as Test import Language.PureScript qualified as P -import Test.Hspec +import Test.Hspec (Expectation, Spec, describe, it, shouldBe) import Data.Text.Read (decimal) -import System.FilePath +import System.FilePath (()) load :: [Text] -> Command load = LoadSync . map Test.mn diff --git a/tests/TestAst.hs b/tests/TestAst.hs index 75095b239f..88801e14f9 100644 --- a/tests/TestAst.hs +++ b/tests/TestAst.hs @@ -5,14 +5,14 @@ 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 +import Generic.Random (genericArbitraryRecG, genericArbitraryUG, listOf', uniform, withBaseCase, (:+)(..)) +import Test.Hspec (Spec, describe, it) +import Test.QuickCheck (Arbitrary(..), Gen, Property, Testable, counterexample, forAllShrink, subterms, (===)) + +import Language.PureScript.Label (Label(..)) +import Language.PureScript.Names (pattern ByNullSourcePos, OpName(..), OpNameType(..), ProperName(..), ProperNameType(..), Qualified(..)) +import Language.PureScript.PSString (PSString) +import Language.PureScript.Types (Constraint, ConstraintData, SkolemScope(..), Type(..), WildcardData, annForType, everythingOnTypes, everythingWithContextOnTypes, everywhereOnTypes, everywhereOnTypesM, everywhereOnTypesTopDownM, getAnnForType) spec :: Spec spec = do diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs index 8a08024ceb..c13ca20104 100644 --- a/tests/TestCompiler.hs +++ b/tests/TestCompiler.hs @@ -36,18 +36,18 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T -import Control.Monad +import Control.Monad (forM_, when) -import System.Exit -import System.FilePath -import System.IO +import System.Exit (ExitCode(..)) +import System.FilePath (pathSeparator, replaceExtension, takeFileName, ()) +import System.IO (Handle, hPutStr, hPutStrLn) import System.IO.UTF8 (readUTF8File) -import Text.Regex.Base +import Text.Regex.Base (RegexContext(..), RegexMaker(..)) import Text.Regex.TDFA (Regex) -import TestUtils -import Test.Hspec +import TestUtils (ExpectedModuleName(..), SupportModules, compile, createOutputFile, getTestFiles, goldenVsString, modulesDir, trim) +import Test.Hspec (Expectation, SpecWith, beforeAllWith, describe, expectationFailure, it, runIO) spec :: SpecWith SupportModules spec = do diff --git a/tests/TestCoreFn.hs b/tests/TestCoreFn.hs index 263ba795b1..eb71f13b90 100644 --- a/tests/TestCoreFn.hs +++ b/tests/TestCoreFn.hs @@ -4,21 +4,21 @@ module TestCoreFn (spec) where import Prelude -import Data.Aeson -import Data.Aeson.Types as Aeson +import Data.Aeson (Result(..), Value) +import Data.Aeson.Types (parse) import Data.Map as M -import Data.Version +import Data.Version (Version(..)) -import Language.PureScript.AST.Literals -import Language.PureScript.AST.SourcePos -import Language.PureScript.Comments -import Language.PureScript.CoreFn -import Language.PureScript.CoreFn.FromJSON -import Language.PureScript.CoreFn.ToJSON -import Language.PureScript.Names -import Language.PureScript.PSString +import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.AST.SourcePos (SourcePos(..), SourceSpan(..)) +import Language.PureScript.Comments (Comment(..)) +import Language.PureScript.CoreFn (Ann, Bind(..), Binder(..), CaseAlternative(..), ConstructorType(..), Expr(..), Meta(..), Module(..), ssAnn) +import Language.PureScript.CoreFn.FromJSON (moduleFromJSON) +import Language.PureScript.CoreFn.ToJSON (moduleToJSON) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName(..), ProperName(..), Qualified(..), QualifiedBy(..)) +import Language.PureScript.PSString (mkString) -import Test.Hspec +import Test.Hspec (Spec, context, shouldBe, shouldSatisfy, specify) parseModule :: Value -> Result (Version, Module Ann) parseModule = parse moduleFromJSON @@ -30,7 +30,7 @@ parseMod m = in snd <$> parseModule (moduleToJSON v m) isSuccess :: Result a -> Bool -isSuccess (Aeson.Success _) = True +isSuccess (Success _) = True isSuccess _ = False spec :: Spec @@ -47,49 +47,49 @@ spec = context "CoreFnFromJson" $ do r `shouldSatisfy` isSuccess case r of Error _ -> return () - Aeson.Success v' -> v' `shouldBe` v + Success v' -> v' `shouldBe` v specify "should parse an empty module" $ do let r = parseMod $ Module ss [] mn mp [] [] M.empty [] [] r `shouldSatisfy` isSuccess case r of Error _ -> return () - Aeson.Success m -> moduleName m `shouldBe` mn + Success m -> moduleName m `shouldBe` mn specify "should parse source span" $ do let r = parseMod $ Module ss [] mn mp [] [] M.empty [] [] r `shouldSatisfy` isSuccess case r of Error _ -> return () - Aeson.Success m -> moduleSourceSpan m `shouldBe` ss + Success m -> moduleSourceSpan m `shouldBe` ss specify "should parse module path" $ do let r = parseMod $ Module ss [] mn mp [] [] M.empty [] [] r `shouldSatisfy` isSuccess case r of Error _ -> return () - Aeson.Success m -> modulePath m `shouldBe` mp + Success m -> modulePath m `shouldBe` mp specify "should parse imports" $ do let r = parseMod $ Module ss [] mn mp [(ann, mn)] [] M.empty [] [] r `shouldSatisfy` isSuccess case r of Error _ -> return () - Aeson.Success m -> moduleImports m `shouldBe` [(ann, mn)] + Success m -> moduleImports m `shouldBe` [(ann, mn)] specify "should parse exports" $ do let r = parseMod $ Module ss [] mn mp [] [Ident "exp"] M.empty [] [] r `shouldSatisfy` isSuccess case r of Error _ -> return () - Aeson.Success m -> moduleExports m `shouldBe` [Ident "exp"] + Success m -> moduleExports m `shouldBe` [Ident "exp"] specify "should parse re-exports" $ do let r = parseMod $ Module ss [] mn mp [] [] (M.singleton (ModuleName "Example.A") [Ident "exp"]) [] [] r `shouldSatisfy` isSuccess case r of Error _ -> return () - Aeson.Success m -> moduleReExports m `shouldBe` M.singleton (ModuleName "Example.A") [Ident "exp"] + Success m -> moduleReExports m `shouldBe` M.singleton (ModuleName "Example.A") [Ident "exp"] specify "should parse foreign" $ do @@ -97,7 +97,7 @@ spec = context "CoreFnFromJson" $ do r `shouldSatisfy` isSuccess case r of Error _ -> return () - Aeson.Success m -> moduleForeign m `shouldBe` [Ident "exp"] + Success m -> moduleForeign m `shouldBe` [Ident "exp"] context "Expr" $ do specify "should parse literals" $ do @@ -154,7 +154,7 @@ spec = context "CoreFnFromJson" $ do r `shouldSatisfy` isSuccess case r of Error _ -> pure () - Aeson.Success Module{..} -> + Success Module{..} -> moduleDecls `shouldBe` [i] specify "should parse Case" $ do diff --git a/tests/TestCst.hs b/tests/TestCst.hs index b051d540a0..6f4a227e63 100644 --- a/tests/TestCst.hs +++ b/tests/TestCst.hs @@ -8,14 +8,14 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Text.IO qualified as Text -import Test.Hspec -import Test.QuickCheck -import TestUtils +import Test.Hspec (Spec, describe, it, runIO, specify) +import Test.QuickCheck (Arbitrary(..), Gen, Testable(..), arbitrarySizedNatural, arbitraryUnicodeChar, discard, elements, frequency, listOf, listOf1, oneof, resize) +import TestUtils (getTestFiles, goldenVsString) import Text.Read (readMaybe) import Language.PureScript.CST.Errors as CST import Language.PureScript.CST.Lexer as CST import Language.PureScript.CST.Print as CST -import Language.PureScript.CST.Types +import Language.PureScript.CST.Types (SourceToken(..), Token(..)) import System.FilePath (takeBaseName, replaceExtension) spec :: Spec diff --git a/tests/TestDocs.hs b/tests/TestDocs.hs index 4e9dcad8e4..cb9f67066a 100644 --- a/tests/TestDocs.hs +++ b/tests/TestDocs.hs @@ -4,11 +4,11 @@ import Prelude import Data.Bifunctor (first) import Data.List (findIndex) -import Data.Foldable +import Data.Foldable (find, forM_) import Safe (headMay) import Data.Map qualified as Map import Data.Maybe (fromMaybe, isNothing, mapMaybe) -import Data.Monoid +import Data.Monoid (Any(..), First(..)) import Data.Text (Text) import Data.Text qualified as T import Text.PrettyPrint.Boxes qualified as Boxes @@ -22,7 +22,7 @@ import Web.Bower.PackageMeta (parsePackageName, runPackageName) import TestPscPublish (preparePackage) -import Test.Hspec +import Test.Hspec (Spec, beforeAll, context, expectationFailure, it) spec :: Spec spec = beforeAll (handleDocPrepFailure <$> preparePackage "tests/purs/docs" "purs.json" "resolutions.json") $ diff --git a/tests/TestGraph.hs b/tests/TestGraph.hs index 92233b439a..087bbc3601 100644 --- a/tests/TestGraph.hs +++ b/tests/TestGraph.hs @@ -2,7 +2,7 @@ module TestGraph where import Prelude -import Test.Hspec +import Test.Hspec (Spec, it, shouldBe, shouldSatisfy) import Data.Either (isLeft) import Data.Aeson qualified as Json diff --git a/tests/TestHierarchy.hs b/tests/TestHierarchy.hs index 18832a8d7c..2ba3e82946 100644 --- a/tests/TestHierarchy.hs +++ b/tests/TestHierarchy.hs @@ -2,10 +2,10 @@ module TestHierarchy where import Prelude -import Language.PureScript.Hierarchy +import Language.PureScript.Hierarchy (Digraph(..), Graph(..), GraphName(..), SuperMap(..), prettyPrint, typeClassGraph) import Language.PureScript qualified as P -import Test.Hspec +import Test.Hspec (Spec, describe, it, shouldBe) spec :: Spec spec = describe "hierarchy" $ do diff --git a/tests/TestMake.hs b/tests/TestMake.hs index 051abb373d..610e8465c8 100644 --- a/tests/TestMake.hs +++ b/tests/TestMake.hs @@ -9,23 +9,23 @@ import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST import Control.Concurrent (threadDelay) -import Control.Monad +import Control.Monad (guard, void) import Control.Exception (tryJust) import Control.Monad.IO.Class (liftIO) import Control.Concurrent.MVar (readMVar, newMVar, modifyMVar_) -import Data.Time.Calendar -import Data.Time.Clock +import Data.Time.Calendar (fromGregorian) +import Data.Time.Clock (UTCTime(..), secondsToDiffTime) import Data.Text qualified as T import Data.Set (Set) import Data.Set qualified as Set import Data.Map qualified as M -import System.FilePath -import System.Directory +import System.FilePath (()) +import System.Directory (createDirectory, removeDirectoryRecursive, removeFile, setModificationTime) import System.IO.Error (isDoesNotExistError) import System.IO.UTF8 (readUTF8FilesT, writeUTF8FileT) -import Test.Hspec +import Test.Hspec (Spec, before_, it, shouldReturn) utcMidnightOnDate :: Integer -> Int -> Int -> UTCTime utcMidnightOnDate year month day = UTCTime (fromGregorian year month day) (secondsToDiffTime 0) diff --git a/tests/TestPrimDocs.hs b/tests/TestPrimDocs.hs index d59232f6b6..3e702786a0 100644 --- a/tests/TestPrimDocs.hs +++ b/tests/TestPrimDocs.hs @@ -10,7 +10,7 @@ import Data.Text qualified as Text import Language.PureScript qualified as P import Language.PureScript.Docs qualified as D -import Test.Hspec +import Test.Hspec (Spec, it, shouldBe) spec :: Spec spec = do diff --git a/tests/TestPscPublish.hs b/tests/TestPscPublish.hs index dcd621946e..d6a0f70bb5 100644 --- a/tests/TestPscPublish.hs +++ b/tests/TestPscPublish.hs @@ -8,20 +8,20 @@ import Control.Monad.IO.Class (liftIO) import Data.ByteString.Lazy (ByteString) import Data.Time.Clock (getCurrentTime) import Data.Aeson qualified as A -import Data.Version +import Data.Version (Version(..)) import Data.Foldable (forM_) import Text.PrettyPrint.Boxes qualified as Boxes import System.Directory (listDirectory, removeDirectoryRecursive) import System.FilePath (()) import System.IO.Error (isDoesNotExistError) -import Language.PureScript.Docs +import Language.PureScript.Docs (UploadedPackage, VerifiedPackage) import Language.PureScript.Publish (PublishOptions(..), defaultPublishOptions) import Language.PureScript.Publish qualified as Publish import Language.PureScript.Publish.ErrorsWarnings qualified as Publish -import Test.Hspec -import TestUtils hiding (inferForeignModules, makeActions) +import Test.Hspec (Expectation, Spec, context, expectationFailure, it, runIO) +import TestUtils (pushd) spec :: Spec spec = do diff --git a/tests/TestPsci.hs b/tests/TestPsci.hs index 0d9394f817..b2dfa0dbd5 100644 --- a/tests/TestPsci.hs +++ b/tests/TestPsci.hs @@ -5,7 +5,7 @@ import TestPsci.CommandTest (commandTests) import TestPsci.CompletionTest (completionTests) import TestPsci.EvalTest (evalTests) -import Test.Hspec +import Test.Hspec (Spec) spec :: Spec spec = do diff --git a/tests/TestPsci/CommandTest.hs b/tests/TestPsci/CommandTest.hs index 9e148f779c..da68b9cd3a 100644 --- a/tests/TestPsci/CommandTest.hs +++ b/tests/TestPsci/CommandTest.hs @@ -5,11 +5,11 @@ import Prelude import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS.Strict (get) import Language.PureScript (moduleNameFromString) -import Language.PureScript.Interactive +import Language.PureScript.Interactive (psciImportedModules, psciInteractivePrint) import System.FilePath (()) import System.Directory (getCurrentDirectory) -import Test.Hspec -import TestPsci.TestEnv +import Test.Hspec (Spec, context, shouldContain, shouldNotContain, specify) +import TestPsci.TestEnv (TestPSCi, equalsTo, execTestPSCi, printed, prints, run, simulateModuleEdit) specPSCi :: String -> TestPSCi () -> Spec specPSCi label = specify label . execTestPSCi diff --git a/tests/TestPsci/CompletionTest.hs b/tests/TestPsci/CompletionTest.hs index 0305d703fa..e1fe2af592 100644 --- a/tests/TestPsci/CompletionTest.hs +++ b/tests/TestPsci/CompletionTest.hs @@ -2,14 +2,14 @@ module TestPsci.CompletionTest where import Prelude -import Test.Hspec +import Test.Hspec (Spec, SpecWith, beforeAll, context, shouldBe, specify) import Control.Monad.Trans.State.Strict (evalStateT) import Data.Functor ((<&>)) import Data.List (sort) import Data.Text qualified as T import Language.PureScript qualified as P -import Language.PureScript.Interactive +import Language.PureScript.Interactive (CompletionM, PSCiState, completion', formatCompletions, liftCompletionM, updateImportedModules) import TestPsci.TestEnv (initTestPSCiEnv) import TestUtils (getSupportModuleNames) diff --git a/tests/TestPsci/EvalTest.hs b/tests/TestPsci/EvalTest.hs index 61323ec6ea..b46b3492f9 100644 --- a/tests/TestPsci/EvalTest.hs +++ b/tests/TestPsci/EvalTest.hs @@ -11,8 +11,8 @@ import System.Exit (exitFailure) import System.FilePath ((), takeFileName) import System.FilePath.Glob qualified as Glob import System.IO.UTF8 (readUTF8File) -import Test.Hspec -import TestPsci.TestEnv +import Test.Hspec (Spec, context, runIO, specify) +import TestPsci.TestEnv (TestPSCi, evaluatesTo, execTestPSCi, run) evalTests :: Spec evalTests = context "evalTests" $ do diff --git a/tests/TestPsci/TestEnv.hs b/tests/TestPsci/TestEnv.hs index b255052656..b79b4c2220 100644 --- a/tests/TestPsci/TestEnv.hs +++ b/tests/TestPsci/TestEnv.hs @@ -11,7 +11,7 @@ import Data.List (isSuffixOf) import Data.Text qualified as T import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST -import Language.PureScript.Interactive +import Language.PureScript.Interactive (Command(..), PSCiConfig(..), PSCiState, handleCommand, indexFile, initialPSCiState, loadAllModules, make, modulesDir, parseCommand, readNodeProcessWithExitCode, runMake, updateLoadedExterns) import System.Directory (getCurrentDirectory, doesPathExist, removeFile) import System.Exit import System.FilePath ((), pathSeparator) diff --git a/tests/TestSourceMaps.hs b/tests/TestSourceMaps.hs index 178680a4db..5b91017d52 100644 --- a/tests/TestSourceMaps.hs +++ b/tests/TestSourceMaps.hs @@ -4,7 +4,7 @@ import Prelude import Control.Monad (void, forM_) import Data.Aeson as Json -import Test.Hspec +import Test.Hspec (Expectation, SpecWith, describe, expectationFailure, it, runIO, shouldBe) import System.FilePath (replaceExtension, takeFileName, (), (<.>)) import Language.PureScript qualified as P import Data.ByteString qualified as BS diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs index 6a313c1a47..146093c452 100644 --- a/tests/TestUtils.hs +++ b/tests/TestUtils.hs @@ -9,12 +9,12 @@ import Language.PureScript.Names qualified as N import Language.PureScript.Interactive.IO (findNodeProcess) import Control.Arrow ((***), (>>>)) -import Control.Monad -import Control.Monad.Reader -import Control.Monad.Trans.Except -import Control.Monad.Trans.Maybe +import Control.Monad (forM, guard, unless) +import Control.Monad.Reader (MonadIO(..), MonadTrans(..)) +import Control.Monad.Trans.Except (ExceptT(..), runExceptT) +import Control.Monad.Trans.Maybe (MaybeT(..)) import Control.Monad.Writer.Class (tell) -import Control.Exception +import Control.Exception (IOException, catch, throw, throwIO, try, tryJust) import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.Char (isSpace) @@ -26,16 +26,16 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Time.Clock (UTCTime(), diffUTCTime, getCurrentTime, nominalDay) import Data.Tuple (swap) -import System.Directory +import System.Directory (createDirectoryIfMissing, doesDirectoryExist, getCurrentDirectory, getModificationTime, getTemporaryDirectory, listDirectory, setCurrentDirectory, withCurrentDirectory) import System.Exit (exitFailure) import System.Environment (lookupEnv) -import System.FilePath +import System.FilePath (dropExtensions, makeRelative, takeDirectory, takeExtensions, takeFileName, ()) import System.IO.Error (isDoesNotExistError) import System.IO.UTF8 (readUTF8FileT) -import System.Process hiding (cwd) +import System.Process (callCommand, callProcess) import System.FilePath.Glob qualified as Glob -import System.IO -import Test.Hspec +import System.IO (Handle, IOMode(..), hPutStrLn, openFile, stderr) +import Test.Hspec (Expectation, HasCallStack, expectationFailure, pendingWith) -- | -- Fetches code necessary to run the tests with. The resulting support code From 7026f64a79103ea87f69da6429e0908c8b0c0fc5 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Wed, 29 Mar 2023 09:32:09 -0400 Subject: [PATCH 26/68] Fix prerelease version number on macOS (#4461) * Migrate deprecated set-output commands in GitHub https://github.blog/changelog/2022-10-11-github-actions-deprecating-save-state-and-set-output-commands/ * Fix prerelease version number on macOS --- CHANGELOG.d/fix_4460.md | 1 + ci/build.sh | 29 ++++++++++++++++++++++++----- 2 files changed, 25 insertions(+), 5 deletions(-) create mode 100644 CHANGELOG.d/fix_4460.md diff --git a/CHANGELOG.d/fix_4460.md b/CHANGELOG.d/fix_4460.md new file mode 100644 index 0000000000..f86926fef2 --- /dev/null +++ b/CHANGELOG.d/fix_4460.md @@ -0,0 +1 @@ +* Fix prerelease version number on macOS diff --git a/ci/build.sh b/ci/build.sh index 5bcb7d4950..b2ef51251e 100755 --- a/ci/build.sh +++ b/ci/build.sh @@ -52,7 +52,7 @@ then then echo "Skipping prerelease because no input affecting the published package was" echo "changed since the last prerelease" - echo "::set-output name=do-not-prerelease::true" + echo "do-not-prerelease=true" >> $GITHUB_OUTPUT else do_prerelease=true fi @@ -82,6 +82,16 @@ fi if [ "$do_prerelease" ] then + # (some versions of?) macOS have an old FreeBSD sed that requires -i to be followed with an argument + if sed --version >/dev/null + then + # Probably GNU sed + sedi=(sed -i) + else + # Probably FreeBSD sed + sedi=(sed -i '') + fi + function largest-matching-git-tag { grep -E "^${1//./\\.}(\\.|$)" "$git_tags" | head -n 1 } @@ -127,11 +137,11 @@ then build_version=${build_version#v} else # (current version has not been published) build_version=$package_version - echo "::set-output name=do-not-prerelease::true" + echo "do-not-prerelease=true" >> $GITHUB_OUTPUT fi fi - echo "::set-output name=version::$build_version" + echo "version=$build_version" >> $GITHUB_OUTPUT popd @@ -142,8 +152,8 @@ then # We don't need to update the install-purescript command before we build; # we'll do that when we publish. All we need to update here are the files # that affect the purs binary. - sed -i -e "s/^\\(version:\\s*\\)${package_release_version//./\\.}/\1$build_release_version/" purescript.cabal - sed -i -e "s/^prerelease = \"${package_prerelease_suffix//./\\.}\"$/prerelease = \"${build_prerelease_suffix}\"/" app/Version.hs + "${sedi[@]}" -e "s/^\\(version:[[:blank:]]*\\)${package_release_version//./\\.}/\1$build_release_version/" purescript.cabal + "${sedi[@]}" -e "s/^prerelease = \"${package_prerelease_suffix//./\\.}\"$/prerelease = \"${build_prerelease_suffix}\"/" app/Version.hs fi fi @@ -165,6 +175,15 @@ pushd sdist-test # Haddock -Werror goes here to keep us honest but prevent failing on # documentation errors in dependencies $STACK build $STACK_OPTS --haddock-arguments --optghc=-Werror + +if [ "$do_prerelease" ] +then + if [ "$($STACK exec -- purs --version)" != "$build_version" ] + then + echo "purs --version doesn't equal the expected value" + exit 1 + fi +fi popd (echo "::endgroup::") 2>/dev/null From d7785056014cec498634cb1103365740c9b0b290 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Berk=20=C3=96zk=C3=BCt=C3=BCk?= Date: Sun, 2 Apr 2023 04:01:32 +0200 Subject: [PATCH 27/68] Consider fixity declarations during linting (#4462) * Consider fixity declarations during linting --- CHANGELOG.d/fix_4414.md | 1 + CONTRIBUTORS.md | 1 + src/Language/PureScript/Linter.hs | 2 ++ tests/purs/warning/4414.out | 0 tests/purs/warning/4414.purs | 21 +++++++++++++++++++++ 5 files changed, 25 insertions(+) create mode 100644 CHANGELOG.d/fix_4414.md create mode 100644 tests/purs/warning/4414.out create mode 100644 tests/purs/warning/4414.purs diff --git a/CHANGELOG.d/fix_4414.md b/CHANGELOG.d/fix_4414.md new file mode 100644 index 0000000000..8d4e8209c7 --- /dev/null +++ b/CHANGELOG.d/fix_4414.md @@ -0,0 +1 @@ +* Consider fixity declarations during linting diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index a4f8790422..18d0ad69ac 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -113,6 +113,7 @@ If you would prefer to use different terms, please use the section below instead | [@noraesae](https://github.com/noraesae) | Hyunje Jun | [MIT license] | | [@nullobject](https://github.com/nullobject) | Josh Bassett | [MIT license] | | [@osa1](https://github.com/osa1) | Ömer Sinan Ağacan | [MIT license] | +| [@ozkutuk](https://github.com/ozkutuk) | Berk Özkütük | [MIT license] | | [@paf31](https://github.com/paf31) | Phil Freeman | [MIT license] | | [@parsonsmatt](https://github.com/parsonsmatt) | Matt Parsons | [MIT license] | | [@passy](https://github.com/passy) | Pascal Hartig | [MIT license] | diff --git a/src/Language/PureScript/Linter.hs b/src/Language/PureScript/Linter.hs index c77d66c1d4..95f4029cdf 100644 --- a/src/Language/PureScript/Linter.hs +++ b/src/Language/PureScript/Linter.hs @@ -183,6 +183,8 @@ lintUnused (Module modSS _ mn modDecls exports) = in (vars, errs') + goDecl (ValueFixityDeclaration _ _ (Qualified _ (Left v)) _) = (S.singleton v, mempty) + goDecl (TypeInstanceDeclaration _ _ _ _ _ _ _ _ (ExplicitInstance decls)) = mconcat $ map goDecl decls goDecl _ = mempty diff --git a/tests/purs/warning/4414.out b/tests/purs/warning/4414.out new file mode 100644 index 0000000000..e69de29bb2 diff --git a/tests/purs/warning/4414.purs b/tests/purs/warning/4414.purs new file mode 100644 index 0000000000..7d9ecb2d05 --- /dev/null +++ b/tests/purs/warning/4414.purs @@ -0,0 +1,21 @@ +module Main + ( something + , main + ) + where + +import Prelude + +import Effect (Effect) +import Effect.Console (log) + +something :: Boolean +something = 42 .?.?. 1 + +foo :: forall a. a -> a -> Boolean +foo _ _ = true + +infix 7 foo as .?.?. + +main :: Effect Unit +main = log "Done" From 284cefc60f757eef9ed6f58f083917ad49fc9038 Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Sat, 22 Apr 2023 12:59:08 +0800 Subject: [PATCH 28/68] Defer monomorphization for data constructors (#4376) --- CHANGELOG.d/fix_polymorhic_constructors.md | 40 ++++++ src/Language/PureScript/TypeChecker/Types.hs | 134 ++++++++++++++----- tests/purs/passing/4376.purs | 29 ++++ tests/purs/warning/4376.out | 16 +++ tests/purs/warning/4376.purs | 6 + 5 files changed, 188 insertions(+), 37 deletions(-) create mode 100644 CHANGELOG.d/fix_polymorhic_constructors.md create mode 100644 tests/purs/passing/4376.purs create mode 100644 tests/purs/warning/4376.out create mode 100644 tests/purs/warning/4376.purs diff --git a/CHANGELOG.d/fix_polymorhic_constructors.md b/CHANGELOG.d/fix_polymorhic_constructors.md new file mode 100644 index 0000000000..ad77cb1c82 --- /dev/null +++ b/CHANGELOG.d/fix_polymorhic_constructors.md @@ -0,0 +1,40 @@ +* Defer monomorphization for data constructors + + In `0.15.4` and earlier, the compiler monomorphizes type + constructors early, yielding the following type: + + ```purs + > :t Nothing + forall (a1 :: Type). Maybe a1 + + > :t { a : Nothing } + forall (a1 :: Type). + { a :: Maybe a1 + } + ``` + + With this change, the monomorphization introduced in + [#835](https://github.com/purescript/purescript/pull/835) is + deferred to only when it's needed, such as when constructors are + used as values inside of records. + + ```purs + > :t Nothing + forall a. Maybe a + + > :t { a : Nothing } + forall (a1 :: Type). + { a :: Maybe a1 + } + ``` + + Also as a consequence, record updates should not throw + `ConstrainedTypeUnified` in cases such as: + + ```purs + v1 :: { a :: Maybe Unit } + v1 = { a : Just Unit } + + v2 :: { a :: Maybe Unit } + v2 = let v3 = v1 { a = mempty } in v3 + ``` diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs index c8615e6b42..ab532057e8 100644 --- a/src/Language/PureScript/TypeChecker/Types.hs +++ b/src/Language/PureScript/TypeChecker/Types.hs @@ -50,7 +50,6 @@ import Language.PureScript.Crash (internalError) import Language.PureScript.Environment import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors, SimpleErrorMessage(..), errorMessage, errorMessage', escalateWarningWhen, internalCompilerError, onErrorMessages, onTypesInErrorMessage, parU) import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName, coerceProperName, freshIdent) -import Language.PureScript.Traversals (sndM) import Language.PureScript.TypeChecker.Deriving (deriveInstance) import Language.PureScript.TypeChecker.Entailment (InstanceContext, newDictionaries, replaceTypeClassDictionaries) import Language.PureScript.TypeChecker.Kinds (checkConstraint, checkTypeKind, kindOf, kindOfWithScopedVars, unifyKinds', unknownsWithKinds) @@ -369,38 +368,62 @@ infer' (Literal ss (ArrayLiteral vals)) = do return $ TypedValue' True (Literal ss (ArrayLiteral ts')) (srcTypeApp tyArray els) infer' (Literal ss (ObjectLiteral ps)) = do ensureNoDuplicateProperties ps - -- We make a special case for Vars in record labels, since these are the - -- only types of expressions for which 'infer' can return a polymorphic type. - -- They need to be instantiated here. - let shouldInstantiate :: Expr -> Bool - shouldInstantiate Var{} = True - shouldInstantiate (PositionedValue _ _ e) = shouldInstantiate e - shouldInstantiate _ = False - - inferProperty :: (PSString, Expr) -> m (PSString, (Expr, SourceType)) - inferProperty (name, val) = do - TypedValue' _ val' ty <- infer val - valAndType <- if shouldInstantiate val - then instantiatePolyTypeWithUnknowns val' ty - else pure (val', ty) - pure (name, valAndType) - - toRowListItem (lbl, (_, ty)) = srcRowListItem (Label lbl) ty - - fields <- forM ps inferProperty - let ty = srcTypeApp tyRecord $ rowFromList (map toRowListItem fields, srcKindApp srcREmpty kindType) - return $ TypedValue' True (Literal ss (ObjectLiteral (map (fmap (uncurry (TypedValue True))) fields))) ty -infer' (ObjectUpdate o ps) = do + typedFields <- inferProperties ps + let + toRowListItem :: (PSString, (Expr, SourceType)) -> RowListItem SourceAnn + toRowListItem (l, (_, t)) = srcRowListItem (Label l) t + + recordType :: SourceType + recordType = srcTypeApp tyRecord $ rowFromList (toRowListItem <$> typedFields, srcKindApp srcREmpty kindType) + + typedProperties :: [(PSString, Expr)] + typedProperties = fmap (fmap (uncurry (TypedValue True))) typedFields + pure $ TypedValue' True (Literal ss (ObjectLiteral typedProperties)) recordType +infer' (ObjectUpdate ob ps) = do ensureNoDuplicateProperties ps - row <- freshTypeWithKind (kindRow kindType) - typedVals <- zipWith (\(name, _) t -> (name, t)) ps <$> traverse (infer . snd) ps - let toRowListItem = uncurry srcRowListItem - let newTys = map (\(name, TypedValue' _ _ ty) -> (Label name, ty)) typedVals - oldTys <- zip (map (Label . fst) ps) <$> replicateM (length ps) (freshTypeWithKind kindType) - let oldTy = srcTypeApp tyRecord $ rowFromList (toRowListItem <$> oldTys, row) - o' <- TypedValue True <$> (tvToExpr <$> check o oldTy) <*> pure oldTy - let newVals = map (fmap tvToExpr) typedVals - return $ TypedValue' True (ObjectUpdate o' newVals) $ srcTypeApp tyRecord $ rowFromList (toRowListItem <$> newTys, row) + -- This "tail" holds all other fields not being updated. + rowType <- freshTypeWithKind (kindRow kindType) + let updateLabels = Label . fst <$> ps + -- Generate unification variables for each field in ps. + -- + -- Given: + -- + -- ob { a = 0, b = 0 } + -- + -- Then: + -- + -- obTypes = [(a, ?0), (b, ?1)] + obTypes <- zip updateLabels <$> replicateM (length updateLabels) (freshTypeWithKind kindType) + let obItems :: [RowListItem SourceAnn] + obItems = uncurry srcRowListItem <$> obTypes + -- Create a record type that contains the unification variables. + -- + -- obRecordType = Record ( a :: ?0, b :: ?1 | rowType ) + obRecordType :: SourceType + obRecordType = srcTypeApp tyRecord $ rowFromList (obItems, rowType) + -- Check ob against obRecordType. + -- + -- Given: + -- + -- ob : { a :: Int, b :: Int } + -- + -- Then: + -- + -- ?0 ~ Int + -- ?1 ~ Int + -- ob' : { a :: ?0, b :: ?1 } + ob' <- TypedValue True <$> (tvToExpr <$> check ob obRecordType) <*> pure obRecordType + -- Infer the types of the values used for the record update. + typedFields <- inferProperties ps + let newItems :: [RowListItem SourceAnn] + newItems = (\(l, (_, t)) -> srcRowListItem (Label l) t) <$> typedFields + + ps' :: [(PSString, Expr)] + ps' = (\(l, (e, t)) -> (l, TypedValue True e t)) <$> typedFields + + newRecordType :: SourceType + newRecordType = srcTypeApp tyRecord $ rowFromList (newItems, rowType) + pure $ TypedValue' True (ObjectUpdate ob' ps') newRecordType infer' (Accessor prop val) = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do field <- freshTypeWithKind kindType rest <- freshTypeWithKind (kindRow kindType) @@ -431,8 +454,7 @@ infer' v@(Constructor _ c) = do env <- getEnv case M.lookup c (dataConstructors env) of Nothing -> throwError . errorMessage . UnknownName . fmap DctorName $ c - Just (_, _, ty, _) -> do (v', ty') <- sndM (introduceSkolemScope <=< replaceAllTypeSynonyms) <=< instantiatePolyTypeWithUnknowns v $ ty - return $ TypedValue' True v' ty' + Just (_, _, ty, _) -> TypedValue' True v <$> (introduceSkolemScope <=< replaceAllTypeSynonyms $ ty) infer' (Case vals binders) = do (vals', ts) <- instantiateForBinders vals binders ret <- freshTypeWithKind kindType @@ -474,6 +496,44 @@ infer' (PositionedValue pos c val) = warnAndRethrowWithPositionTC pos $ do return $ TypedValue' t (PositionedValue pos c v) ty infer' v = internalError $ "Invalid argument to infer: " ++ show v +-- | +-- Infer the types of named record fields. +inferProperties + :: ( MonadSupply m + , MonadState CheckState m + , MonadError MultipleErrors m + , MonadWriter MultipleErrors m + ) + => [(PSString, Expr)] + -> m [(PSString, (Expr, SourceType))] +inferProperties = traverse (traverse inferWithinRecord) + +-- | +-- Infer the type of a value when used as a record field. +inferWithinRecord + :: ( MonadSupply m + , MonadState CheckState m + , MonadError MultipleErrors m + , MonadWriter MultipleErrors m + ) + => Expr + -> m (Expr, SourceType) +inferWithinRecord e = do + TypedValue' _ v t <- infer e + if propertyShouldInstantiate e + then instantiatePolyTypeWithUnknowns v t + else pure (v, t) + +-- | +-- Determines if a value's type needs to be monomorphized when +-- used inside of a record. +propertyShouldInstantiate :: Expr -> Bool +propertyShouldInstantiate = \case + Var{} -> True + Constructor{} -> True + PositionedValue _ _ e -> propertyShouldInstantiate e + _ -> False + inferLetBinding :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [Declaration] @@ -795,7 +855,7 @@ check' v@(Constructor _ c) ty = do Nothing -> throwError . errorMessage . UnknownName . fmap DctorName $ c Just (_, _, ty1, _) -> do repl <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1 - ty' <- introduceSkolemScope ty + ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty elaborate <- subsumes repl ty' return $ TypedValue' True (elaborate v) ty' check' (Let w ds val) ty = do @@ -841,11 +901,11 @@ checkProperties expr ps row lax = convert <$> go ps (toRowPair <$> ts') r' where go ((p,v):ps') ts r = case lookup (Label p) ts of Nothing -> do - v'@(TypedValue' _ _ ty) <- infer v + (v', ty) <- inferWithinRecord v rest <- freshTypeWithKind (kindRow kindType) unifyTypes r (srcRCons (Label p) ty rest) ps'' <- go ps' ts rest - return $ (p, v') : ps'' + return $ (p, TypedValue' True v' ty) : ps'' Just ty -> do v' <- check v ty ps'' <- go ps' (delete (Label p, ty) ts) r diff --git a/tests/purs/passing/4376.purs b/tests/purs/passing/4376.purs new file mode 100644 index 0000000000..46c3463a00 --- /dev/null +++ b/tests/purs/passing/4376.purs @@ -0,0 +1,29 @@ +module Main where + +import Prelude +import Prim.Row (class Union) + +import Data.Maybe (Maybe(..)) +import Data.Monoid (mempty) +import Effect.Console (log) +import Type.Proxy (Proxy(..)) + +-- Make sure that record updates get monomorphized. +asNothing :: forall a. { a :: Maybe a } -> { a :: Maybe a } +asNothing = _ { a = Nothing } + +union :: forall a b c. Union a b c => Record a -> Record b -> Proxy c +union _ _ = Proxy + +-- This fails to solve if neither is monomorphized. +shouldSolve :: forall a b. Proxy ( a :: Maybe a, b :: Maybe b ) +shouldSolve = { a: Nothing } `union` { b: Nothing } + +-- Removes ConstrainedTypeUnified +v1 :: { a :: Maybe Unit } +v1 = { a : Just unit } + +v2 :: { a :: Maybe Unit } +v2 = let v3 = v1 { a = mempty } in v3 + +main = log "Done" diff --git a/tests/purs/warning/4376.out b/tests/purs/warning/4376.out new file mode 100644 index 0000000000..a7107df7e1 --- /dev/null +++ b/tests/purs/warning/4376.out @@ -0,0 +1,16 @@ +Warning found: +in module Main +at tests/purs/warning/4376.purs:6:1 - 6:16 (line 6, column 1 - line 6, column 16) + + No type declaration was provided for the top-level declaration of value. + It is good practice to provide type declarations as a form of documentation. + The inferred type of value was: +   +  forall a. Maybe a +   + +in value declaration value + +See https://github.com/purescript/documentation/blob/master/errors/MissingTypeDeclaration.md for more information, +or to contribute content related to this warning. + diff --git a/tests/purs/warning/4376.purs b/tests/purs/warning/4376.purs new file mode 100644 index 0000000000..0a6d4d535a --- /dev/null +++ b/tests/purs/warning/4376.purs @@ -0,0 +1,6 @@ +-- @shouldWarnWith MissingTypeDeclaration +module Main where + +data Maybe a = Just a | Nothing + +value = Nothing From 198a49ed7ba650a626c1d0f73839bc1a89af5d7c Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Wed, 26 Apr 2023 04:20:20 -0400 Subject: [PATCH 29/68] Update installer to version 0.3.4 (#4468) --- CHANGELOG.d/fix_bump-installer.md | 1 + npm-package/package.json | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 CHANGELOG.d/fix_bump-installer.md diff --git a/CHANGELOG.d/fix_bump-installer.md b/CHANGELOG.d/fix_bump-installer.md new file mode 100644 index 0000000000..7ed009fc8c --- /dev/null +++ b/CHANGELOG.d/fix_bump-installer.md @@ -0,0 +1 @@ +* Update installer to version 0.3.4 to support ARM builds diff --git a/npm-package/package.json b/npm-package/package.json index b0ac8d355c..54e59edfc0 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -15,7 +15,7 @@ "purs": "purs.bin" }, "dependencies": { - "purescript-installer": "^0.3.3" + "purescript-installer": "^0.3.4" }, "homepage": "https://github.com/purescript/purescript", "repository": { From d8abcf00de7ec2bf6e4807e5a843d00ae1751c5b Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Wed, 26 Apr 2023 15:46:48 -0400 Subject: [PATCH 30/68] Update installer to version 0.3.5 (#4469) --- CHANGELOG.d/fix_bump-installer.md | 2 +- npm-package/package.json | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.d/fix_bump-installer.md b/CHANGELOG.d/fix_bump-installer.md index 7ed009fc8c..a8d722d304 100644 --- a/CHANGELOG.d/fix_bump-installer.md +++ b/CHANGELOG.d/fix_bump-installer.md @@ -1 +1 @@ -* Update installer to version 0.3.4 to support ARM builds +* Update installer to version 0.3.5 to support ARM builds diff --git a/npm-package/package.json b/npm-package/package.json index 54e59edfc0..4e7fad21ee 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -15,7 +15,7 @@ "purs": "purs.bin" }, "dependencies": { - "purescript-installer": "^0.3.4" + "purescript-installer": "^0.3.5" }, "homepage": "https://github.com/purescript/purescript", "repository": { From 5b9031ae7e97873fa8ff4ba38aa2208abd60c9a7 Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Thu, 27 Apr 2023 03:47:58 +0800 Subject: [PATCH 31/68] Fix exhaustiveness checking to account for case guards (#4467) --- CHANGELOG.d/fix_4466.md | 1 + src/Language/PureScript/Linter/Exhaustive.hs | 49 ++++++-------------- tests/purs/failing/4466.out | 24 ++++++++++ tests/purs/failing/4466.purs | 16 +++++++ 4 files changed, 54 insertions(+), 36 deletions(-) create mode 100644 CHANGELOG.d/fix_4466.md create mode 100644 tests/purs/failing/4466.out create mode 100644 tests/purs/failing/4466.purs diff --git a/CHANGELOG.d/fix_4466.md b/CHANGELOG.d/fix_4466.md new file mode 100644 index 0000000000..c14b2f07d4 --- /dev/null +++ b/CHANGELOG.d/fix_4466.md @@ -0,0 +1 @@ +* Fix exhaustiveness checking to account for case guards diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs index 0521eda985..697fefe8a0 100644 --- a/src/Language/PureScript/Linter/Exhaustive.hs +++ b/src/Language/PureScript/Linter/Exhaustive.hs @@ -14,7 +14,7 @@ import Protolude (ordNub) import Control.Applicative (Applicative(..)) import Control.Arrow (first, second) import Control.Monad (unless) -import Control.Monad.Writer.Class (MonadWriter(..), censor) +import Control.Monad.Writer.Class (MonadWriter(..)) import Data.List (foldl', sortOn) import Data.Maybe (fromMaybe) @@ -22,14 +22,14 @@ import Data.Map qualified as M import Data.Text qualified as T import Language.PureScript.AST.Binders (Binder(..)) -import Language.PureScript.AST.Declarations (CaseAlternative(..), Declaration(..), ErrorMessageHint(..), Expr(..), Guard(..), GuardedExpr(..), pattern MkUnguarded, pattern ValueDecl, isTrueExpr) +import Language.PureScript.AST.Declarations (CaseAlternative(..), Expr(..), Guard(..), GuardedExpr(..), pattern MkUnguarded, isTrueExpr) import Language.PureScript.AST.Literals (Literal(..)) +import Language.PureScript.AST.Traversals (everywhereOnValuesM) import Language.PureScript.Crash (internalError) import Language.PureScript.Environment (DataDeclType, Environment(..), TypeKind(..)) -import Language.PureScript.Errors (MultipleErrors, pattern NullSourceAnn, SimpleErrorMessage(..), SourceSpan, addHint, errorMessage') +import Language.PureScript.Errors (MultipleErrors, pattern NullSourceAnn, SimpleErrorMessage(..), SourceSpan, errorMessage') import Language.PureScript.Names as P import Language.PureScript.Pretty.Values (prettyPrintBinderAtom) -import Language.PureScript.Traversals (sndM) import Language.PureScript.Types as P import Language.PureScript.Constants.Prim qualified as C @@ -297,36 +297,13 @@ checkExhaustiveExpr -> ModuleName -> Expr -> m Expr -checkExhaustiveExpr initSS env mn = onExpr initSS +checkExhaustiveExpr ss env mn = onExpr' where - onDecl :: Declaration -> m Declaration - onDecl (BindingGroupDeclaration bs) = BindingGroupDeclaration <$> mapM (\(sai@((ss, _), _), nk, expr) -> (sai, nk,) <$> onExpr ss expr) bs - onDecl (ValueDecl sa@(ss, _) name x y [MkUnguarded e]) = - ValueDecl sa name x y . mkUnguardedExpr <$> censor (addHint (ErrorInValueDeclaration name)) (onExpr ss e) - onDecl decl = return decl - - onExpr :: SourceSpan -> Expr -> m Expr - onExpr _ (UnaryMinus ss e) = UnaryMinus ss <$> onExpr ss e - onExpr _ (Literal ss (ArrayLiteral es)) = Literal ss . ArrayLiteral <$> mapM (onExpr ss) es - onExpr _ (Literal ss (ObjectLiteral es)) = Literal ss . ObjectLiteral <$> mapM (sndM (onExpr ss)) es - onExpr ss (Accessor x e) = Accessor x <$> onExpr ss e - onExpr ss (ObjectUpdate o es) = ObjectUpdate <$> onExpr ss o <*> mapM (sndM (onExpr ss)) es - onExpr ss (Abs x e) = Abs x <$> onExpr ss e - onExpr ss (App e1 e2) = App <$> onExpr ss e1 <*> onExpr ss e2 - onExpr ss (IfThenElse e1 e2 e3) = IfThenElse <$> onExpr ss e1 <*> onExpr ss e2 <*> onExpr ss e3 - onExpr ss (Case es cas) = do - case' <- Case <$> mapM (onExpr ss) es <*> mapM (onCaseAlternative ss) cas - checkExhaustive ss env mn (length es) cas case' - onExpr ss (TypedValue x e y) = TypedValue x <$> onExpr ss e <*> pure y - onExpr ss (Let w ds e) = Let w <$> mapM onDecl ds <*> onExpr ss e - onExpr _ (PositionedValue ss x e) = PositionedValue ss x <$> onExpr ss e - onExpr _ expr = return expr - - onCaseAlternative :: SourceSpan -> CaseAlternative -> m CaseAlternative - onCaseAlternative ss (CaseAlternative x [MkUnguarded e]) = CaseAlternative x . mkUnguardedExpr <$> onExpr ss e - onCaseAlternative ss (CaseAlternative x es) = CaseAlternative x <$> mapM (onGuardedExpr ss) es - - onGuardedExpr :: SourceSpan -> GuardedExpr -> m GuardedExpr - onGuardedExpr ss (GuardedExpr guard rhs) = GuardedExpr guard <$> onExpr ss rhs - - mkUnguardedExpr = pure . MkUnguarded + (_, onExpr', _) = everywhereOnValuesM pure onExpr pure + + onExpr :: Expr -> m Expr + onExpr e = case e of + Case es cas -> + checkExhaustive ss env mn (length es) cas e + _ -> + pure e diff --git a/tests/purs/failing/4466.out b/tests/purs/failing/4466.out new file mode 100644 index 0000000000..77b1cf3ea8 --- /dev/null +++ b/tests/purs/failing/4466.out @@ -0,0 +1,24 @@ +Error found: +in module Main +at tests/purs/failing/4466.purs:15:44 - 15:67 (line 15, column 44 - line 15, column 67) + + A case expression could not be determined to cover all inputs. + The following additional cases are required to cover all inputs: + + { sound: Quack } + { sound: Bark } + + Alternatively, add a Partial constraint to the type of the enclosing value. + +while checking that type Partial => t0 + is at least as general as type Boolean +while checking that expression case $0 of  +  { sound: Moo } -> true + has type Boolean +in value declaration animalFunc + +where t0 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/4466.purs b/tests/purs/failing/4466.purs new file mode 100644 index 0000000000..1c3d75db36 --- /dev/null +++ b/tests/purs/failing/4466.purs @@ -0,0 +1,16 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +import Prelude + +import Data.Array as Array +import Data.Maybe (Maybe(..)) + +data Sound = Moo | Quack | Bark + +type Animal = { sound :: Sound } + +animalFunc :: Array Animal -> Unit +animalFunc animals + | Just { sound } <- animals # Array.find \{ sound: Moo } -> true = unit + | otherwise = unit From b1825f9bb1eb3dcc508848507a2f838049a4fb19 Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Sun, 30 Apr 2023 01:02:39 +0800 Subject: [PATCH 32/68] Prepare 0.15.9 release (#4470) --- CHANGELOG.d/feature_arm_builds.md | 1 - CHANGELOG.d/fix_4414.md | 1 - CHANGELOG.d/fix_4460.md | 1 - CHANGELOG.d/fix_4466.md | 1 - CHANGELOG.d/fix_bump-installer.md | 1 - CHANGELOG.d/fix_polymorhic_constructors.md | 40 ------------- CHANGELOG.d/internal_no-haddock-warnings.md | 1 - CHANGELOG.d/internal_simplify-imports.md | 1 - CHANGELOG.md | 63 +++++++++++++++++++++ npm-package/package.json | 4 +- purescript.cabal | 2 +- 11 files changed, 66 insertions(+), 50 deletions(-) delete mode 100644 CHANGELOG.d/feature_arm_builds.md delete mode 100644 CHANGELOG.d/fix_4414.md delete mode 100644 CHANGELOG.d/fix_4460.md delete mode 100644 CHANGELOG.d/fix_4466.md delete mode 100644 CHANGELOG.d/fix_bump-installer.md delete mode 100644 CHANGELOG.d/fix_polymorhic_constructors.md delete mode 100644 CHANGELOG.d/internal_no-haddock-warnings.md delete mode 100644 CHANGELOG.d/internal_simplify-imports.md diff --git a/CHANGELOG.d/feature_arm_builds.md b/CHANGELOG.d/feature_arm_builds.md deleted file mode 100644 index 7429fe3445..0000000000 --- a/CHANGELOG.d/feature_arm_builds.md +++ /dev/null @@ -1 +0,0 @@ -* Add release artifacts for Linux and macOS running on the ARM64 architecture. diff --git a/CHANGELOG.d/fix_4414.md b/CHANGELOG.d/fix_4414.md deleted file mode 100644 index 8d4e8209c7..0000000000 --- a/CHANGELOG.d/fix_4414.md +++ /dev/null @@ -1 +0,0 @@ -* Consider fixity declarations during linting diff --git a/CHANGELOG.d/fix_4460.md b/CHANGELOG.d/fix_4460.md deleted file mode 100644 index f86926fef2..0000000000 --- a/CHANGELOG.d/fix_4460.md +++ /dev/null @@ -1 +0,0 @@ -* Fix prerelease version number on macOS diff --git a/CHANGELOG.d/fix_4466.md b/CHANGELOG.d/fix_4466.md deleted file mode 100644 index c14b2f07d4..0000000000 --- a/CHANGELOG.d/fix_4466.md +++ /dev/null @@ -1 +0,0 @@ -* Fix exhaustiveness checking to account for case guards diff --git a/CHANGELOG.d/fix_bump-installer.md b/CHANGELOG.d/fix_bump-installer.md deleted file mode 100644 index a8d722d304..0000000000 --- a/CHANGELOG.d/fix_bump-installer.md +++ /dev/null @@ -1 +0,0 @@ -* Update installer to version 0.3.5 to support ARM builds diff --git a/CHANGELOG.d/fix_polymorhic_constructors.md b/CHANGELOG.d/fix_polymorhic_constructors.md deleted file mode 100644 index ad77cb1c82..0000000000 --- a/CHANGELOG.d/fix_polymorhic_constructors.md +++ /dev/null @@ -1,40 +0,0 @@ -* Defer monomorphization for data constructors - - In `0.15.4` and earlier, the compiler monomorphizes type - constructors early, yielding the following type: - - ```purs - > :t Nothing - forall (a1 :: Type). Maybe a1 - - > :t { a : Nothing } - forall (a1 :: Type). - { a :: Maybe a1 - } - ``` - - With this change, the monomorphization introduced in - [#835](https://github.com/purescript/purescript/pull/835) is - deferred to only when it's needed, such as when constructors are - used as values inside of records. - - ```purs - > :t Nothing - forall a. Maybe a - - > :t { a : Nothing } - forall (a1 :: Type). - { a :: Maybe a1 - } - ``` - - Also as a consequence, record updates should not throw - `ConstrainedTypeUnified` in cases such as: - - ```purs - v1 :: { a :: Maybe Unit } - v1 = { a : Just Unit } - - v2 :: { a :: Maybe Unit } - v2 = let v3 = v1 { a = mempty } in v3 - ``` diff --git a/CHANGELOG.d/internal_no-haddock-warnings.md b/CHANGELOG.d/internal_no-haddock-warnings.md deleted file mode 100644 index 8d661b6cf6..0000000000 --- a/CHANGELOG.d/internal_no-haddock-warnings.md +++ /dev/null @@ -1 +0,0 @@ -* Require comments not to cause Haddock warnings diff --git a/CHANGELOG.d/internal_simplify-imports.md b/CHANGELOG.d/internal_simplify-imports.md deleted file mode 100644 index 13bf406888..0000000000 --- a/CHANGELOG.d/internal_simplify-imports.md +++ /dev/null @@ -1 +0,0 @@ -* Refactor module imports to make identifiers' origins obvious diff --git a/CHANGELOG.md b/CHANGELOG.md index d1c1c3d925..00ad84751d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,69 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.9 + +New features: + +* Add release artifacts for Linux and macOS running on the ARM64 architecture. (#4455 by @f-f) + +Bugfixes: + +* Fix prerelease version number on macOS (#4461 by @rhendric) + +* Consider fixity declarations during linting (#4462 by @ozkutuk) + +* Defer monomorphization for data constructors (#4376 by @purefunctor) + + In `0.15.4` and earlier, the compiler monomorphizes type + constructors early, yielding the following type: + + ```purs + > :t Nothing + forall (a1 :: Type). Maybe a1 + + > :t { a : Nothing } + forall (a1 :: Type). + { a :: Maybe a1 + } + ``` + + With this change, the monomorphization introduced in + [#835](https://github.com/purescript/purescript/pull/835) is + deferred to only when it's needed, such as when constructors are + used as values inside of records. + + ```purs + > :t Nothing + forall a. Maybe a + + > :t { a : Nothing } + forall (a1 :: Type). + { a :: Maybe a1 + } + ``` + + Also as a consequence, record updates should not throw + `ConstrainedTypeUnified` in cases such as: + + ```purs + v1 :: { a :: Maybe Unit } + v1 = { a : Just Unit } + + v2 :: { a :: Maybe Unit } + v2 = let v3 = v1 { a = mempty } in v3 + ``` + +* Update installer to version 0.3.5 to support ARM builds (#4468 and #4469 by @rhendric) + +* Fix exhaustiveness checking to account for case guards (#4467 by @purefunctor) + +Internal: + +* Refactor module imports to make identifiers' origins obvious (#4451 by @JordanMartinez) + +* Require comments not to cause Haddock warnings (#4456 by @rhendric) + ## 0.15.8 New features: diff --git a/npm-package/package.json b/npm-package/package.json index 4e7fad21ee..3f391d5f43 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.8", + "version": "0.15.9", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.8", + "postinstall": "install-purescript --purs-ver=0.15.9", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index 859126a658..383264482d 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.8 +version: 0.15.9 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From 0d337102b30f35f793d33d0293228790e0e71d2f Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Tue, 30 May 2023 22:28:29 +0800 Subject: [PATCH 33/68] RE: Visible Type Applications (#4436) * Defer monomorphization for data constructors * Add test case for ConstrainedTypeUnified * Initial parsing rules for type applications * Add branches for AST traversals * Add type variable visibility * Better typing rule for visible type applications * Add visibility to constructors * Add visibility to type class methods * Instantiate constraints before subsumption * Implement type application skipping * Check type argument kind against type variable * Add pre-processing for the type argument * Update code for tests * Expand type synonyms after kind checking * Fix pretty-printing; regenerate golden tests * Add initial passing tests for type applications * Fold tyArg''' into tyArg'' * Initial errors and golden tests for errors * Add test case for type classes and data types * Move visibility parameter before the variable name * Include at-sign when flattening * Improve docstring for VisibleTypeApp Co-authored-by: Mark Eibes * Update error message for failed type applications * Add comments to clarify ForAll deserialization * Encode and decode ForAll as an object * Fix import in TestAst.hs * Simplify conversion in mkForAll --------- Co-authored-by: Mark Eibes --- src/Language/PureScript/AST/Declarations.hs | 4 + src/Language/PureScript/AST/Traversals.hs | 8 ++ src/Language/PureScript/CST/Convert.hs | 19 +-- src/Language/PureScript/CST/Flatten.hs | 7 +- src/Language/PureScript/CST/Parser.y | 17 ++- src/Language/PureScript/CST/Positions.hs | 3 +- src/Language/PureScript/CST/Types.hs | 5 +- src/Language/PureScript/CST/Utils.hs | 4 +- src/Language/PureScript/Docs/Convert.hs | 6 +- .../Docs/RenderedCode/RenderType.hs | 14 +- src/Language/PureScript/Environment.hs | 6 +- src/Language/PureScript/Errors.hs | 32 ++++- src/Language/PureScript/Ide/CaseSplit.hs | 2 +- src/Language/PureScript/Linter.hs | 5 +- src/Language/PureScript/Pretty/Types.hs | 18 +-- src/Language/PureScript/Pretty/Values.hs | 1 + src/Language/PureScript/Sugar/Names.hs | 2 + src/Language/PureScript/Sugar/TypeClasses.hs | 3 +- src/Language/PureScript/TypeChecker.hs | 2 +- .../PureScript/TypeChecker/Deriving.hs | 2 +- .../TypeChecker/Entailment/Coercible.hs | 2 +- src/Language/PureScript/TypeChecker/Kinds.hs | 35 ++--- src/Language/PureScript/TypeChecker/Roles.hs | 2 +- .../PureScript/TypeChecker/Skolems.hs | 8 +- .../PureScript/TypeChecker/Subsumption.hs | 4 +- src/Language/PureScript/TypeChecker/Types.hs | 48 ++++++- src/Language/PureScript/TypeChecker/Unify.hs | 4 +- src/Language/PureScript/Types.hs | 125 +++++++++++++----- tests/TestAst.hs | 6 +- tests/TestDocs.hs | 2 +- tests/purs/failing/3329.out | 2 +- tests/purs/failing/ConstraintFailure.out | 2 +- tests/purs/failing/TypedHole.out | 2 +- tests/purs/failing/TypedHole3.out | 10 +- .../purs/failing/VisibleTypeApplications1.out | 20 +++ .../failing/VisibleTypeApplications1.purs | 7 + .../purs/failing/VisibleTypeApplications2.out | 19 +++ .../failing/VisibleTypeApplications2.purs | 7 + .../purs/passing/VisibleTypeApplications.purs | 40 ++++++ tests/purs/warning/4376.out | 6 +- 40 files changed, 384 insertions(+), 127 deletions(-) create mode 100644 tests/purs/failing/VisibleTypeApplications1.out create mode 100644 tests/purs/failing/VisibleTypeApplications1.purs create mode 100644 tests/purs/failing/VisibleTypeApplications2.out create mode 100644 tests/purs/failing/VisibleTypeApplications2.purs create mode 100644 tests/purs/passing/VisibleTypeApplications.purs diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs index 5d8555cdbd..f9ca32b3a1 100644 --- a/src/Language/PureScript/AST/Declarations.hs +++ b/src/Language/PureScript/AST/Declarations.hs @@ -676,6 +676,10 @@ data Expr -- | App Expr Expr -- | + -- A type application (e.g. `f @Int`) + -- + | VisibleTypeApp Expr SourceType + -- | -- Hint that an expression is unused. -- This is used to ignore type class dictionaries that are necessarily empty. -- The inner expression lets us solve subgoals before eliminating the whole expression. diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs index 8aa8808a85..abbe6e5a15 100644 --- a/src/Language/PureScript/AST/Traversals.hs +++ b/src/Language/PureScript/AST/Traversals.hs @@ -75,6 +75,7 @@ everywhereOnValues f g h = (f', g', h') g' (ObjectUpdateNested obj vs) = g (ObjectUpdateNested (g' obj) (fmap g' vs)) g' (Abs binder v) = g (Abs (h' binder) (g' v)) g' (App v1 v2) = g (App (g' v1) (g' v2)) + g' (VisibleTypeApp v ty) = g (VisibleTypeApp (g' v) ty) g' (Unused v) = g (Unused (g' v)) g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3)) g' (Case vs alts) = g (Case (fmap g' vs) (fmap handleCaseAlternative alts)) @@ -149,6 +150,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h) g' (ObjectUpdateNested obj vs) = ObjectUpdateNested <$> (g obj >>= g') <*> traverse (g' <=< g) vs g' (Abs binder v) = Abs <$> (h binder >>= h') <*> (g v >>= g') g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g') + g' (VisibleTypeApp v ty) = VisibleTypeApp <$> (g v >>= g') <*> pure ty g' (Unused v) = Unused <$> (g v >>= g') g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g') g' (Case vs alts) = Case <$> traverse (g' <=< g) vs <*> traverse handleCaseAlternative alts @@ -218,6 +220,7 @@ everywhereOnValuesM f g h = (f', g', h') g' (ObjectUpdateNested obj vs) = (ObjectUpdateNested <$> g' obj <*> traverse g' vs) >>= g g' (Abs binder v) = (Abs <$> h' binder <*> g' v) >>= g g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g + g' (VisibleTypeApp v ty) = (VisibleTypeApp <$> g' v <*> pure ty) >>= g g' (Unused v) = (Unused <$> g' v) >>= g g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g g' (Case vs alts) = (Case <$> traverse g' vs <*> traverse handleCaseAlternative alts) >>= g @@ -290,6 +293,7 @@ everythingOnValues (<>.) f g h i j = (f', g', h', i', j') g' v@(ObjectUpdateNested obj vs) = foldl (<>.) (g v <>. g' obj) (fmap g' vs) g' v@(Abs b v1) = g v <>. h' b <>. g' v1 g' v@(App v1 v2) = g v <>. g' v1 <>. g' v2 + g' v@(VisibleTypeApp v' _) = g v <>. g' v' g' v@(Unused v1) = g v <>. g' v1 g' v@(IfThenElse v1 v2 v3) = g v <>. g' v1 <>. g' v2 <>. g' v3 g' v@(Case vs alts) = foldl (<>.) (foldl (<>.) (g v) (fmap g' vs)) (fmap i' alts) @@ -371,6 +375,7 @@ everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i g' s (ObjectUpdateNested obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s) vs) g' s (Abs binder v1) = h'' s binder <>. g'' s v1 g' s (App v1 v2) = g'' s v1 <>. g'' s v2 + g' s (VisibleTypeApp v _) = g'' s v g' s (Unused v) = g'' s v g' s (IfThenElse v1 v2 v3) = g'' s v1 <>. g'' s v2 <>. g'' s v3 g' s (Case vs alts) = foldl (<>.) (foldl (<>.) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts) @@ -479,6 +484,7 @@ everywhereWithContextOnValuesM s0 f g h i j k = (f'' s0, g'' s0, h'' s0, i'' s0, g' s (ObjectUpdateNested obj vs) = ObjectUpdateNested <$> g'' s obj <*> traverse (g'' s) vs g' s (Abs binder v) = Abs <$> h' s binder <*> g'' s v g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2 + g' s (VisibleTypeApp v ty) = VisibleTypeApp <$> g'' s v <*> pure ty g' s (Unused v) = Unused <$> g'' s v g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3 g' s (Case vs alts) = Case <$> traverse (g'' s) vs <*> traverse (i'' s) alts @@ -587,6 +593,7 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s) let s' = S.union (S.fromList (localBinderNames b)) s in h'' s b <> g'' s' v1 g' s (App v1 v2) = g'' s v1 <> g'' s v2 + g' s (VisibleTypeApp v _) = g'' s v g' s (Unused v) = g'' s v g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3 g' s (Case vs alts) = foldMap (g'' s) vs <> foldMap (i'' s) alts @@ -689,6 +696,7 @@ accumTypes f = everythingOnValues mappend forDecls forValues forBinders (const m forValues (TypeClassDictionary c _ _) = foldMap f (constraintArgs c) forValues (DeferredDictionary _ tys) = foldMap f tys forValues (TypedValue _ _ ty) = f ty + forValues (VisibleTypeApp _ ty) = f ty forValues _ = mempty forBinders (TypedBinder ty _) = f ty diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs index b70754f897..1cbe9ef31d 100644 --- a/src/Language/PureScript/CST/Convert.hs +++ b/src/Language/PureScript/CST/Convert.hs @@ -136,11 +136,11 @@ convertType fileName = go T.TypeApp ann (Env.tyRecord $> annRec) $ goRow row b TypeForall _ kw bindings _ ty -> do let - mkForAll a b t = do + mkForAll a b v t = do let ann' = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType t - T.ForAll ann' (getIdent $ nameValue a) b t Nothing - k (TypeVarKinded (Wrapped _ (Labeled a _ b) _)) = mkForAll a (Just (go b)) - k (TypeVarName a) = mkForAll a Nothing + T.ForAll ann' (maybe T.TypeVarInvisible (const T.TypeVarVisible) v) (getIdent $ nameValue a) b t Nothing + k (TypeVarKinded (Wrapped _ (Labeled (v, a) _ b) _)) = mkForAll a (Just (go b)) v + k (TypeVarName (v, a)) = mkForAll a Nothing v ty' = foldr k (go ty) bindings ann = widenLeft (tokAnn kw) $ T.getAnnForType ty' T.setAnnForType ann ty' @@ -335,6 +335,9 @@ convertExpr fileName = go expr@(ExprApp _ a b) -> do let ann = uncurry (sourceAnn fileName) $ exprRange expr positioned ann $ AST.App (go a) (go b) + expr@(ExprVisibleTypeApp _ a _ b) -> do + let ann = uncurry (sourceAnn fileName) $ exprRange expr + positioned ann $ AST.VisibleTypeApp (go a) (convertType fileName b) expr@(ExprLambda _ (Lambda _ as _ b)) -> do let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr positioned ann @@ -455,8 +458,8 @@ convertDeclaration fileName decl = case decl of pure $ AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs DeclClass _ (ClassHead _ sup name vars fdeps) bd -> do let - goTyVar (TypeVarKinded (Wrapped _ (Labeled a _ _) _)) = nameValue a - goTyVar (TypeVarName a) = nameValue a + goTyVar (TypeVarKinded (Wrapped _ (Labeled (_, a) _ _) _)) = nameValue a + goTyVar (TypeVarName (_, a)) = nameValue a vars' = zip (toList $ goTyVar <$> vars) [0..] goName = fromJust . flip lookup vars' . nameValue goFundep (FundepDetermined _ bs) = Env.FunctionalDependency [] (goName <$> NE.toList bs) @@ -593,8 +596,8 @@ convertDeclaration fileName decl = case decl of TypeUnaryRow{} -> "Row" goTypeVar = \case - TypeVarKinded (Wrapped _ (Labeled x _ y) _) -> (getIdent $ nameValue x, Just $ convertType fileName y) - TypeVarName x -> (getIdent $ nameValue x, Nothing) + TypeVarKinded (Wrapped _ (Labeled (_, x) _ y) _) -> (getIdent $ nameValue x, Just $ convertType fileName y) + TypeVarName (_, x) -> (getIdent $ nameValue x, Nothing) goInstanceBinding = \case InstanceBindingSignature _ lbl -> diff --git a/src/Language/PureScript/CST/Flatten.hs b/src/Language/PureScript/CST/Flatten.hs index c6e1b8c80a..890614070d 100644 --- a/src/Language/PureScript/CST/Flatten.hs +++ b/src/Language/PureScript/CST/Flatten.hs @@ -151,6 +151,7 @@ flattenExpr = \case ExprRecordAccessor _ a -> flattenRecordAccessor a ExprRecordUpdate _ a b -> flattenExpr a <> flattenWrapped (flattenSeparated flattenRecordUpdate) b ExprApp _ a b -> flattenExpr a <> flattenExpr b + ExprVisibleTypeApp _ a b c -> flattenExpr a <> pure b <> flattenType c ExprLambda _ a -> flattenLambda a ExprIf _ a -> flattenIfThenElse a ExprCase _ a -> flattenCaseOf a @@ -303,8 +304,10 @@ flattenRow (Row lbls tl) = flattenTypeVarBinding :: TypeVarBinding a -> DList SourceToken flattenTypeVarBinding = \case - TypeVarKinded a -> flattenWrapped (flattenLabeled (pure . nameTok) flattenType) a - TypeVarName a -> pure $ nameTok a + TypeVarKinded a -> flattenWrapped (flattenLabeled go flattenType) a + TypeVarName a -> go a + where + go (a, b) = maybe mempty pure a <> pure (nameTok b) flattenConstraint :: Constraint a -> DList SourceToken flattenConstraint = \case diff --git a/src/Language/PureScript/CST/Parser.y b/src/Language/PureScript/CST/Parser.y index 7785298c0e..edb60d93ec 100644 --- a/src/Language/PureScript/CST/Parser.y +++ b/src/Language/PureScript/CST/Parser.y @@ -347,8 +347,14 @@ rowLabel :: { Labeled Label (Type ()) } : label '::' type { Labeled $1 $2 $3 } typeVarBinding :: { TypeVarBinding () } - : ident { TypeVarName $1 } - | '(' ident '::' type ')' {% checkNoWildcards $4 *> pure (TypeVarKinded (Wrapped $1 (Labeled $2 $3 $4) $5)) } + : ident { TypeVarName (Nothing, $1) } + | '@' ident { TypeVarName (Just $1, $2) } + | '(' ident '::' type ')' {% checkNoWildcards $4 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Nothing, $2) $3 $4) $5)) } + | '(' '@' ident '::' type ')' {% checkNoWildcards $5 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Just $2, $3) $4 $5) $6)) } + +typeVarBindingPlain :: { TypeVarBinding () } + : ident { TypeVarName (Nothing, $1) } + | '(' ident '::' type ')' {% checkNoWildcards $4 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Nothing, $2) $3 $4) $5)) } forall :: { SourceToken } : 'forall' { $1 } @@ -388,6 +394,7 @@ expr4 :: { Expr () } ExprApp () (ExprApp () $1 lhs) rhs _ -> ExprApp () $1 $2 } + | expr4 '@' typeAtom { ExprVisibleTypeApp () $1 $2 $3 } expr5 :: { Expr () } : expr6 { $1 } @@ -675,13 +682,13 @@ decl :: { Declaration () } | 'type' 'role' properName many(role) { DeclRole () $1 $2 (getProperName $3) $4 } dataHead :: { DataHead () } - : 'data' properName manyOrEmpty(typeVarBinding) { DataHead $1 (getProperName $2) $3 } + : 'data' properName manyOrEmpty(typeVarBindingPlain) { DataHead $1 (getProperName $2) $3 } typeHead :: { DataHead () } - : 'type' properName manyOrEmpty(typeVarBinding) { DataHead $1 (getProperName $2) $3 } + : 'type' properName manyOrEmpty(typeVarBindingPlain) { DataHead $1 (getProperName $2) $3 } newtypeHead :: { DataHead () } - : 'newtype' properName manyOrEmpty(typeVarBinding) { DataHead $1 (getProperName $2) $3 } + : 'newtype' properName manyOrEmpty(typeVarBindingPlain) { DataHead $1 (getProperName $2) $3 } dataCtor :: { DataCtor () } : properName manyOrEmpty(typeAtom) diff --git a/src/Language/PureScript/CST/Positions.hs b/src/Language/PureScript/CST/Positions.hs index f8b6167d51..20d5724271 100644 --- a/src/Language/PureScript/CST/Positions.hs +++ b/src/Language/PureScript/CST/Positions.hs @@ -269,7 +269,7 @@ constraintRange = \case typeVarBindingRange :: TypeVarBinding a -> TokenRange typeVarBindingRange = \case TypeVarKinded a -> wrappedRange a - TypeVarName a -> nameRange a + TypeVarName (atSign, a) -> (fromMaybe (nameTok a) atSign, nameTok a) exprRange :: Expr a -> TokenRange exprRange = \case @@ -292,6 +292,7 @@ exprRange = \case ExprRecordAccessor _ (RecordAccessor a _ b) -> (fst $ exprRange a, lblTok $ sepLast b) ExprRecordUpdate _ a b -> (fst $ exprRange a, snd $ wrappedRange b) ExprApp _ a b -> (fst $ exprRange a, snd $ exprRange b) + ExprVisibleTypeApp _ a _ b -> (fst $ exprRange a, snd $ typeRange b) ExprLambda _ (Lambda a _ _ b) -> (a, snd $ exprRange b) ExprIf _ (IfThenElse a _ _ _ _ b) -> (a, snd $ exprRange b) ExprCase _ (CaseOf a _ _ c) -> (a, snd . guardedRange . snd $ NE.last c) diff --git a/src/Language/PureScript/CST/Types.hs b/src/Language/PureScript/CST/Types.hs index d4dec40c04..a89532f1fa 100644 --- a/src/Language/PureScript/CST/Types.hs +++ b/src/Language/PureScript/CST/Types.hs @@ -153,8 +153,8 @@ data Type a deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) data TypeVarBinding a - = TypeVarKinded (Wrapped (Labeled (Name Ident) (Type a))) - | TypeVarName (Name Ident) + = TypeVarKinded (Wrapped (Labeled (Maybe SourceToken, Name Ident) (Type a))) + | TypeVarName (Maybe SourceToken, Name Ident) deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) data Constraint a @@ -337,6 +337,7 @@ data Expr a | ExprRecordAccessor a (RecordAccessor a) | ExprRecordUpdate a (Expr a) (DelimitedNonEmpty (RecordUpdate a)) | ExprApp a (Expr a) (Expr a) + | ExprVisibleTypeApp a (Expr a) SourceToken (Type a) | ExprLambda a (Lambda a) | ExprIf a (IfThenElse a) | ExprCase a (CaseOf a) diff --git a/src/Language/PureScript/CST/Utils.hs b/src/Language/PureScript/CST/Utils.hs index 3d17a03ea2..b941cf5fcf 100644 --- a/src/Language/PureScript/CST/Utils.hs +++ b/src/Language/PureScript/CST/Utils.hs @@ -248,8 +248,8 @@ checkFundeps :: ClassHead a -> Parser () checkFundeps (ClassHead _ _ _ _ Nothing) = pure () checkFundeps (ClassHead _ _ _ vars (Just (_, fundeps))) = do let - k (TypeVarKinded (Wrapped _ (Labeled a _ _) _)) = getIdent $ nameValue a - k (TypeVarName a) = getIdent $ nameValue a + k (TypeVarKinded (Wrapped _ (Labeled (_, a) _ _) _)) = getIdent $ nameValue a + k (TypeVarName (_, a)) = getIdent $ nameValue a names = k <$> vars check a | getIdent (nameValue a) `elem` names = pure () diff --git a/src/Language/PureScript/Docs/Convert.hs b/src/Language/PureScript/Docs/Convert.hs index 9e3ff10cf6..a7dc1758c7 100644 --- a/src/Language/PureScript/Docs/Convert.hs +++ b/src/Language/PureScript/Docs/Convert.hs @@ -119,7 +119,7 @@ insertValueTypesAndAdjustKinds env m = where countParams :: Int -> Type' -> Int countParams acc = \case - P.ForAll _ _ _ rest _ -> + P.ForAll _ _ _ _ rest _ -> countParams acc rest P.TypeApp _ f a | isFunctionApplication f -> @@ -232,8 +232,8 @@ insertValueTypesAndAdjustKinds env m = -- changes `forall (k :: Type). k -> ...` -- to `forall k . k -> ...` dropTypeSortAnnotation = \case - P.ForAll sa txt (Just (P.TypeConstructor _ Prim.Type)) rest skol -> - P.ForAll sa txt Nothing (dropTypeSortAnnotation rest) skol + P.ForAll sa vis txt (Just (P.TypeConstructor _ Prim.Type)) rest skol -> + P.ForAll sa vis txt Nothing (dropTypeSortAnnotation rest) skol rest -> rest Nothing -> diff --git a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs index a0d55988d9..a082b4b833 100644 --- a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs +++ b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs @@ -26,7 +26,7 @@ import Language.PureScript.Label (Label) import Language.PureScript.Names (coerceProperName) import Language.PureScript.Pretty.Types (PrettyPrintConstraint, PrettyPrintType(..), convertPrettyPrintType, prettyPrintLabel) import Language.PureScript.Roles (Role, displayRole) -import Language.PureScript.Types (Type) +import Language.PureScript.Types (Type, TypeVarVisibility, typeVarVisibilityPrefix) import Language.PureScript.PSString (prettyPrintString) import Language.PureScript.Docs.RenderedCode.Types (RenderedCode, keywordForall, roleAnn, sp, syntax, typeCtor, typeOp, typeVar) @@ -149,7 +149,7 @@ matchType = buildPrettyPrinter operators matchTypeAtom , [ Wrap explicitParens $ \_ ty -> ty ] ] -forall_ :: Pattern () PrettyPrintType ([(Text, Maybe PrettyPrintType)], PrettyPrintType) +forall_ :: Pattern () PrettyPrintType ([(TypeVarVisibility, Text, Maybe PrettyPrintType)], PrettyPrintType) forall_ = mkPattern match where match (PPForAll mbKindedIdents ty) = Just (mbKindedIdents, ty) @@ -235,13 +235,13 @@ renderType' = fromMaybe (internalError "Incomplete pattern") . PA.pattern matchType () -renderTypeVars :: [(Text, Maybe PrettyPrintType)] -> RenderedCode +renderTypeVars :: [(TypeVarVisibility, Text, Maybe PrettyPrintType)] -> RenderedCode renderTypeVars tyVars = mintersperse sp (map renderTypeVar tyVars) -renderTypeVar :: (Text, Maybe PrettyPrintType) -> RenderedCode -renderTypeVar (v, mbK) = case mbK of - Nothing -> typeVar v - Just k -> mintersperse sp [ mconcat [syntax "(", typeVar v], syntax "::", mconcat [renderType' k, syntax ")"] ] +renderTypeVar :: (TypeVarVisibility, Text, Maybe PrettyPrintType) -> RenderedCode +renderTypeVar (vis, v, mbK) = case mbK of + Nothing -> syntax (typeVarVisibilityPrefix vis) <> typeVar v + Just k -> mintersperse sp [ mconcat [syntax "(", syntax $ typeVarVisibilityPrefix vis, typeVar v], syntax "::", mconcat [renderType' k, syntax ")"] ] -- | -- Render code representing a Type, as it should appear inside parentheses diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs index a1ef8c3fbe..de1b35d3c9 100644 --- a/src/Language/PureScript/Environment.hs +++ b/src/Language/PureScript/Environment.hs @@ -25,7 +25,7 @@ import Language.PureScript.Crash (internalError) import Language.PureScript.Names (Ident, ProperName(..), ProperNameType(..), Qualified, QualifiedBy, coerceProperName) import Language.PureScript.Roles (Role(..)) import Language.PureScript.TypeClassDictionaries (NamedDict) -import Language.PureScript.Types (SourceConstraint, SourceType, Type(..), eqType, srcTypeConstructor) +import Language.PureScript.Types (SourceConstraint, SourceType, Type(..), TypeVarVisibility(..), eqType, srcTypeConstructor) import Language.PureScript.Constants.Prim qualified as C -- | The @Environment@ defines all values and types which are currently in scope: @@ -341,7 +341,7 @@ tyVar :: Text -> SourceType tyVar = TypeVar nullSourceAnn tyForall :: Text -> SourceType -> SourceType -> SourceType -tyForall var k ty = ForAll nullSourceAnn var (Just k) ty Nothing +tyForall var k ty = ForAll nullSourceAnn TypeVarInvisible var (Just k) ty Nothing -- | Smart constructor for function types function :: SourceType -> SourceType -> SourceType @@ -669,5 +669,5 @@ unapplyKinds :: Type a -> ([Type a], Type a) unapplyKinds = go [] where go kinds (TypeApp _ (TypeApp _ fn k1) k2) | eqType fn tyFunction = go (k1 : kinds) k2 - go kinds (ForAll _ _ _ k _) = go kinds k + go kinds (ForAll _ _ _ _ k _) = go kinds k go kinds k = (reverse kinds, k) diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 4fc63d4419..972e6b69a8 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -47,7 +47,7 @@ import Language.PureScript.Pretty.Common (endWith) import Language.PureScript.PSString (decodeStringWithReplacement) import Language.PureScript.Roles (Role, displayRole) import Language.PureScript.Traversals (sndM) -import Language.PureScript.Types (Constraint(..), ConstraintData(..), RowListItem(..), SourceConstraint, SourceType, Type(..), eraseForAllKindAnnotations, eraseKindApps, everywhereOnTypesTopDownM, getAnnForType, overConstraintArgs, rowFromList, rowToList, srcTUnknown) +import Language.PureScript.Types (Constraint(..), ConstraintData(..), RowListItem(..), SourceConstraint, SourceType, Type(..), eraseForAllKindAnnotations, eraseKindApps, everywhereOnTypesTopDownM, getAnnForType, isMonoType, overConstraintArgs, rowFromList, rowToList, srcTUnknown) import Language.PureScript.Publish.BoxesHelpers qualified as BoxHelpers import System.Console.ANSI qualified as ANSI import System.FilePath (makeRelative) @@ -196,6 +196,8 @@ data SimpleErrorMessage | RoleDeclarationArityMismatch (ProperName 'TypeName) Int Int | DuplicateRoleDeclaration (ProperName 'TypeName) | CannotDeriveInvalidConstructorArg (Qualified (ProperName 'ClassName)) [Qualified (ProperName 'ClassName)] Bool + | CannotSkipTypeApplication SourceType + | CannotApplyExpressionOfTypeOnType SourceType SourceType deriving (Show) data ErrorMessage = ErrorMessage @@ -364,6 +366,8 @@ errorCode em = case unwrapErrorMessage em of RoleDeclarationArityMismatch {} -> "RoleDeclarationArityMismatch" DuplicateRoleDeclaration {} -> "DuplicateRoleDeclaration" CannotDeriveInvalidConstructorArg{} -> "CannotDeriveInvalidConstructorArg" + CannotSkipTypeApplication{} -> "CannotSkipTypeApplication" + CannotApplyExpressionOfTypeOnType{} -> "CannotApplyExpressionOfTypeOnType" -- | A stack trace for an error newtype MultipleErrors = MultipleErrors @@ -1394,6 +1398,32 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon <> "and that those type constructors themselves have instances of " <> commasAndConjunction "or" (markCode . showQualified runProperName <$> relatedClasses) <> "." ] + renderSimpleErrorMessage (CannotSkipTypeApplication tyFn) = + paras + [ "An expression of type:" + , markCodeBox $ indent $ prettyType tyFn + , "cannot be skipped." + ] + + renderSimpleErrorMessage (CannotApplyExpressionOfTypeOnType tyFn tyAr) = + paras $ infoLine <> + [ markCodeBox $ indent $ prettyType tyFn + , "cannot be applied to:" + , markCodeBox $ indent $ prettyType tyAr + ] + where + infoLine = + if isMonoType tyFn then + [ "An expression of monomorphic type:" ] + else + [ "An expression of polymorphic type" + , line $ "with the invisible type variable " <> markCode typeVariable <> ":" + ] + + typeVariable = case tyFn of + ForAll _ _ v _ _ _ -> v + _ -> internalError "renderSimpleErrorMessage: Impossible!" + renderHint :: ErrorMessageHint -> Box.Box -> Box.Box renderHint (ErrorUnifyingTypes t1@RCons{} t2@RCons{}) detail = let (row1Box, row2Box) = printRows t1 t2 diff --git a/src/Language/PureScript/Ide/CaseSplit.hs b/src/Language/PureScript/Ide/CaseSplit.hs index 56cb464f05..8c66f55457 100644 --- a/src/Language/PureScript/Ide/CaseSplit.hs +++ b/src/Language/PureScript/Ide/CaseSplit.hs @@ -148,7 +148,7 @@ splitFunctionType t = fromMaybe [] arguments where arguments = initMay splitted splitted = splitType' t - splitType' (P.ForAll _ _ _ t' _) = splitType' t' + splitType' (P.ForAll _ _ _ _ t' _) = splitType' t' splitType' (P.ConstrainedType _ _ t') = splitType' t' splitType' (P.TypeApp _ (P.TypeApp _ t' lhs) rhs) | P.eqType t' P.tyFunction = lhs : splitType' rhs diff --git a/src/Language/PureScript/Linter.hs b/src/Language/PureScript/Linter.hs index 95f4029cdf..9bce1909de 100644 --- a/src/Language/PureScript/Linter.hs +++ b/src/Language/PureScript/Linter.hs @@ -86,7 +86,7 @@ lint modl@(Module _ _ mn ds _) = do where step :: S.Set Text -> SourceType -> (S.Set Text, MultipleErrors) - step s (ForAll _ tv _ _ _) = bindVar s tv + step s (ForAll _ _ tv _ _ _) = bindVar s tv step s _ = (s, mempty) bindVar :: S.Set Text -> Text -> (S.Set Text, MultipleErrors) @@ -97,7 +97,7 @@ lint modl@(Module _ _ mn ds _) = do -- Recursively walk the type and prune used variables from `unused` go :: S.Set Text -> SourceType -> (S.Set Text, MultipleErrors) go unused (TypeVar _ v) = (S.delete v unused, mempty) - go unused (ForAll _ tv mbK t1 _) = + go unused (ForAll _ _ tv mbK t1 _) = let (nowUnused, errors) | Just k <- mbK = go unused k `combine` go (S.insert tv unused) t1 | otherwise = go (S.insert tv unused) t1 @@ -212,6 +212,7 @@ lintUnused (Module modSS _ mn modDecls exports) = goNode (Branch val) = goTree val go (App v1 v2) = go v1 <> go v2 + go (VisibleTypeApp v _) = go v go (Unused v) = go v go (IfThenElse v1 v2 v3) = go v1 <> go v2 <> go v3 go (Case vs alts) = diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs index e318d352f5..20de0ed9e2 100644 --- a/src/Language/PureScript/Pretty/Types.hs +++ b/src/Language/PureScript/Pretty/Types.hs @@ -19,9 +19,9 @@ module Language.PureScript.Pretty.Types import Prelude hiding ((<>)) import Control.Arrow ((<+>)) +import Control.Lens (_2, (%~)) import Control.PatternArrows as PA -import Data.Bifunctor (first) import Data.Maybe (fromMaybe, catMaybes) import Data.Text (Text) import Data.Text qualified as T @@ -30,7 +30,7 @@ import Language.PureScript.Crash (internalError) import Language.PureScript.Environment (tyFunction, tyRecord) import Language.PureScript.Names (OpName(..), OpNameType(..), ProperName(..), ProperNameType(..), Qualified, coerceProperName, disqualify, showQualified) import Language.PureScript.Pretty.Common (before, objectKeyRequiresQuoting) -import Language.PureScript.Types (Constraint(..), pattern REmptyKinded, RowListItem(..), Type(..), WildcardData(..), eqType, rowToSortedList) +import Language.PureScript.Types (Constraint(..), pattern REmptyKinded, RowListItem(..), Type(..), TypeVarVisibility(..), WildcardData(..), eqType, rowToSortedList, typeVarVisibilityPrefix) import Language.PureScript.PSString (PSString, prettyPrintString, decodeString) import Language.PureScript.Label (Label(..)) @@ -51,7 +51,7 @@ data PrettyPrintType | PPKindedType PrettyPrintType PrettyPrintType | PPBinaryNoParensType PrettyPrintType PrettyPrintType PrettyPrintType | PPParensInType PrettyPrintType - | PPForAll [(Text, Maybe PrettyPrintType)] PrettyPrintType + | PPForAll [(TypeVarVisibility, Text, Maybe PrettyPrintType)] PrettyPrintType | PPFunction PrettyPrintType PrettyPrintType | PPRecord [(Label, PrettyPrintType)] (Maybe PrettyPrintType) | PPRow [(Label, PrettyPrintType)] (Maybe PrettyPrintType) @@ -81,11 +81,11 @@ convertPrettyPrintType = go go d (BinaryNoParensType _ ty1 ty2 ty3) = PPBinaryNoParensType (go (d-1) ty1) (go (d-1) ty2) (go (d-1) ty3) go d (ParensInType _ ty) = PPParensInType (go (d-1) ty) go d ty@RCons{} = uncurry PPRow (goRow d ty) - go d (ForAll _ v mbK ty _) = goForAll d [(v, fmap (go (d-1)) mbK)] ty + go d (ForAll _ vis v mbK ty _) = goForAll d [(vis, v, fmap (go (d-1)) mbK)] ty go d (TypeApp _ a b) = goTypeApp d a b go d (KindApp _ a b) = PPTypeApp (go (d-1) a) (PPKindArg (go (d-1) b)) - goForAll d vs (ForAll _ v mbK ty _) = goForAll d ((v, fmap (go (d-1)) mbK) : vs) ty + goForAll d vs (ForAll _ vis v mbK ty _) = goForAll d ((vis, v, fmap (go (d-1)) mbK) : vs) ty goForAll d vs ty = PPForAll (reverse vs) (go (d-1) ty) goRow d ty = @@ -219,8 +219,8 @@ matchType tro = buildPrettyPrinter operators (matchTypeAtom tro) where forall' = if troUnicode tro then "∀" else "forall" doubleColon = if troUnicode tro then "∷" else "::" - printMbKindedType (v, Nothing) = text v - printMbKindedType (v, Just k) = text ("(" ++ v ++ " " ++ doubleColon ++ " ") <> typeAsBox' k <> text ")" + printMbKindedType (vis, v, Nothing) = text (T.unpack $ typeVarVisibilityPrefix vis) <> text v + printMbKindedType (vis, v, Just k) = text ("(" ++ T.unpack (typeVarVisibilityPrefix vis) ++ v ++ " " ++ doubleColon ++ " ") <> typeAsBox' k <> text ")" -- If both boxes span a single line, keep them on the same line, or else -- use the specified function to modify the second box, then combine vertically. @@ -229,10 +229,10 @@ matchType tro = buildPrettyPrinter operators (matchTypeAtom tro) where | rows b1 > 1 || rows b2 > 1 = vcat left [ b1, f b2 ] | otherwise = hcat top [ b1, text " ", b2] -forall_ :: Pattern () PrettyPrintType ([(String, Maybe PrettyPrintType)], PrettyPrintType) +forall_ :: Pattern () PrettyPrintType ([(TypeVarVisibility, String, Maybe PrettyPrintType)], PrettyPrintType) forall_ = mkPattern match where - match (PPForAll idents ty) = Just (map (first T.unpack) idents, ty) + match (PPForAll idents ty) = Just ((_2 %~ T.unpack) <$> idents, ty) match _ = Nothing typeAtomAsBox' :: PrettyPrintType -> Box diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs index 85b6638fdc..4d5a5ec604 100644 --- a/src/Language/PureScript/Pretty/Values.hs +++ b/src/Language/PureScript/Pretty/Values.hs @@ -66,6 +66,7 @@ prettyPrintValue d (ObjectUpdateNested o ps) = prettyPrintValueAtom (d - 1) o `b printNode (key, Leaf val) = prettyPrintUpdateEntry d key val printNode (key, Branch val) = textT (prettyPrintObjectKey key) `beforeWithSpace` prettyPrintUpdate val prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg +prettyPrintValue d (VisibleTypeApp val _) = prettyPrintValueAtom (d - 1) val prettyPrintValue d (Unused val) = prettyPrintValue d val prettyPrintValue d (Abs arg val) = text ('\\' : T.unpack (prettyPrintBinder arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val) prettyPrintValue d (Case values binders) = diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs index 2202633667..d081764d7f 100644 --- a/src/Language/PureScript/Sugar/Names.hs +++ b/src/Language/PureScript/Sugar/Names.hs @@ -289,6 +289,8 @@ renameInModule imports (Module modSS coms mn decls exps) = ((ss, bound), ) <$> (Constructor ss <$> updateDataConstructorName name ss) updateValue s (TypedValue check val ty) = (s, ) <$> (TypedValue check val <$> updateTypesEverywhere ty) + updateValue s (VisibleTypeApp val ty) = + (s, ) <$> VisibleTypeApp val <$> updateTypesEverywhere ty updateValue s v = return (s, v) updateBinder diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs index a5bfa59b90..ca7a901f6f 100644 --- a/src/Language/PureScript/Sugar/TypeClasses.hs +++ b/src/Language/PureScript/Sugar/TypeClasses.hs @@ -300,10 +300,11 @@ typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration (TypeDeclarati dictObjIdent = Ident "v" ctor = ConstructorBinder ss (coerceProperName . dictTypeName <$> className) [VarBinder ss dictObjIdent] acsr = Accessor (mkString $ runIdent ident) (Var ss (Qualified ByNullSourcePos dictObjIdent)) + visibility = second (const TypeVarVisible) <$> args in ValueDecl sa ident Private [] [MkUnguarded ( TypedValue False (Abs (VarBinder ss dictIdent) (Case [Var ss $ Qualified ByNullSourcePos dictIdent] [CaseAlternative [ctor] [MkUnguarded acsr]])) $ - moveQuantifiersToFront (quantify (srcConstrainedType (srcConstraint className [] (map (srcTypeVar . fst) args) Nothing) ty)) + addVisibility visibility (moveQuantifiersToFront (quantify (srcConstrainedType (srcConstraint className [] (map (srcTypeVar . fst) args) Nothing) ty))) )] typeClassMemberToDictionaryAccessor _ _ _ _ = internalError "Invalid declaration in type class definition" diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index 3f5043ad24..3030750db2 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -566,7 +566,7 @@ typeCheckAll moduleName = traverse go -- withKinds :: [(Text, Maybe SourceType)] -> SourceType -> [(Text, Maybe SourceType)] withKinds [] _ = [] - withKinds ss (ForAll _ _ _ k _) = withKinds ss k + withKinds ss (ForAll _ _ _ _ k _) = withKinds ss k withKinds (s@(_, Just _):ss) (TypeApp _ (TypeApp _ tyFn _) k2) | eqType tyFn tyFunction = s : withKinds ss k2 withKinds ((s, Nothing):ss) (TypeApp _ (TypeApp _ tyFn k1) k2) | eqType tyFn tyFunction = (s, Just k1) : withKinds ss k2 withKinds _ _ = internalError "Invalid arguments to withKinds" diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index b0114618bf..8d5dcde9b6 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -499,7 +499,7 @@ validateParamsInTypeConstructors derivingClass utc isBi CovariantClasses{..} con headOfTypeWithSubst = headOfType . replaceAllTypeVars subst in \case - ForAll _ name _ ty _ -> + ForAll _ _ name _ ty _ -> fmap join . traverse (\params' -> go params' isNegative ty) $ filterThese (/= name) params ConstrainedType _ _ ty -> diff --git a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs index bbc0e49411..c8abb597c8 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs @@ -383,7 +383,7 @@ rewrite env (Skolem _ _ _ s1 _, ty1) | not $ occurs s1 ty1 = go where | (TypeConstructor _ tyName, _, _) <- unapplyTypes ty2 = do rewriteTyConApp go (lookupRoles env tyName) ty2 go (KindApp sa ty k) = KindApp sa <$> go ty <*> pure k - go (ForAll sa tv k ty scope) = ForAll sa tv k <$> go ty <*> pure scope + go (ForAll sa vis tv k ty scope) = ForAll sa vis tv k <$> go ty <*> pure scope go (ConstrainedType sa Constraint{..} ty) | s1 `S.notMember` foldMap skolems constraintArgs = ConstrainedType sa Constraint{..} <$> go ty go (RCons sa label ty rest) = RCons sa label <$> go ty <*> go rest diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs index b39d980c3e..5be87c0057 100644 --- a/src/Language/PureScript/TypeChecker/Kinds.hs +++ b/src/Language/PureScript/TypeChecker/Kinds.hs @@ -34,7 +34,7 @@ import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State (MonadState, gets, modify) import Control.Monad.Supply.Class (MonadSupply(..)) -import Data.Bifunctor (first) +import Data.Bifunctor (first, second) import Data.Bitraversable (bitraverse) import Data.Foldable (for_, traverse_) import Data.Function (on) @@ -215,7 +215,7 @@ inferKind = \tyToInfer -> KindApp ann t1 t2 -> do (t1', kind) <- bitraverse pure apply =<< go t1 case kind of - ForAll _ arg (Just argKind) resKind _ -> do + ForAll _ _ arg (Just argKind) resKind _ -> do t2' <- checkKind t2 argKind pure (KindApp ann t1' t2', replaceTypeVars arg t2' resKind) _ -> @@ -225,7 +225,7 @@ inferKind = \tyToInfer -> t1' <- checkKind t1 t2' t2'' <- apply t2' pure (t1', t2'') - ForAll ann arg mbKind ty sc -> do + ForAll ann vis arg mbKind ty sc -> do moduleName <- unsafeCheckCurrentModule kind <- case mbKind of Just k -> replaceAllTypeSynonyms =<< checkIsSaturatedType k @@ -235,7 +235,7 @@ inferKind = \tyToInfer -> unks <- unknownsWithKinds . IS.toList $ unknowns ty' pure (ty', unks) for_ unks . uncurry $ addUnsolved Nothing - pure (ForAll ann arg (Just kind) ty' sc, E.kindType $> ann) + pure (ForAll ann vis arg (Just kind) ty' sc, E.kindType $> ann) ParensInType _ ty -> go ty ty -> @@ -261,7 +261,7 @@ inferAppKind ann (fn, fnKind) arg = case fnKind of solve u $ (TUnknown ann u1 E.-:> TUnknown ann u2) $> ann arg' <- checkKind arg $ TUnknown ann u1 pure (TypeApp ann fn arg', TUnknown ann u2) - ForAll _ a (Just k) ty _ -> do + ForAll _ _ a (Just k) ty _ -> do u <- freshUnknown addUnsolved Nothing u k inferAppKind ann (KindApp ann fn (TUnknown ann u), replaceTypeVars a (TUnknown ann u) ty) arg @@ -336,7 +336,7 @@ instantiateKind -> SourceType -> m SourceType instantiateKind (ty, kind1) kind2 = case kind1 of - ForAll _ a (Just k) t _ | shouldInstantiate kind2 -> do + ForAll _ _ a (Just k) t _ | shouldInstantiate kind2 -> do let ann = getAnnForType ty u <- freshKindWithKind (fst ann) k instantiateKind (KindApp ann ty u, replaceTypeVars a u t) kind2 @@ -345,7 +345,7 @@ instantiateKind (ty, kind1) kind2 = case kind1 of pure ty where shouldInstantiate = not . \case - ForAll _ _ _ _ _ -> True + ForAll _ _ _ _ _ _ -> True _ -> False subsumesKind @@ -361,11 +361,11 @@ subsumesKind = go , eqType arr2 E.tyFunction -> do go b1 a1 join $ go <$> apply a2 <*> apply b2 - (a, ForAll ann var mbKind b mbScope) -> do + (a, ForAll ann _ var mbKind b mbScope) -> do scope <- maybe newSkolemScope pure mbScope skolc <- newSkolemConstant go a $ skolemize ann var mbKind skolc scope b - (ForAll ann var (Just kind) a _, b) -> do + (ForAll ann _ var (Just kind) a _, b) -> do a' <- freshKindWithKind (fst ann) kind go (replaceTypeVars var a' a) b (TUnknown ann u, b@(TypeApp _ (TypeApp _ arr _) _)) @@ -559,11 +559,11 @@ elaborateKind = \case KindApp ann t1 t2 -> do k1 <- elaborateKind t1 case k1 of - ForAll _ a _ n _ -> do + ForAll _ _ a _ n _ -> do flip (replaceTypeVars a) n . ($> ann) <$> apply t2 _ -> cannotApplyKindToType t1 t2 - ForAll ann _ _ _ _ -> do + ForAll ann _ _ _ _ _ -> do pure $ E.kindType $> ann ConstrainedType ann _ _ -> pure $ E.kindType $> ann @@ -651,8 +651,9 @@ inferDataDeclaration moduleName (ann, tyName, tyArgs, ctors) = do tyCtor = foldl (\ty -> srcKindApp ty . srcTypeVar . fst . snd) tyCtorName sigBinders tyCtor' = foldl (\ty -> srcTypeApp ty . srcTypeVar . fst) tyCtor tyArgs' ctorBinders = fmap (fmap (fmap Just)) $ sigBinders <> fmap (nullSourceAnn,) tyArgs' + visibility = second (const TypeVarVisible) <$> tyArgs for ctors $ - fmap (fmap (mkForAll ctorBinders)) . inferDataConstructor tyCtor' + fmap (fmap (addVisibility visibility . mkForAll ctorBinders)) . inferDataConstructor tyCtor' inferDataConstructor :: forall m. (MonadError MultipleErrors m, MonadState CheckState m) @@ -767,7 +768,7 @@ checkTypeQuantification = unknownsInKinds False _ = (False, []) unknownsInKinds _ ty = case ty of - ForAll sa _ _ _ _ | unks <- unknowns ty, not (IS.null unks) -> + ForAll sa _ _ _ _ _ | unks <- unknowns ty, not (IS.null unks) -> (False, [(fst sa, unks, ty)]) KindApp sa _ _ | unks <- unknowns ty, not (IS.null unks) -> (False, [(fst sa, unks, ty)]) @@ -916,15 +917,15 @@ checkKindDeclaration _ ty = do -- be referenced (easily). freshVar arg = (arg <>) . T.pack . show <$> fresh freshenForAlls = curry $ \case - (ForAll _ v1 _ ty1 _, ForAll a2 v2 k2 ty2 sc2) | v1 == v2 -> do + (ForAll _ _ v1 _ ty1 _, ForAll a2 vis v2 k2 ty2 sc2) | v1 == v2 -> do ty2' <- freshenForAlls ty1 ty2 - pure $ ForAll a2 v2 k2 ty2' sc2 + pure $ ForAll a2 vis v2 k2 ty2' sc2 (_, ty2) -> go ty2 where go = \case - ForAll a' v' k' ty' sc' -> do + ForAll a' vis v' k' ty' sc' -> do v'' <- freshVar v' ty'' <- go (replaceTypeVars v' (TypeVar a' v'') ty') - pure $ ForAll a' v'' k' ty'' sc' + pure $ ForAll a' vis v'' k' ty'' sc' other -> pure other checkValidKind = everywhereOnTypesM $ \case diff --git a/src/Language/PureScript/TypeChecker/Roles.hs b/src/Language/PureScript/TypeChecker/Roles.hs index fb43b2e821..7b38a317b7 100644 --- a/src/Language/PureScript/TypeChecker/Roles.hs +++ b/src/Language/PureScript/TypeChecker/Roles.hs @@ -195,7 +195,7 @@ inferDataDeclarationRoles moduleName (tyName, tyArgs, ctors) roleEnv = mempty | otherwise = RoleMap $ M.singleton v Representational - walk btvs (ForAll _ tv _ t _) = + walk btvs (ForAll _ _ tv _ t _) = -- We can walk under universal quantifiers as long as we make note of the -- variables that they bind. For instance, given a definition -- @data T z = T (forall z. z -> z)@, we will make note that @z@ is bound diff --git a/src/Language/PureScript/TypeChecker/Skolems.hs b/src/Language/PureScript/TypeChecker/Skolems.hs index 3c49d2bf36..aa49997fd6 100644 --- a/src/Language/PureScript/TypeChecker/Skolems.hs +++ b/src/Language/PureScript/TypeChecker/Skolems.hs @@ -34,7 +34,7 @@ newSkolemConstant = do introduceSkolemScope :: MonadState CheckState m => Type a -> m (Type a) introduceSkolemScope = everywhereOnTypesM go where - go (ForAll ann ident mbK ty Nothing) = ForAll ann ident mbK ty <$> (Just <$> newSkolemScope) + go (ForAll ann vis ident mbK ty Nothing) = ForAll ann vis ident mbK ty <$> (Just <$> newSkolemScope) go other = return other -- | Generate a new skolem scope @@ -63,6 +63,8 @@ skolemizeTypesInValue ann ident mbK sko scope = | ident `notElem` sco = return (sco, DeferredDictionary c (map (skolemize ann ident mbK sko scope) ts)) onExpr sco (TypedValue check val ty) | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedValue check val (skolemize ann ident mbK sko scope ty)) + onExpr sco (VisibleTypeApp val ty) + | ident `notElem` sco = return (sco ++ peelTypeVars ty, VisibleTypeApp val (skolemize ann ident mbK sko scope ty)) onExpr sco other = return (sco, other) onBinder :: [Text] -> Binder -> Identity ([Text], Binder) @@ -71,7 +73,7 @@ skolemizeTypesInValue ann ident mbK sko scope = onBinder sco other = return (sco, other) peelTypeVars :: SourceType -> [Text] - peelTypeVars (ForAll _ i _ ty _) = i : peelTypeVars ty + peelTypeVars (ForAll _ _ i _ ty _) = i : peelTypeVars ty peelTypeVars _ = [] -- | Ensure skolem variables do not escape their scope @@ -116,7 +118,7 @@ skolemEscapeCheck expr@TypedValue{} = -- Collect any scopes appearing in quantifiers at the top level collectScopes :: SourceType -> [SkolemScope] - collectScopes (ForAll _ _ _ t (Just sco)) = sco : collectScopes t + collectScopes (ForAll _ _ _ _ t (Just sco)) = sco : collectScopes t collectScopes ForAll{} = internalError "skolemEscapeCheck: No skolem scope" collectScopes _ = [] diff --git a/src/Language/PureScript/TypeChecker/Subsumption.hs b/src/Language/PureScript/TypeChecker/Subsumption.hs index e99f1c829c..26da5e980f 100644 --- a/src/Language/PureScript/TypeChecker/Subsumption.hs +++ b/src/Language/PureScript/TypeChecker/Subsumption.hs @@ -74,11 +74,11 @@ subsumes' -> SourceType -> SourceType -> m (Coercion mode) -subsumes' mode (ForAll _ ident mbK ty1 _) ty2 = do +subsumes' mode (ForAll _ _ ident mbK ty1 _) ty2 = do u <- maybe (internalCompilerError "Unelaborated forall") freshTypeWithKind mbK let replaced = replaceTypeVars ident u ty1 subsumes' mode replaced ty2 -subsumes' mode ty1 (ForAll _ ident mbK ty2 sco) = +subsumes' mode ty1 (ForAll _ _ ident mbK ty2 sco) = case sco of Just sco' -> do sko <- newSkolemConstant diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs index ab532057e8..04f7de22fe 100644 --- a/src/Language/PureScript/TypeChecker/Types.hs +++ b/src/Language/PureScript/TypeChecker/Types.hs @@ -52,7 +52,7 @@ import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors, SimpleError import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName, coerceProperName, freshIdent) import Language.PureScript.TypeChecker.Deriving (deriveInstance) import Language.PureScript.TypeChecker.Entailment (InstanceContext, newDictionaries, replaceTypeClassDictionaries) -import Language.PureScript.TypeChecker.Kinds (checkConstraint, checkTypeKind, kindOf, kindOfWithScopedVars, unifyKinds', unknownsWithKinds) +import Language.PureScript.TypeChecker.Kinds (checkConstraint, checkKind, checkTypeKind, kindOf, kindOfWithScopedVars, unifyKinds', unknownsWithKinds) import Language.PureScript.TypeChecker.Monad import Language.PureScript.TypeChecker.Skolems (introduceSkolemScope, newSkolemConstant, newSkolemScope, skolemEscapeCheck, skolemize, skolemizeTypesInValue) import Language.PureScript.TypeChecker.Subsumption (subsumes) @@ -325,7 +325,7 @@ instantiatePolyTypeWithUnknowns => Expr -> SourceType -> m (Expr, SourceType) -instantiatePolyTypeWithUnknowns val (ForAll _ ident mbK ty _) = do +instantiatePolyTypeWithUnknowns val (ForAll _ _ ident mbK ty _) = do u <- maybe (internalCompilerError "Unelaborated forall") freshTypeWithKind mbK insertUnkName' u ident instantiatePolyTypeWithUnknowns val $ replaceTypeVars ident u ty @@ -335,6 +335,24 @@ instantiatePolyTypeWithUnknowns val (ConstrainedType _ con ty) = do instantiatePolyTypeWithUnknowns (App val (TypeClassDictionary con dicts hints)) ty instantiatePolyTypeWithUnknowns val ty = return (val, ty) +instantiatePolyTypeWithUnknownsUntilVisible + :: (MonadState CheckState m, MonadError MultipleErrors m) + => Expr + -> SourceType + -> m (Expr, SourceType) +instantiatePolyTypeWithUnknownsUntilVisible val (ForAll _ TypeVarInvisible ident mbK ty _) = do + u <- maybe (internalCompilerError "Unelaborated forall") freshTypeWithKind mbK + insertUnkName' u ident + instantiatePolyTypeWithUnknownsUntilVisible val $ replaceTypeVars ident u ty +instantiatePolyTypeWithUnknownsUntilVisible val ty = return (val, ty) + +instantiateConstraint :: MonadState CheckState m => Expr -> Type SourceAnn -> m (Expr, Type SourceAnn) +instantiateConstraint val (ConstrainedType _ con ty) = do + dicts <- getTypeClassDictionaries + hints <- getHints + instantiateConstraint (App val (TypeClassDictionary con dicts hints)) ty +instantiateConstraint val ty = pure (val, ty) + -- | Match against TUnknown and call insertUnkName, failing otherwise. insertUnkName' :: (MonadState CheckState m, MonadError MultipleErrors m) => SourceType -> Text -> m () insertUnkName' (TUnknown _ i) n = insertUnkName i n @@ -441,6 +459,26 @@ infer' (App f arg) = do f'@(TypedValue' _ _ ft) <- infer f (ret, app) <- checkFunctionApplication (tvToExpr f') ft arg return $ TypedValue' True app ret +infer' (VisibleTypeApp valFn (TypeWildcard _ _)) = do + TypedValue' _ valFn' valTy <- infer valFn + (valFn'', valTy') <- instantiatePolyTypeWithUnknownsUntilVisible valFn' valTy + case valTy' of + ForAll qAnn _ qName qKind qBody qSko -> do + pure $ TypedValue' True valFn'' (ForAll qAnn TypeVarInvisible qName qKind qBody qSko) + _ -> + throwError $ errorMessage $ CannotSkipTypeApplication valTy' +infer' (VisibleTypeApp valFn tyArg) = do + TypedValue' _ valFn' valTy <- infer valFn + tyArg' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ tyArg + (valFn'', valTy') <- instantiatePolyTypeWithUnknownsUntilVisible valFn' valTy + case valTy' of + ForAll _ _ qName (Just qKind) qBody _ -> do + tyArg'' <- replaceAllTypeSynonyms <=< checkKind tyArg' $ qKind + let resTy = replaceTypeVars qName tyArg'' qBody + (valFn''', resTy') <- instantiateConstraint valFn'' resTy + pure $ TypedValue' True valFn''' resTy' + _ -> + throwError $ errorMessage $ CannotApplyExpressionOfTypeOnType valTy tyArg infer' (Var ss var) = do checkVisibility var ty <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards <=< lookupVariable $ var @@ -728,7 +766,7 @@ check' => Expr -> SourceType -> m TypedValue' -check' val (ForAll ann ident mbK ty _) = do +check' val (ForAll ann vis ident mbK ty _) = do env <- getEnv mn <- gets checkCurrentModule scope <- newSkolemScope @@ -746,7 +784,7 @@ check' val (ForAll ann ident mbK ty _) = do skolemizeTypesInValue ss ident mbK sko scope val | otherwise = val val' <- tvToExpr <$> check skVal sk - return $ TypedValue' True val' (ForAll ann ident mbK ty (Just scope)) + return $ TypedValue' True val' (ForAll ann vis ident mbK ty (Just scope)) check' val t@(ConstrainedType _ con@(Constraint _ cls@(Qualified _ (ProperName className)) _ _ _) ty) = do TypeClassData{ typeClassIsEmpty } <- lookupTypeClass cls -- An empty class dictionary is never used; see code in `TypeChecker.Entailment` @@ -950,7 +988,7 @@ checkFunctionApplication' fn (TypeApp _ (TypeApp _ tyFunction' argTy) retTy) arg unifyTypes tyFunction' tyFunction arg' <- tvToExpr <$> check arg argTy return (retTy, App fn arg') -checkFunctionApplication' fn (ForAll _ ident mbK ty _) arg = do +checkFunctionApplication' fn (ForAll _ _ ident mbK ty _) arg = do u <- maybe (internalCompilerError "Unelaborated forall") freshTypeWithKind mbK insertUnkName' u ident let replaced = replaceTypeVars ident u ty diff --git a/src/Language/PureScript/TypeChecker/Unify.hs b/src/Language/PureScript/TypeChecker/Unify.hs index b58c8d78a7..e4f1040ebf 100644 --- a/src/Language/PureScript/TypeChecker/Unify.hs +++ b/src/Language/PureScript/TypeChecker/Unify.hs @@ -114,7 +114,7 @@ unifyTypes t1 t2 = do unifyTypes' (TUnknown _ u1) (TUnknown _ u2) | u1 == u2 = return () unifyTypes' (TUnknown _ u) t = solveType u t unifyTypes' t (TUnknown _ u) = solveType u t - unifyTypes' (ForAll ann1 ident1 mbK1 ty1 sc1) (ForAll ann2 ident2 mbK2 ty2 sc2) = + unifyTypes' (ForAll ann1 _ ident1 mbK1 ty1 sc1) (ForAll ann2 _ ident2 mbK2 ty2 sc2) = case (sc1, sc2) of (Just sc1', Just sc2') -> do sko <- newSkolemConstant @@ -122,7 +122,7 @@ unifyTypes t1 t2 = do let sk2 = skolemize ann2 ident2 mbK2 sko sc2' ty2 sk1 `unifyTypes` sk2 _ -> internalError "unifyTypes: unspecified skolem scope" - unifyTypes' (ForAll ann ident mbK ty1 (Just sc)) ty2 = do + unifyTypes' (ForAll ann _ ident mbK ty1 (Just sc)) ty2 = do sko <- newSkolemConstant let sk = skolemize ann ident mbK sko sc ty1 sk `unifyTypes` ty2 diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs index 6e7552521f..ad5e207882 100644 --- a/src/Language/PureScript/Types.hs +++ b/src/Language/PureScript/Types.hs @@ -53,6 +53,19 @@ data WildcardData = HoleWildcard Text | UnnamedWildcard | IgnoredWildcard instance NFData WildcardData instance Serialise WildcardData +data TypeVarVisibility + = TypeVarVisible + | TypeVarInvisible + deriving (Show, Eq, Ord, Generic) + +instance NFData TypeVarVisibility +instance Serialise TypeVarVisibility + +typeVarVisibilityPrefix :: TypeVarVisibility -> Text +typeVarVisibilityPrefix = \case + TypeVarVisible -> "@" + TypeVarInvisible -> mempty + -- | -- The type of types -- @@ -77,7 +90,7 @@ data Type a -- | Explicit kind application | KindApp a (Type a) (Type a) -- | Forall quantifier - | ForAll a Text (Maybe (Type a)) (Type a) (Maybe SkolemScope) + | ForAll a TypeVarVisibility Text (Maybe (Type a)) (Type a) (Maybe SkolemScope) -- | A type with a set of type class constraints | ConstrainedType a (Constraint a) (Type a) -- | A skolem constant @@ -126,7 +139,7 @@ srcTypeApp = TypeApp NullSourceAnn srcKindApp :: SourceType -> SourceType -> SourceType srcKindApp = KindApp NullSourceAnn -srcForAll :: Text -> Maybe SourceType -> SourceType -> Maybe SkolemScope -> SourceType +srcForAll :: TypeVarVisibility -> Text -> Maybe SourceType -> SourceType -> Maybe SkolemScope -> SourceType srcForAll = ForAll NullSourceAnn srcConstrainedType :: SourceConstraint -> SourceType -> SourceType @@ -219,6 +232,11 @@ constraintToJSON annToJSON Constraint {..} = , "constraintData" .= fmap constraintDataToJSON constraintData ] +typeVarVisToJSON :: TypeVarVisibility -> A.Value +typeVarVisToJSON = \case + TypeVarVisible -> A.toJSON ("TypeVarVisible" :: Text) + TypeVarInvisible -> A.toJSON ("TypeVarInvisible" :: Text) + typeToJSON :: forall a. (a -> A.Value) -> Type a -> A.Value typeToJSON annToJSON ty = case ty of @@ -240,10 +258,14 @@ typeToJSON annToJSON ty = variant "TypeApp" a (go b, go c) KindApp a b c -> variant "KindApp" a (go b, go c) - ForAll a b c d e -> - case c of - Nothing -> variant "ForAll" a (b, go d, e) - Just k -> variant "ForAll" a (b, go k, go d, e) + ForAll a b c d e f -> + variant "ForAll" a $ A.object + [ "visibility" .= b + , "identifier" .= c + , "kind" .= fmap go d + , "type" .= go e + , "skolem" .= f + ] ConstrainedType a b c -> variant "ConstrainedType" a (constraintToJSON annToJSON b, go c) Skolem a b c d e -> @@ -292,6 +314,9 @@ instance A.ToJSON a => A.ToJSON (Constraint a) where instance A.ToJSON ConstraintData where toJSON = constraintDataToJSON +instance A.ToJSON TypeVarVisibility where + toJSON = typeVarVisToJSON + constraintDataFromJSON :: A.Value -> A.Parser ConstraintData constraintDataFromJSON = A.withObject "PartialConstraintData" $ \o -> do (bs, trunc) <- o .: "contents" @@ -306,6 +331,14 @@ constraintFromJSON defaultAnn annFromJSON = A.withObject "Constraint" $ \o -> do constraintData <- o .: "constraintData" >>= traverse constraintDataFromJSON pure $ Constraint {..} +typeVarVisFromJSON :: A.Value -> A.Parser TypeVarVisibility +typeVarVisFromJSON v = do + v' <- A.parseJSON v + case v' of + "TypeVarVisible" -> pure TypeVarVisible + "TypeVarInvisible" -> pure TypeVarInvisible + _ -> fail $ "Unrecognized TypeVarVisibility: " <> v' + typeFromJSON :: forall a. A.Parser a -> (A.Value -> A.Parser a) -> A.Value -> A.Parser (Type a) typeFromJSON defaultAnn annFromJSON = A.withObject "Type" $ \o -> do tag <- o .: "tag" @@ -337,13 +370,23 @@ typeFromJSON defaultAnn annFromJSON = A.withObject "Type" $ \o -> do KindApp a <$> go b <*> go c "ForAll" -> do let + asObject = do + f <- contents + v <- f .: "visibility" + i <- f .: "identifier" + k <- f .:? "kind" + t <- f .: "type" + s <- f .: "skolem" + ForAll a v i <$> traverse go k <*> go t <*> pure s + withoutMbKind = do (b, c, d) <- contents - ForAll a b Nothing <$> go c <*> pure d + ForAll a TypeVarInvisible b Nothing <$> go c <*> pure d + withMbKind = do (b, c, d, e) <- contents - ForAll a b <$> (Just <$> go c) <*> go d <*> pure e - withMbKind <|> withoutMbKind + ForAll a TypeVarInvisible b <$> (Just <$> go c) <*> go d <*> pure e + asObject <|> withMbKind <|> withoutMbKind "ConstrainedType" -> do (b, c) <- contents ConstrainedType a <$> constraintFromJSON defaultAnn annFromJSON b <*> go c @@ -411,6 +454,9 @@ instance A.FromJSON WildcardData where A.Null -> pure UnnamedWildcard _ -> fail "Unrecognized WildcardData" +instance A.FromJSON TypeVarVisibility where + parseJSON = typeVarVisFromJSON + data RowListItem a = RowListItem { rowListAnn :: a , rowListLabel :: Label @@ -468,7 +514,7 @@ isMonoType _ = True -- | Universally quantify a type mkForAll :: [(a, (Text, Maybe (Type a)))] -> Type a -> Type a -mkForAll args ty = foldr (\(ann, (arg, mbK)) t -> ForAll ann arg mbK t Nothing) ty args +mkForAll args ty = foldr (\(ann, (arg, mbK)) t -> ForAll ann TypeVarInvisible arg mbK t Nothing) ty args -- | Replace a type variable, taking into account variable shadowing replaceTypeVars :: Text -> Type a -> Type a -> Type a @@ -481,13 +527,13 @@ replaceAllTypeVars = go [] where go _ m (TypeVar ann v) = fromMaybe (TypeVar ann v) (v `lookup` m) go bs m (TypeApp ann t1 t2) = TypeApp ann (go bs m t1) (go bs m t2) go bs m (KindApp ann t1 t2) = KindApp ann (go bs m t1) (go bs m t2) - go bs m (ForAll ann v mbK t sco) - | v `elem` keys = go bs (filter ((/= v) . fst) m) $ ForAll ann v mbK' t sco + go bs m (ForAll ann vis v mbK t sco) + | v `elem` keys = go bs (filter ((/= v) . fst) m) $ ForAll ann vis v mbK' t sco | v `elem` usedVars = let v' = genName v (keys ++ bs ++ usedVars) t' = go bs [(v, TypeVar ann v')] t - in ForAll ann v' mbK' (go (v' : bs) m t') sco - | otherwise = ForAll ann v mbK' (go (v : bs) m t) sco + in ForAll ann vis v' mbK' (go (v' : bs) m t') sco + | otherwise = ForAll ann vis v mbK' (go (v : bs) m t) sco where mbK' = go bs m <$> mbK keys = map fst m @@ -504,6 +550,17 @@ replaceAllTypeVars = go [] where try' n | (orig <> T.pack (show n)) `elem` inUse = try' (n + 1) | otherwise = orig <> T.pack (show n) +-- | Add visible type abstractions to top-level foralls. +addVisibility :: [(Text, TypeVarVisibility)] -> Type a -> Type a +addVisibility v = go where + go (ForAll ann vis arg mbK ty sco) = case lookup arg v of + Just vis' -> + ForAll ann vis' arg mbK (go ty) sco + Nothing -> + ForAll ann vis arg mbK (go ty) sco + go (ParensInType ann ty) = ParensInType ann (go ty) + go ty = ty + -- | Collect all type variables appearing in a type usedTypeVariables :: Type a -> [Text] usedTypeVariables = ordNub . everythingOnTypes (++) go where @@ -518,7 +575,7 @@ freeTypeVariables = ordNub . fmap snd . sortOn fst . go 0 [] where go lvl bound (TypeVar _ v) | v `notElem` bound = [(lvl, v)] go lvl bound (TypeApp _ t1 t2) = go lvl bound t1 ++ go lvl bound t2 go lvl bound (KindApp _ t1 t2) = go lvl bound t1 ++ go (lvl - 1) bound t2 - go lvl bound (ForAll _ v mbK t _) = foldMap (go (lvl - 1) bound) mbK ++ go lvl (v : bound) t + go lvl bound (ForAll _ _ v mbK t _) = foldMap (go (lvl - 1) bound) mbK ++ go lvl (v : bound) t go lvl bound (ConstrainedType _ c t) = foldMap (go (lvl - 1) bound) (constraintKindArgs c) ++ foldMap (go lvl bound) (constraintArgs c) ++ go lvl bound t go lvl bound (RCons _ _ t r) = go lvl bound t ++ go lvl bound r go lvl bound (KindedType _ t k) = go lvl bound t ++ go (lvl - 1) bound k @@ -531,20 +588,20 @@ completeBinderList :: Type a -> Maybe ([(a, (Text, Type a))], Type a) completeBinderList = go [] where go acc = \case - ForAll _ _ Nothing _ _ -> Nothing - ForAll ann var (Just k) ty _ -> go ((ann, (var, k)) : acc) ty + ForAll _ _ _ Nothing _ _ -> Nothing + ForAll ann _ var (Just k) ty _ -> go ((ann, (var, k)) : acc) ty ty -> Just (reverse acc, ty) -- | Universally quantify over all type variables appearing free in a type quantify :: Type a -> Type a -quantify ty = foldr (\arg t -> ForAll (getAnnForType ty) arg Nothing t Nothing) ty $ freeTypeVariables ty +quantify ty = foldr (\arg t -> ForAll (getAnnForType ty) TypeVarInvisible arg Nothing t Nothing) ty $ freeTypeVariables ty -- | Move all universal quantifiers to the front of a type moveQuantifiersToFront :: Type a -> Type a moveQuantifiersToFront = go [] [] where - go qs cs (ForAll ann q mbK ty sco) = go ((ann, q, sco, mbK) : qs) cs ty + go qs cs (ForAll ann vis q mbK ty sco) = go ((ann, q, sco, mbK, vis) : qs) cs ty go qs cs (ConstrainedType ann c ty) = go qs ((ann, c) : cs) ty - go qs cs ty = foldl (\ty' (ann, q, sco, mbK) -> ForAll ann q mbK ty' sco) (foldl (\ty' (ann, c) -> ConstrainedType ann c ty') ty cs) qs + go qs cs ty = foldl (\ty' (ann, q, sco, mbK, vis) -> ForAll ann vis q mbK ty' sco) (foldl (\ty' (ann, c) -> ConstrainedType ann c ty') ty cs) qs -- | Check if a type contains `forall` containsForAll :: Type a -> Bool @@ -580,12 +637,12 @@ eraseForAllKindAnnotations :: Type a -> Type a eraseForAllKindAnnotations = removeAmbiguousVars . removeForAllKinds where removeForAllKinds = everywhereOnTypes $ \case - ForAll ann arg _ ty sco -> - ForAll ann arg Nothing ty sco + ForAll ann vis arg _ ty sco -> + ForAll ann vis arg Nothing ty sco other -> other removeAmbiguousVars = everywhereOnTypes $ \case - fa@(ForAll _ arg _ ty _) + fa@(ForAll _ _ arg _ ty _) | arg `elem` freeTypeVariables ty -> fa | otherwise -> ty other -> other @@ -615,7 +672,7 @@ srcInstanceType -> SourceType srcInstanceType ss vars className tys = setAnnForType (ss, []) - . flip (foldr $ \(tv, k) ty -> srcForAll tv (Just k) ty Nothing) vars + . flip (foldr $ \(tv, k) ty -> srcForAll TypeVarInvisible tv (Just k) ty Nothing) vars . flip (foldl' srcTypeApp) tys $ srcTypeConstructor $ coerceProperName <$> className @@ -623,7 +680,7 @@ everywhereOnTypes :: (Type a -> Type a) -> Type a -> Type a everywhereOnTypes f = go where go (TypeApp ann t1 t2) = f (TypeApp ann (go t1) (go t2)) 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 (ForAll ann vis arg mbK ty sco) = f (ForAll ann vis 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)) @@ -636,7 +693,7 @@ everywhereOnTypesM :: Monad m => (Type a -> m (Type a)) -> Type a -> m (Type a) everywhereOnTypesM f = go where go (TypeApp ann t1 t2) = (TypeApp ann <$> go t1 <*> go t2) >>= f 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 (ForAll ann vis arg mbK ty sco) = (ForAll ann vis 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 @@ -649,7 +706,7 @@ everywhereOnTypesTopDownM :: Monad m => (Type a -> m (Type a)) -> Type a -> m (T everywhereOnTypesTopDownM f = go <=< f where go (TypeApp ann t1 t2) = TypeApp ann <$> (f t1 >>= go) <*> (f t2 >>= go) 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 (ForAll ann vis arg mbK ty sco) = ForAll ann vis 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) @@ -662,8 +719,8 @@ everythingOnTypes :: (r -> r -> r) -> (Type a -> r) -> Type a -> r everythingOnTypes (<+>) f = go where go t@(TypeApp _ t1 t2) = f t <+> go t1 <+> go t2 go t@(KindApp _ t1 t2) = f t <+> go t1 <+> go t2 - go t@(ForAll _ _ (Just k) ty _) = f t <+> go k <+> go ty - go t@(ForAll _ _ _ ty _) = f t <+> go ty + 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 @@ -677,8 +734,8 @@ everythingWithContextOnTypes s0 r0 (<+>) f = go' s0 where go' s t = let (s', r) = f s t in r <+> go s' t go s (TypeApp _ t1 t2) = go' s t1 <+> go' s t2 go s (KindApp _ t1 t2) = go' s t1 <+> go' s t2 - go s (ForAll _ _ (Just k) ty _) = go' s k <+> go' s ty - go s (ForAll _ _ _ ty _) = go' s ty + 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 @@ -697,7 +754,7 @@ annForType k (TypeConstructor a b) = (\z -> TypeConstructor z b) <$> k a annForType k (TypeOp a b) = (\z -> TypeOp z b) <$> k a annForType k (TypeApp a b c) = (\z -> TypeApp z b c) <$> k a annForType k (KindApp a b c) = (\z -> KindApp z b c) <$> k a -annForType k (ForAll a b c d e) = (\z -> ForAll z b c d e) <$> k a +annForType k (ForAll a b c d e f) = (\z -> ForAll z b c d e f) <$> k a annForType k (ConstrainedType a b c) = (\z -> ConstrainedType z b c) <$> k a annForType k (Skolem a b c d e) = (\z -> Skolem z b c d e) <$> k a annForType k (REmpty a) = REmpty <$> k a @@ -728,7 +785,7 @@ eqType (TypeConstructor _ a) (TypeConstructor _ a') = a == a' eqType (TypeOp _ a) (TypeOp _ a') = a == a' eqType (TypeApp _ a b) (TypeApp _ a' b') = eqType a a' && eqType b b' eqType (KindApp _ a b) (KindApp _ a' b') = eqType a a' && eqType b b' -eqType (ForAll _ a b c d) (ForAll _ a' b' c' d') = a == a' && eqMaybeType b b' && eqType c c' && d == d' +eqType (ForAll _ _ a b c d) (ForAll _ _ a' b' c' d') = a == a' && eqMaybeType b b' && eqType c c' && d == d' eqType (ConstrainedType _ a b) (ConstrainedType _ a' b') = eqConstraint a a' && eqType b b' eqType (Skolem _ a b c d) (Skolem _ a' b' c' d') = a == a' && eqMaybeType b b' && c == c' && d == d' eqType (REmpty _) (REmpty _) = True @@ -753,7 +810,7 @@ compareType (TypeConstructor _ a) (TypeConstructor _ a') = compare a a' compareType (TypeOp _ a) (TypeOp _ a') = compare a a' compareType (TypeApp _ a b) (TypeApp _ a' b') = compareType a a' <> compareType b b' compareType (KindApp _ a b) (KindApp _ a' b') = compareType a a' <> compareType b b' -compareType (ForAll _ a b c d) (ForAll _ a' b' c' d') = compare a a' <> compareMaybeType b b' <> compareType c c' <> compare d d' +compareType (ForAll _ _ a b c d) (ForAll _ _ a' b' c' d') = compare a a' <> compareMaybeType b b' <> compareType c c' <> compare d d' compareType (ConstrainedType _ a b) (ConstrainedType _ a' b') = compareConstraint a a' <> compareType b b' compareType (Skolem _ a b c d) (Skolem _ a' b' c' d') = compare a a' <> compareMaybeType b b' <> compare c c' <> compare d d' compareType (REmpty _) (REmpty _) = EQ diff --git a/tests/TestAst.hs b/tests/TestAst.hs index 88801e14f9..bb2e880443 100644 --- a/tests/TestAst.hs +++ b/tests/TestAst.hs @@ -12,7 +12,7 @@ import Test.QuickCheck (Arbitrary(..), Gen, Property, Testable, counterexample, import Language.PureScript.Label (Label(..)) import Language.PureScript.Names (pattern ByNullSourcePos, OpName(..), OpNameType(..), ProperName(..), ProperNameType(..), Qualified(..)) import Language.PureScript.PSString (PSString) -import Language.PureScript.Types (Constraint, ConstraintData, SkolemScope(..), Type(..), WildcardData, annForType, everythingOnTypes, everythingWithContextOnTypes, everywhereOnTypes, everywhereOnTypesM, everywhereOnTypesTopDownM, getAnnForType) +import Language.PureScript.Types (Constraint, ConstraintData, SkolemScope(..), Type(..), TypeVarVisibility(..), WildcardData, annForType, everythingOnTypes, everythingWithContextOnTypes, everywhereOnTypes, everywhereOnTypesM, everywhereOnTypesTopDownM, getAnnForType) spec :: Spec spec = do @@ -65,6 +65,7 @@ genTypeAnnotatedWith genTypeAnn genConstraintAnn = genType where :+ listOf' genType :+ maybeOf genType :+ genWildcardData + :+ genVisibility genConstraint :: Gen (Constraint a) genConstraint = genericArbitraryUG (genConstraintAnn :+ generatorEnvironment) @@ -92,3 +93,6 @@ genTypeAnnotatedWith genTypeAnn genConstraintAnn = genType where genPSString :: Gen PSString genPSString = pure "x" -- Ditto. + + genVisibility :: Gen TypeVarVisibility + genVisibility = pure TypeVarInvisible diff --git a/tests/TestDocs.hs b/tests/TestDocs.hs index cb9f67066a..d2b805ff0e 100644 --- a/tests/TestDocs.hs +++ b/tests/TestDocs.hs @@ -647,7 +647,7 @@ checkConstrained ty tyClass = P.ConstrainedType _ c ty' | matches tyClass c -> True | otherwise -> checkConstrained ty' tyClass - P.ForAll _ _ _ ty' _ -> + P.ForAll _ _ _ _ ty' _ -> checkConstrained ty' tyClass _ -> False diff --git a/tests/purs/failing/3329.out b/tests/purs/failing/3329.out index ce9bbe6c77..d176c58889 100644 --- a/tests/purs/failing/3329.out +++ b/tests/purs/failing/3329.out @@ -12,7 +12,7 @@ at tests/purs/failing/3329.purs:24:8 - 24:11 (line 24, column 8 - line 24, colum Main.injectLeft -while checking that type forall (f :: Type) (g :: Type). Inject f g => f -> g +while checking that type forall (@f :: Type) (@g :: Type). Inject f g => f -> g is at least as general as type g0 -> Either f1 g0 while checking that expression inj has type g0 -> Either f1 g0 diff --git a/tests/purs/failing/ConstraintFailure.out b/tests/purs/failing/ConstraintFailure.out index 17d2c94bad..f6207999b7 100644 --- a/tests/purs/failing/ConstraintFailure.out +++ b/tests/purs/failing/ConstraintFailure.out @@ -7,7 +7,7 @@ at tests/purs/failing/ConstraintFailure.purs:12:8 - 12:12 (line 12, column 8 - l  Data.Show.Show Foo   -while checking that type forall (a :: Type). Show a => a -> String +while checking that type forall (@a :: Type). Show a => a -> String is at least as general as type t0 t1 t2 while checking that expression show has type t0 t1 t2 diff --git a/tests/purs/failing/TypedHole.out b/tests/purs/failing/TypedHole.out index 9153ca38fc..8cc1bcb38b 100644 --- a/tests/purs/failing/TypedHole.out +++ b/tests/purs/failing/TypedHole.out @@ -8,7 +8,7 @@ at tests/purs/failing/TypedHole.purs:8:8 - 8:13 (line 8, column 8 - line 8, colu   You could substitute the hole with one of these values:   -  Data.Monoid.mempty :: forall m. Monoid m => m  +  Data.Monoid.mempty :: forall @m. Monoid m => m   Effect.Class.Console.clear :: forall m. MonadEffect m => m Unit  Effect.Console.clear :: Effect Unit   Main.main :: Effect Unit  diff --git a/tests/purs/failing/TypedHole3.out b/tests/purs/failing/TypedHole3.out index db08ba593b..02677b82b9 100644 --- a/tests/purs/failing/TypedHole3.out +++ b/tests/purs/failing/TypedHole3.out @@ -8,21 +8,21 @@ at tests/purs/failing/TypedHole3.purs:4:10 - 4:15 (line 4, column 10 - line 4, c   You could substitute the hole with one of these values:   -  Control.Alt.alt :: forall f a. Alt f => f a -> f a -> f a  +  Control.Alt.alt :: forall @f a. Alt f => f a -> f a -> f a   Control.Alternative.guard :: forall m. Alternative m => Boolean -> m Unit   Control.Applicative.liftA1 :: forall f a b. Applicative f => (a -> b) -> f a -> f b  -  Control.Applicative.pure :: forall f a. Applicative f => a -> f a  +  Control.Applicative.pure :: forall @f a. Applicative f => a -> f a   Control.Applicative.unless :: forall m. Applicative m => Boolean -> m Unit -> m Unit   Control.Applicative.when :: forall m. Applicative m => Boolean -> m Unit -> m Unit  -  Control.Apply.apply :: forall f a b. Apply f => f (a -> b) -> f a -> f b  +  Control.Apply.apply :: forall @f a b. Apply f => f (a -> b) -> f a -> f b   Control.Apply.applyFirst :: forall a b f. Apply f => f a -> f b -> f a   Control.Apply.applySecond :: forall a b f. Apply f => f a -> f b -> f b   Control.Apply.lift2 :: forall a b c f. Apply f => (a -> b -> c) -> f a -> ... -> ...   Control.Apply.lift3 :: forall a b c d f. Apply f => (a -> b -> ...) -> f a -> ... -> ...   Control.Apply.lift4 :: forall a b c d e f. Apply f => (a -> b -> ...) -> f a -> ... -> ...   Control.Apply.lift5 :: forall a b c d e f g. Apply f => (a -> b -> ...) -> f a -> ... -> ... -  Control.Biapplicative.bipure :: forall w a b. Biapplicative w => a -> b -> w a b  -  Control.Biapply.biapply :: forall w a b c d. Biapply w => w (a -> b) (c -> d) -> w a c -> w b d  +  Control.Biapplicative.bipure :: forall @w a b. Biapplicative w => a -> b -> w a b  +  Control.Biapply.biapply :: forall @w a b c d. Biapply w => w (a -> b) (c -> d) -> w a c -> w b d   in value declaration fn diff --git a/tests/purs/failing/VisibleTypeApplications1.out b/tests/purs/failing/VisibleTypeApplications1.out new file mode 100644 index 0000000000..db1974405c --- /dev/null +++ b/tests/purs/failing/VisibleTypeApplications1.out @@ -0,0 +1,20 @@ +Error found: +in module Main +at tests/purs/failing/VisibleTypeApplications1.purs:7:11 - 7:18 (line 7, column 11 - line 7, column 18) + + An expression of polymorphic type + with the invisible type variable a: +   +  forall a. a -> a +   + cannot be applied to: +   +  Int +   + +while inferring the type of id +in value declaration failOne + +See https://github.com/purescript/documentation/blob/master/errors/CannotApplyExpressionOfTypeOnType.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/VisibleTypeApplications1.purs b/tests/purs/failing/VisibleTypeApplications1.purs new file mode 100644 index 0000000000..463750fdf3 --- /dev/null +++ b/tests/purs/failing/VisibleTypeApplications1.purs @@ -0,0 +1,7 @@ +-- @shouldFailWith CannotApplyExpressionOfTypeOnType +module Main where + +id :: forall a. a -> a +id a = a + +failOne = id @Int diff --git a/tests/purs/failing/VisibleTypeApplications2.out b/tests/purs/failing/VisibleTypeApplications2.out new file mode 100644 index 0000000000..bb14c33dfd --- /dev/null +++ b/tests/purs/failing/VisibleTypeApplications2.out @@ -0,0 +1,19 @@ +Error found: +in module Main +at tests/purs/failing/VisibleTypeApplications2.purs:7:11 - 7:18 (line 7, column 11 - line 7, column 18) + + An expression of monomorphic type: +   +  Int -> Int +   + cannot be applied to: +   +  Int +   + +while inferring the type of id +in value declaration failTwo + +See https://github.com/purescript/documentation/blob/master/errors/CannotApplyExpressionOfTypeOnType.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/VisibleTypeApplications2.purs b/tests/purs/failing/VisibleTypeApplications2.purs new file mode 100644 index 0000000000..9cd202b221 --- /dev/null +++ b/tests/purs/failing/VisibleTypeApplications2.purs @@ -0,0 +1,7 @@ +-- @shouldFailWith CannotApplyExpressionOfTypeOnType +module Main where + +id :: Int -> Int +id a = a + +failTwo = id @Int diff --git a/tests/purs/passing/VisibleTypeApplications.purs b/tests/purs/passing/VisibleTypeApplications.purs new file mode 100644 index 0000000000..ea555a386e --- /dev/null +++ b/tests/purs/passing/VisibleTypeApplications.purs @@ -0,0 +1,40 @@ +module Main where + +import Prelude +import Effect.Console (log) + +foreign import data Id :: forall (a :: Type). a -> a + +identityCheck :: forall (@f :: forall (a :: Type). a -> a). Int +identityCheck = 0 + +identityPass :: Int +identityPass = identityCheck @Id + +foreign import data Const :: forall a b. a -> b -> a + +constCheck :: forall (a :: Type) (@f :: forall (b :: Type). b -> a). Int +constCheck = 0 + +constPass :: Int +constPass = constCheck @(Const Int) + +-- Type variables in class heads and data declarations are always visible. + +class ConstClass a where + constClass :: forall @b. a -> b -> a + +instance ConstClass a where + constClass a _ = a + +constClassInt = constClass @Int @Number + +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +treeInt :: Int -> Tree Int +treeInt = Leaf @Int + +treeInt' :: Tree Int -> Tree Int -> Tree Int +treeInt' = Branch @Int + +main = log "Done" diff --git a/tests/purs/warning/4376.out b/tests/purs/warning/4376.out index a7107df7e1..31006de8a6 100644 --- a/tests/purs/warning/4376.out +++ b/tests/purs/warning/4376.out @@ -5,9 +5,9 @@ at tests/purs/warning/4376.purs:6:1 - 6:16 (line 6, column 1 - line 6, column 16 No type declaration was provided for the top-level declaration of value. It is good practice to provide type declarations as a form of documentation. The inferred type of value was: -   -  forall a. Maybe a -   +   +  forall @a. Maybe a +   in value declaration value From 1e4e0f248cb0f16b15f72892d585974f662a7f4d Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Thu, 1 Jun 2023 20:58:59 +0800 Subject: [PATCH 34/68] Add CHANGELOG.d entry for visible type applications (#4476) --- .../feature_visible_type_applications.md | 113 ++++++++++++++++++ 1 file changed, 113 insertions(+) create mode 100644 CHANGELOG.d/feature_visible_type_applications.md diff --git a/CHANGELOG.d/feature_visible_type_applications.md b/CHANGELOG.d/feature_visible_type_applications.md new file mode 100644 index 0000000000..5013b4fea1 --- /dev/null +++ b/CHANGELOG.d/feature_visible_type_applications.md @@ -0,0 +1,113 @@ +* Implement visible type applications + + The compiler now supports visible type applications, allowing the user to instantiate one or more "visible" type variables to a specific type. + + A "visible" type variable is a type variable in a `forall` binder that appears prefixed with an `@`, like the following example: + + ```purescript + id :: forall @a. a -> a -- or with kinds: `forall (@a :: Type). a -> a` + id a = a + ``` + + We can then use type application syntax to instantiate this binding to a specific type: + + ```purescript + idInt :: Int -> Int + idInt = id @Int + + example :: Int + example = id @Int 0 + ``` + + Type variables appearing in `class` or `data` are automatically visible, meaning that they do not require annotations: + + ```purescript + data Maybe a = Just a | Nothing + + nothingInt :: Maybe Int + nothingInt = Nothing @Int + + class Identity a where + identity :: a -> a + + instance Identity Int where + identity a = a + + identityInt = identity @Int + + -- This throws a `NoInstanceFound` error. + identityNumber = identity @Number + ``` + + Lastly, visible type variables can also be skipped with a wildcard (i.e. `_`) + + ```purescript + data Either a b = Left a | Right b + + example = Left @_ @Number 0 + ``` + + Note that performing a type application with a type that has no visible type variables throws an error: + + ```purescript + module Main where + + id :: forall a. a -> a + id a = a + + idInt = id @Int + + {- + Error found: + in module Main + at Main.purs:6:9 - 6:16 (line 6, column 9 - line 6, column 16) + + An expression of polymorphic type + with the invisible type variable a: + + forall a. a -> a + + cannot be applied to: + + Int + + + while inferring the type of id + in value declaration idInt + + See https://github.com/purescript/documentation/blob/master/errors/CannotApplyExpressionOfTypeOnType.md for more information, + or to contribute content related to this error. + -} + ``` + + Similarly, monomorphic types also cannot be used for type applications: + + ```purescript + module Main where + + idInt :: Int -> Int + idInt a = a + + example = idInt @Int + + {- + Error found: + in module Main + at Main.purs:6:11 - 6:21 (line 6, column 11 - line 6, column 21) + + An expression of monomorphic type: + + Int -> Int + + cannot be applied to: + + Int + + + while inferring the type of idInt + in value declaration example + + See https://github.com/purescript/documentation/blob/master/errors/CannotApplyExpressionOfTypeOnType.md for more information, + or to contribute content related to this error. + -} + ``` From a6f6dcc05bd535937f680d48950220acbb10b5ff Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Mon, 3 Jul 2023 12:43:32 +0200 Subject: [PATCH 35/68] Add option to exclude globs from given input (#4480) --- ...eature_exclude_files_from_compile_input.md | 45 +++++++++++++++++++ app/Command/Compile.hs | 14 +++++- 2 files changed, 57 insertions(+), 2 deletions(-) create mode 100644 CHANGELOG.d/feature_exclude_files_from_compile_input.md diff --git a/CHANGELOG.d/feature_exclude_files_from_compile_input.md b/CHANGELOG.d/feature_exclude_files_from_compile_input.md new file mode 100644 index 0000000000..357596f96f --- /dev/null +++ b/CHANGELOG.d/feature_exclude_files_from_compile_input.md @@ -0,0 +1,45 @@ +* Exclude files from compiler input + + The compiler now supports excluding files from the globs given to it as input. + This means there's now a new option for `purs compile`, namely + `--exclude-files` (or the short version `-x`): + +```sh +> purs compile --help +Usage: purs compile [FILE] [-x|--exclude-files ARG] [-o|--output ARG] ... + + Compile PureScript source files + +Available options: + -h,--help Show this help text + FILE The input .purs file(s). + -x,--exclude-files ARG Glob of .purs files to exclude from the supplied + files. + ... +``` + +This allows you to keep related files closer together (that is, [colocate](https://kentcdodds.com/blog/colocation) them). + +Consider a setup like the following: + +```sh +src/ + Main.purs + View/ + LoginPage.purs + LoginPageTest.purs + LoginPageStories.purs +``` + +In order to exclude the files in the example above you can now invoke `purs` +like this and it will only compile `LoginPage.purs`: + +```sh +purs compile "src/**/*.purs" --exclude-files "src/**/*Stories.purs" -x "src/**/*Test.purs" +``` + +With `spago`, the equivalent command is: + +```sh +spago build --purs-args '-x "src/**/*Test.purs" -x "src/**/*Stories.purs"' +``` diff --git a/app/Command/Compile.hs b/app/Command/Compile.hs index 27fbb39d01..8f348da9dd 100644 --- a/app/Command/Compile.hs +++ b/app/Command/Compile.hs @@ -7,7 +7,7 @@ import Control.Monad (when) import Data.Aeson qualified as A import Data.Bool (bool) import Data.ByteString.Lazy.UTF8 qualified as LBU8 -import Data.List (intercalate) +import Data.List (intercalate, (\\)) import Data.Map qualified as M import Data.Set qualified as S import Data.Text qualified as T @@ -26,6 +26,7 @@ import System.IO.UTF8 (readUTF8FilesT) data PSCMakeOptions = PSCMakeOptions { pscmInput :: [FilePath] + , pscmExclude :: [FilePath] , pscmOutputDir :: FilePath , pscmOpts :: P.Options , pscmUsePrefix :: Bool @@ -53,7 +54,9 @@ printWarningsAndErrors verbose True files warnings errors = do compile :: PSCMakeOptions -> IO () compile PSCMakeOptions{..} = do - input <- globWarningOnMisses warnFileTypeNotFound pscmInput + included <- globWarningOnMisses warnFileTypeNotFound pscmInput + excluded <- globWarningOnMisses warnFileTypeNotFound pscmExclude + let input = included \\ excluded when (null input) $ do hPutStr stderr $ unlines [ "purs compile: No input files." , "Usage: For basic information, try the `--help' option." @@ -86,6 +89,12 @@ inputFile = Opts.strArgument $ Opts.metavar "FILE" <> Opts.help "The input .purs file(s)." +excludedFiles :: Opts.Parser FilePath +excludedFiles = Opts.strOption $ + Opts.short 'x' + <> Opts.long "exclude-files" + <> Opts.help "Glob of .purs files to exclude from the supplied files." + outputDirectory :: Opts.Parser FilePath outputDirectory = Opts.strOption $ Opts.short 'o' @@ -153,6 +162,7 @@ options = pscMakeOptions :: Opts.Parser PSCMakeOptions pscMakeOptions = PSCMakeOptions <$> many inputFile + <*> many excludedFiles <*> outputDirectory <*> options <*> (not <$> noPrefix) From 193977ed819f6cc957a4c253e8a89e3784da0c5b Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Tue, 18 Jul 2023 16:11:16 -0500 Subject: [PATCH 36/68] Prep v0.15.10 release (#4484) * Update version to 0.15.10 * Update changelog --- ...eature_exclude_files_from_compile_input.md | 45 ----- .../feature_visible_type_applications.md | 113 ------------ CHANGELOG.md | 164 ++++++++++++++++++ npm-package/package.json | 4 +- purescript.cabal | 2 +- 5 files changed, 167 insertions(+), 161 deletions(-) delete mode 100644 CHANGELOG.d/feature_exclude_files_from_compile_input.md delete mode 100644 CHANGELOG.d/feature_visible_type_applications.md diff --git a/CHANGELOG.d/feature_exclude_files_from_compile_input.md b/CHANGELOG.d/feature_exclude_files_from_compile_input.md deleted file mode 100644 index 357596f96f..0000000000 --- a/CHANGELOG.d/feature_exclude_files_from_compile_input.md +++ /dev/null @@ -1,45 +0,0 @@ -* Exclude files from compiler input - - The compiler now supports excluding files from the globs given to it as input. - This means there's now a new option for `purs compile`, namely - `--exclude-files` (or the short version `-x`): - -```sh -> purs compile --help -Usage: purs compile [FILE] [-x|--exclude-files ARG] [-o|--output ARG] ... - - Compile PureScript source files - -Available options: - -h,--help Show this help text - FILE The input .purs file(s). - -x,--exclude-files ARG Glob of .purs files to exclude from the supplied - files. - ... -``` - -This allows you to keep related files closer together (that is, [colocate](https://kentcdodds.com/blog/colocation) them). - -Consider a setup like the following: - -```sh -src/ - Main.purs - View/ - LoginPage.purs - LoginPageTest.purs - LoginPageStories.purs -``` - -In order to exclude the files in the example above you can now invoke `purs` -like this and it will only compile `LoginPage.purs`: - -```sh -purs compile "src/**/*.purs" --exclude-files "src/**/*Stories.purs" -x "src/**/*Test.purs" -``` - -With `spago`, the equivalent command is: - -```sh -spago build --purs-args '-x "src/**/*Test.purs" -x "src/**/*Stories.purs"' -``` diff --git a/CHANGELOG.d/feature_visible_type_applications.md b/CHANGELOG.d/feature_visible_type_applications.md deleted file mode 100644 index 5013b4fea1..0000000000 --- a/CHANGELOG.d/feature_visible_type_applications.md +++ /dev/null @@ -1,113 +0,0 @@ -* Implement visible type applications - - The compiler now supports visible type applications, allowing the user to instantiate one or more "visible" type variables to a specific type. - - A "visible" type variable is a type variable in a `forall` binder that appears prefixed with an `@`, like the following example: - - ```purescript - id :: forall @a. a -> a -- or with kinds: `forall (@a :: Type). a -> a` - id a = a - ``` - - We can then use type application syntax to instantiate this binding to a specific type: - - ```purescript - idInt :: Int -> Int - idInt = id @Int - - example :: Int - example = id @Int 0 - ``` - - Type variables appearing in `class` or `data` are automatically visible, meaning that they do not require annotations: - - ```purescript - data Maybe a = Just a | Nothing - - nothingInt :: Maybe Int - nothingInt = Nothing @Int - - class Identity a where - identity :: a -> a - - instance Identity Int where - identity a = a - - identityInt = identity @Int - - -- This throws a `NoInstanceFound` error. - identityNumber = identity @Number - ``` - - Lastly, visible type variables can also be skipped with a wildcard (i.e. `_`) - - ```purescript - data Either a b = Left a | Right b - - example = Left @_ @Number 0 - ``` - - Note that performing a type application with a type that has no visible type variables throws an error: - - ```purescript - module Main where - - id :: forall a. a -> a - id a = a - - idInt = id @Int - - {- - Error found: - in module Main - at Main.purs:6:9 - 6:16 (line 6, column 9 - line 6, column 16) - - An expression of polymorphic type - with the invisible type variable a: - - forall a. a -> a - - cannot be applied to: - - Int - - - while inferring the type of id - in value declaration idInt - - See https://github.com/purescript/documentation/blob/master/errors/CannotApplyExpressionOfTypeOnType.md for more information, - or to contribute content related to this error. - -} - ``` - - Similarly, monomorphic types also cannot be used for type applications: - - ```purescript - module Main where - - idInt :: Int -> Int - idInt a = a - - example = idInt @Int - - {- - Error found: - in module Main - at Main.purs:6:11 - 6:21 (line 6, column 11 - line 6, column 21) - - An expression of monomorphic type: - - Int -> Int - - cannot be applied to: - - Int - - - while inferring the type of idInt - in value declaration example - - See https://github.com/purescript/documentation/blob/master/errors/CannotApplyExpressionOfTypeOnType.md for more information, - or to contribute content related to this error. - -} - ``` diff --git a/CHANGELOG.md b/CHANGELOG.md index 00ad84751d..94592161bd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,170 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.10 + +New features: + +* Implement visible type applications + + The compiler now supports visible type applications, allowing the user to instantiate one or more "visible" type variables to a specific type. + + A "visible" type variable is a type variable in a `forall` binder that appears prefixed with an `@`, like the following example: + + ```purescript + id :: forall @a. a -> a -- or with kinds: `forall (@a :: Type). a -> a` + id a = a + ``` + + We can then use type application syntax to instantiate this binding to a specific type: + + ```purescript + idInt :: Int -> Int + idInt = id @Int + + example :: Int + example = id @Int 0 + ``` + + Type variables appearing in `class` or `data` are automatically visible, meaning that they do not require annotations: + + ```purescript + data Maybe a = Just a | Nothing + + nothingInt :: Maybe Int + nothingInt = Nothing @Int + + class Identity a where + identity :: a -> a + + instance Identity Int where + identity a = a + + identityInt = identity @Int + + -- This throws a `NoInstanceFound` error. + identityNumber = identity @Number + ``` + + Lastly, visible type variables can also be skipped with a wildcard (i.e. `_`) + + ```purescript + data Either a b = Left a | Right b + + example = Left @_ @Number 0 + ``` + + Note that performing a type application with a type that has no visible type variables throws an error: + + ```purescript + module Main where + + id :: forall a. a -> a + id a = a + + idInt = id @Int + + {- + Error found: + in module Main + at Main.purs:6:9 - 6:16 (line 6, column 9 - line 6, column 16) + + An expression of polymorphic type + with the invisible type variable a: + + forall a. a -> a + + cannot be applied to: + + Int + + + while inferring the type of id + in value declaration idInt + + See https://github.com/purescript/documentation/blob/master/errors/CannotApplyExpressionOfTypeOnType.md for more information, + or to contribute content related to this error. + -} + ``` + + Similarly, monomorphic types also cannot be used for type applications: + + ```purescript + module Main where + + idInt :: Int -> Int + idInt a = a + + example = idInt @Int + + {- + Error found: + in module Main + at Main.purs:6:11 - 6:21 (line 6, column 11 - line 6, column 21) + + An expression of monomorphic type: + + Int -> Int + + cannot be applied to: + + Int + + + while inferring the type of idInt + in value declaration example + + See https://github.com/purescript/documentation/blob/master/errors/CannotApplyExpressionOfTypeOnType.md for more information, + or to contribute content related to this error. + -} + ``` + +* Exclude files from compiler input (#4480 by @i-am-the-slime) + + The compiler now supports excluding files from the globs given to it as input. + This means there's now a new option for `purs compile`, namely + `--exclude-files` (or the short version `-x`): + + ```sh + > purs compile --help + Usage: purs compile [FILE] [-x|--exclude-files ARG] [-o|--output ARG] ... + + Compile PureScript source files + + Available options: + -h,--help Show this help text + FILE The input .purs file(s). + -x,--exclude-files ARG Glob of .purs files to exclude from the supplied + files. + ... + ``` + + This allows you to keep related files closer together (that is, [colocate](https://kentcdodds.com/blog/colocation) them). + + Consider a setup like the following: + + ```sh + src/ + Main.purs + View/ + LoginPage.purs + LoginPageTest.purs + LoginPageStories.purs + ``` + + In order to exclude the files in the example above you can now invoke `purs` + like this and it will only compile `LoginPage.purs`: + + ```sh + purs compile "src/**/*.purs" --exclude-files "src/**/*Stories.purs" -x "src/**/*Test.purs" + ``` + + With `spago`, the equivalent command is: + + ```sh + spago build --purs-args '-x "src/**/*Test.purs" -x "src/**/*Stories.purs"' + ``` + ## 0.15.9 New features: diff --git a/npm-package/package.json b/npm-package/package.json index 3f391d5f43..8159571081 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.9", + "version": "0.15.10", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.9", + "postinstall": "install-purescript --purs-ver=0.15.10", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index 383264482d..ec35ef3938 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.9 +version: 0.15.10 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From cf530188d726976f75885e57a9c9b78b008080ec Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Sat, 22 Jul 2023 10:27:34 -0400 Subject: [PATCH 37/68] Move the closed record update optimization (#4489) For consumers of CoreFn like alternate backends, the optimization of replacing a closed record update with an object literal has now been moved to the point of desugaring CoreFn into JS. The `ObjectUpdate` expression constructor now contains a `Maybe` field holding a list of record labels to be copied as-is, for backends that want to perform this optimization also. This optimization was the last use of the `Maybe SourceType` member of the `Ann` tuple, so it has been removed. CoreFn is now fully untyped in both its serialized and in-memory forms (previously it was partially typed in memory). --- CHANGELOG.d/feature_closed-record-update.md | 7 ++ src/Language/PureScript/CodeGen/JS.hs | 45 ++++++------ src/Language/PureScript/CoreFn/Ann.hs | 7 +- src/Language/PureScript/CoreFn/CSE.hs | 6 +- src/Language/PureScript/CoreFn/Desugar.hs | 77 ++++++++++++-------- src/Language/PureScript/CoreFn/Expr.hs | 24 +++--- src/Language/PureScript/CoreFn/FromJSON.hs | 5 +- src/Language/PureScript/CoreFn/Laziness.hs | 4 +- src/Language/PureScript/CoreFn/Optimizer.hs | 30 +------- src/Language/PureScript/CoreFn/ToJSON.hs | 10 ++- src/Language/PureScript/CoreFn/Traversals.hs | 4 +- src/Language/PureScript/Renamer.hs | 4 +- tests/TestCoreFn.hs | 11 +-- tests/purs/optimize/ObjectUpdate.out.js | 27 +++++++ tests/purs/optimize/ObjectUpdate.purs | 10 +++ 15 files changed, 153 insertions(+), 118 deletions(-) create mode 100644 CHANGELOG.d/feature_closed-record-update.md create mode 100644 tests/purs/optimize/ObjectUpdate.out.js create mode 100644 tests/purs/optimize/ObjectUpdate.purs diff --git a/CHANGELOG.d/feature_closed-record-update.md b/CHANGELOG.d/feature_closed-record-update.md new file mode 100644 index 0000000000..c3534373c6 --- /dev/null +++ b/CHANGELOG.d/feature_closed-record-update.md @@ -0,0 +1,7 @@ +* Move the closed record update optimization + + For consumers of CoreFn like alternate backends, the optimization of + replacing a closed record update with an object literal has now been moved to + the point of desugaring CoreFn into JS. The `ObjectUpdate` expression + constructor now contains a `Maybe` field holding a list of record labels to + be copied as-is, for backends that want to perform this optimization also. diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 14d3e66610..14d122a37d 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -240,7 +240,7 @@ moduleBindToJs mn = bindToJs where -- Generate code in the simplified JavaScript intermediate representation for a declaration bindToJs :: Bind Ann -> m [AST] - bindToJs (NonRec (_, _, _, Just IsTypeClassConstructor) _ _) = pure [] + bindToJs (NonRec (_, _, Just IsTypeClassConstructor) _ _) = pure [] -- Unlike other newtype constructors, type class constructors are only -- ever applied; it's not possible to use them as values. So it's safe to -- erase them. @@ -252,20 +252,20 @@ moduleBindToJs mn = bindToJs -- -- The main purpose of this function is to handle code generation for comments. nonRecToJS :: Ann -> Ident -> Expr Ann -> m AST - nonRecToJS a i e@(extractAnn -> (_, com, _, _)) | not (null com) = do + nonRecToJS a i e@(extractAnn -> (_, com, _)) | not (null com) = do withoutComment <- asks optionsNoComments if withoutComment then nonRecToJS a i (modifyAnn removeComments e) else AST.Comment (AST.SourceComments com) <$> nonRecToJS a i (modifyAnn removeComments e) - nonRecToJS (ss, _, _, _) ident val = do + nonRecToJS (ss, _, _) ident val = do js <- valueToJs val withPos ss $ AST.VariableIntroduction Nothing (identToJs ident) (Just (guessEffects val, js)) guessEffects :: Expr Ann -> AST.InitializerEffects guessEffects = \case - Var _ (Qualified (BySourcePos _) _) -> NoEffects - App (_, _, _, Just IsSyntheticApp) _ _ -> NoEffects - _ -> UnknownEffects + Var _ (Qualified (BySourcePos _) _) -> NoEffects + App (_, _, Just IsSyntheticApp) _ _ -> NoEffects + _ -> UnknownEffects withPos :: SourceSpan -> AST -> m AST withPos ss js = do @@ -282,22 +282,25 @@ moduleBindToJs mn = bindToJs -- Generate code in the simplified JavaScript intermediate representation for a value or expression. valueToJs :: Expr Ann -> m AST valueToJs e = - let (ss, _, _, _) = extractAnn e in + let (ss, _, _) = extractAnn e in withPos ss =<< valueToJs' e valueToJs' :: Expr Ann -> m AST - valueToJs' (Literal (pos, _, _, _) l) = + valueToJs' (Literal (pos, _, _) l) = rethrowWithPosition pos $ literalToValueJS pos l - valueToJs' (Var (_, _, _, Just (IsConstructor _ [])) name) = + valueToJs' (Var (_, _, Just (IsConstructor _ [])) name) = return $ accessorString "value" $ qualifiedToJS id name - valueToJs' (Var (_, _, _, Just (IsConstructor _ _)) name) = + valueToJs' (Var (_, _, Just (IsConstructor _ _)) name) = return $ accessorString "create" $ qualifiedToJS id name valueToJs' (Accessor _ prop val) = accessorString prop <$> valueToJs val - valueToJs' (ObjectUpdate _ o ps) = do + valueToJs' (ObjectUpdate (pos, _, _) o copy ps) = do obj <- valueToJs o sts <- mapM (sndM valueToJs) ps - extendObj obj sts + case copy of + Nothing -> extendObj obj sts + Just names -> pure $ AST.ObjectLiteral (Just pos) (map f names ++ sts) + where f name = (name, accessorString name obj) valueToJs' (Abs _ arg val) = do ret <- valueToJs val let jsArg = case arg of @@ -308,29 +311,29 @@ moduleBindToJs mn = bindToJs let (f, args) = unApp e [] args' <- mapM valueToJs args case f of - Var (_, _, _, Just IsNewtype) _ -> return (head args') - Var (_, _, _, Just (IsConstructor _ fields)) name | length args == length fields -> + Var (_, _, Just IsNewtype) _ -> return (head args') + Var (_, _, Just (IsConstructor _ fields)) name | length args == length fields -> return $ AST.Unary Nothing AST.New $ AST.App Nothing (qualifiedToJS id name) args' _ -> flip (foldl (\fn a -> AST.App Nothing fn [a])) args' <$> valueToJs f where unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann]) unApp (App _ val arg) args = unApp val (arg : args) unApp other args = (other, args) - valueToJs' (Var (_, _, _, Just IsForeign) qi@(Qualified (ByModuleName mn') ident)) = + valueToJs' (Var (_, _, Just IsForeign) qi@(Qualified (ByModuleName mn') ident)) = return $ if mn' == mn then foreignIdent ident else varToJs qi - valueToJs' (Var (_, _, _, Just IsForeign) ident) = + valueToJs' (Var (_, _, Just IsForeign) ident) = internalError $ "Encountered an unqualified reference to a foreign ident " ++ T.unpack (showQualified showIdent ident) valueToJs' (Var _ ident) = return $ varToJs ident - valueToJs' (Case (ss, _, _, _) values binders) = do + valueToJs' (Case (ss, _, _) values binders) = do vals <- mapM valueToJs values bindersToJs ss binders vals valueToJs' (Let _ ds val) = do ds' <- concat <$> mapM bindToJs ds ret <- valueToJs val return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (ds' ++ [AST.Return Nothing ret]))) [] - valueToJs' (Constructor (_, _, _, Just IsNewtype) _ ctor _) = + valueToJs' (Constructor (_, _, Just IsNewtype) _ ctor _) = return $ AST.VariableIntroduction Nothing (properToJs ctor) (Just . (UnknownEffects, ) $ AST.ObjectLiteral Nothing [("create", AST.Function Nothing Nothing ["value"] @@ -442,7 +445,7 @@ moduleBindToJs mn = bindToJs binderToJs :: Text -> [AST] -> Binder Ann -> m [AST] binderToJs s done binder = - let (ss, _, _, _) = extractBinderAnn binder in + let (ss, _, _) = extractBinderAnn binder in traverse (withPos ss) =<< binderToJs' s done binder -- Generate code in the simplified JavaScript intermediate representation for a pattern match @@ -453,9 +456,9 @@ moduleBindToJs mn = bindToJs literalToBinderJS varName done l binderToJs' varName done (VarBinder _ ident) = return (AST.VariableIntroduction Nothing (identToJs ident) (Just (NoEffects, AST.Var Nothing varName)) : done) - binderToJs' varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) = + binderToJs' varName done (ConstructorBinder (_, _, Just IsNewtype) _ _ [b]) = binderToJs varName done b - binderToJs' varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do + binderToJs' varName done (ConstructorBinder (_, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do js <- go (zip fields bs) done return $ case ctorType of ProductType -> js diff --git a/src/Language/PureScript/CoreFn/Ann.hs b/src/Language/PureScript/CoreFn/Ann.hs index 851f0da376..185f8beb5b 100644 --- a/src/Language/PureScript/CoreFn/Ann.hs +++ b/src/Language/PureScript/CoreFn/Ann.hs @@ -5,21 +5,20 @@ import Prelude import Language.PureScript.AST.SourcePos (SourceSpan) import Language.PureScript.Comments (Comment) import Language.PureScript.CoreFn.Meta (Meta) -import Language.PureScript.Types (SourceType) -- | -- Type alias for basic annotations -- -type Ann = (SourceSpan, [Comment], Maybe SourceType, Maybe Meta) +type Ann = (SourceSpan, [Comment], Maybe Meta) -- | -- An annotation empty of metadata aside from a source span. -- ssAnn :: SourceSpan -> Ann -ssAnn ss = (ss, [], Nothing, Nothing) +ssAnn ss = (ss, [], Nothing) -- | -- Remove the comments from an annotation -- removeComments :: Ann -> Ann -removeComments (ss, _, ty, meta) = (ss, [], ty, meta) +removeComments (ss, _, meta) = (ss, [], meta) diff --git a/src/Language/PureScript/CoreFn/CSE.hs b/src/Language/PureScript/CoreFn/CSE.hs index 6b339f7911..576243c252 100644 --- a/src/Language/PureScript/CoreFn/CSE.hs +++ b/src/Language/PureScript/CoreFn/CSE.hs @@ -262,7 +262,7 @@ generateIdentFor d e = at d . non mempty . at e %%<~ \case _ -> "ref" nullAnn :: Ann -nullAnn = (nullSourceSpan, [], Nothing, Nothing) +nullAnn = (nullSourceSpan, [], Nothing) -- | -- Use a map to substitute local Vars in a list of Binds. @@ -386,8 +386,8 @@ optimizeCommonSubexpressions mn -- common subexpression elimination pass. shouldFloatExpr :: Expr Ann -> Bool shouldFloatExpr = \case - App (_, _, _, Just IsSyntheticApp) e _ -> isSimple e - _ -> False + App (_, _, Just IsSyntheticApp) e _ -> isSimple e + _ -> False isSimple :: Expr Ann -> Bool isSimple = \case diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs index 5b0f821be4..34bf08f1f3 100644 --- a/src/Language/PureScript/CoreFn/Desugar.hs +++ b/src/Language/PureScript/CoreFn/Desugar.hs @@ -22,8 +22,10 @@ import Language.PureScript.CoreFn.Meta (ConstructorType(..), Meta(..)) import Language.PureScript.CoreFn.Module (Module(..)) import Language.PureScript.Crash (internalError) import Language.PureScript.Environment (DataDeclType(..), Environment(..), NameKind(..), isDictTypeName, lookupConstructor, lookupValue) +import Language.PureScript.Label (Label(..)) import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), getQual) -import Language.PureScript.Types (SourceType) +import Language.PureScript.PSString (PSString) +import Language.PureScript.Types (pattern REmptyKinded, SourceType, Type(..)) import Language.PureScript.AST qualified as A import Language.PureScript.Constants.Prim qualified as C @@ -57,13 +59,13 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = dedupeImports = fmap swap . M.toList . M.fromListWith const . fmap swap ssA :: SourceSpan -> Ann - ssA ss = (ss, [], Nothing, Nothing) + ssA ss = (ss, [], Nothing) -- Desugars member declarations from AST to CoreFn representation. declToCoreFn :: A.Declaration -> [Bind Ann] declToCoreFn (A.DataDeclaration (ss, com) Newtype _ _ [ctor]) = - [NonRec (ss, [], Nothing, declMeta) (properToIdent $ A.dataCtorName ctor) $ - Abs (ss, com, Nothing, Just IsNewtype) (Ident "x") (Var (ssAnn ss) $ Qualified ByNullSourcePos (Ident "x"))] + [NonRec (ss, [], declMeta) (properToIdent $ A.dataCtorName ctor) $ + Abs (ss, com, Just IsNewtype) (Ident "x") (Var (ssAnn ss) $ Qualified ByNullSourcePos (Ident "x"))] where declMeta = isDictTypeName (A.dataCtorName ctor) `orEmpty` IsTypeClassConstructor declToCoreFn d@(A.DataDeclaration _ Newtype _ _ _) = @@ -73,7 +75,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = let ctor = A.dataCtorName ctorDecl (_, _, _, fields) = lookupConstructor env (Qualified (ByModuleName mn) ctor) - in NonRec (ssA ss) (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields + in NonRec (ssA ss) (properToIdent ctor) $ Constructor (ss, com, Nothing) tyName ctor fields declToCoreFn (A.DataBindingGroupDeclaration ds) = concatMap declToCoreFn ds declToCoreFn (A.ValueDecl (ss, com) name _ _ [A.MkUnguarded e]) = @@ -84,18 +86,29 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = -- Desugars expressions from AST to CoreFn representation. exprToCoreFn :: SourceSpan -> [Comment] -> Maybe SourceType -> A.Expr -> Expr Ann - exprToCoreFn _ com ty (A.Literal ss lit) = - Literal (ss, com, ty, Nothing) (fmap (exprToCoreFn ss com Nothing) lit) - exprToCoreFn ss com ty (A.Accessor name v) = - Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v) + exprToCoreFn _ com _ (A.Literal ss lit) = + Literal (ss, com, Nothing) (fmap (exprToCoreFn ss com Nothing) lit) + exprToCoreFn ss com _ (A.Accessor name v) = + Accessor (ss, com, Nothing) name (exprToCoreFn ss [] Nothing v) exprToCoreFn ss com ty (A.ObjectUpdate obj vs) = - ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ fmap (second (exprToCoreFn ss [] Nothing)) vs - exprToCoreFn ss com ty (A.Abs (A.VarBinder _ name) v) = - Abs (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v) + ObjectUpdate (ss, com, Nothing) (exprToCoreFn ss [] Nothing obj) (ty >>= unchangedRecordFields (fmap fst vs)) $ fmap (second (exprToCoreFn ss [] Nothing)) vs + where + -- Return the unchanged labels of a closed record, or Nothing for other types or open records. + unchangedRecordFields :: [PSString] -> Type a -> Maybe [PSString] + unchangedRecordFields updated (TypeApp _ (TypeConstructor _ C.Record) row) = + collect row + where + collect :: Type a -> Maybe [PSString] + collect (REmptyKinded _ _) = Just [] + collect (RCons _ (Label l) _ r) = (if l `elem` updated then id else (l :)) <$> collect r + collect _ = Nothing + unchangedRecordFields _ _ = Nothing + exprToCoreFn ss com _ (A.Abs (A.VarBinder _ name) v) = + Abs (ss, com, Nothing) name (exprToCoreFn ss [] Nothing v) exprToCoreFn _ _ _ (A.Abs _ _) = internalError "Abs with Binder argument was not desugared before exprToCoreFn mn" - exprToCoreFn ss com ty (A.App v1 v2) = - App (ss, com, ty, (isDictCtor v1 || isSynthetic v2) `orEmpty` IsSyntheticApp) v1' v2' + exprToCoreFn ss com _ (A.App v1 v2) = + App (ss, com, (isDictCtor v1 || isSynthetic v2) `orEmpty` IsSyntheticApp) v1' v2' where v1' = exprToCoreFn ss [] Nothing v1 v2' = exprToCoreFn ss [] Nothing v2 @@ -108,24 +121,24 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = A.Var NullSourceSpan _ -> True A.Unused{} -> True _ -> False - exprToCoreFn ss com ty (A.Unused _) = - Var (ss, com, ty, Nothing) C.I_undefined - exprToCoreFn _ com ty (A.Var ss ident) = - Var (ss, com, ty, getValueMeta ident) ident - exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) = - Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1] + exprToCoreFn ss com _ (A.Unused _) = + Var (ss, com, Nothing) C.I_undefined + exprToCoreFn _ com _ (A.Var ss ident) = + Var (ss, com, getValueMeta ident) ident + exprToCoreFn ss com _ (A.IfThenElse v1 v2 v3) = + Case (ss, com, Nothing) [exprToCoreFn ss [] Nothing v1] [ CaseAlternative [LiteralBinder (ssAnn ss) $ BooleanLiteral True] (Right $ exprToCoreFn ss [] Nothing v2) , CaseAlternative [NullBinder (ssAnn ss)] (Right $ exprToCoreFn ss [] Nothing v3) ] - exprToCoreFn _ com ty (A.Constructor ss name) = - Var (ss, com, ty, Just $ getConstructorMeta name) $ fmap properToIdent name - exprToCoreFn ss com ty (A.Case vs alts) = - Case (ss, com, ty, Nothing) (fmap (exprToCoreFn ss [] Nothing) vs) (fmap (altToCoreFn ss) alts) + exprToCoreFn _ com _ (A.Constructor ss name) = + Var (ss, com, Just $ getConstructorMeta name) $ fmap properToIdent name + exprToCoreFn ss com _ (A.Case vs alts) = + Case (ss, com, Nothing) (fmap (exprToCoreFn ss [] Nothing) vs) (fmap (altToCoreFn ss) alts) exprToCoreFn ss com _ (A.TypedValue _ v ty) = exprToCoreFn ss com (Just ty) v - exprToCoreFn ss com ty (A.Let w ds v) = - Let (ss, com, ty, getLetMeta w) (concatMap declToCoreFn ds) (exprToCoreFn ss [] Nothing v) + exprToCoreFn ss com _ (A.Let w ds v) = + Let (ss, com, getLetMeta w) (concatMap declToCoreFn ds) (exprToCoreFn ss [] Nothing v) exprToCoreFn _ com ty (A.PositionedValue ss com1 v) = exprToCoreFn ss (com ++ com1) ty v exprToCoreFn _ _ _ e = @@ -150,16 +163,16 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) = -- Desugars case binders from AST to CoreFn representation. binderToCoreFn :: SourceSpan -> [Comment] -> A.Binder -> Binder Ann binderToCoreFn _ com (A.LiteralBinder ss lit) = - LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit) + LiteralBinder (ss, com, Nothing) (fmap (binderToCoreFn ss com) lit) binderToCoreFn ss com A.NullBinder = - NullBinder (ss, com, Nothing, Nothing) + NullBinder (ss, com, Nothing) binderToCoreFn _ com (A.VarBinder ss name) = - VarBinder (ss, com, Nothing, Nothing) name + VarBinder (ss, com, Nothing) name binderToCoreFn _ com (A.ConstructorBinder ss dctor@(Qualified mn' _) bs) = let (_, tctor, _, _) = lookupConstructor env dctor - in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (fmap (binderToCoreFn ss []) bs) + in ConstructorBinder (ss, com, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (fmap (binderToCoreFn ss []) bs) binderToCoreFn _ com (A.NamedBinder ss name b) = - NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b) + NamedBinder (ss, com, Nothing) name (binderToCoreFn ss [] b) binderToCoreFn _ com (A.PositionedBinder ss com1 b) = binderToCoreFn ss (com ++ com1) b binderToCoreFn ss com (A.TypedBinder _ b) = @@ -232,7 +245,7 @@ findQualModules decls = -- | Desugars import declarations from AST to CoreFn representation. importToCoreFn :: A.Declaration -> Maybe (Ann, ModuleName) -importToCoreFn (A.ImportDeclaration (ss, com) name _ _) = Just ((ss, com, Nothing, Nothing), name) +importToCoreFn (A.ImportDeclaration (ss, com) name _ _) = Just ((ss, com, Nothing), name) importToCoreFn _ = Nothing -- | Desugars foreign declarations from AST to CoreFn representation. diff --git a/src/Language/PureScript/CoreFn/Expr.hs b/src/Language/PureScript/CoreFn/Expr.hs index aa8b13b942..20ab333011 100644 --- a/src/Language/PureScript/CoreFn/Expr.hs +++ b/src/Language/PureScript/CoreFn/Expr.hs @@ -29,9 +29,9 @@ data Expr a -- | Accessor a PSString (Expr a) -- | - -- Partial record update + -- Partial record update (original value, fields to copy (if known), fields to update) -- - | ObjectUpdate a (Expr a) [(PSString, Expr a)] + | ObjectUpdate a (Expr a) (Maybe [PSString]) [(PSString, Expr a)] -- | -- Function introduction -- @@ -99,7 +99,7 @@ extractAnn :: Expr a -> a extractAnn (Literal a _) = a extractAnn (Constructor a _ _ _) = a extractAnn (Accessor a _ _) = a -extractAnn (ObjectUpdate a _ _) = a +extractAnn (ObjectUpdate a _ _ _) = a extractAnn (Abs a _ _) = a extractAnn (App a _ _) = a extractAnn (Var a _) = a @@ -111,12 +111,12 @@ extractAnn (Let a _ _) = a -- Modify the annotation on a term -- modifyAnn :: (a -> a) -> Expr a -> Expr a -modifyAnn f (Literal a b) = Literal (f a) b -modifyAnn f (Constructor a b c d) = Constructor (f a) b c d -modifyAnn f (Accessor a b c) = Accessor (f a) b c -modifyAnn f (ObjectUpdate a b c) = ObjectUpdate (f a) b c -modifyAnn f (Abs a b c) = Abs (f a) b c -modifyAnn f (App a b c) = App (f a) b c -modifyAnn f (Var a b) = Var (f a) b -modifyAnn f (Case a b c) = Case (f a) b c -modifyAnn f (Let a b c) = Let (f a) b c +modifyAnn f (Literal a b) = Literal (f a) b +modifyAnn f (Constructor a b c d) = Constructor (f a) b c d +modifyAnn f (Accessor a b c) = Accessor (f a) b c +modifyAnn f (ObjectUpdate a b c d) = ObjectUpdate (f a) b c d +modifyAnn f (Abs a b c) = Abs (f a) b c +modifyAnn f (App a b c) = App (f a) b c +modifyAnn f (Var a b) = Var (f a) b +modifyAnn f (Case a b c) = Case (f a) b c +modifyAnn f (Let a b c) = Let (f a) b c diff --git a/src/Language/PureScript/CoreFn/FromJSON.hs b/src/Language/PureScript/CoreFn/FromJSON.hs index 04b4eda425..d0426b6f8d 100644 --- a/src/Language/PureScript/CoreFn/FromJSON.hs +++ b/src/Language/PureScript/CoreFn/FromJSON.hs @@ -70,7 +70,7 @@ annFromJSON modulePath = withObject "Ann" annFromObj annFromObj o = do ss <- o .: "sourceSpan" >>= sourceSpanFromJSON modulePath mm <- o .: "meta" >>= metaFromJSON - return (ss, [], Nothing, mm) + return (ss, [], mm) sourceSpanFromJSON :: FilePath -> Value -> Parser SourceSpan sourceSpanFromJSON modulePath = withObject "SourceSpan" $ \o -> @@ -228,8 +228,9 @@ exprFromJSON modulePath = withObject "Expr" exprFromObj objectUpdateFromObj o = do ann <- o .: "annotation" >>= annFromJSON modulePath e <- o .: "expression" >>= exprFromJSON modulePath + copy <- o .: "copy" >>= parseJSON us <- o .: "updates" >>= recordFromJSON (exprFromJSON modulePath) - return $ ObjectUpdate ann e us + return $ ObjectUpdate ann e copy us absFromObj o = do ann <- o .: "annotation" >>= annFromJSON modulePath diff --git a/src/Language/PureScript/CoreFn/Laziness.hs b/src/Language/PureScript/CoreFn/Laziness.hs index 42197f88d2..9941fd41c5 100644 --- a/src/Language/PureScript/CoreFn/Laziness.hs +++ b/src/Language/PureScript/CoreFn/Laziness.hs @@ -142,7 +142,7 @@ onVarsWithDelayAndForce f = snd . go 0 $ Just 0 handleApp len args = \case App a e1 e2 -> handleApp (len + 1) ((a, e2) : args) e1 - Var a@(_, _, _, Just meta) i | isConstructorLike meta + Var a@(_, _, Just meta) i | isConstructorLike meta -> foldl (\e1 (a2, e2) -> App a2 <$> e1 <*> handleExpr' e2) (f delay force a i) args e -> foldl (\e1 (a2, e2) -> App a2 <$> e1 <*> snd (go delay Nothing) e2) (snd (go delay (fmap (+ len) force)) e) args isConstructorLike = \case @@ -540,7 +540,7 @@ applyLazinessTransform mn rawItems = let _ -> internalError "Unexpected argument to lazifyIdent" makeForceCall :: Ann -> Ident -> Expr Ann - makeForceCall (ss, _, _, _) ident + makeForceCall (ss, _, _) ident -- We expect the functions produced by `runtimeLazy` to accept one -- argument: the line number on which this reference is made. The runtime -- code uses this number to generate a message that identifies where the diff --git a/src/Language/PureScript/CoreFn/Optimizer.hs b/src/Language/PureScript/CoreFn/Optimizer.hs index 340815be32..722893c439 100644 --- a/src/Language/PureScript/CoreFn/Optimizer.hs +++ b/src/Language/PureScript/CoreFn/Optimizer.hs @@ -3,18 +3,12 @@ module Language.PureScript.CoreFn.Optimizer (optimizeCoreFn) where import Protolude hiding (Type, moduleName) import Control.Monad.Supply (Supply) -import Data.List (lookup) -import Language.PureScript.AST.Literals (Literal(..)) -import Language.PureScript.AST.SourcePos (nullSourceSpan) import Language.PureScript.CoreFn.Ann (Ann) import Language.PureScript.CoreFn.CSE (optimizeCommonSubexpressions) import Language.PureScript.CoreFn.Expr (Bind, Expr(..)) import Language.PureScript.CoreFn.Module (Module(..)) import Language.PureScript.CoreFn.Traversals (everywhereOnValues) -import Language.PureScript.Label (Label(..)) -import Language.PureScript.Types (pattern REmptyKinded, Type(..)) import Language.PureScript.Constants.Libs qualified as C -import Language.PureScript.Constants.Prim qualified as C -- | -- CoreFn optimization pass. @@ -27,29 +21,7 @@ optimizeModuleDecls = map transformBinds where (transformBinds, _, _) = everywhereOnValues identity transformExprs identity transformExprs - = optimizeClosedRecordUpdate - . optimizeDataFunctionApply - -optimizeClosedRecordUpdate :: Expr Ann -> Expr Ann -optimizeClosedRecordUpdate ou@(ObjectUpdate a@(_, _, Just t, _) r updatedFields) = - case closedRecordFields t of - Nothing -> ou - Just allFields -> Literal a (ObjectLiteral (map f allFields)) - where f (Label l) = case lookup l updatedFields of - Nothing -> (l, Accessor (nullSourceSpan, [], Nothing, Nothing) l r) - Just e -> (l, e) -optimizeClosedRecordUpdate e = e - --- | Return the labels of a closed record, or Nothing for other types or open records. -closedRecordFields :: Type a -> Maybe [Label] -closedRecordFields (TypeApp _ (TypeConstructor _ C.Record) row) = - collect row - where - collect :: Type a -> Maybe [Label] - collect (REmptyKinded _ _) = Just [] - collect (RCons _ l _ r) = (l :) <$> collect r - collect _ = Nothing -closedRecordFields _ = Nothing + = optimizeDataFunctionApply optimizeDataFunctionApply :: Expr a -> Expr a optimizeDataFunctionApply e = case e of diff --git a/src/Language/PureScript/CoreFn/ToJSON.hs b/src/Language/PureScript/CoreFn/ToJSON.hs index cae56cd016..1b20ac4e65 100644 --- a/src/Language/PureScript/CoreFn/ToJSON.hs +++ b/src/Language/PureScript/CoreFn/ToJSON.hs @@ -54,9 +54,9 @@ sourceSpanToJSON (SourceSpan _ spanStart spanEnd) = ] annToJSON :: Ann -> Value -annToJSON (ss, _, _, m) = object [ "sourceSpan" .= sourceSpanToJSON ss - , "meta" .= maybe Null metaToJSON m - ] +annToJSON (ss, _, m) = object [ "sourceSpan" .= sourceSpanToJSON ss + , "meta" .= maybe Null metaToJSON m + ] literalToJSON :: (a -> Value) -> Literal a -> Value literalToJSON _ (NumericLiteral (Left n)) @@ -181,9 +181,11 @@ exprToJSON (Accessor ann f r) = object [ "type" .= "Accessor" , "fieldName" .= f , "expression" .= exprToJSON r ] -exprToJSON (ObjectUpdate ann r fs) = object [ "type" .= "ObjectUpdate" +exprToJSON (ObjectUpdate ann r copy fs) + = object [ "type" .= "ObjectUpdate" , "annotation" .= annToJSON ann , "expression" .= exprToJSON r + , "copy" .= toJSON copy , "updates" .= recordToJSON exprToJSON fs ] exprToJSON (Abs ann p b) = object [ "type" .= "Abs" diff --git a/src/Language/PureScript/CoreFn/Traversals.hs b/src/Language/PureScript/CoreFn/Traversals.hs index 16d6a34003..f0684d34d5 100644 --- a/src/Language/PureScript/CoreFn/Traversals.hs +++ b/src/Language/PureScript/CoreFn/Traversals.hs @@ -23,7 +23,7 @@ everywhereOnValues f g h = (f', g', h') g' (Literal ann e) = g (Literal ann (handleLiteral g' e)) g' (Accessor ann prop e) = g (Accessor ann prop (g' e)) - g' (ObjectUpdate ann obj vs) = g (ObjectUpdate ann (g' obj) (map (fmap g') vs)) + g' (ObjectUpdate ann obj copy vs) = g (ObjectUpdate ann (g' obj) copy (map (fmap g') vs)) g' (Abs ann name e) = g (Abs ann name (g' e)) g' (App ann v1 v2) = g (App ann (g' v1) (g' v2)) g' (Case ann vs alts) = g (Case ann (map g' vs) (map handleCaseAlternative alts)) @@ -66,7 +66,7 @@ traverseCoreFn f g h i = (f', g', h', i') g' (Literal ann e) = Literal ann <$> handleLiteral g e g' (Accessor ann prop e) = Accessor ann prop <$> g e - g' (ObjectUpdate ann obj vs) = ObjectUpdate ann <$> g obj <*> traverse (traverse g) vs + g' (ObjectUpdate ann obj copy vs) = (\obj' -> ObjectUpdate ann obj' copy) <$> g obj <*> traverse (traverse g) vs g' (Abs ann name e) = Abs ann name <$> g e g' (App ann v1 v2) = App ann <$> g v1 <*> g v2 g' (Case ann vs alts) = Case ann <$> traverse g vs <*> traverse i alts diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs index 780095d039..a54e39f1e1 100644 --- a/src/Language/PureScript/Renamer.hs +++ b/src/Language/PureScript/Renamer.hs @@ -166,8 +166,8 @@ renameInValue (Literal ann l) = renameInValue c@Constructor{} = return c renameInValue (Accessor ann prop v) = Accessor ann prop <$> renameInValue v -renameInValue (ObjectUpdate ann obj vs) = - ObjectUpdate ann <$> renameInValue obj <*> traverse (\(name, v) -> (name, ) <$> renameInValue v) vs +renameInValue (ObjectUpdate ann obj copy vs) = + (\obj' -> ObjectUpdate ann obj' copy) <$> renameInValue obj <*> traverse (\(name, v) -> (name, ) <$> renameInValue v) vs renameInValue (Abs ann name v) = newScope $ Abs ann <$> updateScope name <*> renameInValue v renameInValue (App ann v1 v2) = diff --git a/tests/TestCoreFn.hs b/tests/TestCoreFn.hs index eb71f13b90..588c6817b4 100644 --- a/tests/TestCoreFn.hs +++ b/tests/TestCoreFn.hs @@ -128,6 +128,7 @@ spec = context "CoreFnFromJson" $ do [ NonRec ann (Ident "objectUpdate") $ ObjectUpdate ann (Literal ann $ ObjectLiteral [(mkString "field", Literal ann (StringLiteral (mkString "abc")))]) + (Just [mkString "unchangedField"]) [(mkString "field", Literal ann (StringLiteral (mkString "xyz")))] ] parseMod m `shouldSatisfy` isSuccess @@ -191,28 +192,28 @@ spec = context "CoreFnFromJson" $ do context "Meta" $ do specify "should parse IsConstructor" $ do let m = Module ss [] mn mp [] [] M.empty [] - [ NonRec (ss, [], Nothing, Just (IsConstructor ProductType [Ident "x"])) (Ident "x") $ - Literal (ss, [], Nothing, Just (IsConstructor SumType [])) (CharLiteral 'a') + [ NonRec (ss, [], Just (IsConstructor ProductType [Ident "x"])) (Ident "x") $ + Literal (ss, [], Just (IsConstructor SumType [])) (CharLiteral 'a') ] parseMod m `shouldSatisfy` isSuccess specify "should parse IsNewtype" $ do let m = Module ss [] mn mp [] [] M.empty [] - [ NonRec (ss, [], Nothing, Just IsNewtype) (Ident "x") $ + [ NonRec (ss, [], Just IsNewtype) (Ident "x") $ Literal ann (CharLiteral 'a') ] parseMod m `shouldSatisfy` isSuccess specify "should parse IsTypeClassConstructor" $ do let m = Module ss [] mn mp [] [] M.empty [] - [ NonRec (ss, [], Nothing, Just IsTypeClassConstructor) (Ident "x") $ + [ NonRec (ss, [], Just IsTypeClassConstructor) (Ident "x") $ Literal ann (CharLiteral 'a') ] parseMod m `shouldSatisfy` isSuccess specify "should parse IsForeign" $ do let m = Module ss [] mn mp [] [] M.empty [] - [ NonRec (ss, [], Nothing, Just IsForeign) (Ident "x") $ + [ NonRec (ss, [], Just IsForeign) (Ident "x") $ Literal ann (CharLiteral 'a') ] parseMod m `shouldSatisfy` isSuccess diff --git a/tests/purs/optimize/ObjectUpdate.out.js b/tests/purs/optimize/ObjectUpdate.out.js new file mode 100644 index 0000000000..37356ae668 --- /dev/null +++ b/tests/purs/optimize/ObjectUpdate.out.js @@ -0,0 +1,27 @@ +var staticUpdate2 = function (x) { + return { + alpha: x.alpha, + bravo: true + }; +}; +var staticUpdate1 = function (x) { + return { + alpha: x.alpha, + bravo: "replaced" + }; +}; +var dynamicUpdate1 = function (x) { + var $3 = {}; + for (var $4 in x) { + if ({}.hasOwnProperty.call(x, $4)) { + $3[$4] = x[$4]; + }; + }; + $3.bravo = true; + return $3; +}; +export { + staticUpdate1, + staticUpdate2, + dynamicUpdate1 +}; diff --git a/tests/purs/optimize/ObjectUpdate.purs b/tests/purs/optimize/ObjectUpdate.purs new file mode 100644 index 0000000000..862638fa83 --- /dev/null +++ b/tests/purs/optimize/ObjectUpdate.purs @@ -0,0 +1,10 @@ +module Main where + +staticUpdate1 :: { alpha :: Int, bravo :: String } -> { alpha :: Int, bravo :: String } +staticUpdate1 x = x { bravo = "replaced" } + +staticUpdate2 :: { alpha :: Int, bravo :: String } -> { alpha :: Int, bravo :: Boolean } +staticUpdate2 x = x { bravo = true } + +dynamicUpdate1 :: forall r. { alpha :: Int, bravo :: String | r } -> { alpha :: Int, bravo :: Boolean | r } +dynamicUpdate1 x = x { bravo = true } From 6431cd32119e50ac08243cb441c5e122fd9a5800 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Sat, 22 Jul 2023 10:28:34 -0400 Subject: [PATCH 38/68] Allow instances that require `Fail` to be empty (#4490) A class instance declaration that has `Prim.TypeError.Fail` as a constraint will never be used. In light of this, such instances are now allowed to have empty bodies even if the class has members. (Such instances are still allowed to declare all of their members, and it is still an error to specify some but not all members.) --- CHANGELOG.d/feature_empty-fail-instances.md | 8 ++++ src/Language/PureScript/Sugar/TypeClasses.hs | 48 ++++++++++++-------- tests/purs/failing/4483.out | 14 ++++++ tests/purs/failing/4483.purs | 13 ++++++ tests/purs/passing/4483.purs | 12 +++++ 5 files changed, 75 insertions(+), 20 deletions(-) create mode 100644 CHANGELOG.d/feature_empty-fail-instances.md create mode 100644 tests/purs/failing/4483.out create mode 100644 tests/purs/failing/4483.purs create mode 100644 tests/purs/passing/4483.purs diff --git a/CHANGELOG.d/feature_empty-fail-instances.md b/CHANGELOG.d/feature_empty-fail-instances.md new file mode 100644 index 0000000000..56e34d5ce5 --- /dev/null +++ b/CHANGELOG.d/feature_empty-fail-instances.md @@ -0,0 +1,8 @@ +* Allow instances that require `Fail` to be empty + + A class instance declaration that has `Prim.TypeError.Fail` as a constraint + will never be used. In light of this, such instances are now allowed to have + empty bodies even if the class has members. + + (Such instances are still allowed to declare all of their members, and it is + still an error to specify some but not all members.) diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs index ca7a901f6f..ae70919b5f 100644 --- a/src/Language/PureScript/Sugar/TypeClasses.hs +++ b/src/Language/PureScript/Sugar/TypeClasses.hs @@ -11,6 +11,7 @@ module Language.PureScript.Sugar.TypeClasses import Prelude import Control.Arrow (first, second) +import Control.Monad (unless) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State (MonadState(..), StateT, evalStateT, modify) import Control.Monad.Supply.Class (MonadSupply) @@ -336,26 +337,33 @@ typeInstanceDictionaryDeclaration sa@(ss, _) name mn deps className tys decls = let declaredMembers = S.fromList $ mapMaybe declIdent decls - case filter (\(ident, _) -> not $ S.member ident declaredMembers) memberTypes of - hd : tl -> throwError . errorMessage' ss $ MissingClassMember (hd NEL.:| tl) - [] -> do - -- Create values for the type instance members - members <- zip (map typeClassMemberName decls) <$> traverse (memberToValue memberTypes) decls - - -- Create the type of the dictionary - -- The type is a record type, but depending on type instance dependencies, may be constrained. - -- The dictionary itself is a record literal. - superclassesDicts <- for typeClassSuperclasses $ \(Constraint _ superclass _ suTyArgs _) -> do - let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs - pure $ Abs (VarBinder ss UnusedIdent) (DeferredDictionary superclass tyArgs) - let superclasses = superClassDictionaryNames typeClassSuperclasses `zip` superclassesDicts - - let props = Literal ss $ ObjectLiteral $ map (first mkString) (members ++ superclasses) - dictTy = foldl srcTypeApp (srcTypeConstructor (fmap (coerceProperName . dictTypeName) className)) tys - constrainedTy = quantify (foldr srcConstrainedType dictTy deps) - dict = App (Constructor ss (fmap (coerceProperName . dictTypeName) className)) props - result = ValueDecl sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)] - return result + -- Instance declarations with a Fail constraint are unreachable code, so + -- we allow them to be empty. + let unreachable = any ((C.Fail ==) . constraintClass) deps && null decls + + unless unreachable $ + case filter (\(ident, _) -> not $ S.member ident declaredMembers) memberTypes of + hd : tl -> throwError . errorMessage' ss $ MissingClassMember (hd NEL.:| tl) + [] -> pure () + + -- Create values for the type instance members + members <- zip (map typeClassMemberName decls) <$> traverse (memberToValue memberTypes) decls + + -- Create the type of the dictionary + -- The type is a record type, but depending on type instance dependencies, may be constrained. + -- The dictionary itself is a record literal (unless unreachable, in which case it's undefined). + superclassesDicts <- for typeClassSuperclasses $ \(Constraint _ superclass _ suTyArgs _) -> do + let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs + pure $ Abs (VarBinder ss UnusedIdent) (DeferredDictionary superclass tyArgs) + let superclasses = superClassDictionaryNames typeClassSuperclasses `zip` superclassesDicts + + let props = Literal ss $ ObjectLiteral $ map (first mkString) (members ++ superclasses) + dictTy = foldl srcTypeApp (srcTypeConstructor (fmap (coerceProperName . dictTypeName) className)) tys + constrainedTy = quantify (foldr srcConstrainedType dictTy deps) + dict = App (Constructor ss (fmap (coerceProperName . dictTypeName) className)) props + mkTV = if unreachable then TypedValue False (Var nullSourceSpan C.I_undefined) else TypedValue True dict + result = ValueDecl sa name Private [] [MkUnguarded (mkTV constrainedTy)] + return result where diff --git a/tests/purs/failing/4483.out b/tests/purs/failing/4483.out new file mode 100644 index 0000000000..ccc01dfb59 --- /dev/null +++ b/tests/purs/failing/4483.out @@ -0,0 +1,14 @@ +Error found: +at tests/purs/failing/4483.purs:10:1 - 11:24 (line 10, column 1 - line 11, column 24) + + The following type class members have not been implemented: + bar :: Int -> Int + +in type class instance +  + Main.Foo Int +  + +See https://github.com/purescript/documentation/blob/master/errors/MissingClassMember.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/4483.purs b/tests/purs/failing/4483.purs new file mode 100644 index 0000000000..970c7887e1 --- /dev/null +++ b/tests/purs/failing/4483.purs @@ -0,0 +1,13 @@ +-- @shouldFailWith MissingClassMember +module Main where + +import Prim.TypeError + +class Foo t where + foo :: t -> String + bar :: Int -> t + +instance fooInt :: Fail (Text "can't use this") => Foo Int where + foo _ = "unreachable" + -- bar is missing; you can get away with an empty instance here but not a + -- half-implemented one diff --git a/tests/purs/passing/4483.purs b/tests/purs/passing/4483.purs new file mode 100644 index 0000000000..f2f202e304 --- /dev/null +++ b/tests/purs/passing/4483.purs @@ -0,0 +1,12 @@ +module Main where + +import Effect.Console (log) +import Prim.TypeError + +class Foo t where + foo :: t -> String + bar :: Int -> t + +instance fooInt :: Fail (Text "can't use this") => Foo Int + +main = log "Done" From 9074fc6611987147a5909be9a3aa5d2c52dfc8a1 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Mon, 24 Jul 2023 11:31:51 -0400 Subject: [PATCH 39/68] Use `gh` for release artifacts (#4493) --- .github/workflows/ci.yml | 14 +++++--------- .../internal_use-gh-for-release-artifacts.md | 1 + 2 files changed, 6 insertions(+), 9 deletions(-) create mode 100644 CHANGELOG.d/internal_use-gh-for-release-artifacts.md diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 6cee437bc1..e76caa8fdf 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -180,15 +180,11 @@ jobs: - name: "(Release only) Publish bundle" if: "${{ env.CI_RELEASE == 'true' }}" - # Astonishingly, GitHub doesn't currently maintain a first-party action - # for uploading assets to GitHub releases! This is the best third-party - # one I could find, but as this step handles a token, it seems - # particularly important that we lock it down to a specific audited - # version, instead of a tag like the other steps. - uses: "AButler/upload-release-assets@ec6d3263266dc57eb6645b5f75e827987f7c217d" - with: - repo-token: "${{ secrets.GITHUB_TOKEN }}" - files: "sdist-test/bundle/*.{tar.gz,sha}" + # This requires the gh command line tool to be installed on our + # self-hosted runners + env: + GITHUB_TOKEN: "${{ secrets.GITHUB_TOKEN }}" + run: "gh release upload --clobber ${{ github.ref_name }} sdist-test/bundle/*.{tar.gz,sha}" lint: runs-on: "ubuntu-latest" diff --git a/CHANGELOG.d/internal_use-gh-for-release-artifacts.md b/CHANGELOG.d/internal_use-gh-for-release-artifacts.md new file mode 100644 index 0000000000..cb66d500f0 --- /dev/null +++ b/CHANGELOG.d/internal_use-gh-for-release-artifacts.md @@ -0,0 +1 @@ +* Use `gh` for release artifacts From 4afea2fbefeebd5e89c67d5a951efee870bcf2f2 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Tue, 25 Jul 2023 07:01:28 -0700 Subject: [PATCH 40/68] Fix VTAs wildcard inferred warning (#4492) The problem initially arises when we convert the [`ExprVisibleApp` (CST value) into `VisibleTypeApp` (AST value)](https://github.com/purescript/purescript/blob/master/src/Language/PureScript/CST/Convert.hs#L338-L340). Using [`convertType`](https://github.com/purescript/purescript/blob/master/src/Language/PureScript/CST/Convert.hs#L122-L123), whenever we come across a wildcard, we always convert the resulting value into an `UnnamedWildcard`. Later, [right before we typecheck a module's declarations](https://github.com/purescript/purescript/blob/master/src/Language/PureScript/TypeChecker.hs#L614), we update all `UnnamedWildcard` to `IgnoreWildcard` if they appear in a specific context via [`ignoreWildcardsUnderCompleteTypeSignatures`](https://github.com/purescript/purescript/blob/master/src/Language/PureScript/Linter/Wildcards.hs#L10-L47). Because Visible Type Applications are a separate concept, they aren't converted here. Presumably, while typechecking, the compiler emits a warning for each `UnnamedWildcard` found, which produces the issue. Thus, there are two ways to resolve this: 1. (this PR) we update `convertType` to take another arg indicating whether it was called while converting an `ExprVisibleApp` into a `VisibleTypeApp`. If it was, then convert any wildcards into `IgnoreWildcard` in the first place. This solves the root of the problem but any other usages of `convertType` don't have this special rule in place. 1. (not this PR) we update the `ignoreWildcards*` function to also account for `VisibleTypeApp`. This is a smaller change but comes at the cost of another traversal through the AST. AFAICT, `convertType` is only used in two other places, both of which I think aren't affected by this change: - [Ide/CaseSplit.hs](https://github.com/purescript/purescript/blob/master/src/Language/PureScript/Ide/CaseSplit.hs#L128) - [Interactive/Parser.hs](https://github.com/purescript/purescript/blob/master/src/Language/PureScript/Interactive/Parser.hs#L108) Lastly, we call into `convertType` via the conversion of `ExprVisibleApp` to `VisibleTypeApp`, However, `convertType` can also call `convertConstraint`, which calls `convertType`. Thus, `convertConstraint` needs to propagate the `withinVta` arg as well. --- CHANGELOG.d/fix_vtas-wildcard-inferred.md | 12 +++++++++ src/Language/PureScript/CST/Convert.hs | 26 +++++++++++------- tests/purs/warning/VTAsWildcardInferred.out | 0 tests/purs/warning/VTAsWildcardInferred.purs | 28 ++++++++++++++++++++ 4 files changed, 56 insertions(+), 10 deletions(-) create mode 100644 CHANGELOG.d/fix_vtas-wildcard-inferred.md create mode 100644 tests/purs/warning/VTAsWildcardInferred.out create mode 100644 tests/purs/warning/VTAsWildcardInferred.purs diff --git a/CHANGELOG.d/fix_vtas-wildcard-inferred.md b/CHANGELOG.d/fix_vtas-wildcard-inferred.md new file mode 100644 index 0000000000..98899b5102 --- /dev/null +++ b/CHANGELOG.d/fix_vtas-wildcard-inferred.md @@ -0,0 +1,12 @@ +* Stop emitting warnings for wildcards in Visible Type Applications + + Previously, the below usage of a wildcard (i.e. `_`) would + incorrectly cause the compiler to emit a warning. + + ```purs + f :: forall @a. a -> a + f = identity + + x :: { x :: Int } + x = f @{ x :: _ } { x: 42 } + ``` diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs index 1cbe9ef31d..c75d333dcc 100644 --- a/src/Language/PureScript/CST/Convert.hs +++ b/src/Language/PureScript/CST/Convert.hs @@ -98,7 +98,13 @@ ident :: Ident -> N.Ident ident = N.Ident . getIdent convertType :: String -> Type a -> T.SourceType -convertType fileName = go +convertType = convertType' False + +convertVtaType :: String -> Type a -> T.SourceType +convertVtaType = convertType' True + +convertType' :: Bool -> String -> Type a -> T.SourceType +convertType' withinVta fileName = go where goRow (Row labels tl) b = do let @@ -120,7 +126,7 @@ convertType fileName = go TypeConstructor _ a -> T.TypeConstructor (sourceQualName fileName a) $ qualified a TypeWildcard _ a -> - T.TypeWildcard (sourceAnnCommented fileName a a) T.UnnamedWildcard + T.TypeWildcard (sourceAnnCommented fileName a a) $ if withinVta then T.IgnoredWildcard else T.UnnamedWildcard TypeHole _ a -> T.TypeWildcard (sourceName fileName a) . T.HoleWildcard . getIdent $ nameValue a TypeString _ a b -> @@ -182,7 +188,7 @@ convertType fileName = go Env.tyFunction $> sourceAnnCommented fileName a a TypeConstrained _ a _ b -> do let - a' = convertConstraint fileName a + a' = convertConstraint withinVta fileName a b' = go b ann = Pos.widenSourceAnn (T.constraintAnn a') (T.getAnnForType b') T.ConstrainedType ann a' b' @@ -195,13 +201,13 @@ convertType fileName = go ann = uncurry (sourceAnnCommented fileName) rng T.setAnnForType ann $ Env.kindRow a' -convertConstraint :: String -> Constraint a -> T.SourceConstraint -convertConstraint fileName = go +convertConstraint :: Bool -> String -> Constraint a -> T.SourceConstraint +convertConstraint withinVta fileName = go where go = \case cst@(Constraint _ name args) -> do let ann = uncurry (sourceAnnCommented fileName) $ constraintRange cst - T.Constraint ann (qualified name) [] (convertType fileName <$> args) Nothing + T.Constraint ann (qualified name) [] (convertType' withinVta fileName <$> args) Nothing ConstraintParens _ (Wrapped _ c _) -> go c convertGuarded :: String -> Guarded a -> [AST.GuardedExpr] @@ -337,7 +343,7 @@ convertExpr fileName = go positioned ann $ AST.App (go a) (go b) expr@(ExprVisibleTypeApp _ a _ b) -> do let ann = uncurry (sourceAnn fileName) $ exprRange expr - positioned ann $ AST.VisibleTypeApp (go a) (convertType fileName b) + positioned ann $ AST.VisibleTypeApp (go a) (convertVtaType fileName b) expr@(ExprLambda _ (Lambda _ as _ b)) -> do let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr positioned ann @@ -472,7 +478,7 @@ convertDeclaration fileName decl = case decl of pure $ AST.TypeClassDeclaration ann (nameValue name) (goTypeVar <$> vars) - (convertConstraint fileName <$> maybe [] (toList . fst) sup) + (convertConstraint False fileName <$> maybe [] (toList . fst) sup) (goFundep <$> maybe [] (toList . snd) fdeps) (goSig <$> maybe [] (NE.toList . snd) bd) DeclInstanceChain _ insts -> do @@ -483,7 +489,7 @@ convertDeclaration fileName decl = case decl of clsAnn = findInstanceAnn cls args AST.TypeInstanceDeclaration ann' clsAnn chainId ix (mkPartialInstanceName nameSep cls args) - (convertConstraint fileName <$> maybe [] (toList . fst) ctrs) + (convertConstraint False fileName <$> maybe [] (toList . fst) ctrs) (qualified cls) (convertType fileName <$> args) (AST.ExplicitInstance $ goInstanceBinding <$> maybe [] (NE.toList . snd) bd) @@ -497,7 +503,7 @@ convertDeclaration fileName decl = case decl of | otherwise = AST.DerivedInstance clsAnn = findInstanceAnn cls args pure $ AST.TypeInstanceDeclaration ann clsAnn chainId 0 name' - (convertConstraint fileName <$> maybe [] (toList . fst) ctrs) + (convertConstraint False fileName <$> maybe [] (toList . fst) ctrs) (qualified cls) (convertType fileName <$> args) instTy diff --git a/tests/purs/warning/VTAsWildcardInferred.out b/tests/purs/warning/VTAsWildcardInferred.out new file mode 100644 index 0000000000..e69de29bb2 diff --git a/tests/purs/warning/VTAsWildcardInferred.purs b/tests/purs/warning/VTAsWildcardInferred.purs new file mode 100644 index 0000000000..4a5da616d1 --- /dev/null +++ b/tests/purs/warning/VTAsWildcardInferred.purs @@ -0,0 +1,28 @@ +-- See https://github.com/purescript/purescript/issues/4487 +module Main where + +import Prelude +import Effect (Effect) +import Effect.Console (log) + +f :: forall @a. a -> a +f = identity + +test1 :: { x :: Int } +test1 = f @{ x :: _ } { x: 42 } + +class Foo :: Type -> Type -> Type -> Constraint +class Foo a b c | a -> b c where + fooMember :: a -> b + +wrap :: forall @a. Array a -> Array (Array a) +wrap as = [as] + +arrFooMember :: forall c. Array (Foo Int Boolean c => Int -> Boolean) +arrFooMember = [fooMember] + +test2 :: forall c. Array (Array (Foo Int Boolean c => Int -> Boolean)) +test2 = wrap @(Foo Int Boolean _ => _) arrFooMember -- neither wildcard should warn IMO + +main :: Effect Unit +main = log "Done" From 0662cccfb938181305149c7d52cd6ef5d80b3e77 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Tue, 8 Aug 2023 13:15:08 -0500 Subject: [PATCH 41/68] Fix record type inference involving visible type applications (#4501) --- CHANGELOG.d/fix_vtas-record-inference.md | 14 ++++++++++++++ src/Language/PureScript/TypeChecker/Types.hs | 1 + tests/purs/passing/4500.purs | 15 +++++++++++++++ 3 files changed, 30 insertions(+) create mode 100644 CHANGELOG.d/fix_vtas-record-inference.md create mode 100644 tests/purs/passing/4500.purs diff --git a/CHANGELOG.d/fix_vtas-record-inference.md b/CHANGELOG.d/fix_vtas-record-inference.md new file mode 100644 index 0000000000..92e0b18285 --- /dev/null +++ b/CHANGELOG.d/fix_vtas-record-inference.md @@ -0,0 +1,14 @@ +* Infer types using VTA inside a record + + Previously, `use` would fail to compile + because the `v` type variable would not be inferred + to `String`. Now the below code compiles: + + ```purs + reflect :: forall @t v . Reflectable t v => v + reflect = reflectType (Proxy @t) + + use :: String + use = show { asdf: reflect @"asdf" } + ``` + diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs index 04f7de22fe..3f758805c6 100644 --- a/src/Language/PureScript/TypeChecker/Types.hs +++ b/src/Language/PureScript/TypeChecker/Types.hs @@ -569,6 +569,7 @@ propertyShouldInstantiate :: Expr -> Bool propertyShouldInstantiate = \case Var{} -> True Constructor{} -> True + VisibleTypeApp e _ -> propertyShouldInstantiate e PositionedValue _ _ e -> propertyShouldInstantiate e _ -> False diff --git a/tests/purs/passing/4500.purs b/tests/purs/passing/4500.purs new file mode 100644 index 0000000000..2e11a30d44 --- /dev/null +++ b/tests/purs/passing/4500.purs @@ -0,0 +1,15 @@ +module Main where + +import Prelude + +import Data.Reflectable (class Reflectable, reflectType) +import Type.Proxy (Proxy(..)) +import Effect.Console (log) + +reflect :: forall @t v . Reflectable t v => v +reflect = reflectType (Proxy @t) + +use :: String +use = show { asdf: reflect @"asdf" } + +main = log "Done" From 8ede652b6f040dcaadff8a59f9cfb118993f7986 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Tue, 8 Aug 2023 13:42:17 -0500 Subject: [PATCH 42/68] Stop triggering CI on non-code-related changes (#4502) --- .github/workflows/ci.yml | 17 +++++++++++++++++ ...l_stop-building-if-non-significant-change.md | 1 + 2 files changed, 18 insertions(+) create mode 100644 CHANGELOG.d/internal_stop-building-if-non-significant-change.md diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e76caa8fdf..0460c5762a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -5,6 +5,23 @@ on: branches: [ "master" ] pull_request: branches: [ "master" ] + paths: + - .github/workflows/**/*.yml + - app/**/* + - bundle/**/* + - ci/**/* + - license-generator/**/* + - src/**/* + - test/**/* + - .gitignore + - .hlint.yaml + - .hspec + - cabal.project + - purescript.cabal + - Setup.hs + - stack.yaml + - update-changelog.hs + - weeder.dhall release: types: [ "published" ] diff --git a/CHANGELOG.d/internal_stop-building-if-non-significant-change.md b/CHANGELOG.d/internal_stop-building-if-non-significant-change.md new file mode 100644 index 0000000000..f635c7e88e --- /dev/null +++ b/CHANGELOG.d/internal_stop-building-if-non-significant-change.md @@ -0,0 +1 @@ +* Stop triggering CI on non-code-related changes (e.g. Readme) From 843c1097bab3fa9fe25e1f661f6af3ab95d3141c Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Fri, 29 Sep 2023 09:05:23 -0500 Subject: [PATCH 43/68] Prep 0.15.11 release (#4507) * Update changelog * Update versions to 0.15.11 --- CHANGELOG.d/feature_closed-record-update.md | 7 --- CHANGELOG.d/feature_empty-fail-instances.md | 8 --- CHANGELOG.d/fix_vtas-record-inference.md | 14 ----- CHANGELOG.d/fix_vtas-wildcard-inferred.md | 12 ---- ...stop-building-if-non-significant-change.md | 1 - .../internal_use-gh-for-release-artifacts.md | 1 - CHANGELOG.md | 56 +++++++++++++++++++ npm-package/package.json | 4 +- purescript.cabal | 2 +- 9 files changed, 59 insertions(+), 46 deletions(-) delete mode 100644 CHANGELOG.d/feature_closed-record-update.md delete mode 100644 CHANGELOG.d/feature_empty-fail-instances.md delete mode 100644 CHANGELOG.d/fix_vtas-record-inference.md delete mode 100644 CHANGELOG.d/fix_vtas-wildcard-inferred.md delete mode 100644 CHANGELOG.d/internal_stop-building-if-non-significant-change.md delete mode 100644 CHANGELOG.d/internal_use-gh-for-release-artifacts.md diff --git a/CHANGELOG.d/feature_closed-record-update.md b/CHANGELOG.d/feature_closed-record-update.md deleted file mode 100644 index c3534373c6..0000000000 --- a/CHANGELOG.d/feature_closed-record-update.md +++ /dev/null @@ -1,7 +0,0 @@ -* Move the closed record update optimization - - For consumers of CoreFn like alternate backends, the optimization of - replacing a closed record update with an object literal has now been moved to - the point of desugaring CoreFn into JS. The `ObjectUpdate` expression - constructor now contains a `Maybe` field holding a list of record labels to - be copied as-is, for backends that want to perform this optimization also. diff --git a/CHANGELOG.d/feature_empty-fail-instances.md b/CHANGELOG.d/feature_empty-fail-instances.md deleted file mode 100644 index 56e34d5ce5..0000000000 --- a/CHANGELOG.d/feature_empty-fail-instances.md +++ /dev/null @@ -1,8 +0,0 @@ -* Allow instances that require `Fail` to be empty - - A class instance declaration that has `Prim.TypeError.Fail` as a constraint - will never be used. In light of this, such instances are now allowed to have - empty bodies even if the class has members. - - (Such instances are still allowed to declare all of their members, and it is - still an error to specify some but not all members.) diff --git a/CHANGELOG.d/fix_vtas-record-inference.md b/CHANGELOG.d/fix_vtas-record-inference.md deleted file mode 100644 index 92e0b18285..0000000000 --- a/CHANGELOG.d/fix_vtas-record-inference.md +++ /dev/null @@ -1,14 +0,0 @@ -* Infer types using VTA inside a record - - Previously, `use` would fail to compile - because the `v` type variable would not be inferred - to `String`. Now the below code compiles: - - ```purs - reflect :: forall @t v . Reflectable t v => v - reflect = reflectType (Proxy @t) - - use :: String - use = show { asdf: reflect @"asdf" } - ``` - diff --git a/CHANGELOG.d/fix_vtas-wildcard-inferred.md b/CHANGELOG.d/fix_vtas-wildcard-inferred.md deleted file mode 100644 index 98899b5102..0000000000 --- a/CHANGELOG.d/fix_vtas-wildcard-inferred.md +++ /dev/null @@ -1,12 +0,0 @@ -* Stop emitting warnings for wildcards in Visible Type Applications - - Previously, the below usage of a wildcard (i.e. `_`) would - incorrectly cause the compiler to emit a warning. - - ```purs - f :: forall @a. a -> a - f = identity - - x :: { x :: Int } - x = f @{ x :: _ } { x: 42 } - ``` diff --git a/CHANGELOG.d/internal_stop-building-if-non-significant-change.md b/CHANGELOG.d/internal_stop-building-if-non-significant-change.md deleted file mode 100644 index f635c7e88e..0000000000 --- a/CHANGELOG.d/internal_stop-building-if-non-significant-change.md +++ /dev/null @@ -1 +0,0 @@ -* Stop triggering CI on non-code-related changes (e.g. Readme) diff --git a/CHANGELOG.d/internal_use-gh-for-release-artifacts.md b/CHANGELOG.d/internal_use-gh-for-release-artifacts.md deleted file mode 100644 index cb66d500f0..0000000000 --- a/CHANGELOG.d/internal_use-gh-for-release-artifacts.md +++ /dev/null @@ -1 +0,0 @@ -* Use `gh` for release artifacts diff --git a/CHANGELOG.md b/CHANGELOG.md index 94592161bd..81547a9ff3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,62 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.11 + +New features: + +* Move the closed record update optimization (#4489 by @rhendric) + + For consumers of CoreFn like alternate backends, the optimization of + replacing a closed record update with an object literal has now been moved to + the point of desugaring CoreFn into JS. The `ObjectUpdate` expression + constructor now contains a `Maybe` field holding a list of record labels to + be copied as-is, for backends that want to perform this optimization also. + +* Allow instances that require `Fail` to be empty (#4490 by @rhendric) + + A class instance declaration that has `Prim.TypeError.Fail` as a constraint + will never be used. In light of this, such instances are now allowed to have + empty bodies even if the class has members. + + (Such instances are still allowed to declare all of their members, and it is + still an error to specify some but not all members.) + +Bugfixes: + +* Stop emitting warnings for wildcards in Visible Type Applications (#4492 by @JordanMartinez) + + Previously, the below usage of a wildcard (i.e. `_`) would + incorrectly cause the compiler to emit a warning. + + ```purs + f :: forall @a. a -> a + f = identity + + x :: { x :: Int } + x = f @{ x :: _ } { x: 42 } + ``` + +* Infer types using VTA inside a record (#4501 by @JordanMartinez) + + Previously, `use` would fail to compile + because the `v` type variable would not be inferred + to `String`. Now the below code compiles: + + ```purs + reflect :: forall @t v . Reflectable t v => v + reflect = reflectType (Proxy @t) + + use :: String + use = show { asdf: reflect @"asdf" } + ``` + +Internal: + +* Use `gh` for release artifacts (#4493 by @rhendric) + +* Stop triggering CI on non-code-related changes (e.g. Readme) (#4502 by @JordanMartinez) + ## 0.15.10 New features: diff --git a/npm-package/package.json b/npm-package/package.json index 8159571081..86e278e6f5 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.10", + "version": "0.15.11", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.10", + "postinstall": "install-purescript --purs-ver=0.15.11", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index ec35ef3938..2e4451d88f 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.10 +version: 0.15.11 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From 2412101a8301f2d63e8fb8b316a23ac8ff6463e6 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Sat, 7 Oct 2023 06:21:50 -0500 Subject: [PATCH 44/68] Install gh on ubuntu-latest run; prep 0.15.12 release (#4509) * Install gh on ubuntu-latest run * Prep 0.15.12 release --- .github/workflows/ci.yml | 11 +++++++++++ CHANGELOG.md | 9 +++++++-- npm-package/package.json | 4 ++-- purescript.cabal | 2 +- 4 files changed, 21 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0460c5762a..07a3155e80 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -77,6 +77,17 @@ jobs: . /etc/os-release echo deb http://deb.debian.org/debian "$VERSION_CODENAME"-backports main >> /etc/apt/sources.list apt-get update && apt-get install -y git/"$VERSION_CODENAME"-backports + + - # We need `gh` installed on the Linux version. Otherwise, release artifacts won't be uploaded. + name: "(Linux only) Install gh" + if: "contains(matrix.os, 'ubuntu-latest')" + run: | + curl -fsSL https://cli.github.com/packages/githubcli-archive-keyring.gpg | dd of=/usr/share/keyrings/githubcli-archive-keyring.gpg + chmod go+r /usr/share/keyrings/githubcli-archive-keyring.gpg + echo "deb [arch=$(dpkg --print-architecture) signed-by=/usr/share/keyrings/githubcli-archive-keyring.gpg] https://cli.github.com/packages stable main" | tee /etc/apt/sources.list.d/github-cli.list > /dev/null + apt-get update + apt-get install gh + - uses: "actions/checkout@v2" - uses: "actions/setup-node@v2" with: diff --git a/CHANGELOG.md b/CHANGELOG.md index 81547a9ff3..67eae177e8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,7 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## 0.15.11 +## 0.15.12 New features: @@ -54,10 +54,15 @@ Bugfixes: Internal: -* Use `gh` for release artifacts (#4493 by @rhendric) +* Use `gh` for release artifacts (#4493 by @rhendric, #4509 by @JordanMartinez) * Stop triggering CI on non-code-related changes (e.g. Readme) (#4502 by @JordanMartinez) + +## 0.15.11 + +Please use `0.15.12` instead of this release. There was an issue with the Linux build. This release notes were moved into `0.15.12`'s release notes. + ## 0.15.10 New features: diff --git a/npm-package/package.json b/npm-package/package.json index 86e278e6f5..9ab1997120 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.11", + "version": "0.15.12", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.11", + "postinstall": "install-purescript --purs-ver=0.15.12", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index 2e4451d88f..bd1595adec 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.11 +version: 0.15.12 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From 4f4672d26d024ee4eb855eccd93dc48e6f5eb036 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Fri, 3 Nov 2023 11:03:36 -0500 Subject: [PATCH 45/68] Drop UnusableDeclaration; update NoInstanceFound error (#4513) With the advent of visible type applications (VTAs), all type class instances can be determined via VTAs. This PR removes the `UnusableDeclaration` error. Whereas before, the code would throw the above error when type variables in the type class head are not mentioned in the type class member's type signature, now we simply track these "VTA-required" args. These args represent type variables that must be disambiguated using VTAs. If VTAs are used, the instance should be found. If they are not used, an updated `NoInstanceFound` error is thrown that notifies the user of these "VTA-required" args if possible. When a `NoInstanceFound` error is thrown, we do not attempt to do anything other than notify the user of the "VTA-required" args. In a previous and problematic approach, we did try to do more but found a number of difficult problems with this approach: - Suggesting a correct usage of `coerce` with VTAs in all of its complex cases - When a user does supply a VTA arg, assuming that that arg refers to a corresponding type in a valid type class instance: `foo @Int` when there is no `Foo Int` instance - User confusion due to a difference in order of VTA args with their usage within the type class member's type signature: `foo @1 @2` when `foo :: forall one two. two -> one` A side effect of dropping the `UnusableDeclaration` error is a scoping bug that was revealed in `moveQuantifiersToFront`. This bug has also been fixed. Other notes: - `replaceAllTypeSynonymsM` is removed as it's no longer used by anything. - The Externs files do not store the "VTA-required" args and instead recompute them after being loaded. - The "VTA-required" args are tracked via their indices so as to print them in their corresponding order later. --- .../bug_fix-moveQuantifiersToFront-scoping.md | 23 ++ .../feature_replace-unused-declarations.md | 71 +++++++ src/Language/PureScript/AST/Declarations.hs | 11 + .../PureScript/Docs/Convert/ReExports.hs | 2 +- src/Language/PureScript/Environment.hs | 26 ++- src/Language/PureScript/Errors.hs | 54 ++--- src/Language/PureScript/Externs.hs | 2 +- .../PureScript/Interactive/Printer.hs | 2 +- src/Language/PureScript/Sugar/TypeClasses.hs | 7 +- src/Language/PureScript/TypeChecker.hs | 26 +-- .../PureScript/TypeChecker/Entailment.hs | 56 ++++- .../TypeChecker/Entailment/Coercible.hs | 5 +- .../PureScript/TypeChecker/Synonyms.hs | 10 - src/Language/PureScript/Types.hs | 39 ++-- tests/purs/failing/ClassHeadNoVTA1.out | 25 +++ tests/purs/failing/ClassHeadNoVTA1.purs | 8 + tests/purs/failing/ClassHeadNoVTA2.out | 27 +++ tests/purs/failing/ClassHeadNoVTA2.purs | 11 + tests/purs/failing/ClassHeadNoVTA3.out | 28 +++ tests/purs/failing/ClassHeadNoVTA3.purs | 9 + tests/purs/failing/ClassHeadNoVTA4.out | 27 +++ tests/purs/failing/ClassHeadNoVTA4.purs | 8 + tests/purs/failing/ClassHeadNoVTA5.out | 29 +++ tests/purs/failing/ClassHeadNoVTA5.purs | 10 + tests/purs/failing/ClassHeadNoVTA6a.out | 37 ++++ tests/purs/failing/ClassHeadNoVTA6a.purs | 12 ++ tests/purs/failing/ClassHeadNoVTA6b.out | 50 +++++ tests/purs/failing/ClassHeadNoVTA6b.purs | 16 ++ tests/purs/failing/ClassHeadNoVTA6c.out | 50 +++++ tests/purs/failing/ClassHeadNoVTA6c.purs | 16 ++ tests/purs/failing/ClassHeadNoVTA7.out | 25 +++ tests/purs/failing/ClassHeadNoVTA7.purs | 12 ++ tests/purs/failing/TypedHole.out | 14 +- .../purs/failing/UnusableTypeClassMethod.out | 12 -- .../purs/failing/UnusableTypeClassMethod.purs | 7 - ...nusableTypeClassMethodConflictingIdent.out | 12 -- ...usableTypeClassMethodConflictingIdent.purs | 7 - .../UnusableTypeClassMethodSynonym.out | 12 -- .../UnusableTypeClassMethodSynonym.purs | 9 - tests/purs/passing/VTAsClassHeads.purs | 196 ++++++++++++++++++ tests/purs/warning/TypeClassMethodSynonym.out | 11 + .../purs/warning/TypeClassMethodSynonym.purs | 8 + 42 files changed, 864 insertions(+), 158 deletions(-) create mode 100644 CHANGELOG.d/bug_fix-moveQuantifiersToFront-scoping.md create mode 100644 CHANGELOG.d/feature_replace-unused-declarations.md create mode 100644 tests/purs/failing/ClassHeadNoVTA1.out create mode 100644 tests/purs/failing/ClassHeadNoVTA1.purs create mode 100644 tests/purs/failing/ClassHeadNoVTA2.out create mode 100644 tests/purs/failing/ClassHeadNoVTA2.purs create mode 100644 tests/purs/failing/ClassHeadNoVTA3.out create mode 100644 tests/purs/failing/ClassHeadNoVTA3.purs create mode 100644 tests/purs/failing/ClassHeadNoVTA4.out create mode 100644 tests/purs/failing/ClassHeadNoVTA4.purs create mode 100644 tests/purs/failing/ClassHeadNoVTA5.out create mode 100644 tests/purs/failing/ClassHeadNoVTA5.purs create mode 100644 tests/purs/failing/ClassHeadNoVTA6a.out create mode 100644 tests/purs/failing/ClassHeadNoVTA6a.purs create mode 100644 tests/purs/failing/ClassHeadNoVTA6b.out create mode 100644 tests/purs/failing/ClassHeadNoVTA6b.purs create mode 100644 tests/purs/failing/ClassHeadNoVTA6c.out create mode 100644 tests/purs/failing/ClassHeadNoVTA6c.purs create mode 100644 tests/purs/failing/ClassHeadNoVTA7.out create mode 100644 tests/purs/failing/ClassHeadNoVTA7.purs delete mode 100644 tests/purs/failing/UnusableTypeClassMethod.out delete mode 100644 tests/purs/failing/UnusableTypeClassMethod.purs delete mode 100644 tests/purs/failing/UnusableTypeClassMethodConflictingIdent.out delete mode 100644 tests/purs/failing/UnusableTypeClassMethodConflictingIdent.purs delete mode 100644 tests/purs/failing/UnusableTypeClassMethodSynonym.out delete mode 100644 tests/purs/failing/UnusableTypeClassMethodSynonym.purs create mode 100644 tests/purs/passing/VTAsClassHeads.purs create mode 100644 tests/purs/warning/TypeClassMethodSynonym.out create mode 100644 tests/purs/warning/TypeClassMethodSynonym.purs diff --git a/CHANGELOG.d/bug_fix-moveQuantifiersToFront-scoping.md b/CHANGELOG.d/bug_fix-moveQuantifiersToFront-scoping.md new file mode 100644 index 0000000000..5d701a22cb --- /dev/null +++ b/CHANGELOG.d/bug_fix-moveQuantifiersToFront-scoping.md @@ -0,0 +1,23 @@ +* Fix scoping issues in `moveQuantifiersToFront` + +As a side effect of replacing `UnusableDeclaration` with +an updated `NoInstanceFound` error, a bug appeared in how +scoping is handled when constraints are involved. + +```purs +-- | a0 +class Foo a where +-- | a1 + foo :: forall a. a +``` +Before this fix, `foo`'s type signature was being transformed to +`foo :: forall @a a. Foo a => a` +where two type variables with the same identifier +are present rather than the correct signature of +`foo :: forall @a0. Foo a0 => (forall a1. a1)`. + +With this fix, the above type class declaration +will now compile and trigger a `ShadowedName` +warning since the type class member's `a` +(i.e. `a1` above) shadows the type class head's `a` +(i.e. `a0` above). diff --git a/CHANGELOG.d/feature_replace-unused-declarations.md b/CHANGELOG.d/feature_replace-unused-declarations.md new file mode 100644 index 0000000000..4bc3b11273 --- /dev/null +++ b/CHANGELOG.d/feature_replace-unused-declarations.md @@ -0,0 +1,71 @@ +* Replace `UnusableDeclaration` with updated `NoInstanceFound` + + Previously, the following type class would be invalid + because there was no way for the compiler to infer + which type class instance to select because + the type variable in the class head `a` was + not mentioned in `bar`'s type signature: + + ```purs + class Foo a where + bar :: Int + ``` + + The recently-added visible type applications (VTAs) + can now be used to guide the compiler in such cases: + + ```purs + class Foo a where bar :: Int + instance Foo String where bar = 0 + someInt = bar @String -- use the `String` instance + ``` + + Without VTAs, the compiler + will still produce an `InstanceNotFound` error, but this error + has been updated to note which type variables in the class head + can only be disambiguated via visible type applications. + Given the following code + + ```purs + class Single tyVarDoesNotAppearInBody where + useSingle :: Int + + single :: Int + single = useSingle + ``` + + The error reported for `useSingle` will be: + + ``` + No type class instance was found for + + Main.Single t0 + + The instance head contains unknown type variables. + + + Note: The following type class members found in the expression require visible type applications + to be unambiguous (e.g. tyClassMember @Int). + Main.useSingle + tyNotAppearInBody + ``` + + For a multiparameter typeclass with functional dependencies... + + ```purs + class MultiFdBidi a b | a -> b, b -> a where + useMultiFdBidi :: Int + + multiFdBidi :: Int + multiFdBidi = useMultiFdBidi + ``` + + ...the "Note" part is updated to read + ``` + Note: The following type class members found in the expression require visible type applications + to be unambiguous (e.g. tyClassMember @Int). + Main.useMultiFdBidi + One of the following sets of type variables: + a + b + ``` diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs index f9ca32b3a1..e6d13c74aa 100644 --- a/src/Language/PureScript/AST/Declarations.hs +++ b/src/Language/PureScript/AST/Declarations.hs @@ -103,6 +103,17 @@ data HintCategory | OtherHint deriving (Show, Eq) +-- | +-- In constraint solving, indicates whether there were `TypeUnknown`s that prevented +-- an instance from being found, and whether VTAs are required +-- due to type class members not referencing all the type class +-- head's type variables. +data UnknownsHint + = NoUnknowns + | Unknowns + | UnknownsWithVtaRequiringArgs (NEL.NonEmpty (Qualified Ident, [[Text]])) + deriving (Show) + -- | -- A module declaration, consisting of comments about the module, a module name, -- a list of declarations, and a list of the declarations that are diff --git a/src/Language/PureScript/Docs/Convert/ReExports.hs b/src/Language/PureScript/Docs/Convert/ReExports.hs index 9574f0fe7d..600b343a5b 100644 --- a/src/Language/PureScript/Docs/Convert/ReExports.hs +++ b/src/Language/PureScript/Docs/Convert/ReExports.hs @@ -441,7 +441,7 @@ handleEnv TypeClassEnv{..} = ++ T.unpack cdeclTitle) addConstraint constraint = - P.quantify . P.moveQuantifiersToFront . P.ConstrainedType () constraint + P.quantify . P.moveQuantifiersToFront () . P.ConstrainedType () constraint splitMap :: Map k (v1, v2) -> (Map k v1, Map k v2) splitMap = fmap fst &&& fmap snd diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs index de1b35d3c9..e1f857031f 100644 --- a/src/Language/PureScript/Environment.hs +++ b/src/Language/PureScript/Environment.hs @@ -14,7 +14,7 @@ import Data.IntMap qualified as IM import Data.IntSet qualified as IS import Data.Map qualified as M import Data.Set qualified as S -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, mapMaybe) import Data.Semigroup (First(..)) import Data.Text (Text) import Data.Text qualified as T @@ -25,7 +25,7 @@ import Language.PureScript.Crash (internalError) import Language.PureScript.Names (Ident, ProperName(..), ProperNameType(..), Qualified, QualifiedBy, coerceProperName) import Language.PureScript.Roles (Role(..)) import Language.PureScript.TypeClassDictionaries (NamedDict) -import Language.PureScript.Types (SourceConstraint, SourceType, Type(..), TypeVarVisibility(..), eqType, srcTypeConstructor) +import Language.PureScript.Types (SourceConstraint, SourceType, Type(..), TypeVarVisibility(..), eqType, srcTypeConstructor, freeTypeVariables) import Language.PureScript.Constants.Prim qualified as C -- | The @Environment@ defines all values and types which are currently in scope: @@ -54,9 +54,10 @@ data TypeClassData = TypeClassData { typeClassArguments :: [(Text, Maybe SourceType)] -- ^ A list of type argument names, and their kinds, where kind annotations -- were provided. - , typeClassMembers :: [(Ident, SourceType)] - -- ^ A list of type class members and their types. Type arguments listed above - -- are considered bound in these types. + , typeClassMembers :: [(Ident, SourceType, Maybe (S.Set (NEL.NonEmpty Int)))] + -- ^ A list of type class members and their types and whether or not + -- they have type variables that must be defined using Visible Type Applications. + -- Type arguments listed above are considered bound in these types. , typeClassSuperclasses :: [SourceConstraint] -- ^ A list of superclasses of this type class. Type arguments listed above -- are considered bound in the types appearing in these constraints. @@ -129,10 +130,23 @@ makeTypeClassData -> [FunctionalDependency] -> Bool -> TypeClassData -makeTypeClassData args m s deps = TypeClassData args m s deps determinedArgs coveringSets +makeTypeClassData args m s deps = TypeClassData args m' s deps determinedArgs coveringSets where ( determinedArgs, coveringSets ) = computeCoveringSets (length args) deps + coveringSets' = S.toList coveringSets + + m' = map (\(a, b) -> (a, b, addVtaInfo b)) m + + addVtaInfo :: SourceType -> Maybe (S.Set (NEL.NonEmpty Int)) + addVtaInfo memberTy = do + let mentionedArgIndexes = S.fromList (mapMaybe argToIndex $ freeTypeVariables memberTy) + let leftovers = map (`S.difference` mentionedArgIndexes) coveringSets' + S.fromList <$> traverse (NEL.nonEmpty . S.toList) leftovers + + argToIndex :: Text -> Maybe Int + argToIndex = flip M.lookup $ M.fromList (zipWith ((,) . fst) args [0..]) + -- A moving frontier of sets to consider, along with the fundeps that can be -- applied in each case. At each stage, all sets in the frontier will be the -- same size, decreasing by 1 each time. diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 972e6b69a8..2d8225f324 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -111,7 +111,7 @@ data SimpleErrorMessage | NoInstanceFound SourceConstraint -- ^ constraint that could not be solved [Qualified (Either SourceType Ident)] -- ^ a list of instances that stopped further progress in instance chains due to ambiguity - Bool -- ^ whether eliminating unknowns with annotations might help + UnknownsHint -- ^ whether eliminating unknowns with annotations might help or if visible type applications are required | AmbiguousTypeVariables SourceType [(Text, Int)] | UnknownClass (Qualified (ProperName 'ClassName)) | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [SourceType] @@ -177,8 +177,6 @@ data SimpleErrorMessage | ClassInstanceArityMismatch Ident (Qualified (ProperName 'ClassName)) Int Int -- | a user-defined warning raised by using the Warn type class | UserDefinedWarning SourceType - -- | a declaration couldn't be used because it contained free variables - | UnusableDeclaration Ident [[Text]] | CannotDefinePrimModules ModuleName | MixedAssociativityError (NEL.NonEmpty (Qualified (OpName 'AnyOpName), Associativity)) | NonAssociativeError (NEL.NonEmpty (Qualified (OpName 'AnyOpName))) @@ -352,7 +350,6 @@ errorCode em = case unwrapErrorMessage em of CannotUseBindWithDo{} -> "CannotUseBindWithDo" ClassInstanceArityMismatch{} -> "ClassInstanceArityMismatch" UserDefinedWarning{} -> "UserDefinedWarning" - UnusableDeclaration{} -> "UnusableDeclaration" CannotDefinePrimModules{} -> "CannotDefinePrimModules" MixedAssociativityError{} -> "MixedAssociativityError" NonAssociativeError{} -> "NonAssociativeError" @@ -917,7 +914,8 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon , line ("You can use " <> markCode "_ <- ..." <> " to explicitly discard the result.") ] renderSimpleErrorMessage (NoInstanceFound (Constraint _ nm _ ts _) ambiguous unks) = - paras [ line "No type class instance was found for" + paras $ + [ line "No type class instance was found for" , markCodeBox $ indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm) , Box.vcat Box.left (map prettyTypeAtom ts) @@ -930,10 +928,32 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon [] -> [] [_] -> useMessage "The following instance partially overlaps the above constraint, which means the rest of its instance chain will not be considered:" _ -> useMessage "The following instances partially overlap the above constraint, which means the rest of their instance chains will not be considered:" - , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation." - | unks - ] - ] + ] <> case unks of + NoUnknowns -> + [] + Unknowns -> + [ line "The instance head contains unknown type variables. Consider adding a type annotation." ] + UnknownsWithVtaRequiringArgs tyClassMembersRequiringVtas -> + let + renderSingleTyClassMember (tyClassMember, argsRequiringVtas) = + Box.moveRight 2 $ paras $ + [ line $ markCode (showQualified showIdent tyClassMember) ] + <> case argsRequiringVtas of + [required] -> + [ Box.moveRight 2 $ line $ T.intercalate ", " required ] + options -> + [ Box.moveRight 2 $ line "One of the following sets of type variables:" + , Box.moveRight 2 $ paras $ + map (\set -> Box.moveRight 2 $ line $ T.intercalate ", " set) options + ] + in + [ paras + [ line "The instance head contains unknown type variables." + , Box.moveDown 1 $ paras $ + [ line $ "Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. " <> markCode "tyClassMember @Int" <> ")."] + <> map renderSingleTyClassMember (NEL.toList tyClassMembersRequiringVtas) + ] + ] renderSimpleErrorMessage (AmbiguousTypeVariables t uis) = paras [ line "The inferred type" , markCodeBox $ indent $ prettyType t @@ -1277,22 +1297,6 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon , indent msg ] - renderSimpleErrorMessage (UnusableDeclaration ident unexplained) = - paras $ - [ line $ "The declaration " <> markCode (showIdent ident) <> " contains arguments that couldn't be determined." - ] <> - - case unexplained of - [required] -> - [ line $ "These arguments are: { " <> T.intercalate ", " required <> " }" - ] - - options -> - [ line "To fix this, one of the following sets of variables must be determined:" - , Box.moveRight 2 . Box.vsep 0 Box.top $ - map (\set -> line $ "{ " <> T.intercalate ", " set <> " }") options - ] - renderSimpleErrorMessage (CannotDefinePrimModules mn) = paras [ line $ "The module name " <> markCode (runModuleName mn) <> " is in the Prim namespace." diff --git a/src/Language/PureScript/Externs.hs b/src/Language/PureScript/Externs.hs index 12838a1bcd..29d15ec8cd 100644 --- a/src/Language/PureScript/Externs.hs +++ b/src/Language/PureScript/Externs.hs @@ -254,7 +254,7 @@ moduleToExternsFile (Module ss _ mn ds (Just exps)) env renamedIdents = ExternsF = [ EDType (coerceProperName className) kind tk , EDType dictName dictKind dictData , EDDataConstructor dctor dty dictName ty args - , EDClass className typeClassArguments typeClassMembers typeClassSuperclasses typeClassDependencies typeClassIsEmpty + , EDClass className typeClassArguments ((\(a, b, _) -> (a, b)) <$> typeClassMembers) typeClassSuperclasses typeClassDependencies typeClassIsEmpty ] toExternsDeclaration (TypeInstanceRef ss' ident ns) = [ EDInstance tcdClassName (lookupRenamedIdent ident) tcdForAll tcdInstanceKinds tcdInstanceTypes tcdDependencies tcdChain tcdIndex ns ss' diff --git a/src/Language/PureScript/Interactive/Printer.hs b/src/Language/PureScript/Interactive/Printer.hs index cd0b8f58f3..ed2d145219 100644 --- a/src/Language/PureScript/Interactive/Printer.hs +++ b/src/Language/PureScript/Interactive/Printer.hs @@ -69,7 +69,7 @@ printModuleSignatures moduleName P.Environment{..} = textT (P.runProperName name) Box.<> textT (foldMap ((" " <>) . fst) typeClassArguments) classBody = - Box.vcat Box.top (map (\(i, t) -> textT (P.showIdent i <> " ::") Box.<+> P.typeAsBox maxBound t) typeClassMembers) + Box.vcat Box.top (map (\(i, t, _) -> textT (P.showIdent i <> " ::") Box.<+> P.typeAsBox maxBound t) typeClassMembers) in Just $ diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs index ae70919b5f..4f3129baf8 100644 --- a/src/Language/PureScript/Sugar/TypeClasses.hs +++ b/src/Language/PureScript/Sugar/TypeClasses.hs @@ -305,7 +305,7 @@ typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration (TypeDeclarati in ValueDecl sa ident Private [] [MkUnguarded ( TypedValue False (Abs (VarBinder ss dictIdent) (Case [Var ss $ Qualified ByNullSourcePos dictIdent] [CaseAlternative [ctor] [MkUnguarded acsr]])) $ - addVisibility visibility (moveQuantifiersToFront (quantify (srcConstrainedType (srcConstraint className [] (map (srcTypeVar . fst) args) Nothing) ty))) + addVisibility visibility (moveQuantifiersToFront NullSourceAnn (quantify (srcConstrainedType (srcConstraint className [] (map (srcTypeVar . fst) args) Nothing) ty))) )] typeClassMemberToDictionaryAccessor _ _ _ _ = internalError "Invalid declaration in type class definition" @@ -333,7 +333,7 @@ typeInstanceDictionaryDeclaration sa@(ss, _) name mn deps className tys decls = M.lookup (qualify mn className) m -- Replace the type arguments with the appropriate types in the member types - let memberTypes = map (second (replaceAllTypeVars (zip (map fst typeClassArguments) tys))) typeClassMembers + let memberTypes = map (second (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) . tuple3To2) typeClassMembers let declaredMembers = S.fromList $ mapMaybe declIdent decls @@ -386,3 +386,6 @@ superClassDictionaryNames supers = [ superclassName pn index | (index, Constraint _ pn _ _ _) <- zip [0..] supers ] + +tuple3To2 :: (a, b, c) -> (a, b) +tuple3To2 (a, b, _) = (a, b) diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index 3030750db2..479a01f012 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -18,7 +18,7 @@ import Control.Monad.Supply.Class (MonadSupply) import Control.Monad.Writer.Class (MonadWriter, tell) import Data.Foldable (for_, traverse_, toList) -import Data.List (nub, nubBy, (\\), sort, group) +import Data.List (nubBy, (\\), sort, group) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Either (partitionEithers) import Data.Text (Text) @@ -45,7 +45,7 @@ import Language.PureScript.TypeChecker.Synonyms as T import Language.PureScript.TypeChecker.Types as T import Language.PureScript.TypeChecker.Unify (varIfUnknown) import Language.PureScript.TypeClassDictionaries (NamedDict, TypeClassDictionaryInScope(..)) -import Language.PureScript.Types (Constraint(..), SourceConstraint, SourceType, Type(..), containsForAll, eqType, everythingOnTypes, freeTypeVariables, overConstraintArgs, srcInstanceType, unapplyTypes) +import Language.PureScript.Types (Constraint(..), SourceConstraint, SourceType, Type(..), containsForAll, eqType, everythingOnTypes, overConstraintArgs, srcInstanceType, unapplyTypes) addDataType :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) @@ -161,7 +161,6 @@ addTypeClass _ qualifiedClassName args implies dependencies ds kind = do hasSig = qualName `M.member` types env unless (hasSig || not (containsForAll kind)) $ do tell . errorMessage $ MissingKindDeclaration ClassSig (disqualify qualName) kind - traverse_ (checkMemberIsUsable newClass (typeSynonyms env) (types env)) classMembers putEnv $ env { types = M.insert qualName (kind, ExternData (nominalRolesForKind kind)) (types env) , typeClasses = M.insert qualifiedClassName newClass (typeClasses env) } where @@ -179,30 +178,9 @@ addTypeClass _ qualifiedClassName args implies dependencies ds kind = do Just tcd -> tcd Nothing -> internalError "Unknown super class in TypeClassDeclaration" - coveringSets :: TypeClassData -> [S.Set Int] - coveringSets = S.toList . typeClassCoveringSets - - argToIndex :: Text -> Maybe Int - argToIndex = flip M.lookup $ M.fromList (zipWith ((,) . fst) args [0..]) - toPair (TypeDeclaration (TypeDeclarationData _ ident ty)) = (ident, ty) toPair _ = internalError "Invalid declaration in TypeClassDeclaration" - -- Currently we are only checking usability based on the type class currently - -- being defined. If the mentioned arguments don't include a covering set, - -- then we won't be able to find a instance. - checkMemberIsUsable :: TypeClassData -> T.SynonymMap -> T.KindMap -> (Ident, SourceType) -> m () - checkMemberIsUsable newClass syns kinds (ident, memberTy) = do - memberTy' <- T.replaceAllTypeSynonymsM syns kinds memberTy - let mentionedArgIndexes = S.fromList (mapMaybe argToIndex (freeTypeVariables memberTy')) - let leftovers = map (`S.difference` mentionedArgIndexes) (coveringSets newClass) - - unless (any null leftovers) . throwError . errorMessage $ - let - solutions = map (map (fst . (args !!)) . S.toList) leftovers - in - UnusableDeclaration ident (nub solutions) - addTypeClassDictionaries :: (MonadState CheckState m) => QualifiedBy diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index 74d70a3aa7..7a3872c1c8 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -11,7 +11,7 @@ module Language.PureScript.TypeChecker.Entailment ) where import Prelude -import Protolude (ordNub) +import Protolude (ordNub, headMay) import Control.Arrow (second, (&&&)) import Control.Monad.Error.Class (MonadError(..)) @@ -22,7 +22,7 @@ import Control.Monad.Writer (Any(..), MonadWriter(..), WriterT(..)) import Data.Either (lefts, partitionEithers) import Data.Foldable (for_, fold, toList) import Data.Function (on) -import Data.Functor (($>)) +import Data.Functor (($>), (<&>)) import Data.List (delete, findIndices, minimumBy, nubBy, sortOn, tails) import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe) import Data.Map qualified as M @@ -33,7 +33,8 @@ import Data.Text qualified as T import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty qualified as NEL -import Language.PureScript.AST (Binder(..), ErrorMessageHint(..), Expr(..), Literal(..), pattern NullSourceSpan, everywhereOnValuesTopDownM, nullSourceSpan) +import Language.PureScript.AST (Binder(..), ErrorMessageHint(..), Expr(..), Literal(..), pattern NullSourceSpan, everywhereOnValuesTopDownM, nullSourceSpan, everythingOnValues) +import Language.PureScript.AST.Declarations (UnknownsHint(..)) import Language.PureScript.Crash (internalError) import Language.PureScript.Environment (Environment(..), FunctionalDependency(..), TypeClassData(..), dictTypeName, kindRow, tyBoolean, tyInt, tyString) import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, addHints, errorMessage, rethrow) @@ -250,9 +251,11 @@ entails SolverOptions{..} constraint context hints = env <- lift . lift $ gets checkEnv let classesInScope = typeClasses env TypeClassData - { typeClassDependencies + { typeClassArguments + , typeClassDependencies , typeClassIsEmpty , typeClassCoveringSets + , typeClassMembers } <- case M.lookup className' classesInScope of Nothing -> throwError . errorMessage $ UnknownClass className' Just tcd -> pure tcd @@ -276,7 +279,9 @@ entails SolverOptions{..} constraint context hints = else Left (Left (tcdToInstanceDescription tcd)) -- can't continue with this chain yet, need proof of apartness lefts [found] - solution <- lift . lift $ unique kinds'' tys'' ambiguous instances (unknownsInAllCoveringSets tys'' typeClassCoveringSets) + solution <- lift . lift + $ unique kinds'' tys'' ambiguous instances + $ unknownsInAllCoveringSets (fst . (typeClassArguments !!)) typeClassMembers tys'' typeClassCoveringSets case solution of Solved substs tcd -> do -- Note that we solved something. @@ -354,7 +359,7 @@ entails SolverOptions{..} constraint context hints = (substituteType currentSubst . replaceAllTypeVars (M.toList subst) $ instKind) (substituteType currentSubst tyKind) - unique :: [SourceType] -> [SourceType] -> [Qualified (Either SourceType Ident)] -> [(a, TypeClassDict)] -> Bool -> m (EntailsResult a) + unique :: [SourceType] -> [SourceType] -> [Qualified (Either SourceType Ident)] -> [(a, TypeClassDict)] -> UnknownsHint -> m (EntailsResult a) unique kindArgs tyArgs ambiguous [] unks | solverDeferErrors = return Deferred -- We need a special case for nullary type classes, since we want @@ -421,9 +426,42 @@ entails SolverOptions{..} constraint context hints = let fields = [ ("reflectType", Abs (VarBinder nullSourceSpan UnusedIdent) (asExpression ref)) ] in pure $ App (Constructor nullSourceSpan (coerceProperName . dictTypeName <$> C.Reflectable)) (Literal nullSourceSpan (ObjectLiteral fields)) - unknownsInAllCoveringSets :: [SourceType] -> S.Set (S.Set Int) -> Bool - unknownsInAllCoveringSets tyArgs = all (\s -> any (`S.member` s) unkIndices) - where unkIndices = findIndices containsUnknowns tyArgs + unknownsInAllCoveringSets :: (Int -> Text) -> [(Ident, SourceType, Maybe (S.Set (NEL.NonEmpty Int)))] -> [SourceType] -> S.Set (S.Set Int) -> UnknownsHint + unknownsInAllCoveringSets indexToArgText tyClassMembers tyArgs coveringSets = do + let unkIndices = findIndices containsUnknowns tyArgs + if all (\s -> any (`S.member` s) unkIndices) coveringSets then + fromMaybe Unknowns unknownsRequiringVtas + else + NoUnknowns + where + unknownsRequiringVtas = do + tyClassModuleName <- getQual className' + let + tyClassMemberVta :: M.Map (Qualified Ident) [[Text]] + tyClassMemberVta = M.fromList $ mapMaybe qualifyAndFilter tyClassMembers + where + -- Only keep type class members that need VTAs to resolve their type class instances + qualifyAndFilter (ident, _, mbVtaRequiredArgs) = mbVtaRequiredArgs <&> \vtaRequiredArgs -> + (Qualified (ByModuleName tyClassModuleName) ident, map (map indexToArgText . NEL.toList) $ S.toList vtaRequiredArgs) + + tyClassMembersInExpr :: Expr -> [(Qualified Ident, [[Text]])] + tyClassMembersInExpr = getVars + where + (_, getVars, _, _, _) = everythingOnValues (++) ignore getVarIdents ignore ignore ignore + ignore = const [] + getVarIdents = \case + Var _ ident | Just vtas <- M.lookup ident tyClassMemberVta -> + [(ident, vtas)] + _ -> + [] + + getECTExpr = \case + ErrorCheckingType expr _ -> Just expr + _ -> Nothing + + tyClassMembers' <- headMay $ mapMaybe (fmap tyClassMembersInExpr . getECTExpr) hints + membersWithVtas <- NEL.nonEmpty tyClassMembers' + pure $ UnknownsWithVtaRequiringArgs membersWithVtas -- Turn a DictionaryValue into a Expr subclassDictionaryValue :: Expr -> Qualified (ProperName 'ClassName) -> Integer -> Expr diff --git a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs index c8abb597c8..8abaac31ca 100644 --- a/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +++ b/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs @@ -37,7 +37,7 @@ import Data.Set qualified as S import Language.PureScript.Crash (internalError) import Language.PureScript.Environment (DataDeclType(..), Environment(..), TypeKind(..), unapplyKinds) -import Language.PureScript.Errors (DeclarationRef(..), ErrorMessageHint(..), ExportSource, ImportDeclarationType(..), MultipleErrors, SimpleErrorMessage(..), SourceAnn, errorMessage) +import Language.PureScript.Errors (DeclarationRef(..), ErrorMessageHint(..), ExportSource, ImportDeclarationType(..), MultipleErrors, SimpleErrorMessage(..), SourceAnn, errorMessage, UnknownsHint(..)) import Language.PureScript.Names (ModuleName, ProperName, ProperNameType(..), Qualified(..), byMaybeModuleName, toMaybeModuleName) import Language.PureScript.TypeChecker.Kinds (elaborateKind, freshKindWithKind, unifyKinds') import Language.PureScript.TypeChecker.Monad (CheckState(..)) @@ -531,7 +531,8 @@ insoluble k a b = -- "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]) + errorMessage $ NoInstanceFound (srcConstraint Prim.Coercible [k] [a, b] Nothing) [] + $ if any containsUnknowns [a, b] then Unknowns else NoUnknowns -- | Constraints of the form @Coercible a b@ can be solved if the two arguments -- are the same. Since we currently don't support higher-rank arguments in diff --git a/src/Language/PureScript/TypeChecker/Synonyms.hs b/src/Language/PureScript/TypeChecker/Synonyms.hs index dc7b0522d4..567ae415ef 100644 --- a/src/Language/PureScript/TypeChecker/Synonyms.hs +++ b/src/Language/PureScript/TypeChecker/Synonyms.hs @@ -7,7 +7,6 @@ module Language.PureScript.TypeChecker.Synonyms ( SynonymMap , KindMap , replaceAllTypeSynonyms - , replaceAllTypeSynonymsM ) where import Prelude @@ -61,12 +60,3 @@ replaceAllTypeSynonyms :: (e ~ MultipleErrors, MonadState CheckState m, MonadErr replaceAllTypeSynonyms d = do env <- getEnv either throwError return $ replaceAllTypeSynonyms' (typeSynonyms env) (types env) d - --- | Replace fully applied type synonyms by explicitly providing a 'SynonymMap'. -replaceAllTypeSynonymsM - :: MonadError MultipleErrors m - => SynonymMap - -> KindMap - -> SourceType - -> m SourceType -replaceAllTypeSynonymsM syns kinds = either throwError pure . replaceAllTypeSynonyms' syns kinds diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs index ad5e207882..ef00e21a07 100644 --- a/src/Language/PureScript/Types.hs +++ b/src/Language/PureScript/Types.hs @@ -4,7 +4,7 @@ module Language.PureScript.Types where import Prelude -import Protolude (ordNub) +import Protolude (ordNub, fromMaybe) import Codec.Serialise (Serialise) import Control.Applicative ((<|>)) @@ -18,7 +18,7 @@ import Data.Aeson.Types qualified as A import Data.Foldable (fold, foldl') import Data.IntSet qualified as IS import Data.List (sortOn) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (isJust) import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic) @@ -530,7 +530,7 @@ replaceAllTypeVars = go [] where go bs m (ForAll ann vis v mbK t sco) | v `elem` keys = go bs (filter ((/= v) . fst) m) $ ForAll ann vis v mbK' t sco | v `elem` usedVars = - let v' = genName v (keys ++ bs ++ usedVars) + let v' = genPureName v (keys ++ bs ++ usedVars) t' = go bs [(v, TypeVar ann v')] t in ForAll ann vis v' mbK' (go (v' : bs) m t') sco | otherwise = ForAll ann vis v mbK' (go (v : bs) m t) sco @@ -545,10 +545,12 @@ replaceAllTypeVars = go [] where go bs m (ParensInType ann t) = ParensInType ann (go bs m t) go _ _ ty = ty - genName orig inUse = try' 0 where - try' :: Integer -> Text - try' n | (orig <> T.pack (show n)) `elem` inUse = try' (n + 1) - | otherwise = orig <> T.pack (show n) +genPureName :: Text -> [Text] -> Text +genPureName orig inUse = try' 0 + where + try' :: Integer -> Text + try' n | (orig <> T.pack (show n)) `elem` inUse = try' (n + 1) + | otherwise = orig <> T.pack (show n) -- | Add visible type abstractions to top-level foralls. addVisibility :: [(Text, TypeVarVisibility)] -> Type a -> Type a @@ -597,11 +599,24 @@ quantify :: Type a -> Type a quantify ty = foldr (\arg t -> ForAll (getAnnForType ty) TypeVarInvisible arg Nothing t Nothing) ty $ freeTypeVariables ty -- | Move all universal quantifiers to the front of a type -moveQuantifiersToFront :: Type a -> Type a -moveQuantifiersToFront = go [] [] where - go qs cs (ForAll ann vis q mbK ty sco) = go ((ann, q, sco, mbK, vis) : qs) cs ty - go qs cs (ConstrainedType ann c ty) = go qs ((ann, c) : cs) ty - go qs cs ty = foldl (\ty' (ann, q, sco, mbK, vis) -> ForAll ann vis q mbK ty' sco) (foldl (\ty' (ann, c) -> ConstrainedType ann c ty') ty cs) qs +moveQuantifiersToFront :: a -> Type a -> Type a +moveQuantifiersToFront syntheticAnn = go [] [] + where + go qs cs = \case + ForAll ann vis q mbK ty sco -> do + let + cArgs :: [Text] = cs >>= constraintArgs . snd >>= freeTypeVariables + (q'', ty') + | q `elem` cArgs = do + let q' = genPureName q $ cArgs <> freeTypeVariables ty + (q', replaceTypeVars q (TypeVar syntheticAnn q') ty) + | otherwise = + (q, ty) + go ((ann, q'', sco, mbK, vis) : qs) cs ty' + ConstrainedType ann c ty -> + go qs ((ann, c) : cs) ty + ty -> + foldl (\ty' (ann, q, sco, mbK, vis) -> ForAll ann vis q mbK ty' sco) (foldl (\ty' (ann, c) -> ConstrainedType ann c ty') ty cs) qs -- | Check if a type contains `forall` containsForAll :: Type a -> Bool diff --git a/tests/purs/failing/ClassHeadNoVTA1.out b/tests/purs/failing/ClassHeadNoVTA1.out new file mode 100644 index 0000000000..dc5cde2c6d --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA1.out @@ -0,0 +1,25 @@ +Error found: +in module Main +at tests/purs/failing/ClassHeadNoVTA1.purs:8:10 - 8:19 (line 8, column 10 - line 8, column 19) + + No type class instance was found for +   +  Main.Single t0 +   + The instance head contains unknown type variables. + + Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. tyClassMember @Int). + Main.useSingle + tyNotAppearInBody + +while checking that type forall (t12 :: Type) (@tyNotAppearInBody :: t12). Single @t12 tyNotAppearInBody => Int + is at least as general as type Int +while checking that expression useSingle + has type Int +in value declaration single + +where t0 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA1.purs b/tests/purs/failing/ClassHeadNoVTA1.purs new file mode 100644 index 0000000000..0c297337b8 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA1.purs @@ -0,0 +1,8 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +class Single tyNotAppearInBody where + useSingle :: Int + +single :: Int +single = useSingle diff --git a/tests/purs/failing/ClassHeadNoVTA2.out b/tests/purs/failing/ClassHeadNoVTA2.out new file mode 100644 index 0000000000..c0d5fd94c1 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA2.out @@ -0,0 +1,27 @@ +Error found: +in module Main +at tests/purs/failing/ClassHeadNoVTA2.purs:10:9 - 10:17 (line 10, column 9 - line 10, column 17) + + No type class instance was found for +   +  Main.Multi t0 +  t1 +   + The instance head contains unknown type variables. + + Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. tyClassMember @Int). + Main.useMulti + tyNotAppearInBody, norThisOne + +while checking that type forall (t20 :: Type) (t21 :: Type) (@tyNotAppearInBody :: t20) (@norThisOne :: t21). Multi @t20 @t21 tyNotAppearInBody norThisOne => Int + is at least as general as type Int +while checking that expression useMulti + has type Int +in value declaration multi + +where t0 is an unknown type + t1 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA2.purs b/tests/purs/failing/ClassHeadNoVTA2.purs new file mode 100644 index 0000000000..8efba3f771 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA2.purs @@ -0,0 +1,11 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +import Prelude + +class Multi tyNotAppearInBody norThisOne where + useMulti :: Int + +multi :: Int +multi = useMulti + diff --git a/tests/purs/failing/ClassHeadNoVTA3.out b/tests/purs/failing/ClassHeadNoVTA3.out new file mode 100644 index 0000000000..7e8edd3209 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA3.out @@ -0,0 +1,28 @@ +Error found: +in module Main +at tests/purs/failing/ClassHeadNoVTA3.purs:8:16 - 8:36 (line 8, column 16 - line 8, column 36) + + No type class instance was found for +   +  Main.MultiMissing Int +  t2  +   + The instance head contains unknown type variables. + + Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. tyClassMember @Int). + Main.useMultiMissing + tyNotAppearInBody, norThisOne + +while checking that type forall (@norThisOne :: t0). MultiMissing @t1 @t0 Int norThisOne => Int + is at least as general as type Int +while checking that expression useMultiMissing + has type Int +in value declaration multiMissing + +where t1 is an unknown type + t0 is an unknown type + t2 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA3.purs b/tests/purs/failing/ClassHeadNoVTA3.purs new file mode 100644 index 0000000000..00179dd9b5 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA3.purs @@ -0,0 +1,9 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +class MultiMissing tyNotAppearInBody norThisOne where + useMultiMissing :: Int + +multiMissing :: Int +multiMissing = useMultiMissing @Int + diff --git a/tests/purs/failing/ClassHeadNoVTA4.out b/tests/purs/failing/ClassHeadNoVTA4.out new file mode 100644 index 0000000000..010993f201 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA4.out @@ -0,0 +1,27 @@ +Error found: +in module Main +at tests/purs/failing/ClassHeadNoVTA4.purs:8:11 - 8:21 (line 8, column 11 - line 8, column 21) + + No type class instance was found for +   +  Main.MultiFd t0 +  t1 +   + The instance head contains unknown type variables. + + Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. tyClassMember @Int). + Main.useMultiFd + tyNotAppearInBody + +while checking that type forall (t20 :: Type) (t21 :: Type) (@tyNotAppearInBody :: t20) (@norThisOne :: t21). MultiFd @t20 @t21 tyNotAppearInBody norThisOne => Int + is at least as general as type Int +while checking that expression useMultiFd + has type Int +in value declaration multiFd + +where t0 is an unknown type + t1 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA4.purs b/tests/purs/failing/ClassHeadNoVTA4.purs new file mode 100644 index 0000000000..f0444af0c6 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA4.purs @@ -0,0 +1,8 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +class MultiFd tyNotAppearInBody norThisOne | tyNotAppearInBody -> norThisOne where + useMultiFd :: Int + +multiFd :: Int +multiFd = useMultiFd diff --git a/tests/purs/failing/ClassHeadNoVTA5.out b/tests/purs/failing/ClassHeadNoVTA5.out new file mode 100644 index 0000000000..cfe69013dd --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA5.out @@ -0,0 +1,29 @@ +Error found: +in module Main +at tests/purs/failing/ClassHeadNoVTA5.purs:10:15 - 10:29 (line 10, column 15 - line 10, column 29) + + No type class instance was found for +   +  Main.MultiFdBidi t0 +  t1 +   + The instance head contains unknown type variables. + + Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. tyClassMember @Int). + Main.useMultiFdBidi + One of the following sets of type variables: + tyNotAppearInBody + norThisOne + +while checking that type forall (t20 :: Type) (t21 :: Type) (@tyNotAppearInBody :: t20) (@norThisOne :: t21). MultiFdBidi @t20 @t21 tyNotAppearInBody norThisOne => Int + is at least as general as type Int +while checking that expression useMultiFdBidi + has type Int +in value declaration multiFdBidi + +where t0 is an unknown type + t1 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA5.purs b/tests/purs/failing/ClassHeadNoVTA5.purs new file mode 100644 index 0000000000..421b2c8590 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA5.purs @@ -0,0 +1,10 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +-- Verify that args in output match order defined here: +-- `tyNotAppearInBody` appears before `norThisOne` +class MultiFdBidi tyNotAppearInBody norThisOne | tyNotAppearInBody -> norThisOne, norThisOne -> tyNotAppearInBody where + useMultiFdBidi :: Int + +multiFdBidi :: Int +multiFdBidi = useMultiFdBidi diff --git a/tests/purs/failing/ClassHeadNoVTA6a.out b/tests/purs/failing/ClassHeadNoVTA6a.out new file mode 100644 index 0000000000..9827276902 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA6a.out @@ -0,0 +1,37 @@ +Error found: +in module Main +at tests/purs/failing/ClassHeadNoVTA6a.purs:12:15 - 12:25 (line 12, column 15 - line 12, column 25) + + No type class instance was found for +   +  Main.MultiCoveringSets t0 +  t1 +  t2 +  t3 +  t4 +  t5 +   + The instance head contains unknown type variables. + + Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. tyClassMember @Int). + Main.noneOfSets + One of the following sets of type variables: + a, b + e, f + +while checking that type forall (t82 :: Type) (t83 :: Type) (@a :: Type) (@b :: t82) (@c :: Type) (@d :: Type) (@e :: t83) (@f :: Type). MultiCoveringSets @t82 @t83 a b c d e f => Int + is at least as general as type Int +while checking that expression noneOfSets + has type Int +in value declaration noneOfSets' + +where t0 is an unknown type + t1 is an unknown type + t2 is an unknown type + t3 is an unknown type + t4 is an unknown type + t5 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA6a.purs b/tests/purs/failing/ClassHeadNoVTA6a.purs new file mode 100644 index 0000000000..b3aef76875 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA6a.purs @@ -0,0 +1,12 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +class MultiCoveringSets a b c d e f | a b -> c d e f, f e -> a b c d where + noneOfSets :: Int + + partialOfABSet :: a -> { c :: c, d :: d } + + partialOfFESet :: f -> { c :: c, d :: d } + +noneOfSets' :: Int +noneOfSets' = noneOfSets diff --git a/tests/purs/failing/ClassHeadNoVTA6b.out b/tests/purs/failing/ClassHeadNoVTA6b.out new file mode 100644 index 0000000000..ea4034dc77 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA6b.out @@ -0,0 +1,50 @@ +Error found: +in module Main +at tests/purs/failing/ClassHeadNoVTA6b.purs:16:19 - 16:33 (line 16, column 19 - line 16, column 33) + + No type class instance was found for +   +  Main.MultiCoveringSets a0 +  t3 +  c1 +  d2 +  t4 +  t5 +   + The instance head contains unknown type variables. + + Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. tyClassMember @Int). + Main.partialOfABSet + One of the following sets of type variables: + b + e, f + +while checking that type forall (t70 :: Type) (t71 :: Type) (@a :: Type) (@b :: t70) (@c :: Type) (@d :: Type) (@e :: t71) (@f :: Type). +  MultiCoveringSets @t70 @t71 a b c d e f => a  +  -> { c :: c  +  , d :: d  +  }  + is at least as general as type a0  + -> { c :: c1 +  , d :: d2 +  }  +while checking that expression partialOfABSet + has type a0  + -> { c :: c1 +  , d :: d2 +  }  +in value declaration partialOfABSet' + +where a0 is a rigid type variable + bound at (line 16, column 19 - line 16, column 33) + c1 is a rigid type variable + bound at (line 16, column 19 - line 16, column 33) + d2 is a rigid type variable + bound at (line 16, column 19 - line 16, column 33) + t3 is an unknown type + t4 is an unknown type + t5 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA6b.purs b/tests/purs/failing/ClassHeadNoVTA6b.purs new file mode 100644 index 0000000000..3da5823d0d --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA6b.purs @@ -0,0 +1,16 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +class MultiCoveringSets a b c d e f | a b -> c d e f, f e -> a b c d where + noneOfSets :: Int + + partialOfABSet :: a -> { c :: c, d :: d } + + partialOfFESet :: f -> { c :: c, d :: d } + +partialOfABSet' + :: forall a b c d e f + . MultiCoveringSets a b c d e f + => a + -> { c :: c, d :: d } +partialOfABSet' = partialOfABSet diff --git a/tests/purs/failing/ClassHeadNoVTA6c.out b/tests/purs/failing/ClassHeadNoVTA6c.out new file mode 100644 index 0000000000..b8e3d95daf --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA6c.out @@ -0,0 +1,50 @@ +Error found: +in module Main +at tests/purs/failing/ClassHeadNoVTA6c.purs:16:19 - 16:33 (line 16, column 19 - line 16, column 33) + + No type class instance was found for +   +  Main.MultiCoveringSets t3 +  t4 +  c1 +  d2 +  t5 +  f0 +   + The instance head contains unknown type variables. + + Note: The following type class members found in the expression require visible type applications to be unambiguous (e.g. tyClassMember @Int). + Main.partialOfFESet + One of the following sets of type variables: + a, b + e + +while checking that type forall (t58 :: Type) (t59 :: Type) (@a :: Type) (@b :: t58) (@c :: Type) (@d :: Type) (@e :: t59) (@f :: Type). +  MultiCoveringSets @t58 @t59 a b c d e f => f  +  -> { c :: c  +  , d :: d  +  }  + is at least as general as type f0  + -> { c :: c1 +  , d :: d2 +  }  +while checking that expression partialOfFESet + has type f0  + -> { c :: c1 +  , d :: d2 +  }  +in value declaration partialOfFESet' + +where c1 is a rigid type variable + bound at (line 16, column 19 - line 16, column 33) + d2 is a rigid type variable + bound at (line 16, column 19 - line 16, column 33) + f0 is a rigid type variable + bound at (line 16, column 19 - line 16, column 33) + t3 is an unknown type + t4 is an unknown type + t5 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA6c.purs b/tests/purs/failing/ClassHeadNoVTA6c.purs new file mode 100644 index 0000000000..9d6710d26f --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA6c.purs @@ -0,0 +1,16 @@ +-- @shouldFailWith NoInstanceFound +module Main where + +class MultiCoveringSets a b c d e f | a b -> c d e f, f e -> a b c d where + noneOfSets :: Int + + partialOfABSet :: a -> { c :: c, d :: d } + + partialOfFESet :: f -> { c :: c, d :: d } + +partialOfFESet' + :: forall a b c d e f + . MultiCoveringSets a b c d e f + => f + -> { c :: c, d :: d } +partialOfFESet' = partialOfFESet diff --git a/tests/purs/failing/ClassHeadNoVTA7.out b/tests/purs/failing/ClassHeadNoVTA7.out new file mode 100644 index 0000000000..b44c3e8f44 --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA7.out @@ -0,0 +1,25 @@ +Error found: +in module ClassHeadNoVTA7 +at tests/purs/failing/ClassHeadNoVTA7.purs:12:8 - 12:26 (line 12, column 8 - line 12, column 26) + + No type class instance was found for +   +  ClassHeadNoVTA7.TestClass t1 +  t2 +   + The instance head contains unknown type variables. Consider adding a type annotation. + +while applying a function testMethod + of type TestClass @t0 t1 t2 => Maybe t1 -> Int + to argument Nothing +while checking that expression testMethod Nothing + has type Int +in value declaration test + +where t0 is an unknown type + t1 is an unknown type + t2 is an unknown type + +See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/ClassHeadNoVTA7.purs b/tests/purs/failing/ClassHeadNoVTA7.purs new file mode 100644 index 0000000000..d492ce722d --- /dev/null +++ b/tests/purs/failing/ClassHeadNoVTA7.purs @@ -0,0 +1,12 @@ +-- @shouldFailWith NoInstanceFound +module ClassHeadNoVTA7 where + +import Prelude + +import Data.Maybe (Maybe(..)) + +class TestClass a b | a -> b, b -> a where + testMethod :: Maybe a -> Int + +test :: Int +test = testMethod Nothing diff --git a/tests/purs/failing/TypedHole.out b/tests/purs/failing/TypedHole.out index 8cc1bcb38b..f502390e07 100644 --- a/tests/purs/failing/TypedHole.out +++ b/tests/purs/failing/TypedHole.out @@ -7,12 +7,14 @@ at tests/purs/failing/TypedHole.purs:8:8 - 8:13 (line 8, column 8 - line 8, colu  Effect Unit   You could substitute the hole with one of these values: -   -  Data.Monoid.mempty :: forall @m. Monoid m => m  -  Effect.Class.Console.clear :: forall m. MonadEffect m => m Unit -  Effect.Console.clear :: Effect Unit  -  Main.main :: Effect Unit  -   +   +  Data.Monoid.mempty :: forall @m. Monoid m => m  +  Effect.Class.Console.clear :: forall m. MonadEffect m => m Unit +  Effect.Class.Console.groupEnd :: forall m. MonadEffect m => m Unit +  Effect.Console.clear :: Effect Unit  +  Effect.Console.groupEnd :: Effect Unit  +  Main.main :: Effect Unit  +   in value declaration main diff --git a/tests/purs/failing/UnusableTypeClassMethod.out b/tests/purs/failing/UnusableTypeClassMethod.out deleted file mode 100644 index 62924705dd..0000000000 --- a/tests/purs/failing/UnusableTypeClassMethod.out +++ /dev/null @@ -1,12 +0,0 @@ -Error found: -in module Main -at tests/purs/failing/UnusableTypeClassMethod.purs:4:1 - 6:9 (line 4, column 1 - line 6, column 9) - - The declaration c contains arguments that couldn't be determined. - These arguments are: { a } - -in type class declaration for C - -See https://github.com/purescript/documentation/blob/master/errors/UnusableDeclaration.md for more information, -or to contribute content related to this error. - diff --git a/tests/purs/failing/UnusableTypeClassMethod.purs b/tests/purs/failing/UnusableTypeClassMethod.purs deleted file mode 100644 index 058f504338..0000000000 --- a/tests/purs/failing/UnusableTypeClassMethod.purs +++ /dev/null @@ -1,7 +0,0 @@ --- @shouldFailWith UnusableDeclaration -module Main where - -class C a b where - -- type doesn't contain `a`, which is also required to determine an instance - c :: b - diff --git a/tests/purs/failing/UnusableTypeClassMethodConflictingIdent.out b/tests/purs/failing/UnusableTypeClassMethodConflictingIdent.out deleted file mode 100644 index f7acded5fc..0000000000 --- a/tests/purs/failing/UnusableTypeClassMethodConflictingIdent.out +++ /dev/null @@ -1,12 +0,0 @@ -Error found: -in module Main -at tests/purs/failing/UnusableTypeClassMethodConflictingIdent.purs:4:1 - 6:19 (line 4, column 1 - line 6, column 19) - - The declaration c contains arguments that couldn't be determined. - These arguments are: { a } - -in type class declaration for C - -See https://github.com/purescript/documentation/blob/master/errors/UnusableDeclaration.md for more information, -or to contribute content related to this error. - diff --git a/tests/purs/failing/UnusableTypeClassMethodConflictingIdent.purs b/tests/purs/failing/UnusableTypeClassMethodConflictingIdent.purs deleted file mode 100644 index 08ed602ab8..0000000000 --- a/tests/purs/failing/UnusableTypeClassMethodConflictingIdent.purs +++ /dev/null @@ -1,7 +0,0 @@ --- @shouldFailWith UnusableDeclaration -module Main where - -class C a where - -- type doesn't contain the type class var `a` - c :: forall a. a - diff --git a/tests/purs/failing/UnusableTypeClassMethodSynonym.out b/tests/purs/failing/UnusableTypeClassMethodSynonym.out deleted file mode 100644 index 6adb687c04..0000000000 --- a/tests/purs/failing/UnusableTypeClassMethodSynonym.out +++ /dev/null @@ -1,12 +0,0 @@ -Error found: -in module Main -at tests/purs/failing/UnusableTypeClassMethodSynonym.purs:6:1 - 8:11 (line 6, column 1 - line 8, column 11) - - The declaration c contains arguments that couldn't be determined. - These arguments are: { a } - -in type class declaration for C - -See https://github.com/purescript/documentation/blob/master/errors/UnusableDeclaration.md for more information, -or to contribute content related to this error. - diff --git a/tests/purs/failing/UnusableTypeClassMethodSynonym.purs b/tests/purs/failing/UnusableTypeClassMethodSynonym.purs deleted file mode 100644 index aae1e3379c..0000000000 --- a/tests/purs/failing/UnusableTypeClassMethodSynonym.purs +++ /dev/null @@ -1,9 +0,0 @@ --- @shouldFailWith UnusableDeclaration -module Main where - -type M x = forall a. a - -class C a where - -- after synonym expansion, the type doesn't actually contain an `a` - c :: M a - diff --git a/tests/purs/passing/VTAsClassHeads.purs b/tests/purs/passing/VTAsClassHeads.purs new file mode 100644 index 0000000000..a25d7c4564 --- /dev/null +++ b/tests/purs/passing/VTAsClassHeads.purs @@ -0,0 +1,196 @@ +module Main where + +import Prelude +import Data.Array as Array +import Data.Array.NonEmpty as NEA +import Data.Maybe (Maybe(..)) +import Data.Either (Either(..), either) +import Data.Foldable (traverse_) +import Data.Traversable (sequence) +import Effect (Effect) +import Effect.Console (log) + +class Singleton x where + singleton :: String + +instance Singleton Int where + singleton = "int" + +instance Singleton String where + singleton = "string" + +singletonWorks :: Effect (Maybe String) +singletonWorks = do + let + left = singleton @Int + right = singleton @String + pure if left /= right then Nothing else Just "Singleton failed" + +class ConflictingIdent :: Type -> Constraint +class ConflictingIdent a where + -- The `a` in the type below should refer to the `a` + -- introduced by the `forall`, not the class head. + conflictingIdent :: forall a. a -> Int + +instance ConflictingIdent String where + conflictingIdent _ = 1 + +instance ConflictingIdent Int where + conflictingIdent _ = 2 + +conflictingIdentWorks :: Effect (Maybe String) +conflictingIdentWorks = do + pure if (1 == conflictingIdent @String 4) then Nothing else Just "ConflictingIdent failed" + +type M :: Type -> Type +type M x = forall a. a -> Int + +class ConflictingIdentSynonym :: Type -> Constraint +class ConflictingIdentSynonym a where + -- The `a` in the type below should refer to the `a` + -- introduced by the `forall`, not the class head. + conflictingIdentSynonym :: M a + +instance ConflictingIdentSynonym String where + conflictingIdentSynonym _ = 1 + +instance ConflictingIdentSynonym Int where + conflictingIdentSynonym _ = 2 + +conflictingIdentSynonymWorks :: Effect (Maybe String) +conflictingIdentSynonymWorks = do + pure if (1 == conflictingIdentSynonym @String 4) then Nothing else Just "ConflictingIdentSynonym failed" + +class MultiNoFDs a b where + multiNoFds :: Int + +instance MultiNoFDs Int Int where + multiNoFds = 0 + +instance MultiNoFDs String Int where + multiNoFds = 1 + +multiNoFdsWorks :: Effect (Maybe String) +multiNoFdsWorks = do + let + left = multiNoFds @Int @Int + right = multiNoFds @String @Int + pure if left /= right then Nothing else Just "MultiNoFDs failed" + +class MultiWithFDs a b | a -> b where + multiWithFDs :: Int + +instance MultiWithFDs Int Int where + multiWithFDs = 0 + +instance MultiWithFDs String Int where + multiWithFDs = 1 + +multiWithFdsWorks :: Effect (Maybe String) +multiWithFdsWorks = do + let + left = multiWithFDs @Int + right = multiWithFDs @String + pure if left /= right then Nothing else Just "MultiWithFds failed" + +class MultiWithBidiFDs a b | a -> b, b -> a where + multiWithBidiFDs :: Int + +instance MultiWithBidiFDs Int Int where + multiWithBidiFDs = 0 + +instance MultiWithBidiFDs String String where + multiWithBidiFDs = 1 + +multiWithBidiFDsLeftWorks :: Effect (Maybe String) +multiWithBidiFDsLeftWorks = do + let + left = multiWithBidiFDs @Int + right = multiWithBidiFDs @String + pure if left /= right then Nothing else Just "MultiWithFds failed" + +multiWithBidiFDsRightWorks :: Effect (Maybe String) +multiWithBidiFDsRightWorks = do + let + left = multiWithBidiFDs @_ @Int + right = multiWithBidiFDs @_ @String + pure if left /= right then Nothing else Just "MultiWithFds failed" + +class Superclass a where + superClassValue :: a + +class Superclass a <= MainClass a where + mainClassInt :: Int + +data A2 = A2 + +derive instance Eq A2 + +instance Superclass A2 where + superClassValue = A2 + +instance MainClass A2 where + mainClassInt = 0 + +data B2 = B2 + +derive instance Eq B2 + +instance Superclass B2 where + superClassValue = B2 + +instance MainClass B2 where + mainClassInt = 3 + +mainClassWorks :: Effect (Maybe String) +mainClassWorks = do + let + test1 = 0 == mainClassInt @A2 + test2 = A2 == superClassValue @A2 + pure if test1 && test2 then Nothing else Just "MainClass failed" + +class MultiCoveringSets a b c d e f | a b -> c d e f, f e -> a b c d where + noneOfSets :: Int + + partialOfABSet :: a -> { c :: c, d :: d } + + partialOfFESet :: f -> { c :: c, d :: d } + +instance MultiCoveringSets Boolean Boolean String String Int Int where + noneOfSets = 1 + partialOfABSet a = { c: if a then "101" else "100", d: "1" } + partialOfFESet f = { c: show f, d: "1" } + +instance MultiCoveringSets Int Int String String Boolean Boolean where + noneOfSets = 2 + partialOfABSet a = { c: show a, d: "2" } + partialOfFESet f = { c: show f, d: "2" } + +multiCoveringSetsWorks :: Effect (Maybe String) +multiCoveringSetsWorks = do + let + test1a = 1 == noneOfSets @Boolean @Boolean + test1b = "101" == (partialOfABSet @Boolean @Boolean true).c + test1c = show 3 == (partialOfFESet @_ @_ @_ @_ @Int @Int 3).c + test2a = 2 == noneOfSets @_ @_ @_ @_ @Boolean @Boolean + test2b = show 20 == (partialOfABSet @_ @_ @_ @_ @Boolean @Boolean 20).c + test2c = show false == (partialOfFESet @_ @_ @_ @_ @Boolean @Boolean false).c + passes = test1a && test1b && test1c && test2a && test2b && test2c + pure if passes then Nothing else Just "MultiCoveringSets failed" + +main = do + arr' <- sequence + [ singletonWorks + , conflictingIdentWorks + , conflictingIdentSynonymWorks + , multiNoFdsWorks + , multiWithFdsWorks + , multiWithBidiFDsLeftWorks + , multiWithBidiFDsRightWorks + , mainClassWorks + ] + case NEA.fromArray $ Array.catMaybes arr' of + Just errs -> + log $ "Errors..." <> (Array.intercalate "\n" $ NEA.toArray errs) + Nothing -> + log "Done" diff --git a/tests/purs/warning/TypeClassMethodSynonym.out b/tests/purs/warning/TypeClassMethodSynonym.out new file mode 100644 index 0000000000..47bb4c0796 --- /dev/null +++ b/tests/purs/warning/TypeClassMethodSynonym.out @@ -0,0 +1,11 @@ +Warning found: +in module Main +at tests/purs/warning/TypeClassMethodSynonym.purs:8:3 - 8:19 (line 8, column 3 - line 8, column 19) + + Type variable a was shadowed. + +in type declaration for c + +See https://github.com/purescript/documentation/blob/master/errors/ShadowedTypeVar.md for more information, +or to contribute content related to this warning. + diff --git a/tests/purs/warning/TypeClassMethodSynonym.purs b/tests/purs/warning/TypeClassMethodSynonym.purs new file mode 100644 index 0000000000..d290524ecc --- /dev/null +++ b/tests/purs/warning/TypeClassMethodSynonym.purs @@ -0,0 +1,8 @@ +-- @shouldWarnWith ShadowedTypeVar +module Main where + +class C :: Type -> Constraint +class C a where + -- The `a` in the type below should refer to the `a` + -- introduced by the `forall`, not the class head. + c :: forall a. a From 6b49918b9646863e73bbedd1d47f474ba3783408 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Fri, 3 Nov 2023 22:29:17 -0400 Subject: [PATCH 46/68] Drop container ID from CI cache key, use image (#4516) --- .github/workflows/ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 07a3155e80..d88257ed07 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -116,7 +116,7 @@ jobs: path: | /root/.stack ${{ steps.haskell.outputs.stack-root }} - key: "${{ runner.os }}-${{ job.container.id }}-MdyPsf-${{ hashFiles('stack.yaml') }}" + key: "${{ matrix.image || runner.os }}--MdyPsf-${{ hashFiles('stack.yaml') }}" - name: "(Windows only) Configure Stack to store its programs in STACK_ROOT" # This ensures that the local GHC and MSYS binaries that Stack installs @@ -242,7 +242,7 @@ jobs: with: path: | /root/.stack - key: "${{ runner.os }}-${{ job.container.id }}-UnWw0N-lint-${{ hashFiles('stack.yaml') }}" + key: "lint-${{ hashFiles('stack.yaml') }}" - run: "ci/fix-home ci/run-hlint.sh --git" env: From a6feba021f6513b3f2dedc3b20384f6c23ec739a Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Mon, 20 Nov 2023 11:19:20 -0600 Subject: [PATCH 47/68] Prep 0.15.13 (#4520) * Update versions * Regenerate changelog --- .../feature_replace-unused-declarations.md | 71 ----------------- CHANGELOG.md | 76 +++++++++++++++++++ npm-package/package.json | 4 +- purescript.cabal | 2 +- 4 files changed, 79 insertions(+), 74 deletions(-) delete mode 100644 CHANGELOG.d/feature_replace-unused-declarations.md diff --git a/CHANGELOG.d/feature_replace-unused-declarations.md b/CHANGELOG.d/feature_replace-unused-declarations.md deleted file mode 100644 index 4bc3b11273..0000000000 --- a/CHANGELOG.d/feature_replace-unused-declarations.md +++ /dev/null @@ -1,71 +0,0 @@ -* Replace `UnusableDeclaration` with updated `NoInstanceFound` - - Previously, the following type class would be invalid - because there was no way for the compiler to infer - which type class instance to select because - the type variable in the class head `a` was - not mentioned in `bar`'s type signature: - - ```purs - class Foo a where - bar :: Int - ``` - - The recently-added visible type applications (VTAs) - can now be used to guide the compiler in such cases: - - ```purs - class Foo a where bar :: Int - instance Foo String where bar = 0 - someInt = bar @String -- use the `String` instance - ``` - - Without VTAs, the compiler - will still produce an `InstanceNotFound` error, but this error - has been updated to note which type variables in the class head - can only be disambiguated via visible type applications. - Given the following code - - ```purs - class Single tyVarDoesNotAppearInBody where - useSingle :: Int - - single :: Int - single = useSingle - ``` - - The error reported for `useSingle` will be: - - ``` - No type class instance was found for - - Main.Single t0 - - The instance head contains unknown type variables. - - - Note: The following type class members found in the expression require visible type applications - to be unambiguous (e.g. tyClassMember @Int). - Main.useSingle - tyNotAppearInBody - ``` - - For a multiparameter typeclass with functional dependencies... - - ```purs - class MultiFdBidi a b | a -> b, b -> a where - useMultiFdBidi :: Int - - multiFdBidi :: Int - multiFdBidi = useMultiFdBidi - ``` - - ...the "Note" part is updated to read - ``` - Note: The following type class members found in the expression require visible type applications - to be unambiguous (e.g. tyClassMember @Int). - Main.useMultiFdBidi - One of the following sets of type variables: - a - b - ``` diff --git a/CHANGELOG.md b/CHANGELOG.md index 67eae177e8..d8052d14cf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,82 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.13 + +New features: + +* Replace `UnusableDeclaration` with updated `NoInstanceFound` (#4513 by @JordanMartinez) + + Previously, the following type class would be invalid + because there was no way for the compiler to infer + which type class instance to select because + the type variable in the class head `a` was + not mentioned in `bar`'s type signature: + + ```purs + class Foo a where + bar :: Int + ``` + + The recently-added visible type applications (VTAs) + can now be used to guide the compiler in such cases: + + ```purs + class Foo a where bar :: Int + instance Foo String where bar = 0 + someInt = bar @String -- use the `String` instance + ``` + + Without VTAs, the compiler + will still produce an `InstanceNotFound` error, but this error + has been updated to note which type variables in the class head + can only be disambiguated via visible type applications. + Given the following code + + ```purs + class Single tyVarDoesNotAppearInBody where + useSingle :: Int + + single :: Int + single = useSingle + ``` + + The error reported for `useSingle` will be: + + ``` + No type class instance was found for + + Main.Single t0 + + The instance head contains unknown type variables. + + + Note: The following type class members found in the expression require visible type applications + to be unambiguous (e.g. tyClassMember @Int). + Main.useSingle + tyNotAppearInBody + ``` + + For a multiparameter typeclass with functional dependencies... + + ```purs + class MultiFdBidi a b | a -> b, b -> a where + useMultiFdBidi :: Int + + multiFdBidi :: Int + multiFdBidi = useMultiFdBidi + ``` + + ...the "Note" part is updated to read + ``` + Note: The following type class members found in the expression require visible type applications + to be unambiguous (e.g. tyClassMember @Int). + Main.useMultiFdBidi + One of the following sets of type variables: + a + b + ``` + ## 0.15.12 New features: diff --git a/npm-package/package.json b/npm-package/package.json index 9ab1997120..b24866695b 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.12", + "version": "0.15.13", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.12", + "postinstall": "install-purescript --purs-ver=0.15.13", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index bd1595adec..a608c61cac 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.12 +version: 0.15.13 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From a915253de357239e62265953f364460bf22d0328 Mon Sep 17 00:00:00 2001 From: Matt Russell Date: Fri, 24 Nov 2023 03:04:57 -0800 Subject: [PATCH 48/68] Uses strict Map to fix a compile time regression (#4521) For extremely large files (14K lines) with a lot of types and instances memory increases dramatically using Lazy Maps, causing swapping and an big increase in compilation time. Switching to a strict map brings compilation performance close to 15.2 levels. Fixes #4491 --- CHANGELOG.d/fix_compilation_regression-4491.md | 8 ++++++++ CONTRIBUTORS.md | 1 + src/Language/PureScript/CoreFn/CSE.hs | 4 ++-- 3 files changed, 11 insertions(+), 2 deletions(-) create mode 100644 CHANGELOG.d/fix_compilation_regression-4491.md diff --git a/CHANGELOG.d/fix_compilation_regression-4491.md b/CHANGELOG.d/fix_compilation_regression-4491.md new file mode 100644 index 0000000000..a2fbc45f4e --- /dev/null +++ b/CHANGELOG.d/fix_compilation_regression-4491.md @@ -0,0 +1,8 @@ +* Fix a compilation memory regression for very large files + + When compiling a a very large file (>12K lines) + the CSE pass could balloon memory and result in increased + compilation times. + + This fix uses a strict Map instead of a lazy Map to avoid + building up unnecessary thunks during the optimization pass. diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 18d0ad69ac..7213ef9c67 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -102,6 +102,7 @@ If you would prefer to use different terms, please use the section below instead | [@milesfrain](https://github.com/milesfrain) | Miles Frain | [MIT license] | | [@MiracleBlue](https://github.com/MiracleBlue) | Nicholas Kircher | [MIT license] | | [@mjgpy3](https://github.com/mjgpy3) | Michael Gilliland | [MIT license] | +| [@mjrussell](https://github.com/mjrussell) | Matthew Russell | [MIT license] | | [@MonoidMusician](https://github.com/MonoidMusician) | Verity Scheel | [MIT license] | | [@mpietrzak](https://github.com/mpietrzak) | Maciej Pietrzak | [MIT license] | | [@mrhania](https://github.com/mrhania) | Łukasz Hanuszczak | [MIT license] | diff --git a/src/Language/PureScript/CoreFn/CSE.hs b/src/Language/PureScript/CoreFn/CSE.hs index 576243c252..e3e59bddad 100644 --- a/src/Language/PureScript/CoreFn/CSE.hs +++ b/src/Language/PureScript/CoreFn/CSE.hs @@ -12,7 +12,7 @@ import Data.Bitraversable (bitraverse) import Data.Functor.Compose (Compose(..)) import Data.IntMap.Monoidal qualified as IM import Data.IntSet qualified as IS -import Data.Map qualified as M +import Data.Map.Strict qualified as M import Data.Maybe (fromJust) import Data.Semigroup (Min(..)) import Data.Semigroup.Generic (GenericSemigroupMonoid(..)) @@ -216,7 +216,7 @@ newScope isTopLevel body = local goDeeper $ do if isTopLevel then env{ _depth = depth', _deepestTopLevelScope = depth' } else env{ _depth = depth' } - where + where depth' = succ _depth -- | From bff8c575ab7edd669b3d2002e03ee8c5b3ae6967 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Thu, 14 Dec 2023 09:48:36 -0600 Subject: [PATCH 49/68] Fix ty var parsing on class head (#4523) * Fix ty var parsing on class head --- CHANGELOG.d/fix_fix-class-head-ty-var.md | 1 + src/Language/PureScript/CST/Parser.y | 2 +- tests/purs/failing/4522.out | 10 ++++++++++ tests/purs/failing/4522.purs | 4 ++++ 4 files changed, 16 insertions(+), 1 deletion(-) create mode 100644 CHANGELOG.d/fix_fix-class-head-ty-var.md create mode 100644 tests/purs/failing/4522.out create mode 100644 tests/purs/failing/4522.purs diff --git a/CHANGELOG.d/fix_fix-class-head-ty-var.md b/CHANGELOG.d/fix_fix-class-head-ty-var.md new file mode 100644 index 0000000000..12a3f8ab11 --- /dev/null +++ b/CHANGELOG.d/fix_fix-class-head-ty-var.md @@ -0,0 +1 @@ +* Fix parsing bug where `@var` was allowed in type class head \ No newline at end of file diff --git a/src/Language/PureScript/CST/Parser.y b/src/Language/PureScript/CST/Parser.y index edb60d93ec..55aa95da79 100644 --- a/src/Language/PureScript/CST/Parser.y +++ b/src/Language/PureScript/CST/Parser.y @@ -722,7 +722,7 @@ classSuper :: { (OneOrDelimited (Constraint ()), SourceToken) } : constraints '<=' {%^ revert $ pure ($1, $2) } classNameAndFundeps :: { (Name (N.ProperName 'N.ClassName), [TypeVarBinding ()], Maybe (SourceToken, Separated ClassFundep)) } - : properName manyOrEmpty(typeVarBinding) fundeps {%^ revert $ pure (getProperName $1, $2, $3) } + : properName manyOrEmpty(typeVarBindingPlain) fundeps {%^ revert $ pure (getProperName $1, $2, $3) } fundeps :: { Maybe (SourceToken, Separated ClassFundep) } : {- empty -} { Nothing } diff --git a/tests/purs/failing/4522.out b/tests/purs/failing/4522.out new file mode 100644 index 0000000000..75e072315d --- /dev/null +++ b/tests/purs/failing/4522.out @@ -0,0 +1,10 @@ +Error found: +at tests/purs/failing/4522.purs:4:11 - 4:12 (line 4, column 11 - line 4, column 12) + + Unable to parse module: + Unexpected token '@' + + +See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/4522.purs b/tests/purs/failing/4522.purs new file mode 100644 index 0000000000..78fc65f03a --- /dev/null +++ b/tests/purs/failing/4522.purs @@ -0,0 +1,4 @@ +-- @shouldFailWith ErrorParsingModule +module Main where + +class Foo @a \ No newline at end of file From e826bfff901c7b778e1c0457334f980a4ee186fc Mon Sep 17 00:00:00 2001 From: Verity Scheel Date: Tue, 19 Dec 2023 20:04:32 -0600 Subject: [PATCH 50/68] Fix space leak between modules during compilation (#4517) * Fix space leak between modules during compilation For builds with a lot of warnings, memory usage grows drastically since it appears that the thunks for the warnings hang onto a lot of memory from compiling the module itself. The goal of this change is to get memory usage for full builds back in line with partial builds. * Limit concurrent builds to getNumCapabilities This ensures that modules are fully built in one pass, to avoid partial builds being interrupted and holding onto memory in the meantime. * Use Data.Map.Strict in CSE * Add script for traces in eventlog * Add changelog entry --- CHANGELOG.d/fix_module-space-leak.md | 11 + debug/eventlog.js | 215 ++++++++++++++++++++ src/Language/PureScript/AST/Binders.hs | 5 +- src/Language/PureScript/AST/Declarations.hs | 48 ++--- src/Language/PureScript/AST/Literals.hs | 5 +- src/Language/PureScript/Bundle.hs | 11 +- src/Language/PureScript/CST/Errors.hs | 9 +- src/Language/PureScript/CST/Layout.hs | 5 +- src/Language/PureScript/CST/Types.hs | 18 +- src/Language/PureScript/Errors.hs | 18 +- src/Language/PureScript/Externs.hs | 14 +- src/Language/PureScript/Make.hs | 49 +++-- src/Language/PureScript/Make/Monad.hs | 4 +- 13 files changed, 342 insertions(+), 70 deletions(-) create mode 100644 CHANGELOG.d/fix_module-space-leak.md create mode 100644 debug/eventlog.js diff --git a/CHANGELOG.d/fix_module-space-leak.md b/CHANGELOG.d/fix_module-space-leak.md new file mode 100644 index 0000000000..2cb86e8562 --- /dev/null +++ b/CHANGELOG.d/fix_module-space-leak.md @@ -0,0 +1,11 @@ +* Fix two space leaks while compiling many modules + + The first would interleave compilation of too many modules at once, which + would increase memory usage, especially for single threaded builds with + `+RTS -N1 -RTS`. Now the number of concurrent modules is limited to + the number of threads available to the + [GHC runtime system](https://downloads.haskell.org/ghc/latest/docs/users_guide/using-concurrent.html#rts-options-for-smp-parallelism). + + The second would hold on to memory from modules that compiled with warnings + until the end of the build when the warnings were printed and the memory freed. + This is now fixed with additional `NFData` instances. diff --git a/debug/eventlog.js b/debug/eventlog.js new file mode 100644 index 0000000000..43aa4f7221 --- /dev/null +++ b/debug/eventlog.js @@ -0,0 +1,215 @@ +// Debug compilation times of modules from eventlog profiling +// +// Build and run purs with profiling enabled: +// cabal build --enable-profiling +// cabal exec -- purs ...... +// Or with stack: +// stack build --profile +// stack --profile exec -- purs ...... +// Run a command like this to generate purs.eventlog: +// purs +RTS -l-agu -i1.5 -hc -RTS compile -g corefn $(spago sources) +// (If you want accurate stats for individual modules, add -N1.) +// Process it with +// eventlog2html --json purs.eventlog +// node eventlog.js purs.eventlog.json +// +// See the GHC docs for descriptions of the RTS flags: +// - https://downloads.haskell.org/ghc/latest/docs/users_guide/profiling.html#rts-options-for-heap-profiling +// - https://downloads.haskell.org/ghc/latest/docs/users_guide/runtime_control.html#rts-eventlog +// - https://downloads.haskell.org/ghc/latest/docs/users_guide/using-concurrent.html?highlight=threaded#rts-options-for-smp-parallelism +var mainFile = process.argv[2]; +if (!mainFile) throw new Error("Provide a file name"); + +var name_length = 0; + +function summarizeEventlog(filename) { + var eventlog = JSON.parse(require("fs").readFileSync(filename, "utf-8")); + // eventlog.heap + // c: Set(3) { 'Heap Size', 'Live Bytes', 'Blocks Size' } + // eventlog.samples + // eventlog.traces + + var traces = {}; + var minTx = Infinity; + var maxTx = -Infinity; + var maxMem = -Infinity; + var total = 0; + var con = []; + var max_cons = [[]]; + var cursor = 0; + + // I guess some buffering makes it out of order? + eventlog.traces.sort(({tx: tx1}, {tx: tx2}) => tx1 - tx2); + + for (let trace of eventlog.traces) { + var m = /^([\w.]+) (start|end)$/.exec(trace.desc); + if (!m) continue; + var name = m[1]; + if (!(name in traces)) traces[name] = {}; + if (name.length > name_length) name_length = name.length; + var ev = m[2]; + + if (traces[name][ev]) { + if (traces[name].time === 0) { + console.log("Warn: start after end", name, traces[name].start, trace.tx); + } else { + console.log("Warn: duplicate event", trace.desc); + } + continue; + } + + var time = trace.tx; + if (time < minTx) minTx = time; + if (time > maxTx) maxTx = time; + + while (cursor < eventlog.heap.length && eventlog.heap[cursor].x < trace.tx) { + cursor++; + if (eventlog.heap[cursor].c !== 'Heap Size') { + cursor = eventlog.heap.length; + } + } + if (ev === "start") { + traces[name].cursor = cursor; + } + + traces[name][ev] = time; + if (ev === "end" && !("start" in traces[name])) { + console.log("Warn: missing start for", name); + traces[name].start = time; + traces[name].time = 0; + continue; + } + if ("start" in traces[name] && "end" in traces[name]) { + traces[name].time = traces[name].end - traces[name].start; + var mems = eventlog.heap.slice(traces[name].cursor, cursor).map(e => e.y); + var mem_min = Math.min(...mems); + var mem_max = Math.max(...mems); + var maxMem = Math.max(maxMem, mem_max); + Object.assign(traces[name], {mem_min,mem_max}); + total += traces[name].time; + } + + if (ev === "start") con = con.concat([name]); + if (ev === "end") { + var l = con.length; + con = con.filter(n => n !== name); + if (con.length !== l - 1) { + console.log(con, name); + } + } + if (con.length >= max_cons[0].length) { + if (con.length > max_cons[0].length) + max_cons = []; + max_cons.push(con); + } + } + + var timespan = maxTx - minTx; + + return { traces, total, minTx, maxTx, timespan, max_cons, maxMem }; +} + +var mainFiles = process.argv.slice(2); + +if (mainFiles.length > 1) { + for (let file of mainFiles) { + console.log(file); + var { traces, total, timespan, max_cons, maxMem } = summarizeEventlog(file); + if (timespan === -Infinity && total === 0 && max_cons[0].length === 0) continue; + var max_con_time = 0; + var concurrencies = max_cons.map(max_con => { + if (max_con.length !== max_cons[0].length) + throw new Error("max_con length error"); + var modules = max_con.map(name => [name, traces[name]]); + var start = Math.max(...modules.map(([name, {start}]) => start)); + var end = Math.min(...modules.map(([name, {end}]) => end)); + var time = end - start; + max_con_time += time; + return { + modules, + start, + end, + time, + }; + }); + console.log("timespan ", timespan); + console.log("ratio (avg concurrency?) ", total/timespan); + console.log("max concurrency ", max_cons[0].length); + console.log("time at max concurrency (%)", 100*max_con_time/timespan); + console.log("peak heap size ", space(maxMem)); + } + process.exit(0); +} + +var { traces, total, timespan, max_cons } = summarizeEventlog(mainFile); + +var timings = []; +for (let name in traces) { + let trace = traces[name]; + if (!("time" in trace)) { + console.log("Warn: missing timing for", name, trace); + } else if (trace.time > 0) { + timings.push([name, trace.time]); + } +} + +timings.sort(([n1,t1,_1,m1], [n2,t2,_2,m2]) => t1 - t2); + +timings.push(["stats", "-----"]); +timings.push(["total", total]); +timings.push(["timespan", timespan]); +timings.push(["ratio (avg concurrency?)", total/timespan]); +var max_con_time = 0; +var concurrencies = max_cons.map(max_con => { + if (max_con.length !== max_cons[0].length) + throw new Error("max_con length error"); + var modules = max_con.map(name => [name, traces[name]]); + var start = Math.max(...modules.map(([name, {start}]) => start)); + var end = Math.min(...modules.map(([name, {end}]) => end)); + var time = end - start; + max_con_time += time; + return { + modules, + start, + end, + time, + }; +}); +timings.push(["max concurrency", max_cons[0].length]); +timings.push(["time at max concurrency (s)", max_con_time]); +timings.push(["time at max concurrency (%)", 100*max_con_time/timespan]); + +for (let [name, time] of timings) { + // console.log(name.padEnd(name_length, " "), (""+time).substring(0, 5).padStart(5, " ")); + console.log(name.padEnd(name_length, " "), time); +} + +//require("fs").writeFileSync("concurrencies.json", JSON.stringify(concurrencies, null, 2), "utf-8"); + + +function space(v) { + if (!isFinite(v)) return "----"; + if (v === Infinity) return "+Inf"; + if (v === -Infinity) return "-Inf"; + if (v !== v) return " NaN"; + var sizes = [ + [1_000_000_000, "G"], + [1_000_000, "M"], + [1_000, "K"], + [0, ""], + ] + for (let [value, suffix] of sizes) { + if (v < value) continue; + if (!suffix) return (""+v).padStart(4, " "); + var adj = v/value; + var str = ""+adj; + if (adj >= 100) return str.substring(0,3)+suffix; + if (adj >= 10) return " "+str.substring(0,2)+suffix; + return str.substring(0,3)+suffix; + } +} +function signed(fmt, v) { + if (!isFinite(v)) return " "+fmt(v); + if (v < 0) return "-"+fmt(-v); + return "+"+fmt(v); +} diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs index 6d88ff3d97..1f427755f0 100644 --- a/src/Language/PureScript/AST/Binders.hs +++ b/src/Language/PureScript/AST/Binders.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} -- | -- Case binders -- @@ -5,6 +6,8 @@ module Language.PureScript.AST.Binders where import Prelude +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) import Language.PureScript.AST.SourcePos (SourceSpan) import Language.PureScript.AST.Literals (Literal(..)) import Language.PureScript.Names (Ident, OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified) @@ -61,7 +64,7 @@ data Binder -- A binder with a type annotation -- | TypedBinder SourceType Binder - deriving (Show) + deriving (Show, Generic, NFData) -- Manual Eq and Ord instances for `Binder` were added on 2018-03-05. Comparing -- the `SourceSpan` values embedded in some of the data constructors of `Binder` diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs index e6d13c74aa..cf0c83a42d 100644 --- a/src/Language/PureScript/AST/Declarations.hs +++ b/src/Language/PureScript/AST/Declarations.hs @@ -50,7 +50,7 @@ data TypeSearch -- ^ Record fields that are available on the first argument to the typed -- hole } - deriving Show + deriving (Show, Generic, NFData) onTypeSearchTypes :: (SourceType -> SourceType) -> TypeSearch -> TypeSearch onTypeSearchTypes f = runIdentity . onTypeSearchTypesM (Identity . f) @@ -90,7 +90,7 @@ data ErrorMessageHint | MissingConstructorImportForCoercible (Qualified (ProperName 'ConstructorName)) | PositionedError (NEL.NonEmpty SourceSpan) | RelatedPositions (NEL.NonEmpty SourceSpan) - deriving (Show) + deriving (Show, Generic, NFData) -- | Categories of hints data HintCategory @@ -105,14 +105,14 @@ data HintCategory -- | -- In constraint solving, indicates whether there were `TypeUnknown`s that prevented --- an instance from being found, and whether VTAs are required +-- an instance from being found, and whether VTAs are required -- due to type class members not referencing all the type class -- head's type variables. data UnknownsHint = NoUnknowns | Unknowns | UnknownsWithVtaRequiringArgs (NEL.NonEmpty (Qualified Ident, [[Text]])) - deriving (Show) + deriving (Show, Generic, NFData) -- | -- A module declaration, consisting of comments about the module, a module name, @@ -306,7 +306,7 @@ data ImportDeclarationType -- An import with a list of references to hide: `import M hiding (foo)` -- | Hiding [DeclarationRef] - deriving (Eq, Show, Generic, Serialise) + deriving (Eq, Show, Generic, Serialise, NFData) isExplicit :: ImportDeclarationType -> Bool isExplicit (Explicit _) = True @@ -323,7 +323,7 @@ data RoleDeclarationData = RoleDeclarationData { rdeclSourceAnn :: !SourceAnn , rdeclIdent :: !(ProperName 'TypeName) , rdeclRoles :: ![Role] - } deriving (Show, Eq) + } deriving (Show, Eq, Generic, NFData) -- | A type declaration assigns a type to an identifier, eg: -- @@ -334,7 +334,7 @@ data TypeDeclarationData = TypeDeclarationData { tydeclSourceAnn :: !SourceAnn , tydeclIdent :: !Ident , tydeclType :: !SourceType - } deriving (Show, Eq) + } deriving (Show, Eq, Generic, NFData) getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData getTypeDeclaration (TypeDeclaration d) = Just d @@ -356,7 +356,7 @@ data ValueDeclarationData a = ValueDeclarationData -- ^ Whether or not this value is exported/visible , valdeclBinders :: ![Binder] , valdeclExpression :: !a - } deriving (Show, Functor, Foldable, Traversable) + } deriving (Show, Functor, Generic, NFData, Foldable, Traversable) getValueDeclaration :: Declaration -> Maybe (ValueDeclarationData [GuardedExpr]) getValueDeclaration (ValueDeclaration d) = Just d @@ -370,7 +370,7 @@ data DataConstructorDeclaration = DataConstructorDeclaration { dataCtorAnn :: !SourceAnn , dataCtorName :: !(ProperName 'ConstructorName) , dataCtorFields :: ![(Ident, SourceType)] - } deriving (Show, Eq) + } deriving (Show, Eq, Generic, NFData) mapDataCtorFields :: ([(Ident, SourceType)] -> [(Ident, SourceType)]) -> DataConstructorDeclaration -> DataConstructorDeclaration mapDataCtorFields f DataConstructorDeclaration{..} = DataConstructorDeclaration { dataCtorFields = f dataCtorFields, .. } @@ -445,13 +445,13 @@ data Declaration -- declaration, while the second @SourceAnn@ serves as the -- annotation for the type class and its arguments. | TypeInstanceDeclaration SourceAnn SourceAnn ChainId Integer (Either Text Ident) [SourceConstraint] (Qualified (ProperName 'ClassName)) [SourceType] TypeInstanceBody - deriving (Show) + deriving (Show, Generic, NFData) data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName) - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Generic, NFData) data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName) - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Generic, NFData) pattern ValueFixityDeclaration :: SourceAnn -> Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration pattern ValueFixityDeclaration sa fixity name op = FixityDeclaration sa (Left (ValueFixity fixity name op)) @@ -462,7 +462,7 @@ pattern TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (T data InstanceDerivationStrategy = KnownClassStrategy | NewtypeStrategy - deriving (Show) + deriving (Show, Generic, NFData) -- | The members of a type class instance declaration data TypeInstanceBody @@ -472,7 +472,7 @@ data TypeInstanceBody -- ^ This is an instance derived from a newtype | ExplicitInstance [Declaration] -- ^ This is a regular (explicit) instance - deriving (Show) + deriving (Show, Generic, NFData) mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f) @@ -488,9 +488,7 @@ data KindSignatureFor | NewtypeSig | TypeSynonymSig | ClassSig - deriving (Eq, Ord, Show, Generic) - -instance NFData KindSignatureFor + deriving (Eq, Ord, Show, Generic, NFData) declSourceAnn :: Declaration -> SourceAnn declSourceAnn (DataDeclaration sa _ _ _ _) = sa @@ -627,13 +625,13 @@ flattenDecls = concatMap flattenOne -- data Guard = ConditionGuard Expr | PatternGuard Binder Expr - deriving (Show) + deriving (Show, Generic, NFData) -- | -- The right hand side of a binder in value declarations -- and case expressions. data GuardedExpr = GuardedExpr [Guard] Expr - deriving (Show) + deriving (Show, Generic, NFData) pattern MkUnguarded :: Expr -> GuardedExpr pattern MkUnguarded e = GuardedExpr [] e @@ -764,7 +762,7 @@ data Expr -- A value with source position information -- | PositionedValue SourceSpan [Comment] Expr - deriving (Show) + deriving (Show, Generic, NFData) -- | -- Metadata that tells where a let binding originated @@ -778,7 +776,7 @@ data WhereProvenance -- The let binding was always a let binding -- | FromLet - deriving (Show) + deriving (Show, Generic, NFData) -- | -- An alternative in a case statement @@ -792,7 +790,7 @@ data CaseAlternative = CaseAlternative -- The result expression or a collect of guarded expressions -- , caseAlternativeResult :: [GuardedExpr] - } deriving (Show) + } deriving (Show, Generic, NFData) -- | -- A statement in a do-notation block @@ -814,7 +812,7 @@ data DoNotationElement -- A do notation element with source position information -- | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement - deriving (Show) + deriving (Show, Generic, NFData) -- For a record update such as: @@ -842,12 +840,14 @@ data DoNotationElement newtype PathTree t = PathTree (AssocList PSString (PathNode t)) deriving (Show, Eq, Ord, Functor, Foldable, Traversable) + deriving newtype NFData data PathNode t = Leaf t | Branch (PathTree t) - deriving (Show, Eq, Ord, Functor, Foldable, Traversable) + deriving (Show, Eq, Ord, Generic, NFData, Functor, Foldable, Traversable) newtype AssocList k t = AssocList { runAssocList :: [(k, t)] } deriving (Show, Eq, Ord, Foldable, Functor, Traversable) + deriving newtype NFData $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''NameSource) $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExportSource) diff --git a/src/Language/PureScript/AST/Literals.hs b/src/Language/PureScript/AST/Literals.hs index cfa2e880e8..05e06ab8f9 100644 --- a/src/Language/PureScript/AST/Literals.hs +++ b/src/Language/PureScript/AST/Literals.hs @@ -1,9 +1,12 @@ +{-# LANGUAGE DeriveAnyClass #-} -- | -- The core functional representation for literal values. -- module Language.PureScript.AST.Literals where import Prelude +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) import Language.PureScript.PSString (PSString) -- | @@ -35,4 +38,4 @@ data Literal a -- An object literal -- | ObjectLiteral [(PSString, a)] - deriving (Eq, Ord, Show, Functor) + deriving (Eq, Ord, Show, Functor, Generic, NFData) diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 26b932323f..f40cc44e9f 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -4,6 +4,7 @@ -- This module takes as input the individual generated modules from 'Language.PureScript.Make' and -- performs dead code elimination, filters empty modules, -- and generates the final JavaScript bundle. +{-# LANGUAGE DeriveAnyClass #-} module Language.PureScript.Bundle ( ModuleIdentifier(..) , ModuleType(..) @@ -18,6 +19,7 @@ module Language.PureScript.Bundle import Prelude +import Control.DeepSeq (NFData) import Control.Monad.Error.Class (MonadError(..)) import Data.Aeson ((.=)) @@ -27,6 +29,8 @@ import Data.Maybe (mapMaybe, maybeToList) import Data.Aeson qualified as A import Data.Text.Lazy qualified as LT +import GHC.Generics (Generic) + import Language.JavaScript.Parser (JSAST(..), JSAnnot(..), JSAssignOp(..), JSExpression(..), JSStatement(..), renderToText) import Language.JavaScript.Parser.AST (JSCommaList(..), JSCommaTrailingList(..), JSExportClause(..), JSExportDeclaration(..), JSExportSpecifier(..), JSFromClause(..), JSIdent(..), JSImportDeclaration(..), JSModuleItem(..), JSObjectProperty(..), JSObjectPropertyList, JSPropertyName(..), JSVarInitializer(..)) import Language.JavaScript.Process.Minify (minifyJS) @@ -42,21 +46,22 @@ data ErrorMessage | ErrorInModule ModuleIdentifier ErrorMessage | MissingEntryPoint String | MissingMainModule String - deriving (Show) + deriving (Show, Generic, NFData) -- | Modules are either "regular modules" (i.e. those generated by the PureScript compiler) or -- foreign modules. data ModuleType = Regular | Foreign - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic, NFData) showModuleType :: ModuleType -> String showModuleType Regular = "Regular" showModuleType Foreign = "Foreign" -- | A module is identified by its module name and its type. -data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord) +data ModuleIdentifier = ModuleIdentifier String ModuleType + deriving (Show, Eq, Ord, Generic, NFData) instance A.ToJSON ModuleIdentifier where toJSON (ModuleIdentifier name mt) = diff --git a/src/Language/PureScript/CST/Errors.hs b/src/Language/PureScript/CST/Errors.hs index 5cdea343ef..3682f2f0a5 100644 --- a/src/Language/PureScript/CST/Errors.hs +++ b/src/Language/PureScript/CST/Errors.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} module Language.PureScript.CST.Errors ( ParserErrorInfo(..) , ParserErrorType(..) @@ -11,8 +12,10 @@ module Language.PureScript.CST.Errors import Prelude +import Control.DeepSeq (NFData) import Data.Text qualified as Text import Data.Char (isSpace, toUpper) +import GHC.Generics (Generic) import Language.PureScript.CST.Layout (LayoutStack) import Language.PureScript.CST.Print (printToken) import Language.PureScript.CST.Types (SourcePos(..), SourceRange(..), SourceToken(..), Token(..)) @@ -56,7 +59,7 @@ data ParserErrorType | ErrConstraintInForeignImportSyntax | ErrEof | ErrCustom String - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic, NFData) data ParserWarningType = WarnDeprecatedRowSyntax @@ -64,14 +67,14 @@ data ParserWarningType | WarnDeprecatedKindImportSyntax | WarnDeprecatedKindExportSyntax | WarnDeprecatedCaseOfOffsideSyntax - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic, NFData) data ParserErrorInfo a = ParserErrorInfo { errRange :: SourceRange , errToks :: [SourceToken] , errStack :: LayoutStack , errType :: a - } deriving (Show, Eq) + } deriving (Show, Eq, Generic, NFData) type ParserError = ParserErrorInfo ParserErrorType type ParserWarning = ParserErrorInfo ParserWarningType diff --git a/src/Language/PureScript/CST/Layout.hs b/src/Language/PureScript/CST/Layout.hs index 989cf1563d..2f41df6b4f 100644 --- a/src/Language/PureScript/CST/Layout.hs +++ b/src/Language/PureScript/CST/Layout.hs @@ -166,14 +166,17 @@ -- "body of a case of expression" by pushing 'LytOf' onto the layout stack. -- Insert the @of@ token into the stream of tokens. -- +{-# LANGUAGE DeriveAnyClass #-} module Language.PureScript.CST.Layout where import Prelude +import Control.DeepSeq (NFData) import Data.DList (snoc) import Data.DList qualified as DList import Data.Foldable (find) import Data.Function ((&)) +import GHC.Generics (Generic) import Language.PureScript.CST.Types (Comment, LineFeed, SourcePos(..), SourceRange(..), SourceToken(..), Token(..), TokenAnn(..)) type LayoutStack = [(SourcePos, LayoutDelim)] @@ -201,7 +204,7 @@ data LayoutDelim | LytOf | LytDo | LytAdo - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic, NFData) isIndented :: LayoutDelim -> Bool isIndented = \case diff --git a/src/Language/PureScript/CST/Types.hs b/src/Language/PureScript/CST/Types.hs index a89532f1fa..ba90f7e95b 100644 --- a/src/Language/PureScript/CST/Types.hs +++ b/src/Language/PureScript/CST/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} -- | This module contains data types for the entire PureScript surface language. Every -- token is represented in the tree, and every token is annotated with -- whitespace and comments (both leading and trailing). This means one can write @@ -9,6 +10,7 @@ module Language.PureScript.CST.Types where import Prelude +import Control.DeepSeq (NFData) import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import Data.Void (Void) @@ -20,30 +22,30 @@ import Language.PureScript.PSString (PSString) data SourcePos = SourcePos { srcLine :: {-# UNPACK #-} !Int , srcColumn :: {-# UNPACK #-} !Int - } deriving (Show, Eq, Ord, Generic) + } deriving (Show, Eq, Ord, Generic, NFData) data SourceRange = SourceRange { srcStart :: !SourcePos , srcEnd :: !SourcePos - } deriving (Show, Eq, Ord, Generic) + } deriving (Show, Eq, Ord, Generic, NFData) data Comment l = Comment !Text | Space {-# UNPACK #-} !Int | Line !l - deriving (Show, Eq, Ord, Generic, Functor) + deriving (Show, Eq, Ord, Generic, Functor, NFData) data LineFeed = LF | CRLF - deriving (Show, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic, NFData) data TokenAnn = TokenAnn { tokRange :: !SourceRange , tokLeadingComments :: ![Comment LineFeed] , tokTrailingComments :: ![Comment Void] - } deriving (Show, Eq, Ord, Generic) + } deriving (Show, Eq, Ord, Generic, NFData) data SourceStyle = ASCII | Unicode - deriving (Show, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic, NFData) data Token = TokLeftParen @@ -79,12 +81,12 @@ data Token | TokLayoutSep | TokLayoutEnd | TokEof - deriving (Show, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic, NFData) data SourceToken = SourceToken { tokAnn :: !TokenAnn , tokValue :: !Token - } deriving (Show, Eq, Ord, Generic) + } deriving (Show, Eq, Ord, Generic, NFData) data Ident = Ident { getIdent :: Text diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 2d8225f324..56d962b3c7 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} module Language.PureScript.Errors ( module Language.PureScript.AST , module Language.PureScript.Errors @@ -7,7 +8,7 @@ import Prelude import Protolude (unsnoc) import Control.Arrow ((&&&)) -import Control.Exception (displayException) +import Control.DeepSeq (NFData) import Control.Lens (both, head1, over) import Control.Monad (forM, unless) import Control.Monad.Error.Class (MonadError(..)) @@ -32,6 +33,7 @@ import Data.Set qualified as S import Data.Text qualified as T import Data.Text (Text) import Data.Traversable (for) +import GHC.Generics (Generic) import GHC.Stack qualified import Language.PureScript.AST import Language.PureScript.Bundle qualified as Bundle @@ -70,7 +72,7 @@ data SimpleErrorMessage | DeprecatedFFICommonJSModule ModuleName FilePath | UnsupportedFFICommonJSExports ModuleName [Text] | UnsupportedFFICommonJSImports ModuleName [Text] - | FileIOError Text IOError -- ^ A description of what we were trying to do, and the error which occurred + | FileIOError Text Text -- ^ A description of what we were trying to do, and the error which occurred | InfiniteType SourceType | InfiniteKind SourceType | MultipleValueOpFixities (OpName 'ValueOpName) @@ -196,12 +198,12 @@ data SimpleErrorMessage | CannotDeriveInvalidConstructorArg (Qualified (ProperName 'ClassName)) [Qualified (ProperName 'ClassName)] Bool | CannotSkipTypeApplication SourceType | CannotApplyExpressionOfTypeOnType SourceType SourceType - deriving (Show) + deriving (Show, Generic, NFData) data ErrorMessage = ErrorMessage [ErrorMessageHint] SimpleErrorMessage - deriving (Show) + deriving (Show, Generic, NFData) newtype ErrorSuggestion = ErrorSuggestion Text @@ -369,7 +371,9 @@ errorCode em = case unwrapErrorMessage em of -- | A stack trace for an error newtype MultipleErrors = MultipleErrors { runMultipleErrors :: [ErrorMessage] - } deriving (Show, Semigroup, Monoid) + } + deriving stock (Show) + deriving newtype (Semigroup, Monoid, NFData) -- | Check whether a collection of errors is empty or not. nonEmpty :: MultipleErrors -> Bool @@ -679,7 +683,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon ] renderSimpleErrorMessage (FileIOError doWhat err) = paras [ line $ "I/O error while trying to " <> doWhat - , indent . lineS $ displayException err + , indent . line $ err ] renderSimpleErrorMessage (ErrorParsingFFIModule path extra) = paras $ [ line "Unable to parse foreign module:" @@ -941,7 +945,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon <> case argsRequiringVtas of [required] -> [ Box.moveRight 2 $ line $ T.intercalate ", " required ] - options -> + options -> [ Box.moveRight 2 $ line "One of the following sets of type variables:" , Box.moveRight 2 $ paras $ map (\set -> Box.moveRight 2 $ line $ T.intercalate ", " set) options diff --git a/src/Language/PureScript/Externs.hs b/src/Language/PureScript/Externs.hs index 29d15ec8cd..a9669a9995 100644 --- a/src/Language/PureScript/Externs.hs +++ b/src/Language/PureScript/Externs.hs @@ -1,3 +1,4 @@ +{-# Language DeriveAnyClass #-} -- | -- This module generates code for \"externs\" files, i.e. files containing only -- foreign import declarations. @@ -17,8 +18,8 @@ module Language.PureScript.Externs import Prelude import Codec.Serialise (Serialise) +import Control.DeepSeq (NFData) import Control.Monad (join) -import GHC.Generics (Generic) import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import Data.List (foldl', find) import Data.Foldable (fold) @@ -27,6 +28,7 @@ import Data.Text qualified as T import Data.Version (showVersion) import Data.Map qualified as M import Data.List.NonEmpty qualified as NEL +import GHC.Generics (Generic) import Language.PureScript.AST (Associativity, Declaration(..), DeclarationRef(..), Fixity(..), ImportDeclarationType, Module(..), NameSource(..), Precedence, SourceSpan, pattern TypeFixityDeclaration, pattern ValueFixityDeclaration, getTypeOpRef, getValueOpRef) import Language.PureScript.AST.Declarations.ChainId (ChainId) @@ -59,7 +61,7 @@ data ExternsFile = ExternsFile -- ^ List of type and value declaration , efSourceSpan :: SourceSpan -- ^ Source span for error reporting - } deriving (Show, Generic) + } deriving (Show, Generic, NFData) instance Serialise ExternsFile @@ -72,7 +74,7 @@ data ExternsImport = ExternsImport , eiImportType :: ImportDeclarationType -- | The imported-as name, for qualified imports , eiImportedAs :: Maybe ModuleName - } deriving (Show, Generic) + } deriving (Show, Generic, NFData) instance Serialise ExternsImport @@ -87,7 +89,7 @@ data ExternsFixity = ExternsFixity , efOperator :: OpName 'ValueOpName -- | The value the operator is an alias for , efAlias :: Qualified (Either Ident (ProperName 'ConstructorName)) - } deriving (Show, Generic) + } deriving (Show, Generic, NFData) instance Serialise ExternsFixity @@ -102,7 +104,7 @@ data ExternsTypeFixity = ExternsTypeFixity , efTypeOperator :: OpName 'TypeOpName -- | The value the operator is an alias for , efTypeAlias :: Qualified (ProperName 'TypeName) - } deriving (Show, Generic) + } deriving (Show, Generic, NFData) instance Serialise ExternsTypeFixity @@ -155,7 +157,7 @@ data ExternsDeclaration = , edInstanceNameSource :: NameSource , edInstanceSourceSpan :: SourceSpan } - deriving (Show, Generic) + deriving (Show, Generic, NFData) instance Serialise ExternsDeclaration diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index 8340d77caa..5228dc86e6 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -12,12 +12,14 @@ module Language.PureScript.Make import Prelude import Control.Concurrent.Lifted as C -import Control.Exception.Base (onException) -import Control.Monad (foldM, unless, when) +import Control.DeepSeq (force) +import Control.Exception.Lifted (onException, bracket_, evaluate) +import Control.Monad (foldM, unless, when, (<=<)) +import Control.Monad.Base (MonadBase(liftBase)) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Supply (evalSupplyT, runSupply, runSupplyT) -import Control.Monad.Trans.Control (MonadBaseControl(..), control) +import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.State (runStateT) import Control.Monad.Writer.Class (MonadWriter(..), censor) import Control.Monad.Writer.Strict (runWriterT) @@ -29,6 +31,7 @@ import Data.Maybe (fromMaybe) import Data.Map qualified as M import Data.Set qualified as S import Data.Text qualified as T +import Debug.Trace (traceMarkerIO) import Language.PureScript.AST (ErrorMessageHint(..), Module(..), SourceSpan(..), getModuleName, getModuleSourceSpan, importPrim) import Language.PureScript.Crash (internalError) import Language.PureScript.CST qualified as CST @@ -56,7 +59,7 @@ import System.FilePath (replaceExtension) -- This function is used for fast-rebuild workflows (PSCi and psc-ide are examples). rebuildModule :: forall m - . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) + . (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MakeActions m -> [ExternsFile] -> Module @@ -67,7 +70,7 @@ rebuildModule actions externs m = do rebuildModule' :: forall m - . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) + . (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MakeActions m -> Env -> [ExternsFile] @@ -77,7 +80,7 @@ rebuildModule' act env ext mdl = rebuildModuleWithIndex act env ext mdl Nothing rebuildModuleWithIndex :: forall m - . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) + . (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MakeActions m -> Env -> [ExternsFile] @@ -148,12 +151,21 @@ make ma@MakeActions{..} ms = do (buildPlan, newCacheDb) <- BuildPlan.construct ma cacheDb (sorted, graph) + -- Limit concurrent module builds to the number of capabilities as + -- (by default) inferred from `+RTS -N -RTS` or set explicitly like `-N4`. + -- This is to ensure that modules complete fully before moving on, to avoid + -- holding excess memory during compilation from modules that were paused + -- by the Haskell runtime. + capabilities <- getNumCapabilities + let concurrency = max 1 capabilities + lock <- C.newQSem concurrency + let toBeRebuilt = filter (BuildPlan.needsRebuild buildPlan . getModuleName . CST.resPartial) sorted let totalModuleCount = length toBeRebuilt for_ toBeRebuilt $ \m -> fork $ do let moduleName = getModuleName . CST.resPartial $ m let deps = fromMaybe (internalError "make: module not found in dependency graph.") (lookup moduleName graph) - buildModule buildPlan moduleName totalModuleCount + buildModule lock buildPlan moduleName totalModuleCount (spanName . getModuleSourceSpan . CST.resPartial $ m) (fst $ CST.resFull m) (fmap importPrim . snd $ CST.resFull m) @@ -161,7 +173,7 @@ make ma@MakeActions{..} ms = do -- Prevent hanging on other modules when there is an internal error -- (the exception is thrown, but other threads waiting on MVars are released) - `onExceptionLifted` BuildPlan.markComplete buildPlan moduleName (BuildJobFailed mempty) + `onException` BuildPlan.markComplete buildPlan moduleName (BuildJobFailed mempty) -- Wait for all threads to complete, and collect results (and errors). (failures, successes) <- @@ -227,8 +239,8 @@ make ma@MakeActions{..} ms = do inOrderOf :: (Ord a) => [a] -> [a] -> [a] inOrderOf xs ys = let s = S.fromList xs in filter (`S.member` s) ys - buildModule :: BuildPlan -> ModuleName -> Int -> FilePath -> [CST.ParserWarning] -> Either (NEL.NonEmpty CST.ParserError) Module -> [ModuleName] -> m () - buildModule buildPlan moduleName cnt fp pwarnings mres deps = do + buildModule :: QSem -> BuildPlan -> ModuleName -> Int -> FilePath -> [CST.ParserWarning] -> Either (NEL.NonEmpty CST.ParserError) Module -> [ModuleName] -> m () + buildModule lock buildPlan moduleName cnt fp pwarnings mres deps = do result <- flip catchError (return . BuildJobFailed) $ do let pwarnings' = CST.toMultipleWarnings fp pwarnings tell pwarnings' @@ -252,15 +264,24 @@ make ma@MakeActions{..} ms = do env <- C.readMVar (bpEnv buildPlan) idx <- C.takeMVar (bpIndex buildPlan) C.putMVar (bpIndex buildPlan) (idx + 1) - (exts, warnings) <- listen $ rebuildModuleWithIndex ma env externs m (Just (idx, cnt)) + + -- Bracket all of the per-module work behind the semaphore, including + -- forcing the result. This is done to limit concurrency and keep + -- memory usage down; see comments above. + (exts, warnings) <- bracket_ (C.waitQSem lock) (C.signalQSem lock) $ do + -- Eventlog markers for profiling; see debug/eventlog.js + liftBase $ traceMarkerIO $ T.unpack (runModuleName moduleName) <> " start" + -- Force the externs and warnings to avoid retaining excess module + -- data after the module is finished compiling. + extsAndWarnings <- evaluate . force <=< listen $ do + rebuildModuleWithIndex ma env externs m (Just (idx, cnt)) + liftBase $ traceMarkerIO $ T.unpack (runModuleName moduleName) <> " end" + return extsAndWarnings return $ BuildJobSucceeded (pwarnings' <> warnings) exts Nothing -> return BuildJobSkipped BuildPlan.markComplete buildPlan moduleName result - onExceptionLifted :: m a -> m b -> m a - onExceptionLifted l r = control $ \runInIO -> runInIO l `onException` runInIO r - -- | Infer the module name for a module by looking for the same filename with -- a .js extension. inferForeignModules diff --git a/src/Language/PureScript/Make/Monad.hs b/src/Language/PureScript/Make/Monad.hs index d8326ee129..8c86144e9a 100644 --- a/src/Language/PureScript/Make/Monad.hs +++ b/src/Language/PureScript/Make/Monad.hs @@ -23,7 +23,7 @@ import Prelude import Codec.Serialise (Serialise) import Codec.Serialise qualified as Serialise -import Control.Exception (fromException, tryJust) +import Control.Exception (fromException, tryJust, Exception (displayException)) import Control.Monad (join, guard) import Control.Monad.Base (MonadBase(..)) import Control.Monad.Error.Class (MonadError(..)) @@ -71,7 +71,7 @@ runMake opts = runLogger' . runExceptT . flip runReaderT opts . unMake makeIO :: (MonadIO m, MonadError MultipleErrors m) => Text -> IO a -> m a makeIO description io = do res <- liftIO (tryIOError io) - either (throwError . singleError . ErrorMessage [] . FileIOError description) pure res + either (throwError . singleError . ErrorMessage [] . FileIOError description . Text.pack . displayException) pure res -- | Get a file's modification time in the 'Make' monad, capturing any errors -- using the 'MonadError' instance. From e25c476c08c2e134f5d369326060be2f0d9ef583 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Wed, 3 Jan 2024 07:58:55 -0800 Subject: [PATCH 51/68] Prep 0.15.14 release (#4526) * Update version to 0.15.14 * Update changelog --- .../fix_compilation_regression-4491.md | 8 ----- CHANGELOG.d/fix_fix-class-head-ty-var.md | 1 - CHANGELOG.d/fix_module-space-leak.md | 11 ------- CHANGELOG.md | 29 +++++++++++++++++++ npm-package/package.json | 4 +-- purescript.cabal | 2 +- 6 files changed, 32 insertions(+), 23 deletions(-) delete mode 100644 CHANGELOG.d/fix_compilation_regression-4491.md delete mode 100644 CHANGELOG.d/fix_fix-class-head-ty-var.md delete mode 100644 CHANGELOG.d/fix_module-space-leak.md diff --git a/CHANGELOG.d/fix_compilation_regression-4491.md b/CHANGELOG.d/fix_compilation_regression-4491.md deleted file mode 100644 index a2fbc45f4e..0000000000 --- a/CHANGELOG.d/fix_compilation_regression-4491.md +++ /dev/null @@ -1,8 +0,0 @@ -* Fix a compilation memory regression for very large files - - When compiling a a very large file (>12K lines) - the CSE pass could balloon memory and result in increased - compilation times. - - This fix uses a strict Map instead of a lazy Map to avoid - building up unnecessary thunks during the optimization pass. diff --git a/CHANGELOG.d/fix_fix-class-head-ty-var.md b/CHANGELOG.d/fix_fix-class-head-ty-var.md deleted file mode 100644 index 12a3f8ab11..0000000000 --- a/CHANGELOG.d/fix_fix-class-head-ty-var.md +++ /dev/null @@ -1 +0,0 @@ -* Fix parsing bug where `@var` was allowed in type class head \ No newline at end of file diff --git a/CHANGELOG.d/fix_module-space-leak.md b/CHANGELOG.d/fix_module-space-leak.md deleted file mode 100644 index 2cb86e8562..0000000000 --- a/CHANGELOG.d/fix_module-space-leak.md +++ /dev/null @@ -1,11 +0,0 @@ -* Fix two space leaks while compiling many modules - - The first would interleave compilation of too many modules at once, which - would increase memory usage, especially for single threaded builds with - `+RTS -N1 -RTS`. Now the number of concurrent modules is limited to - the number of threads available to the - [GHC runtime system](https://downloads.haskell.org/ghc/latest/docs/users_guide/using-concurrent.html#rts-options-for-smp-parallelism). - - The second would hold on to memory from modules that compiled with warnings - until the end of the build when the warnings were printed and the memory freed. - This is now fixed with additional `NFData` instances. diff --git a/CHANGELOG.md b/CHANGELOG.md index d8052d14cf..309b8ac703 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,31 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.14 + +Bugfixes: + +* Fix a compilation memory regression for very large files (#4521 by @mjrussell) + + When compiling a a very large file (>12K lines) + the CSE pass could balloon memory and result in increased + compilation times. + + This fix uses a strict Map instead of a lazy Map to avoid + building up unnecessary thunks during the optimization pass. + +* Fix two space leaks while compiling many modules (#4517 by @MonoidMusician) + + The first would interleave compilation of too many modules at once, which + would increase memory usage, especially for single threaded builds with + `+RTS -N1 -RTS`. Now the number of concurrent modules is limited to + the number of threads available to the + [GHC runtime system](https://downloads.haskell.org/ghc/latest/docs/users_guide/using-concurrent.html#rts-options-for-smp-parallelism). + + The second would hold on to memory from modules that compiled with warnings + until the end of the build when the warnings were printed and the memory freed. + This is now fixed with additional `NFData` instances. + ## 0.15.13 New features: @@ -78,6 +103,10 @@ New features: b ``` +Bugfixes: + +* Fix parsing bug where `@var` was allowed in type class head (#4523 by @JordanMartinez) + ## 0.15.12 New features: diff --git a/npm-package/package.json b/npm-package/package.json index b24866695b..8470f00e4c 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.13", + "version": "0.15.14", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.13", + "postinstall": "install-purescript --purs-ver=0.15.14", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index a608c61cac..496e669a81 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.13 +version: 0.15.14 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From 5dcd000363c3c27e29f2bb8e6848c7782c17a40d Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Wed, 7 Feb 2024 10:02:42 -0600 Subject: [PATCH 52/68] Add support for `--source-globs-file` CLI arg in relevant `purs` commands (#4530) * Enable passing source input globs via `--source-globs-file path/to/file` `--source-globs-file` support has been added to the following commands: `compile`, `docs`, `graph`, `ide`, and `publish`. Due to a [shell character limitation on Windows](https://learn.microsoft.com/en-us/troubleshoot/windows-client/shell-experience/command-line-string-limitation) where a large list of source globs cannot be passed (e.g. `purs compile ... glob1000/src/**/*.purs`), source globs can be stored in a file according to the format below and the file is passed in instead via `purs compile ---source-globs-file path/to/file`. ``` # Lines starting with '#' are comments. # Blank lines are ignored. # Otherwise, every line is a glob. .spago/foo-1.2.3/src/**/*.purs .spago/bar-2.3.3/src/**/*.purs my-package/src/**/*.purs my-package/tests/**/*.purs ``` `--source-globs-file` is an optional argument. Mixing it with the normal source globs is fine. Assuming `.spago/source-globs` contains `src/**/*.purs`, each command below will use the same input globs: ```sh purs compile src/**/*.purs purs compile --source-globs .spago/source-globs purs compile --source-globs .spago/source-globs src/**/*.purs ``` In the command... ``` purs compile inputGlob1 inputGlob2 --source-globs-file fileWithMoreGlobs --exclude-files excludeGlob1 ``` the files passed to the compiler are: all the files found by `inputGlob1`, `inputGlob2`, and all the globs listed in `fileWithMoreGlobs` minus the files found by `excludeGlob1`. * Add `--exclude-file` to more commands While implementing the fix above, I discovered that the `--exclude-file` CLI arg wasn't included in other `purs` commands where such a usage would be relevant (e.g. `docs`, `repl`, `graph`, and `ide`). This PR also rectifies that problem. --- .github/workflows/ci.yml | 9 ++ ...ature_add-exclude-file-to-more-commands.md | 5 + CHANGELOG.d/feature_glob-input-files.md | 38 ++++++ app/Command/Compile.hs | 45 +++---- app/Command/Docs.hs | 28 +++-- app/Command/Graph.hs | 42 +++---- app/Command/Ide.hs | 11 +- app/Command/REPL.hs | 21 ++-- app/SharedCLI.hs | 24 ++++ glob-test.sh | 113 ++++++++++++++++++ purescript.cabal | 2 + src/Language/PureScript/Glob.hs | 44 +++++++ src/Language/PureScript/Ide.hs | 12 +- src/Language/PureScript/Ide/Types.hs | 2 + tests/Language/PureScript/Ide/Test.hs | 2 + 15 files changed, 317 insertions(+), 81 deletions(-) create mode 100644 CHANGELOG.d/feature_add-exclude-file-to-more-commands.md create mode 100644 CHANGELOG.d/feature_glob-input-files.md create mode 100644 app/SharedCLI.hs create mode 100644 glob-test.sh create mode 100644 src/Language/PureScript/Glob.hs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d88257ed07..8efd13812b 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -130,6 +130,15 @@ jobs: - id: "build" run: "ci/fix-home ci/build.sh" + - name: "(Linux only) Glob tests" + if: "contains(matrix.os, 'ubuntu-latest')" + working-directory: "sdist-test" + # We build in this directory in build.sh, so this is where we need to + # launch `stack exec`. The actual glob checks happen in a temporary directory. + run: | + apt-get install tree + ../ci/fix-home stack exec bash ../glob-test.sh + - name: "(Linux only) Build the entire package set" if: "contains(matrix.os, 'ubuntu-latest')" # We build in this directory in build.sh, so this is where we need to diff --git a/CHANGELOG.d/feature_add-exclude-file-to-more-commands.md b/CHANGELOG.d/feature_add-exclude-file-to-more-commands.md new file mode 100644 index 0000000000..b613e791c3 --- /dev/null +++ b/CHANGELOG.d/feature_add-exclude-file-to-more-commands.md @@ -0,0 +1,5 @@ +* Add `--exclude-file` to more commands + + This CLI arg was added to the `compile` command, but not to other commands + where such a usage would be relevant (e.g. `docs`, `repl`, `graph`, and `ide`). + \ No newline at end of file diff --git a/CHANGELOG.d/feature_glob-input-files.md b/CHANGELOG.d/feature_glob-input-files.md new file mode 100644 index 0000000000..076b94cf4c --- /dev/null +++ b/CHANGELOG.d/feature_glob-input-files.md @@ -0,0 +1,38 @@ +* Enable passing source input globs via `--source-globs-file path/to/file` + + `--source-globs-file` support has been added to the following commands: + `compile`, `docs`, `graph`, `ide`, and `publish`. + + Due to a [shell character limitation on Windows](https://learn.microsoft.com/en-us/troubleshoot/windows-client/shell-experience/command-line-string-limitation) where a large list of + source globs cannot be passed (e.g. `purs compile ... glob1000/src/**/*.purs`), + source globs can be stored in a file according to the format below + and the file is passed in instead via `purs compile ---source-globs-file path/to/file`. + + ``` + # Lines starting with '#' are comments. + # Blank lines are ignored. + # Otherwise, every line is a glob. + + .spago/foo-1.2.3/src/**/*.purs + .spago/bar-2.3.3/src/**/*.purs + my-package/src/**/*.purs + my-package/tests/**/*.purs + ``` + + `--source-globs-file` is an optional argument. Mixing it with the normal source globs is fine. + Assuming `.spago/source-globs` contains `src/**/*.purs`, each command below will use + the same input globs: + ```sh + purs compile src/**/*.purs + purs compile --source-globs .spago/source-globs + purs compile --source-globs .spago/source-globs src/**/*.purs + ``` + + In the command... + ``` + purs compile inputGlob1 inputGlob2 --source-globs-file fileWithMoreGlobs --exclude-files excludeGlob1 + ``` + the files passed to the compiler are: all the files found by + `inputGlob1`, `inputGlob2`, and all the globs listed in `fileWithMoreGlobs` + minus the files found by `excludeGlob1`. + \ No newline at end of file diff --git a/app/Command/Compile.hs b/app/Command/Compile.hs index 8f348da9dd..d81dd75c07 100644 --- a/app/Command/Compile.hs +++ b/app/Command/Compile.hs @@ -7,7 +7,7 @@ import Control.Monad (when) import Data.Aeson qualified as A import Data.Bool (bool) import Data.ByteString.Lazy.UTF8 qualified as LBU8 -import Data.List (intercalate, (\\)) +import Data.List (intercalate) import Data.Map qualified as M import Data.Set qualified as S import Data.Text qualified as T @@ -15,17 +15,19 @@ import Data.Traversable (for) import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST import Language.PureScript.Errors.JSON (JSONResult(..), toJSONErrors) +import Language.PureScript.Glob (toInputGlobs, PSCGlobs(..), warnFileTypeNotFound) import Language.PureScript.Make (buildMakeActions, inferForeignModules, runMake) import Options.Applicative qualified as Opts +import SharedCLI qualified import System.Console.ANSI qualified as ANSI import System.Exit (exitSuccess, exitFailure) import System.Directory (getCurrentDirectory) -import System.FilePath.Glob (glob) -import System.IO (hPutStr, hPutStrLn, stderr, stdout) +import System.IO (hPutStr, stderr, stdout) import System.IO.UTF8 (readUTF8FilesT) data PSCMakeOptions = PSCMakeOptions { pscmInput :: [FilePath] + , pscmInputFromFile :: Maybe FilePath , pscmExclude :: [FilePath] , pscmOutputDir :: FilePath , pscmOpts :: P.Options @@ -54,9 +56,12 @@ printWarningsAndErrors verbose True files warnings errors = do compile :: PSCMakeOptions -> IO () compile PSCMakeOptions{..} = do - included <- globWarningOnMisses warnFileTypeNotFound pscmInput - excluded <- globWarningOnMisses warnFileTypeNotFound pscmExclude - let input = included \\ excluded + input <- toInputGlobs $ PSCGlobs + { pscInputGlobs = pscmInput + , pscInputGlobsFromFile = pscmInputFromFile + , pscExcludeGlobs = pscmExclude + , pscWarnFileTypeNotFound = warnFileTypeNotFound "compile" + } when (null input) $ do hPutStr stderr $ unlines [ "purs compile: No input files." , "Usage: For basic information, try the `--help' option." @@ -72,29 +77,6 @@ compile PSCMakeOptions{..} = do printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors moduleFiles makeWarnings makeErrors exitSuccess -warnFileTypeNotFound :: String -> IO () -warnFileTypeNotFound = hPutStrLn stderr . ("purs compile: No files found using pattern: " ++) - -globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath] -globWarningOnMisses warn = concatMapM globWithWarning - where - globWithWarning pattern' = do - paths <- glob pattern' - when (null paths) $ warn pattern' - return paths - concatMapM f = fmap concat . mapM f - -inputFile :: Opts.Parser FilePath -inputFile = Opts.strArgument $ - Opts.metavar "FILE" - <> Opts.help "The input .purs file(s)." - -excludedFiles :: Opts.Parser FilePath -excludedFiles = Opts.strOption $ - Opts.short 'x' - <> Opts.long "exclude-files" - <> Opts.help "Glob of .purs files to exclude from the supplied files." - outputDirectory :: Opts.Parser FilePath outputDirectory = Opts.strOption $ Opts.short 'o' @@ -161,8 +143,9 @@ options = handleTargets ts = S.fromList (if P.JSSourceMap `elem` ts then P.JS : ts else ts) pscMakeOptions :: Opts.Parser PSCMakeOptions -pscMakeOptions = PSCMakeOptions <$> many inputFile - <*> many excludedFiles +pscMakeOptions = PSCMakeOptions <$> many SharedCLI.inputFile + <*> SharedCLI.globInputFile + <*> many SharedCLI.excludeFiles <*> outputDirectory <*> options <*> (not <$> noPrefix) diff --git a/app/Command/Docs.hs b/app/Command/Docs.hs index 38c875083c..f0b6711b09 100644 --- a/app/Command/Docs.hs +++ b/app/Command/Docs.hs @@ -13,12 +13,14 @@ import Data.Text qualified as T import Language.PureScript qualified as P import Language.PureScript.Docs qualified as D import Language.PureScript.Docs.Tags (dumpCtags, dumpEtags) +import Language.PureScript.Glob (PSCGlobs(..), toInputGlobs, warnFileTypeNotFound) import Options.Applicative qualified as Opts import Text.PrettyPrint.ANSI.Leijen qualified as PP +import SharedCLI qualified import System.Directory (getCurrentDirectory, createDirectoryIfMissing, removeFile) import System.Exit (exitFailure) import System.FilePath (()) -import System.FilePath.Glob (compile, glob, globDir1) +import System.FilePath.Glob (compile, globDir1) import System.IO (hPutStrLn, stderr) import System.IO.UTF8 (writeUTF8FileT) @@ -35,12 +37,19 @@ data PSCDocsOptions = PSCDocsOptions , _pscdOutput :: Maybe FilePath , _pscdCompileOutputDir :: FilePath , _pscdInputFiles :: [FilePath] + , _pscdInputFromFile :: Maybe FilePath + , _pscdExcludeFiles :: [FilePath] } deriving (Show) docgen :: PSCDocsOptions -> IO () -docgen (PSCDocsOptions fmt moutput compileOutput inputGlob) = do - input <- concat <$> mapM glob inputGlob +docgen (PSCDocsOptions fmt moutput compileOutput inputGlob inputGlobFromFile excludeGlob) = do + input <- toInputGlobs $ PSCGlobs + { pscInputGlobs = inputGlob + , pscInputGlobsFromFile = inputGlobFromFile + , pscExcludeGlobs = excludeGlob + , pscWarnFileTypeNotFound = warnFileTypeNotFound "docs" + } when (null input) $ do hPutStrLn stderr "purs docs: no input files." exitFailure @@ -104,7 +113,13 @@ defaultOutputForFormat fmt = Ctags -> "tags" pscDocsOptions :: Opts.Parser PSCDocsOptions -pscDocsOptions = PSCDocsOptions <$> format <*> output <*> compileOutputDir <*> many inputFile +pscDocsOptions = + PSCDocsOptions <$> format + <*> output + <*> compileOutputDir + <*> many SharedCLI.inputFile + <*> SharedCLI.globInputFile + <*> many SharedCLI.excludeFiles where format :: Opts.Parser Format format = Opts.option Opts.auto $ @@ -128,11 +143,6 @@ pscDocsOptions = PSCDocsOptions <$> format <*> output <*> compileOutputDir <*> m <> Opts.metavar "DIR" <> Opts.help "Compiler output directory" - inputFile :: Opts.Parser FilePath - inputFile = Opts.strArgument $ - Opts.metavar "FILE" - <> Opts.help "The input .purs file(s)" - command :: Opts.Parser (IO ()) command = docgen <$> (Opts.helper <*> pscDocsOptions) diff --git a/app/Command/Graph.hs b/app/Command/Graph.hs index 4e3c905d9b..43cb1e2591 100644 --- a/app/Command/Graph.hs +++ b/app/Command/Graph.hs @@ -10,21 +10,30 @@ import Data.ByteString.Lazy qualified as LB import Data.ByteString.Lazy.UTF8 qualified as LBU8 import Language.PureScript qualified as P import Language.PureScript.Errors.JSON (JSONResult(..), toJSONErrors) +import Language.PureScript.Glob (PSCGlobs(..), toInputGlobs, warnFileTypeNotFound) import Options.Applicative qualified as Opts +import SharedCLI qualified import System.Console.ANSI qualified as ANSI import System.Exit (exitFailure) import System.Directory (getCurrentDirectory) -import System.FilePath.Glob (glob) import System.IO (hPutStr, hPutStrLn, stderr) data GraphOptions = GraphOptions { graphInput :: [FilePath] + , graphInputFromFile :: Maybe FilePath + , graphExclude :: [FilePath] , graphJSONErrors :: Bool } graph :: GraphOptions -> IO () graph GraphOptions{..} = do - input <- globWarningOnMisses (unless graphJSONErrors . warnFileTypeNotFound) graphInput + input <- toInputGlobs $ PSCGlobs + { pscInputGlobs = graphInput + , pscInputGlobsFromFile = graphInputFromFile + , pscExcludeGlobs = graphExclude + , pscWarnFileTypeNotFound = unless graphJSONErrors . warnFileTypeNotFound "graph" + } + when (null input && not graphJSONErrors) $ do hPutStr stderr $ unlines [ "purs graph: No input files." @@ -37,26 +46,16 @@ graph GraphOptions{..} = do printWarningsAndErrors graphJSONErrors makeWarnings makeResult >>= (LB.putStr . Json.encode) - where - warnFileTypeNotFound :: String -> IO () - warnFileTypeNotFound = - hPutStrLn stderr . ("purs graph: No files found using pattern: " <>) - - command :: Opts.Parser (IO ()) command = graph <$> (Opts.helper <*> graphOptions) where graphOptions :: Opts.Parser GraphOptions graphOptions = - GraphOptions <$> many inputFile + GraphOptions <$> many SharedCLI.inputFile + <*> SharedCLI.globInputFile + <*> many SharedCLI.excludeFiles <*> jsonErrors - inputFile :: Opts.Parser FilePath - inputFile = - Opts.strArgument $ - Opts.metavar "FILE" <> - Opts.help "The input .purs file(s)." - jsonErrors :: Opts.Parser Bool jsonErrors = Opts.switch $ @@ -84,16 +83,3 @@ printWarningsAndErrors True warnings errors = do case errors of Left _errs -> exitFailure Right res -> pure res - - -globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath] -globWarningOnMisses warn = concatMapM globWithWarning - where - globWithWarning :: String -> IO [FilePath] - globWithWarning pattern' = do - paths <- glob pattern' - when (null paths) $ warn pattern' - return paths - - concatMapM :: (a -> IO [b]) -> [a] -> IO [b] - concatMapM f = fmap concat . mapM f diff --git a/app/Command/Ide.hs b/app/Command/Ide.hs index cfb563be4e..f5a501af75 100644 --- a/app/Command/Ide.hs +++ b/app/Command/Ide.hs @@ -35,6 +35,7 @@ import Language.PureScript.Ide.State (updateCacheTimestamp) import Language.PureScript.Ide.Types (Ide, IdeConfiguration(..), IdeEnvironment(..), IdeLogLevel(..), emptyIdeState) import Network.Socket qualified as Network import Options.Applicative qualified as Opts +import SharedCLI qualified import System.Directory (doesDirectoryExist, getCurrentDirectory, setCurrentDirectory) import System.FilePath (()) import System.IO (BufferMode(..), hClose, hFlush, hSetBuffering, hSetEncoding, utf8) @@ -59,6 +60,8 @@ listenOnLocalhost port = do data ServerOptions = ServerOptions { _serverDirectory :: Maybe FilePath , _serverGlobs :: [FilePath] + , _serverGlobsFromFile :: Maybe FilePath + , _serverGlobsExcluded :: [FilePath] , _serverOutputPath :: FilePath , _serverPort :: Network.PortNumber , _serverLoglevel :: IdeLogLevel @@ -110,7 +113,7 @@ command = Opts.helper <*> subcommands where Opts.option Opts.auto (Opts.long "port" `mappend` Opts.short 'p' `mappend` Opts.value (4242 :: Integer)) server :: ServerOptions -> IO () - server opts'@(ServerOptions dir globs outputPath port logLevel editorMode polling noWatch) = do + server opts'@(ServerOptions dir globs globsFromFile globsExcluded outputPath port logLevel editorMode polling noWatch) = do when (logLevel == LogDebug || logLevel == LogAll) (putText "Parsed Options:" *> print opts') maybe (pure ()) setCurrentDirectory dir @@ -136,6 +139,8 @@ command = Opts.helper <*> subcommands where { confLogLevel = logLevel , confOutputPath = outputPath , confGlobs = globs + , confGlobsFromFile = globsFromFile + , confGlobsExclude = globsExcluded } ts <- newIORef Nothing let @@ -150,7 +155,9 @@ command = Opts.helper <*> subcommands where serverOptions = ServerOptions <$> optional (Opts.strOption (Opts.long "directory" `mappend` Opts.short 'd')) - <*> many (Opts.argument Opts.str (Opts.metavar "Source GLOBS...")) + <*> many SharedCLI.inputFile + <*> SharedCLI.globInputFile + <*> many SharedCLI.excludeFiles <*> Opts.strOption (Opts.long "output-directory" `mappend` Opts.value "output/") <*> (fromIntegral <$> Opts.option Opts.auto (Opts.long "port" `mappend` Opts.short 'p' `mappend` Opts.value (4242 :: Integer))) diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index eb254be45c..4d73c2303c 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -15,27 +15,25 @@ import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Data.Foldable (for_) import Language.PureScript qualified as P import Language.PureScript.CST qualified as CST +import Language.PureScript.Glob (PSCGlobs(..), toInputGlobs, warnFileTypeNotFound) import Language.PureScript.Interactive import Options.Applicative qualified as Opts +import SharedCLI qualified import System.Console.Haskeline (InputT, Settings(..), defaultSettings, getInputLine, handleInterrupt, outputStrLn, runInputT, setComplete, withInterrupt) import System.IO.UTF8 (readUTF8File) import System.Exit (ExitCode(..), exitFailure) import System.Directory (doesFileExist, getCurrentDirectory) import System.FilePath (()) -import System.FilePath.Glob qualified as Glob import System.IO (hPutStrLn, stderr) -- | Command line options data PSCiOptions = PSCiOptions { psciInputGlob :: [String] + , psciInputFromFile :: Maybe String + , psciExclude :: [String] , psciBackend :: Backend } -inputFile :: Opts.Parser FilePath -inputFile = Opts.strArgument $ - Opts.metavar "FILES" - <> Opts.help "Optional .purs files to load on start" - nodePathOption :: Opts.Parser (Maybe FilePath) nodePathOption = Opts.optional . Opts.strOption $ Opts.metavar "FILE" @@ -63,7 +61,9 @@ backend = <|> (nodeBackend <$> nodePathOption <*> nodeFlagsOption) psciOptions :: Opts.Parser PSCiOptions -psciOptions = PSCiOptions <$> many inputFile +psciOptions = PSCiOptions <$> many SharedCLI.inputFile + <*> SharedCLI.globInputFile + <*> many SharedCLI.excludeFiles <*> backend -- | Parses the input and returns either a command, or an error as a 'String'. @@ -132,7 +132,12 @@ command = loop <$> options where loop :: PSCiOptions -> IO () loop PSCiOptions{..} = do - inputFiles <- concat <$> traverse Glob.glob psciInputGlob + inputFiles <- toInputGlobs $ PSCGlobs + { pscInputGlobs = psciInputGlob + , pscInputGlobsFromFile = psciInputFromFile + , pscExcludeGlobs = psciExclude + , pscWarnFileTypeNotFound = warnFileTypeNotFound "repl" + } e <- runExceptT $ do modules <- ExceptT (loadAllModules inputFiles) when (null modules) . liftIO $ do diff --git a/app/SharedCLI.hs b/app/SharedCLI.hs new file mode 100644 index 0000000000..0aa85469d4 --- /dev/null +++ b/app/SharedCLI.hs @@ -0,0 +1,24 @@ +module SharedCLI where + +import Prelude + +import Options.Applicative qualified as Opts + +inputFile :: Opts.Parser FilePath +inputFile = Opts.strArgument $ + Opts.metavar "GLOB" + <> Opts.help "A glob for input .purs file(s)." + +globInputFile :: Opts.Parser (Maybe FilePath) +globInputFile = Opts.optional $ Opts.strOption $ + Opts.long "source-globs-file" + <> Opts.metavar "FILE" + <> Opts.help "A file containing a line-separated list of input .purs globs." + +excludeFiles :: Opts.Parser FilePath +excludeFiles = Opts.strOption $ + Opts.short 'x' + <> Opts.long "exclude-files" + <> Opts.metavar "GLOB" + <> Opts.help "A glob of .purs files to exclude from the input .purs files." + diff --git a/glob-test.sh b/glob-test.sh new file mode 100644 index 0000000000..aba4432f31 --- /dev/null +++ b/glob-test.sh @@ -0,0 +1,113 @@ +#!/usr/bin/env bash + +# This script assumes `ci/build.sh && cd sdist-test` has been run +# and that the program `tree` has been installed. + +# Creates the following structure +# Foo.purs +# src/Bar.purs +# src/Bar/Baz.purs +# +# and verifies that the two kinds of input globs interact consistently. + +set -eu -o pipefail +shopt -s nullglob + +PURS="$(stack path --local-doc-root)/../bin/purs" + +tmpdir=$(mktemp -d) +trap 'rm -rf "$tmpdir"' EXIT +cd "$tmpdir" + +echo ::group::Environment info +echo "purs: ${PURS}" +echo "purs --version" +"${PURS}" --version +echo ::endgroup:: + +echo ::group::Setting up structure +mkdir -p "src/Bar" + +cat > "Foo.purs" < "src/Bar.purs" < "src/Bar/Baz.purs" < "globsAll" < "globsNoFoo" <&1 +EXPECTED=$(cd out1 && tree . 2>&1) + +"${PURS}" compile --output "out2" --source-globs-file globsAll 2>&1 +SOURCE_GLOBS=$(cd out2 && tree . 2>&1) + +"${PURS}" compile --output "out3" --source-globs-file globsAll 'Foo.purs' 2>&1 +MIXED_ALL=$(cd out3 && tree . 2>&1) + +"${PURS}" compile --output "out4" --source-globs-file globsNoFoo 'Foo.purs' 2>&1 +MIXED_NO_FOO=$(cd out4 && tree . 2>&1) +echo ::endgroup:: + +echo ::group::Running checks +if [ "${EXPECTED}" = "" ] ; then + echo "'purs compile' output should not be empty" + exit 1 +fi + +if [ "${EXPECTED}" = "${SOURCE_GLOBS}" ]; then + echo "SOURCE_GLOBS is correct" +else + echo "SOURCE_GLOBS output different from EXPECTED" + echo "Expected: ${EXPECTED}" + echo "SOURCE_GLOBS: ${SOURCE_GLOBS}" + exit 1 +fi + +if [ "${EXPECTED}" = "${MIXED_ALL}" ]; then + echo "MIXED_ALL is correct" +else + echo "MIXED_ALL output different from EXPECTED" + echo "Expected: ${MIXED_ALL}" + echo "MIXED_ALL: ${MIXED_ALL}" + exit 1 +fi + +if [ "${EXPECTED}" = "${MIXED_NO_FOO}" ]; then + echo "MIXED_NO_FOO is correct" +else + echo "MIXED_NO_FOO output different from EXPECTED" + echo "Expected: ${MIXED_NO_FOO}" + echo "MIXED_NO_FOO: ${MIXED_NO_FOO}" + exit 1 +fi + +echo "Tests passed" +echo ::endgroup:: +exit 0 diff --git a/purescript.cabal b/purescript.cabal index 496e669a81..5403791867 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -294,6 +294,7 @@ library Language.PureScript.Errors Language.PureScript.Errors.JSON Language.PureScript.Externs + Language.PureScript.Glob Language.PureScript.Graph Language.PureScript.Hierarchy Language.PureScript.Ide @@ -423,6 +424,7 @@ executable purs Command.Ide Command.Publish Command.REPL + SharedCLI Version Paths_purescript autogen-modules: diff --git a/src/Language/PureScript/Glob.hs b/src/Language/PureScript/Glob.hs new file mode 100644 index 0000000000..3493cd969d --- /dev/null +++ b/src/Language/PureScript/Glob.hs @@ -0,0 +1,44 @@ +module Language.PureScript.Glob where + +import Prelude + +import Control.Monad (when) +import Data.List (nub, (\\)) +import Data.Text qualified as T +import System.FilePath.Glob (glob) +import System.IO (hPutStrLn, stderr) +import System.IO.UTF8 (readUTF8FileT) + +data PSCGlobs = PSCGlobs + { pscInputGlobs :: [FilePath] + , pscInputGlobsFromFile :: Maybe FilePath + , pscExcludeGlobs :: [FilePath] + , pscWarnFileTypeNotFound :: FilePath -> IO () + } + +toInputGlobs :: PSCGlobs -> IO [FilePath] +toInputGlobs (PSCGlobs {..}) = do + globsFromFile <- inputGlobsFromFile pscInputGlobsFromFile + included <- globWarningOnMisses pscWarnFileTypeNotFound $ nub $ pscInputGlobs <> globsFromFile + excluded <- globWarningOnMisses pscWarnFileTypeNotFound pscExcludeGlobs + pure $ included \\ excluded + +inputGlobsFromFile :: Maybe FilePath -> IO [FilePath] +inputGlobsFromFile globsFromFile = do + mbInputsFromFile <- traverse readUTF8FileT globsFromFile + let + excludeBlankLines = not . T.null . T.strip + excludeComments = not . T.isPrefixOf "#" + toInputs = map (T.unpack . T.strip) . filter (\x -> excludeBlankLines x && excludeComments x) . T.lines + pure $ foldMap toInputs mbInputsFromFile + +globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath] +globWarningOnMisses warn = foldMap globWithWarning + where + globWithWarning pattern' = do + paths <- glob pattern' + when (null paths) $ warn pattern' + return paths + +warnFileTypeNotFound :: String -> String -> IO () +warnFileTypeNotFound pursCmd = hPutStrLn stderr . ("purs " <> pursCmd <> ": No files found using pattern: " ++) diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs index 746eec259b..57601c3d45 100644 --- a/src/Language/PureScript/Ide.hs +++ b/src/Language/PureScript/Ide.hs @@ -24,6 +24,7 @@ import "monad-logger" Control.Monad.Logger (MonadLogger, logWarnN) import Data.Map qualified as Map import Data.Text qualified as T import Language.PureScript qualified as P +import Language.PureScript.Glob (toInputGlobs, PSCGlobs(..)) import Language.PureScript.Ide.CaseSplit qualified as CS import Language.PureScript.Ide.Command (Command(..), ImportCommand(..), ListType(..)) import Language.PureScript.Ide.Completion (CompletionOptions, completionFromMatch, getCompletions, getExactCompletions, simpleExport) @@ -42,7 +43,6 @@ import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration, n import Language.PureScript.Ide.Usage (findUsages) import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist) import System.FilePath ((), normalise) -import System.FilePath.Glob (glob) -- | Accepts a Command and runs it against psc-ide's State. This is the main -- entry point for the server. @@ -179,8 +179,14 @@ findAvailableExterns = do -- | Finds all matches for the globs specified at the commandline findAllSourceFiles :: Ide m => m [FilePath] findAllSourceFiles = do - globs <- confGlobs . ideConfiguration <$> ask - liftIO (concatMapM glob globs) + IdeConfiguration{..} <- ideConfiguration <$> ask + liftIO $ toInputGlobs $ PSCGlobs + { pscInputGlobs = confGlobs + , pscInputGlobsFromFile = confGlobsFromFile + , pscExcludeGlobs = confGlobsExclude + , pscWarnFileTypeNotFound = const $ pure () + } + -- | Looks up the ExternsFiles for the given Modulenames and loads them into the -- server state. Then proceeds to parse all the specified sourcefiles and diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs index db17094a29..5fa304166b 100644 --- a/src/Language/PureScript/Ide/Types.hs +++ b/src/Language/PureScript/Ide/Types.hs @@ -162,6 +162,8 @@ data IdeConfiguration = { confOutputPath :: FilePath , confLogLevel :: IdeLogLevel , confGlobs :: [FilePath] + , confGlobsFromFile :: Maybe FilePath + , confGlobsExclude :: [FilePath] } data IdeEnvironment = diff --git a/tests/Language/PureScript/Ide/Test.hs b/tests/Language/PureScript/Ide/Test.hs index 7092b1cf53..17998d63d1 100644 --- a/tests/Language/PureScript/Ide/Test.hs +++ b/tests/Language/PureScript/Ide/Test.hs @@ -22,6 +22,8 @@ defConfig = { confLogLevel = LogNone , confOutputPath = "output/" , confGlobs = ["src/**/*.purs"] + , confGlobsFromFile = Nothing + , confGlobsExclude = [] } runIde' :: IdeConfiguration -> IdeState -> [Command] -> IO ([Either IdeError Success], IdeState) From 5589e81af15819023c60c99d3d10b8a19901e4e3 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Wed, 7 Feb 2024 11:22:40 -0600 Subject: [PATCH 53/68] Prep 0.15.15 (#4533) * Drop old bug entry * Update version to 0.15.15 * Update changelog --- .../bug_fix-moveQuantifiersToFront-scoping.md | 23 --------- ...ature_add-exclude-file-to-more-commands.md | 5 -- CHANGELOG.d/feature_glob-input-files.md | 38 --------------- CHANGELOG.md | 47 +++++++++++++++++++ npm-package/package.json | 4 +- purescript.cabal | 2 +- 6 files changed, 50 insertions(+), 69 deletions(-) delete mode 100644 CHANGELOG.d/bug_fix-moveQuantifiersToFront-scoping.md delete mode 100644 CHANGELOG.d/feature_add-exclude-file-to-more-commands.md delete mode 100644 CHANGELOG.d/feature_glob-input-files.md diff --git a/CHANGELOG.d/bug_fix-moveQuantifiersToFront-scoping.md b/CHANGELOG.d/bug_fix-moveQuantifiersToFront-scoping.md deleted file mode 100644 index 5d701a22cb..0000000000 --- a/CHANGELOG.d/bug_fix-moveQuantifiersToFront-scoping.md +++ /dev/null @@ -1,23 +0,0 @@ -* Fix scoping issues in `moveQuantifiersToFront` - -As a side effect of replacing `UnusableDeclaration` with -an updated `NoInstanceFound` error, a bug appeared in how -scoping is handled when constraints are involved. - -```purs --- | a0 -class Foo a where --- | a1 - foo :: forall a. a -``` -Before this fix, `foo`'s type signature was being transformed to -`foo :: forall @a a. Foo a => a` -where two type variables with the same identifier -are present rather than the correct signature of -`foo :: forall @a0. Foo a0 => (forall a1. a1)`. - -With this fix, the above type class declaration -will now compile and trigger a `ShadowedName` -warning since the type class member's `a` -(i.e. `a1` above) shadows the type class head's `a` -(i.e. `a0` above). diff --git a/CHANGELOG.d/feature_add-exclude-file-to-more-commands.md b/CHANGELOG.d/feature_add-exclude-file-to-more-commands.md deleted file mode 100644 index b613e791c3..0000000000 --- a/CHANGELOG.d/feature_add-exclude-file-to-more-commands.md +++ /dev/null @@ -1,5 +0,0 @@ -* Add `--exclude-file` to more commands - - This CLI arg was added to the `compile` command, but not to other commands - where such a usage would be relevant (e.g. `docs`, `repl`, `graph`, and `ide`). - \ No newline at end of file diff --git a/CHANGELOG.d/feature_glob-input-files.md b/CHANGELOG.d/feature_glob-input-files.md deleted file mode 100644 index 076b94cf4c..0000000000 --- a/CHANGELOG.d/feature_glob-input-files.md +++ /dev/null @@ -1,38 +0,0 @@ -* Enable passing source input globs via `--source-globs-file path/to/file` - - `--source-globs-file` support has been added to the following commands: - `compile`, `docs`, `graph`, `ide`, and `publish`. - - Due to a [shell character limitation on Windows](https://learn.microsoft.com/en-us/troubleshoot/windows-client/shell-experience/command-line-string-limitation) where a large list of - source globs cannot be passed (e.g. `purs compile ... glob1000/src/**/*.purs`), - source globs can be stored in a file according to the format below - and the file is passed in instead via `purs compile ---source-globs-file path/to/file`. - - ``` - # Lines starting with '#' are comments. - # Blank lines are ignored. - # Otherwise, every line is a glob. - - .spago/foo-1.2.3/src/**/*.purs - .spago/bar-2.3.3/src/**/*.purs - my-package/src/**/*.purs - my-package/tests/**/*.purs - ``` - - `--source-globs-file` is an optional argument. Mixing it with the normal source globs is fine. - Assuming `.spago/source-globs` contains `src/**/*.purs`, each command below will use - the same input globs: - ```sh - purs compile src/**/*.purs - purs compile --source-globs .spago/source-globs - purs compile --source-globs .spago/source-globs src/**/*.purs - ``` - - In the command... - ``` - purs compile inputGlob1 inputGlob2 --source-globs-file fileWithMoreGlobs --exclude-files excludeGlob1 - ``` - the files passed to the compiler are: all the files found by - `inputGlob1`, `inputGlob2`, and all the globs listed in `fileWithMoreGlobs` - minus the files found by `excludeGlob1`. - \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md index 309b8ac703..27a87cc478 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,53 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.15 + +New features: + +* Add `--exclude-file` to more commands (#4530 by @JordanMartinez) + + This CLI arg was added to the `compile` command, but not to other commands + where such a usage would be relevant (e.g. `docs`, `repl`, `graph`, and `ide`). + +* Enable passing source input globs via `--source-globs-file path/to/file` (#4530 by @JordanMartinez) + + `--source-globs-file` support has been added to the following commands: + `compile`, `docs`, `graph`, `ide`, and `publish`. + + Due to a [shell character limitation on Windows](https://learn.microsoft.com/en-us/troubleshoot/windows-client/shell-experience/command-line-string-limitation) where a large list of + source globs cannot be passed (e.g. `purs compile ... glob1000/src/**/*.purs`), + source globs can be stored in a file according to the format below + and the file is passed in instead via `purs compile ---source-globs-file path/to/file`. + + ``` + # Lines starting with '#' are comments. + # Blank lines are ignored. + # Otherwise, every line is a glob. + + .spago/foo-1.2.3/src/**/*.purs + .spago/bar-2.3.3/src/**/*.purs + my-package/src/**/*.purs + my-package/tests/**/*.purs + ``` + + `--source-globs-file` is an optional argument. Mixing it with the normal source globs is fine. + Assuming `.spago/source-globs` contains `src/**/*.purs`, each command below will use + the same input globs: + ```sh + purs compile src/**/*.purs + purs compile --source-globs .spago/source-globs + purs compile --source-globs .spago/source-globs src/**/*.purs + ``` + + In the command... + ``` + purs compile inputGlob1 inputGlob2 --source-globs-file fileWithMoreGlobs --exclude-files excludeGlob1 + ``` + the files passed to the compiler are: all the files found by + `inputGlob1`, `inputGlob2`, and all the globs listed in `fileWithMoreGlobs` + minus the files found by `excludeGlob1`. + ## 0.15.14 Bugfixes: diff --git a/npm-package/package.json b/npm-package/package.json index 8470f00e4c..56772d2b55 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.14", + "version": "0.15.15", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.14", + "postinstall": "install-purescript --purs-ver=0.15.15", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index 5403791867..6550a803dd 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.14 +version: 0.15.15 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language From debfc2e4e1e859bde3f679850767acd545a0d0f4 Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Tue, 27 Feb 2024 03:16:09 +0800 Subject: [PATCH 54/68] Fix compiler crash when a type operator is used in a type argument (#4536) Add missing traversal branch for VisibleTypeApp in updateTypes --- CHANGELOG.d/fix_issue-4535.md | 1 + src/Language/PureScript/Sugar/Operators.hs | 3 ++ tests/purs/passing/4535.purs | 43 ++++++++++++++++++++++ 3 files changed, 47 insertions(+) create mode 100644 CHANGELOG.d/fix_issue-4535.md create mode 100644 tests/purs/passing/4535.purs diff --git a/CHANGELOG.d/fix_issue-4535.md b/CHANGELOG.d/fix_issue-4535.md new file mode 100644 index 0000000000..77341885a9 --- /dev/null +++ b/CHANGELOG.d/fix_issue-4535.md @@ -0,0 +1 @@ +* Fix compiler crash when a type operator is used in a type argument diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs index bb06486e82..93028d7e22 100644 --- a/src/Language/PureScript/Sugar/Operators.hs +++ b/src/Language/PureScript/Sugar/Operators.hs @@ -409,6 +409,9 @@ updateTypes goType = (goDecl, goExpr, goBinder) goExpr pos (TypedValue check v ty) = do ty' <- goType' pos ty return (pos, TypedValue check v ty') + goExpr pos (VisibleTypeApp v ty) = do + ty' <- goType' pos ty + return (pos, VisibleTypeApp v ty') goExpr pos other = return (pos, other) goBinder :: SourceSpan -> Binder -> m (SourceSpan, Binder) diff --git a/tests/purs/passing/4535.purs b/tests/purs/passing/4535.purs new file mode 100644 index 0000000000..424ba6e7e5 --- /dev/null +++ b/tests/purs/passing/4535.purs @@ -0,0 +1,43 @@ +module Main where + +import Prelude + +import Data.Maybe (Maybe(..)) +import Data.Tuple.Nested ((/\), type (/\)) +import Effect (Effect) +import Effect.Console (log) +import Type.Proxy (Proxy(..)) + +singleArgument :: forall @a. a -> Unit +singleArgument _ = unit + +multiArgument :: forall @a @b. a -> b -> Unit +multiArgument _ _ = unit + +singleApplication :: Int /\ Number -> Unit +singleApplication = singleArgument @(Int /\ Number) + +-- Like expression applications, visible type applications are left-associative. +-- This test accounts for subsequent type applications nested in this manner. +appNestingWorks :: Int /\ Number -> Number /\ Int -> Unit +appNestingWorks = multiArgument @(Int /\ Number) @(Number /\ Int) + +-- This test accounts for type applications nested within other AST nodes. +otherNestingWorks :: Array (Maybe (Int /\ Number)) +otherNestingWorks = [Just @(Int /\ Number) (0 /\ 0.0), Just @(Int /\ Number) (1 /\ 1.0)] + +type InSynonym = Int /\ Number + +-- This test accounts for type synonyms used as type arguments. +-- Since expansion happens during checking, InSynonym would expand +-- to an already-desugared type operator. This test exists for the +-- sake of redundancy. +inSynonym :: InSynonym -> Unit +inSynonym = singleArgument @InSynonym + +-- This test accounts for type operators used as type arguments directly. +operatorAsArgument :: Proxy (/\) +operatorAsArgument = Proxy @(/\) + +main :: Effect Unit +main = log "Done" From 851291e0fff69c24ef714f24653defa978c381e5 Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Tue, 16 Apr 2024 12:47:39 +0800 Subject: [PATCH 55/68] Upgrade to GHC 9.2.8 (#4537) * Update resolver to lts-20.26 * Update haskell/action to haskell-action --- .github/workflows/ci.yml | 8 ++++---- CHANGELOG.d/misc_ghc-bump.md | 1 + INSTALL.md | 4 ++-- purescript.cabal | 2 +- stack.yaml | 2 +- 5 files changed, 9 insertions(+), 8 deletions(-) create mode 100644 CHANGELOG.d/misc_ghc-bump.md diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 8efd13812b..25636a7a3c 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -32,7 +32,7 @@ defaults: env: CI_PRERELEASE: "${{ github.event_name == 'push' && github.ref == 'refs/heads/master' }}" CI_RELEASE: "${{ github.event_name == 'release' }}" - STACK_VERSION: "2.9.3" + STACK_VERSION: "2.15.1" concurrency: # We never want two prereleases building at the same time, since they would @@ -55,7 +55,7 @@ jobs: include: - # If upgrading the Haskell image, also upgrade it in the lint job below os: ["ubuntu-latest"] - image: haskell:9.2.5@sha256:2597b0e2458165a6635906204f7fac43c22e7d2a46aca1235a811194bb6cd419 + image: haskell:9.2.8@sha256:b3b2f3909c7381bb96b8f18766f9407a3d6f61e0f07ea95e812583ac4f442cbb - os: ["macOS-11"] - os: ["windows-2019"] - os: ["self-hosted", "macos", "ARM64"] @@ -99,7 +99,7 @@ jobs: # and their Haskell environment is instead provided by a nix-shell # See https://github.com/purescript/purescript/pulls/4455 if: "!contains(matrix.os, 'ubuntu-latest') && !contains(matrix.os, 'self-hosted')" - uses: "haskell/actions/setup@v1" + uses: "haskell-actions/setup@v2" with: enable-stack: true stack-version: "${{ env.STACK_VERSION }}" @@ -231,7 +231,7 @@ jobs: # means our published binaries will work on the widest number of platforms. # But the HLint binary downloaded by this job requires a newer glibc # version. - container: haskell:9.2.5@sha256:2597b0e2458165a6635906204f7fac43c22e7d2a46aca1235a811194bb6cd419 + container: haskell:9.2.8@sha256:b3b2f3909c7381bb96b8f18766f9407a3d6f61e0f07ea95e812583ac4f442cbb steps: - # We need a proper Git repository, but the checkout step will unpack a tarball instead of doing a clone diff --git a/CHANGELOG.d/misc_ghc-bump.md b/CHANGELOG.d/misc_ghc-bump.md new file mode 100644 index 0000000000..a1222cf6d0 --- /dev/null +++ b/CHANGELOG.d/misc_ghc-bump.md @@ -0,0 +1 @@ +* Update Stackage snapshot to lts-20.26 and GHC to 9.2.8 diff --git a/INSTALL.md b/INSTALL.md index 041cd3315d..0bccc516c7 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -4,12 +4,12 @@ If you are having difficulty installing the PureScript compiler, feel free to as ## Requirements -The PureScript compiler is built using GHC 9.2.5, and should be able to run on any operating system supported by GHC 9.2.5. In particular: +The PureScript compiler is built using GHC 9.2.8, and should be able to run on any operating system supported by GHC 9.2.8. In particular: * for Windows users, versions predating Vista are not officially supported, * for macOS / OS X users, versions predating Mac OS X 10.7 (Lion) are not officially supported. -See also for more details about the operating systems which GHC 9.2.5 supports. +See also for more details about the operating systems which GHC 9.2.8 supports. ## Official prebuilt binaries diff --git a/purescript.cabal b/purescript.cabal index 6550a803dd..0d32ce4814 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -119,7 +119,7 @@ common defaults TypeFamilies ViewPatterns build-tool-depends: - happy:happy ==1.20.0 + happy:happy ==1.20.1.1 build-depends: -- NOTE: Please do not edit these version constraints manually. They are -- deliberately made narrow because changing the dependency versions in diff --git a/stack.yaml b/stack.yaml index cbf7426e01..88b27b1a46 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,6 @@ # Please update Haskell image versions under .github/workflows/ci.yml together to use the same GHC version # (or the CI build will fail) -resolver: lts-20.9 +resolver: lts-20.26 pvp-bounds: both packages: - '.' From 2070d479d133da9a7c33f7572ca7adb45a4c7aee Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Tue, 16 Apr 2024 15:25:55 -0400 Subject: [PATCH 56/68] Remove Git upgrade step from CI (#4541) buster-backports no longer exists in debian/dists and it's breaking CI. The currently available version of Git in this container is 2.20.1, so we don't need this. --- .github/workflows/ci.yml | 16 ---------------- .../internal_remove-git-upgrade-step-in-ci.md | 1 + 2 files changed, 1 insertion(+), 16 deletions(-) create mode 100644 CHANGELOG.d/internal_remove-git-upgrade-step-in-ci.md diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 25636a7a3c..e2991a9118 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -69,15 +69,6 @@ jobs: version: "${{ steps.build.outputs.version }}" steps: - - # We need a proper Git repository, but the checkout step will unpack a tarball instead of doing a clone - # if the Git version is less than 2.18. - name: "(Linux only) Install a newer version of Git" - if: "contains(matrix.os, 'ubuntu-latest')" - run: | - . /etc/os-release - echo deb http://deb.debian.org/debian "$VERSION_CODENAME"-backports main >> /etc/apt/sources.list - apt-get update && apt-get install -y git/"$VERSION_CODENAME"-backports - - # We need `gh` installed on the Linux version. Otherwise, release artifacts won't be uploaded. name: "(Linux only) Install gh" if: "contains(matrix.os, 'ubuntu-latest')" @@ -234,13 +225,6 @@ jobs: container: haskell:9.2.8@sha256:b3b2f3909c7381bb96b8f18766f9407a3d6f61e0f07ea95e812583ac4f442cbb steps: - - # We need a proper Git repository, but the checkout step will unpack a tarball instead of doing a clone - # if the Git version is less than 2.18. - name: "Install a newer version of Git" - run: | - . /etc/os-release - echo deb http://deb.debian.org/debian "$VERSION_CODENAME"-backports main >> /etc/apt/sources.list - apt-get update && apt-get install -y git/"$VERSION_CODENAME"-backports - uses: "actions/checkout@v2" - name: "Fix working directory ownership" diff --git a/CHANGELOG.d/internal_remove-git-upgrade-step-in-ci.md b/CHANGELOG.d/internal_remove-git-upgrade-step-in-ci.md new file mode 100644 index 0000000000..f7f622a96e --- /dev/null +++ b/CHANGELOG.d/internal_remove-git-upgrade-step-in-ci.md @@ -0,0 +1 @@ +* Remove the step that upgraded Git from the CI workflow From 08b6c758b53fface1769c05ca8bcf119db5c114c Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Thu, 25 Jul 2024 01:10:02 +0300 Subject: [PATCH 57/68] Upgrade macOS runner to 14 (#4548) Since the beginning of July GitHub has deprecated the macOS-11 runners that we were using, see [the announcement](https://github.blog/changelog/2024-05-20-actions-upcoming-changes-to-github-hosted-macos-runners/) --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e2991a9118..2cd314dbf1 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -56,7 +56,7 @@ jobs: - # If upgrading the Haskell image, also upgrade it in the lint job below os: ["ubuntu-latest"] image: haskell:9.2.8@sha256:b3b2f3909c7381bb96b8f18766f9407a3d6f61e0f07ea95e812583ac4f442cbb - - os: ["macOS-11"] + - os: ["macOS-14"] - os: ["windows-2019"] - os: ["self-hosted", "macos", "ARM64"] - os: ["self-hosted", "Linux", "ARM64"] From e06b9ccb7cbf31633d25e55531d70dcda7ec28b2 Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Thu, 25 Jul 2024 01:50:43 +0200 Subject: [PATCH 58/68] Fix imports for newer mtl versions (#4547) Newer mtl does not re-export Control.Monad and Data.Monoid anymore. So we fix that by splitting the imports manually. --- app/Command/Docs.hs | 2 +- app/Command/Docs/Html.hs | 2 +- src/Control/Monad/Supply.hs | 3 ++- src/Language/PureScript/Errors.hs | 3 ++- src/Language/PureScript/Renamer.hs | 3 ++- src/Language/PureScript/Sugar/Operators/Common.hs | 2 +- src/Language/PureScript/TypeChecker/Entailment.hs | 6 ++++-- src/Language/PureScript/TypeChecker/Monad.hs | 3 ++- 8 files changed, 15 insertions(+), 9 deletions(-) diff --git a/app/Command/Docs.hs b/app/Command/Docs.hs index f0b6711b09..987023c98c 100644 --- a/app/Command/Docs.hs +++ b/app/Command/Docs.hs @@ -6,7 +6,7 @@ import Prelude import Command.Docs.Html (asHtml, writeHtmlModules) import Command.Docs.Markdown (asMarkdown, writeMarkdownModules) import Control.Applicative (Alternative(..), optional) -import Control.Monad.Writer (when) +import Control.Monad (when) import Control.Monad.Trans.Except (runExceptT) import Data.Maybe (fromMaybe) import Data.Text qualified as T diff --git a/app/Command/Docs/Html.hs b/app/Command/Docs/Html.hs index 6ad51041f3..116cf0f7a7 100644 --- a/app/Command/Docs/Html.hs +++ b/app/Command/Docs/Html.hs @@ -9,7 +9,7 @@ import Prelude import Control.Applicative (Alternative(..)) import Control.Arrow ((&&&)) -import Control.Monad.Writer (guard) +import Control.Monad (guard) import Data.List (sort) import Data.Text (Text) import Data.Text.Lazy (toStrict) diff --git a/src/Control/Monad/Supply.hs b/src/Control/Monad/Supply.hs index 8c64fd2524..dd447a9c39 100644 --- a/src/Control/Monad/Supply.hs +++ b/src/Control/Monad/Supply.hs @@ -7,7 +7,8 @@ import Prelude import Control.Applicative (Alternative) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.Reader (MonadPlus, MonadReader, MonadTrans) +import Control.Monad.Reader (MonadReader, MonadTrans) +import Control.Monad (MonadPlus) import Control.Monad.State (StateT(..)) import Control.Monad.Writer (MonadWriter) diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 56d962b3c7..6a15c3690c 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -13,7 +13,8 @@ import Control.Lens (both, head1, over) import Control.Monad (forM, unless) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Trans.State.Lazy (State, evalState, get, put) -import Control.Monad.Writer (Last(..), MonadWriter(..), censor) +import Control.Monad.Writer (MonadWriter(..), censor) +import Data.Monoid (Last(..)) import Data.Bifunctor (first, second) import Data.Bitraversable (bitraverse) import Data.Char (isSpace) diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs index a54e39f1e1..aff42ca288 100644 --- a/src/Language/PureScript/Renamer.hs +++ b/src/Language/PureScript/Renamer.hs @@ -5,7 +5,8 @@ module Language.PureScript.Renamer (renameInModule) where import Prelude -import Control.Monad.State (MonadState(..), State, gets, modify, runState, (>=>)) +import Control.Monad.State (MonadState(..), State, gets, modify, runState) +import Control.Monad ((>=>)) import Data.Functor ((<&>)) import Data.List (find) diff --git a/src/Language/PureScript/Sugar/Operators/Common.hs b/src/Language/PureScript/Sugar/Operators/Common.hs index 1a18f88014..7fd6df9645 100644 --- a/src/Language/PureScript/Sugar/Operators/Common.hs +++ b/src/Language/PureScript/Sugar/Operators/Common.hs @@ -2,7 +2,7 @@ module Language.PureScript.Sugar.Operators.Common where import Prelude -import Control.Monad.State (guard, join) +import Control.Monad (guard, join) import Control.Monad.Except (MonadError(..)) import Data.Either (rights) diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index 7a3872c1c8..85bdfee4aa 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -15,9 +15,11 @@ import Protolude (ordNub, headMay) import Control.Arrow (second, (&&&)) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State (MonadState(..), MonadTrans(..), StateT(..), evalStateT, execStateT, foldM, gets, guard, join, modify, zipWithM, zipWithM_, (<=<)) +import Control.Monad.State (MonadState(..), MonadTrans(..), StateT(..), evalStateT, execStateT, gets, modify) +import Control.Monad (foldM, guard, join, zipWithM, zipWithM_, (<=<)) import Control.Monad.Supply.Class (MonadSupply(..)) -import Control.Monad.Writer (Any(..), MonadWriter(..), WriterT(..)) +import Control.Monad.Writer (MonadWriter(..), WriterT(..)) +import Data.Monoid (Any(..)) import Data.Either (lefts, partitionEithers) import Data.Foldable (for_, fold, toList) diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs index ba27d0299b..b6382e6707 100644 --- a/src/Language/PureScript/TypeChecker/Monad.hs +++ b/src/Language/PureScript/TypeChecker/Monad.hs @@ -9,7 +9,8 @@ import Prelude import Control.Arrow (second) import Control.Monad.Error.Class (MonadError(..)) -import Control.Monad.State (MonadState(..), StateT(..), forM_, gets, guard, join, modify, when, (<=<)) +import Control.Monad.State (MonadState(..), StateT(..), gets, modify) +import Control.Monad (forM_, guard, join, when, (<=<)) import Control.Monad.Writer.Class (MonadWriter(..), censor) import Data.Maybe (fromMaybe) From fc3fa8897916de1a3973de976eaea1fba23b4df9 Mon Sep 17 00:00:00 2001 From: Rory Campbell Date: Sun, 29 Sep 2024 07:55:41 +0200 Subject: [PATCH 59/68] IDE: don't force state results (#4546) --- CHANGELOG.d/fix_issue-4545.md | 1 + CONTRIBUTORS.md | 1 + src/Language/PureScript/Ide/Reexports.hs | 3 +-- src/Language/PureScript/Ide/State.hs | 9 +++----- src/Language/PureScript/Ide/Types.hs | 28 ++++++++++++------------ 5 files changed, 20 insertions(+), 22 deletions(-) create mode 100644 CHANGELOG.d/fix_issue-4545.md diff --git a/CHANGELOG.d/fix_issue-4545.md b/CHANGELOG.d/fix_issue-4545.md new file mode 100644 index 0000000000..1d6462ee9c --- /dev/null +++ b/CHANGELOG.d/fix_issue-4545.md @@ -0,0 +1 @@ +* Speed up IDE performance on large projects diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 7213ef9c67..aa5ddefd3f 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -167,6 +167,7 @@ If you would prefer to use different terms, please use the section below instead | [@woody88](https://github.com/woody88) | Woodson Delhia | [MIT license] | | [@xgrommx](https://github.com/xgrommx) | Denis Stoyanov | [MIT license] | | [@zudov](https://github.com/zudov) | Konstantin Zudov | [MIT license] | +| [@roryc89](https://github.com/roryc89) | Rory Campbell | [MIT license] | ### Contributors using Modified Terms diff --git a/src/Language/PureScript/Ide/Reexports.hs b/src/Language/PureScript/Ide/Reexports.hs index a50b9de7a9..3da2a0a82e 100644 --- a/src/Language/PureScript/Ide/Reexports.hs +++ b/src/Language/PureScript/Ide/Reexports.hs @@ -35,9 +35,8 @@ data ReexportResult a = ReexportResult { reResolved :: a , reFailed :: [(P.ModuleName, P.DeclarationRef)] - } deriving (Show, Eq, Functor, Generic) + } deriving (Show, Eq, Functor) -instance NFData a => NFData (ReexportResult a) -- | Uses the passed formatter to format the resolved module, and adds possible -- failures diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs index 06eed507e4..32478d7000 100644 --- a/src/Language/PureScript/Ide/State.hs +++ b/src/Language/PureScript/Ide/State.hs @@ -54,7 +54,7 @@ import Language.PureScript.Ide.Externs (convertExterns) import Language.PureScript.Ide.Reexports (ReexportResult(..), prettyPrintReexportResult, reexportHasFailures, resolveReexports) import Language.PureScript.Ide.SourceFile (extractAstInformation) import Language.PureScript.Ide.Types -import Language.PureScript.Ide.Util (discardAnn, displayTimeSpec, logPerf, opNameT, properNameT, runLogger) +import Language.PureScript.Ide.Util (discardAnn, opNameT, properNameT, runLogger) import System.Directory (getModificationTime) -- | Resets all State inside psc-ide @@ -199,10 +199,7 @@ cachedRebuild = vsCachedRebuild <$> getVolatileState populateVolatileStateSync :: (Ide m, MonadLogger m) => m () populateVolatileStateSync = do st <- ideStateVar <$> ask - let message duration = "Finished populating volatile state in: " <> displayTimeSpec duration - results <- logPerf message $ do - !r <- liftIO (atomically (populateVolatileStateSTM st)) - pure r + results <- liftIO (atomically (populateVolatileStateSTM st)) void $ Map.traverseWithKey (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn))) (Map.filter reexportHasFailures results) @@ -235,7 +232,7 @@ populateVolatileStateSTM ref = do & resolveOperators & resolveReexports reexportRefs setVolatileStateSTM ref (IdeVolatileState (AstData asts) (map reResolved results) rebuildCache) - pure (force results) + pure results resolveLocations :: ModuleMap (DefinitionSites P.SourceSpan, TypeAnnotations) diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs index 5fa304166b..41532a3c51 100644 --- a/src/Language/PureScript/Ide/Types.hs +++ b/src/Language/PureScript/Ide/Types.hs @@ -31,43 +31,43 @@ data IdeDeclaration | IdeDeclValueOperator IdeValueOperator | IdeDeclTypeOperator IdeTypeOperator | IdeDeclModule P.ModuleName - deriving (Show, Eq, Ord, Generic, NFData) + deriving (Show, Eq, Ord) data IdeValue = IdeValue { _ideValueIdent :: P.Ident , _ideValueType :: P.SourceType - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) data IdeType = IdeType { _ideTypeName :: P.ProperName 'P.TypeName , _ideTypeKind :: P.SourceType , _ideTypeDtors :: [(P.ProperName 'P.ConstructorName, P.SourceType)] - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) data IdeTypeSynonym = IdeTypeSynonym { _ideSynonymName :: P.ProperName 'P.TypeName , _ideSynonymType :: P.SourceType , _ideSynonymKind :: P.SourceType - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) data IdeDataConstructor = IdeDataConstructor { _ideDtorName :: P.ProperName 'P.ConstructorName , _ideDtorTypeName :: P.ProperName 'P.TypeName , _ideDtorType :: P.SourceType - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) data IdeTypeClass = IdeTypeClass { _ideTCName :: P.ProperName 'P.ClassName , _ideTCKind :: P.SourceType , _ideTCInstances :: [IdeInstance] - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) data IdeInstance = IdeInstance { _ideInstanceModule :: P.ModuleName , _ideInstanceName :: P.Ident , _ideInstanceTypes :: [P.SourceType] , _ideInstanceConstraints :: Maybe [P.SourceConstraint] - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) data IdeValueOperator = IdeValueOperator { _ideValueOpName :: P.OpName 'P.ValueOpName @@ -75,7 +75,7 @@ data IdeValueOperator = IdeValueOperator , _ideValueOpPrecedence :: P.Precedence , _ideValueOpAssociativity :: P.Associativity , _ideValueOpType :: Maybe P.SourceType - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) data IdeTypeOperator = IdeTypeOperator { _ideTypeOpName :: P.OpName 'P.TypeOpName @@ -83,7 +83,7 @@ data IdeTypeOperator = IdeTypeOperator , _ideTypeOpPrecedence :: P.Precedence , _ideTypeOpAssociativity :: P.Associativity , _ideTypeOpKind :: Maybe P.SourceType - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) _IdeDeclValue :: Traversal' IdeDeclaration IdeValue _IdeDeclValue f (IdeDeclValue x) = map IdeDeclValue (f x) @@ -131,7 +131,7 @@ makeLenses ''IdeTypeOperator data IdeDeclarationAnn = IdeDeclarationAnn { _idaAnnotation :: Annotation , _idaDeclaration :: IdeDeclaration - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) data Annotation = Annotation @@ -139,7 +139,7 @@ data Annotation , _annExportedFrom :: Maybe P.ModuleName , _annTypeAnnotation :: Maybe P.SourceType , _annDocumentation :: Maybe Text - } deriving (Show, Eq, Ord, Generic, NFData) + } deriving (Show, Eq, Ord) makeLenses ''Annotation makeLenses ''IdeDeclarationAnn @@ -152,7 +152,7 @@ type TypeAnnotations = Map P.Ident P.SourceType newtype AstData a = AstData (ModuleMap (DefinitionSites a, TypeAnnotations)) -- ^ SourceSpans for the definition sites of values and types as well as type -- annotations found in a module - deriving (Show, Eq, Ord, Generic, NFData, Functor, Foldable) + deriving (Show, Eq, Ord, Functor, Foldable) data IdeLogLevel = LogDebug | LogPerf | LogAll | LogDefault | LogNone deriving (Show, Eq) @@ -313,7 +313,7 @@ encodeImport (P.runModuleName -> mn, importType, map P.runModuleName -> qualifie -- | Denotes the different namespaces a name in PureScript can reside in. data IdeNamespace = IdeNSValue | IdeNSType | IdeNSModule - deriving (Show, Eq, Ord, Generic, NFData) + deriving (Show, Eq, Ord) instance FromJSON IdeNamespace where parseJSON = Aeson.withText "Namespace" $ \case @@ -324,4 +324,4 @@ instance FromJSON IdeNamespace where -- | A name tagged with a namespace data IdeNamespaced = IdeNamespaced IdeNamespace Text - deriving (Show, Eq, Ord, Generic, NFData) + deriving (Show, Eq, Ord) From 48be80d01d904bd3b2cf575ef0e61057c640ea22 Mon Sep 17 00:00:00 2001 From: Adrian Sieber <36796532+ad-si@users.noreply.github.com> Date: Thu, 10 Apr 2025 10:37:23 +0000 Subject: [PATCH 60/68] Upgrade to GHC 9.6.6 (#4568) * Upgrade CI * Back to the previous haskell image * Use new spavo * Upgrade node to latest supported lts * Upgrade to GHC 9.6.6 - Switch from `ansi-wl-pprint` to `prettyprinter` - Add several `extra-deps` * Upgrade CI to use GHC 9.6.6 * Upgrade GitHub Actions * CI: Upgrade to macos-15, specify exact version of Ubuntu * CI: Upgrade Stack from 2.15.1 to 3.3.1 * CI: Include stack.yaml.lock file and use it for the cache's file hashes * CI: Also include `purescript.cabal` in cache's file hashes * Update documentation * CI: Remove obsolete directory ownership changes * CI: Add safe.directory configuration for Ubuntu 24.04 * CI: Fix container ownership issues in workflow configuration * CI: Simplify container configuration and fix working directory ownership for Ubuntu 24.04 * Update version ranges of dependencies * Update Cabal version range and allow newer dependencies in stack configuration * Update Cabal version to 3.10.3.0 in stack configuration * Enable allow-newer option in stack configuration * Update dependency versions in purescript.cabal and stack.yaml * Update weeder installation and streamline CI workflow * Fix wrapping of run commands * Remove obsolete quotes * Add missing `--name` flag to `spago init` * Add Adrian Sieber to contributors * Add changelog entry for GHC upgrade * Use new weeder.toml config file format * Install missing `jq` dependency * CI: Use `-y` flag for all `apt-get install` runs * Vendor pattern-arrows * Run haskell container on ubuntu-latest, use macos-13 and macos-14 * CI: Use strings instead of arrays for matrix.os * Fix Hlint warnings * Add arm64 Linux to testing matrix * Correctly match only self-hosted Linux runner * Don't use self-hosted runners anymore, as GitHub runners cover all cases * Mention glibc bump from `2.28` to `2.31` in changelog * Upgrade to latest version of aeson-better-errors from Hackage * Remove obsolete `allow-newer` section, delete .stack-work on make clean * Re-add `allow-newer` block, improve dependency bounds * Downgrade haskeline to 0.8.2 to avoid libtinfo issues * Update aeson-better-errors and use cheapskate fork * Fix build errors in stack These errors are present in the Cabal build and seem to be caused by Cabal and Stack using different versions of mtl, with 2.3.x notably changing re-exports for certain modules. --------- Co-authored-by: Fabrizio Ferrai Co-authored-by: Justin Garcia --- .github/workflows/ci.yml | 121 +++++++----------- .gitignore | 1 - CHANGELOG.d/internal_upgrade_to_ghc_9.6.md | 2 + CONTRIBUTORS.md | 1 + INSTALL.md | 5 +- LICENSE | 24 ---- Makefile | 5 + app/Command/Docs.hs | 15 ++- app/Main.hs | 9 +- cabal.project | 5 + ci/build-package-set.sh | 16 +-- purescript.cabal | 47 +++---- src/Control/Monad/Supply/Class.hs | 2 + src/Control/PatternArrows.hs | 118 +++++++++++++++++ src/Language/PureScript/CodeGen/JS.hs | 1 - .../PureScript/CoreImp/Optimizer/TCO.hs | 2 +- .../Docs/RenderedCode/RenderType.hs | 4 +- src/Language/PureScript/Linter/Exhaustive.hs | 1 - src/Language/PureScript/Pretty/Types.hs | 4 +- .../PureScript/Sugar/BindingGroups.hs | 6 +- src/Language/PureScript/TypeChecker/Monad.hs | 1 + .../PureScript/TypeChecker/Synonyms.hs | 1 + stack.yaml | 30 ++--- stack.yaml.lock | 58 +++++++++ update-changelog.hs | 3 +- weeder.dhall | 41 ------ weeder.toml | 40 ++++++ 27 files changed, 347 insertions(+), 216 deletions(-) create mode 100644 CHANGELOG.d/internal_upgrade_to_ghc_9.6.md create mode 100644 src/Control/PatternArrows.hs create mode 100644 stack.yaml.lock delete mode 100644 weeder.dhall create mode 100644 weeder.toml diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2cd314dbf1..3557db1a6f 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -20,6 +20,7 @@ on: - purescript.cabal - Setup.hs - stack.yaml + - stack.yaml.lock - update-changelog.hs - weeder.dhall release: @@ -32,7 +33,7 @@ defaults: env: CI_PRERELEASE: "${{ github.event_name == 'push' && github.ref == 'refs/heads/master' }}" CI_RELEASE: "${{ github.event_name == 'release' }}" - STACK_VERSION: "2.15.1" + STACK_VERSION: "3.3.1" concurrency: # We never want two prereleases building at the same time, since they would @@ -53,16 +54,18 @@ jobs: fail-fast: false # do not cancel builds for other OSes if one fails matrix: include: - - # If upgrading the Haskell image, also upgrade it in the lint job below - os: ["ubuntu-latest"] - image: haskell:9.2.8@sha256:b3b2f3909c7381bb96b8f18766f9407a3d6f61e0f07ea95e812583ac4f442cbb - - os: ["macOS-14"] - - os: ["windows-2019"] - - os: ["self-hosted", "macos", "ARM64"] - - os: ["self-hosted", "Linux", "ARM64"] + - image: haskell:9.6.6 # Also upgrade version in the lint job below + os: ubuntu-latest # Exact version is not important, as it's only the container host) + + - image: haskell:9.6.6 + os: ubuntu-24.04-arm # Exact version is not important, as it's only the container host + + - os: macos-13 # x64 + - os: macos-14 # arm64 + - os: windows-2019 # x64 runs-on: "${{ matrix.os }}" - container: "${{ matrix.image }}" + container: "${{ matrix.image }}" outputs: do-not-prerelease: "${{ steps.build.outputs.do-not-prerelease }}" @@ -71,43 +74,40 @@ jobs: steps: - # We need `gh` installed on the Linux version. Otherwise, release artifacts won't be uploaded. name: "(Linux only) Install gh" - if: "contains(matrix.os, 'ubuntu-latest')" + if: startsWith(matrix.image, 'haskell') run: | curl -fsSL https://cli.github.com/packages/githubcli-archive-keyring.gpg | dd of=/usr/share/keyrings/githubcli-archive-keyring.gpg chmod go+r /usr/share/keyrings/githubcli-archive-keyring.gpg echo "deb [arch=$(dpkg --print-architecture) signed-by=/usr/share/keyrings/githubcli-archive-keyring.gpg] https://cli.github.com/packages stable main" | tee /etc/apt/sources.list.d/github-cli.list > /dev/null apt-get update - apt-get install gh + apt-get install -y gh - - uses: "actions/checkout@v2" - - uses: "actions/setup-node@v2" + - uses: "actions/checkout@v4" + - uses: "actions/setup-node@v4" with: - node-version: "16" + node-version: "22" - id: "haskell" name: "(Non-Linux only) Install Haskell" - # Note: here we exclude the self-hosted runners because this action does not work on ARM - # and their Haskell environment is instead provided by a nix-shell - # See https://github.com/purescript/purescript/pulls/4455 - if: "!contains(matrix.os, 'ubuntu-latest') && !contains(matrix.os, 'self-hosted')" + if: startsWith(matrix.os, 'macos') || startsWith(matrix.os, 'windows') uses: "haskell-actions/setup@v2" with: + ghc-version: "9.6.6" enable-stack: true stack-version: "${{ env.STACK_VERSION }}" stack-no-global: true - - name: "(Linux only) Check Stack version and fix working directory ownership" - if: "contains(matrix.os, 'ubuntu-latest')" + - name: "(Linux only) Fix working directory ownership" + if: startsWith(matrix.image, 'haskell') run: | - [ "$(stack --numeric-version)" = "$STACK_VERSION" ] chown root:root . - - uses: "actions/cache@v2" + - uses: "actions/cache@v4" with: path: | /root/.stack ${{ steps.haskell.outputs.stack-root }} - key: "${{ matrix.image || runner.os }}--MdyPsf-${{ hashFiles('stack.yaml') }}" + key: "${{ matrix.image || runner.os }}--MdyPsf-${{ hashFiles('stack.yaml.lock', 'purescript.cabal') }}" - name: "(Windows only) Configure Stack to store its programs in STACK_ROOT" # This ensures that the local GHC and MSYS binaries that Stack installs @@ -122,16 +122,16 @@ jobs: run: "ci/fix-home ci/build.sh" - name: "(Linux only) Glob tests" - if: "contains(matrix.os, 'ubuntu-latest')" + if: startsWith(matrix.image, 'haskell') working-directory: "sdist-test" # We build in this directory in build.sh, so this is where we need to # launch `stack exec`. The actual glob checks happen in a temporary directory. run: | - apt-get install tree + apt-get install -y tree ../ci/fix-home stack exec bash ../glob-test.sh - name: "(Linux only) Build the entire package set" - if: "contains(matrix.os, 'ubuntu-latest')" + if: startsWith(matrix.image, 'haskell') # We build in this directory in build.sh, so this is where we need to # launch `stack exec`. The actual package-set building happens in a # temporary directory. @@ -144,11 +144,11 @@ jobs: # Moreover, npm has a hook issue that will cause spago to fail to install # We upgrade npm to fix this run: | - npm i -g npm@8.8.0 + apt-get install -y jq ../ci/fix-home stack --haddock exec ../ci/build-package-set.sh - name: Verify that 'libtinfo' isn't in binary - if: "runner.os == 'Linux'" + if: runner.os == 'Linux' working-directory: "sdist-test" run: | if [ $(ldd $(../ci/fix-home stack path --local-doc-root)/../bin/purs | grep 'libtinfo' | wc -l) -ge 1 ]; then @@ -157,17 +157,6 @@ jobs: exit 1 fi - - name: "(Self-hosted Linux ARM64 only) Patch the binary to work on non-Nix systems" - if: "runner.os == 'Linux' && runner.arch == 'ARM64'" - working-directory: "sdist-test" - # The self-hosted build happens inside a nix-shell that provides a working stack binary - # on ARM systems, and while the macOS binary is fine - because macOS binaries are almost - # statically linked), the linux ones are all pointing at the nix store. - # So here we first point the binary to the right linker that should work on a generic linux, - # and then fix the RUNPATH with the right location to load the shared libraries from - run: | - patchelf --set-interpreter /usr/lib/ld-linux-aarch64.so.1 --set-rpath /usr/lib/aarch64-linux-gnu $(stack path --local-doc-root)/../bin/purs - - name: "(Release/prerelease only) Create bundle" if: "${{ env.CI_RELEASE == 'true' || env.CI_PRERELEASE == 'true' && steps.build.outputs.do-not-prerelease != 'true' }}" run: | @@ -199,7 +188,7 @@ jobs: - name: "(Prerelease only) Upload bundle" if: "${{ env.CI_PRERELEASE == 'true' && steps.build.outputs.do-not-prerelease != 'true' }}" - uses: "actions/upload-artifact@v3" + uses: "actions/upload-artifact@v4.6.0" with: name: "${{ runner.os }}-${{ runner.arch }}-bundle" path: | @@ -208,59 +197,39 @@ jobs: - name: "(Release only) Publish bundle" if: "${{ env.CI_RELEASE == 'true' }}" - # This requires the gh command line tool to be installed on our - # self-hosted runners env: GITHUB_TOKEN: "${{ secrets.GITHUB_TOKEN }}" run: "gh release upload --clobber ${{ github.ref_name }} sdist-test/bundle/*.{tar.gz,sha}" lint: - runs-on: "ubuntu-latest" - # At the moment, this is a different image from the image used for - # compilation, though the GHC versions match. This is because the - # compilation image uses an old version of glibc, which we want because it - # means our published binaries will work on the widest number of platforms. - # But the HLint binary downloaded by this job requires a newer glibc - # version. - container: haskell:9.2.8@sha256:b3b2f3909c7381bb96b8f18766f9407a3d6f61e0f07ea95e812583ac4f442cbb + container: haskell:9.6.6 + runs-on: ubuntu-latest # Exact version is not important, as it's only the container host steps: - - uses: "actions/checkout@v2" + - uses: "actions/checkout@v4" - name: "Fix working directory ownership" run: | chown root:root . - - uses: "actions/cache@v2" + - uses: "actions/cache@v4" with: path: | /root/.stack - key: "lint-${{ hashFiles('stack.yaml') }}" + key: "lint-${{ hashFiles('stack.yaml.lock', 'purescript.cabal') }}" - run: "ci/fix-home ci/run-hlint.sh --git" env: VERSION: "3.5" - # Note: the weeder version will need to be updated when we next update our version - # of GHC. - # - # weeder-2.2.0 has somewhat strange version deps. It doesn't appear to - # support the exact versions of dhall and generic-lens in LTS-18. - # However, forcing it to use the versions of dhall and generic-lens in - # LTS-18 doesn't cause any problems when building, so the following - # commands build weeder while ignoring version constraints. - name: Install weeder run: | - # The `stack.yaml` file is copied to a separate file so that - # adding `allow-newer: true` doesn't affect any subsequant - # calls to `stack`. - cp stack.yaml stack-weeder.yaml - # `allow-newer: true` is needed so that weeder-2.2.0 can be - # installed with the dependencies present in LTS-18. - echo 'allow-newer: true' >> stack-weeder.yaml - ci/fix-home stack --no-terminal --jobs=2 build --copy-compiler-tool --stack-yaml ./stack-weeder.yaml weeder-2.4.0 + ci/fix-home stack --no-terminal --jobs=2 \ + build --copy-compiler-tool weeder-2.8.0 - - run: "ci/fix-home stack --no-terminal --jobs=2 build --fast --ghc-options -fwrite-ide-info" + - run: | + ci/fix-home stack --no-terminal --jobs=2 \ + build --fast --ghc-options -fwrite-ide-info - run: "ci/fix-home stack exec weeder" @@ -268,26 +237,28 @@ jobs: # reference from our test suite to count in the above check; the fact # that a function is tested is not evidence that it's needed. But we also # don't want to leave weeds lying around in our test suite either. - - run: "ci/fix-home stack --no-terminal --jobs=2 build --fast --test --no-run-tests --ghc-options -fwrite-ide-info" + - run: | + ci/fix-home stack --no-terminal --jobs=2 \ + build --fast --test --no-run-tests --ghc-options -fwrite-ide-info - run: "ci/fix-home stack exec weeder" make-prerelease: - runs-on: "ubuntu-latest" + runs-on: ubuntu-latest needs: - "build" - "lint" if: "${{ github.event_name == 'push' && needs.build.outputs.do-not-prerelease != 'true' }}" steps: - - uses: "actions/download-artifact@v3" + - uses: "actions/download-artifact@v4" - uses: "ncipollo/release-action@v1.10.0" with: tag: "v${{ needs.build.outputs.version }}" artifacts: "*-bundle/*" prerelease: true body: "This is an automated preview release. Get the latest stable release [here](https://github.com/purescript/purescript/releases/latest)." - - uses: "actions/checkout@v3" - - uses: "actions/setup-node@v3" + - uses: "actions/checkout@v4" + - uses: "actions/setup-node@v4" with: node-version: "16.x" registry-url: "https://registry.npmjs.org" diff --git a/.gitignore b/.gitignore index 0454beffcb..73b2b4678f 100644 --- a/.gitignore +++ b/.gitignore @@ -3,7 +3,6 @@ bin dist cabal-dev .cabal-sandbox -stack.yaml.lock cabal.sandbox.config dist-newstyle/ cabal.project.local* diff --git a/CHANGELOG.d/internal_upgrade_to_ghc_9.6.md b/CHANGELOG.d/internal_upgrade_to_ghc_9.6.md new file mode 100644 index 0000000000..6622b6baed --- /dev/null +++ b/CHANGELOG.d/internal_upgrade_to_ghc_9.6.md @@ -0,0 +1,2 @@ +* Upgrade GHC to [`9.6.6`](https://downloads.haskell.org/~ghc/9.6.6/docs/users_guide/9.6.6-notes.html), Stackage LTS `22.43` +* Minimum required glibc version is bumped from [`2.28` to `2.31`](https://sourceware.org/glibc/wiki/Glibc%20Timeline) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index aa5ddefd3f..cfbb98e362 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -16,6 +16,7 @@ If you would prefer to use different terms, please use the section below instead | :------- | :--- | :------ | | [@5outh](https://github.com/5outh) | Benjamin Kovach | [MIT license] | | [@actionshrimp](https://github.com/actionshrimp) | David Aitken | [MIT license] | +| [@ad-si](https://github.com/ad-si) | Adrian Sieber | [MIT license] | | [@adnelson](https://github.com/adnelson) | Allen Nelson | [MIT license] | | [@alexbiehl](https://github.com/alexbiehl) | Alexander Biehl | [MIT license] | | [@andreypopp](https://github.com/andreypopp) | Andrey Popp | [MIT license] | diff --git a/INSTALL.md b/INSTALL.md index 0bccc516c7..03f7748636 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -4,12 +4,13 @@ If you are having difficulty installing the PureScript compiler, feel free to as ## Requirements -The PureScript compiler is built using GHC 9.2.8, and should be able to run on any operating system supported by GHC 9.2.8. In particular: +The PureScript compiler is built using GHC 9.6.6, and should be able to run on any operating system supported by GHC 9.6.6. +In particular: * for Windows users, versions predating Vista are not officially supported, * for macOS / OS X users, versions predating Mac OS X 10.7 (Lion) are not officially supported. -See also for more details about the operating systems which GHC 9.2.8 supports. +See also for more details about the operating systems which GHC 9.6.6 supports. ## Official prebuilt binaries diff --git a/LICENSE b/LICENSE index 490ff3651c..713d3371a3 100644 --- a/LICENSE +++ b/LICENSE @@ -107,7 +107,6 @@ PureScript uses the following Haskell library packages. Their license files foll optparse-applicative parallel parsec - pattern-arrows pretty primitive process @@ -3186,29 +3185,6 @@ parsec LICENSE file: negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. -pattern-arrows LICENSE file: - - The MIT License (MIT) - - Copyright (c) 2013 Phil Freeman - - Permission is hereby granted, free of charge, to any person obtaining a copy of - this software and associated documentation files (the "Software"), to deal in - the Software without restriction, including without limitation the rights to - use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of - the Software, and to permit persons to whom the Software is furnished to do so, - subject to the following conditions: - - The above copyright notice and this permission notice shall be included in all - copies or substantial portions of the Software. - - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS - FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR - COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - pretty LICENSE file: This library (libraries/pretty) is derived from code from diff --git a/Makefile b/Makefile index 53da1f3710..91235d9c8f 100644 --- a/Makefile +++ b/Makefile @@ -4,6 +4,7 @@ package = purescript exe_target = purs stack_yaml = STACK_YAML="stack.yaml" stack = $(stack_yaml) stack +stack_dir = .stack-work .DEFAULT_GOAL := help @@ -14,6 +15,10 @@ $(bin_dir)/hlint: ci/install-hlint.sh clean: ## Remove build artifacts rm -fr $(bin_dir) rm -fr $(build_dir) + rm -fr $(stack_dir) + rm -fr dist-newstyle + rm -fr .psci_modules + rm -fr .test_modules help: ## Print documentation @grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}' diff --git a/app/Command/Docs.hs b/app/Command/Docs.hs index 987023c98c..22bd6bdd3f 100644 --- a/app/Command/Docs.hs +++ b/app/Command/Docs.hs @@ -15,7 +15,8 @@ import Language.PureScript.Docs qualified as D import Language.PureScript.Docs.Tags (dumpCtags, dumpEtags) import Language.PureScript.Glob (PSCGlobs(..), toInputGlobs, warnFileTypeNotFound) import Options.Applicative qualified as Opts -import Text.PrettyPrint.ANSI.Leijen qualified as PP +import Prettyprinter qualified as PP +import Prettyprinter.Render.Terminal (AnsiStyle) import SharedCLI qualified import System.Directory (getCurrentDirectory, createDirectoryIfMissing, removeFile) import System.Exit (exitFailure) @@ -113,10 +114,10 @@ defaultOutputForFormat fmt = Ctags -> "tags" pscDocsOptions :: Opts.Parser PSCDocsOptions -pscDocsOptions = - PSCDocsOptions <$> format - <*> output - <*> compileOutputDir +pscDocsOptions = + PSCDocsOptions <$> format + <*> output + <*> compileOutputDir <*> many SharedCLI.inputFile <*> SharedCLI.globInputFile <*> many SharedCLI.excludeFiles @@ -150,9 +151,9 @@ infoModList :: Opts.InfoMod a infoModList = Opts.fullDesc <> footerInfo where footerInfo = Opts.footerDoc $ Just examples -examples :: PP.Doc +examples :: PP.Doc AnsiStyle examples = - PP.vcat $ map PP.text + PP.vcat [ "Examples:" , " write documentation for all modules to ./generated-docs:" , " purs docs \"src/**/*.purs\" \".psc-package/*/*/*/src/**/*.purs\"" diff --git a/app/Main.hs b/app/Main.hs index c925a4a313..ff4e04ab6d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -13,9 +13,10 @@ import Command.REPL qualified as REPL import Control.Monad (join) import Data.Foldable (fold) import Options.Applicative qualified as Opts +import Prettyprinter qualified as Doc +import Prettyprinter.Render.Terminal (AnsiStyle) import System.Environment (getArgs) import System.IO qualified as IO -import Text.PrettyPrint.ANSI.Leijen qualified as Doc import Version (versionString) @@ -39,11 +40,11 @@ main = do "For example, `purs compile --help` displays options specific to the `compile` command." , Doc.hardline , Doc.hardline - , Doc.text $ "purs " ++ versionString + , Doc.pretty $ "purs " ++ versionString ] - para :: String -> Doc.Doc - para = foldr (Doc.) Doc.empty . map Doc.text . words + para :: String -> Doc.Doc AnsiStyle + para = foldr (\x y -> x <> Doc.softline <> y) mempty . map Doc.pretty . words -- | Displays full command help when invoked with no arguments. execParserPure :: Opts.ParserInfo a -> [String] -> Opts.ParserResult a diff --git a/cabal.project b/cabal.project index 51c7ecb87d..61c5c9bd35 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1,7 @@ packages: purescript.cabal + +source-repository-package + type: git + location: https://github.com/purescript/cheapskate.git + tag: 8bfaf4beeb108e97a274ed51303f278905979e87 diff --git a/ci/build-package-set.sh b/ci/build-package-set.sh index 12a6fcb34c..f11b556871 100755 --- a/ci/build-package-set.sh +++ b/ci/build-package-set.sh @@ -5,7 +5,7 @@ shopt -s nullglob psroot=$(dirname "$(dirname "$(realpath "$0")")") -if [[ "${CI:-}" && "$(echo $psroot/CHANGELOG.d/breaking_*)" ]]; then +if [[ "${CI:-}" && "$(echo "$psroot"/CHANGELOG.d/breaking_*)" ]]; then echo "Skipping package-set build due to unreleased breaking changes" exit 0 fi @@ -16,23 +16,17 @@ export PATH="$tmpdir/node_modules/.bin:$PATH" cd "$tmpdir" echo ::group::Ensure Spago is available -which spago || npm install spago@0.20.8 +which spago || npm install spago@0.93.43 echo ::endgroup:: echo ::group::Create dummy project -echo 'let upstream = https://github.com/purescript/package-sets/releases/download/XXX/packages.dhall in upstream' > packages.dhall -echo '{ name = "my-project", dependencies = [] : List Text, packages = ./packages.dhall, sources = [] : List Text }' > spago.dhall -spago upgrade-set -# Override the `metadata` package's version to match `purs` version -# so that `spago build` actually works -sed -i'' "\$c in upstream with metadata.version = \"v$(purs --version | { read v z && echo $v; })\"" packages.dhall -spago install $(spago ls packages | while read name z; do if [[ $name != metadata ]]; then echo $name; fi; done) +spago init --name purescript-dummy echo ::endgroup:: echo ::group::Compile package set -spago build +spago ls packages --json | jq -r 'keys[]' | xargs spago install echo ::endgroup:: echo ::group::Document package set -spago docs --no-search +spago docs echo ::endgroup:: diff --git a/purescript.cabal b/purescript.cabal index 0d32ce4814..93b02ebbc9 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -153,18 +153,17 @@ common defaults -- modules must be parseable by this library otherwise the compiler -- will reject them. It should therefore always be pinned to a single -- specific version. - aeson >=2.0.3.0 && <2.1, - aeson-better-errors >=0.9.1.1 && <0.10, - ansi-terminal >=0.11.3 && <0.12, + aeson >=2.0.3.0 && <2.2, + aeson-better-errors >=0.9.1.3 && <0.10, + ansi-terminal >=0.11.3 && <1.1, array >=0.5.4.0 && <0.6, - base >=4.16.2.0 && <4.17, + base >=4.16.2.0 && <4.19, blaze-html >=0.9.1.2 && <0.10, bower-json >=1.1.0.0 && <1.2, boxes >=0.1.5 && <0.2, bytestring >=0.11.3.1 && <0.12, - Cabal >=3.6.3.0 && <3.7, + Cabal >=3.10.3.0 && <3.11, cborg >=0.2.7.0 && <0.3, - serialise >=0.2.5.0 && <0.3, cheapskate >=0.1.1.2 && <0.2, clock >=0.8.3 && <0.9, containers >=0.6.5.1 && <0.7, @@ -177,38 +176,38 @@ common defaults file-embed >=0.0.15.0 && <0.1, filepath >=1.4.2.2 && <1.5, Glob >=0.10.2 && <0.11, - haskeline >=0.8.2 && <0.9, + haskeline ==0.8.2, language-javascript ==0.7.0.0, - lens >=5.1.1 && <5.2, + lens >=5.1.1 && <5.3, lifted-async >=0.10.2.2 && <0.11, lifted-base >=0.2.3.12 && <0.3, - memory >=0.17.0 && <0.18, + memory >=0.17.0 && <0.19, monad-control >=1.0.3.1 && <1.1, monad-logger >=0.3.36 && <0.4, monoidal-containers >=0.6.2.0 && <0.7, - mtl >=2.2.2 && <2.3, + mtl >=2.2.2 && <2.4, parallel >=3.2.2.0 && <3.3, parsec >=3.1.15.0 && <3.2, - pattern-arrows >=0.0.2 && <0.1, - process ==1.6.13.1, + process >=1.6.19.0 && <1.7, protolude >=0.3.1 && <0.4, regex-tdfa >=1.3.1.2 && <1.4, safe >=0.3.19 && <0.4, scientific >=0.3.7.0 && <0.4, + semialign >=1.2.0.1 && <1.4, semigroups ==0.20.*, - semialign >=1.2.0.1 && <1.3, + serialise >=0.2.5.0 && <0.3, sourcemap >=0.1.7 && <0.2, stm >=2.5.0.2 && <2.6, stringsearch >=0.3.6.6 && <0.4, - template-haskell >=2.18.0.0 && <2.19, - text >=1.2.5.0 && <1.3, - these >=1.1.1.1 && <1.2, - time >=1.11.1.1 && <1.12, - transformers >=0.5.6.2 && <0.6, + template-haskell >=2.18.0.0 && <2.21, + text >=1.2.5.0 && <2.1, + these >=1.1.1.1 && <1.3, + time >=1.11.1.1 && <1.13, + transformers >=0.5.6.2 && <0.7, transformers-base >=0.4.6 && <0.5, utf8-string >=1.0.2 && <1.1, - vector >=0.12.3.1 && <0.13, - witherable >=0.4.2 && <0.5 + vector >=0.12.3.1 && <0.14, + witherable >=0.4.2 && <0.5, library import: defaults @@ -217,6 +216,7 @@ library Control.Monad.Logger Control.Monad.Supply Control.Monad.Supply.Class + Control.PatternArrows Language.PureScript Language.PureScript.AST Language.PureScript.AST.Binders @@ -403,10 +403,11 @@ executable purs main-is: Main.hs ghc-options: -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N -Wno-unused-packages build-depends: - ansi-wl-pprint >=0.6.9 && <0.7, + prettyprinter >=1.6 && <1.8, + prettyprinter-ansi-terminal >=1.1.1 && <1.2, exceptions >=0.10.4 && <0.11, network >=3.1.2.7 && <3.2, - optparse-applicative >=0.17.0.0 && <0.18, + optparse-applicative >=0.17.0.0 && <0.19, purescript if flag(release) cpp-options: -DRELEASE @@ -440,7 +441,7 @@ test-suite tests build-depends: purescript, generic-random >=1.5.0.1 && <1.6, - hspec >= 2.10.7 && < 3, + hspec >= 2.11.10 && < 3, HUnit >=1.6.2.0 && <1.7, newtype >=0.2.2.0 && <0.3, QuickCheck >=2.14.2 && <2.15, diff --git a/src/Control/Monad/Supply/Class.hs b/src/Control/Monad/Supply/Class.hs index e8656f0c69..b10b42d549 100644 --- a/src/Control/Monad/Supply/Class.hs +++ b/src/Control/Monad/Supply/Class.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeOperators #-} + -- | -- A class for monads supporting a supply of fresh names -- diff --git a/src/Control/PatternArrows.hs b/src/Control/PatternArrows.hs new file mode 100644 index 0000000000..b01d1cccdc --- /dev/null +++ b/src/Control/PatternArrows.hs @@ -0,0 +1,118 @@ +----------------------------------------------------------------------------- +-- +-- Module : Control.PatternArrows +-- Copyright : (c) Phil Freeman 2013 +-- License : MIT +-- +-- Maintainer : Phil Freeman +-- Stability : experimental +-- Portability : +-- +-- | +-- Arrows for Pretty Printing +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE GeneralizedNewtypeDeriving, GADTs #-} + +module Control.PatternArrows where + +import Prelude + +import Control.Arrow ((***), (<+>)) +import Control.Arrow qualified as A +import Control.Category ((>>>)) +import Control.Category qualified as C +import Control.Monad.State +import Control.Monad.Fix (fix) + +-- | +-- A first-order pattern match +-- +-- A pattern is a Kleisli arrow for the @StateT Maybe@ monad. That is, patterns can fail, and can carry user-defined state. +-- +newtype Pattern u a b = Pattern { runPattern :: A.Kleisli (StateT u Maybe) a b } deriving (A.Arrow, A.ArrowZero, A.ArrowPlus) + +instance C.Category (Pattern u) where + id = Pattern C.id + Pattern p1 . Pattern p2 = Pattern (p1 C.. p2) + +instance Functor (Pattern u a) where + fmap f (Pattern p) = Pattern $ A.Kleisli $ fmap f . A.runKleisli p + +-- | +-- Run a pattern with an input and initial user state +-- +-- Returns Nothing if the pattern fails to match +-- +pattern_ :: Pattern u a b -> u -> a -> Maybe b +pattern_ p u = flip evalStateT u . A.runKleisli (runPattern p) + +-- | +-- Construct a pattern from a function +-- +mkPattern :: (a -> Maybe b) -> Pattern u a b +mkPattern f = Pattern $ A.Kleisli (lift . f) + +-- | +-- Construct a pattern from a stateful function +-- +mkPattern' :: (a -> StateT u Maybe b) -> Pattern u a b +mkPattern' = Pattern . A.Kleisli + +-- | +-- Construct a pattern which recursively matches on the left-hand-side +-- +chainl :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r +chainl g f p = fix $ \c -> g >>> ((c <+> p) *** p) >>> A.arr (uncurry f) + +-- | +-- Construct a pattern which recursively matches on the right-hand side +-- +chainr :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r +chainr g f p = fix $ \c -> g >>> (p *** (c <+> p)) >>> A.arr (uncurry f) + +-- | +-- Construct a pattern which recursively matches on one-side of a tuple +-- +wrap :: Pattern u a (s, a) -> (s -> r -> r) -> Pattern u a r -> Pattern u a r +wrap g f p = fix $ \c -> g >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f) + +-- | +-- Construct a pattern which matches a part of a tuple +-- +split :: Pattern u a (s, t) -> (s -> t -> r) -> Pattern u a r +split s f = s >>> A.arr (uncurry f) + +-- | +-- A table of operators +-- +data OperatorTable u a r = OperatorTable { runOperatorTable :: [ [Operator u a r] ] } + +-- | +-- An operator: +-- +-- [@AssocL@] A left-associative operator +-- +-- [@AssocR@] A right-associative operator +-- +-- [@Wrap@] A prefix-like or postfix-like operator +-- +-- [@Split@] A prefix-like or postfix-like operator which does not recurse into its operand +-- +data Operator u a r where + AssocL :: Pattern u a (a, a) -> (r -> r -> r) -> Operator u a r + AssocR :: Pattern u a (a, a) -> (r -> r -> r) -> Operator u a r + Wrap :: Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r + Split :: Pattern u a (s, t) -> (s -> t -> r) -> Operator u a r + +-- | +-- Build a pretty printer from an operator table and an indecomposable pattern +-- +buildPrettyPrinter :: OperatorTable u a r -> Pattern u a r -> Pattern u a r +buildPrettyPrinter table p = foldl (\p' ops -> foldl1 (<+>) (flip map ops $ \case + AssocL pat g -> chainl pat g p' + AssocR pat g -> chainr pat g p' + Wrap pat g -> wrap pat g p' + Split pat g -> split pat g + ) <+> p') p $ runOperatorTable table diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 14d122a37d..3a4e371187 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -9,7 +9,6 @@ module Language.PureScript.CodeGen.JS import Prelude import Protolude (ordNub) -import Control.Applicative (liftA2) import Control.Monad (forM, replicateM, void) import Control.Monad.Except (MonadError, throwError) import Control.Monad.Reader (MonadReader, asks) diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs index 34746ae3db..a1d4a47c2b 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs @@ -3,7 +3,7 @@ module Language.PureScript.CoreImp.Optimizer.TCO (tco) where import Prelude -import Control.Applicative (empty, liftA2) +import Control.Applicative (empty) import Control.Monad (guard) import Control.Monad.State (State, evalState, get, modify) import Data.Functor (($>), (<&>)) diff --git a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs index a082b4b833..c6a985b09b 100644 --- a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs +++ b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs @@ -233,7 +233,7 @@ renderTypeWithRole = \case renderType' :: PrettyPrintType -> RenderedCode renderType' = fromMaybe (internalError "Incomplete pattern") - . PA.pattern matchType () + . PA.pattern_ matchType () renderTypeVars :: [(TypeVarVisibility, Text, Maybe PrettyPrintType)] -> RenderedCode renderTypeVars tyVars = mintersperse sp (map renderTypeVar tyVars) @@ -252,4 +252,4 @@ renderTypeAtom = renderTypeAtom' . convertPrettyPrintType maxBound renderTypeAtom' :: PrettyPrintType -> RenderedCode renderTypeAtom' = fromMaybe (internalError "Incomplete pattern") - . PA.pattern matchTypeAtom () + . PA.pattern_ matchTypeAtom () diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs index 697fefe8a0..eb03da41e0 100644 --- a/src/Language/PureScript/Linter/Exhaustive.hs +++ b/src/Language/PureScript/Linter/Exhaustive.hs @@ -11,7 +11,6 @@ module Language.PureScript.Linter.Exhaustive import Prelude import Protolude (ordNub) -import Control.Applicative (Applicative(..)) import Control.Arrow (first, second) import Control.Monad (unless) import Control.Monad.Writer.Class (MonadWriter(..)) diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs index 20de0ed9e2..9b3be46937 100644 --- a/src/Language/PureScript/Pretty/Types.hs +++ b/src/Language/PureScript/Pretty/Types.hs @@ -238,7 +238,7 @@ forall_ = mkPattern match typeAtomAsBox' :: PrettyPrintType -> Box typeAtomAsBox' = fromMaybe (internalError "Incomplete pattern") - . PA.pattern (matchTypeAtom defaultOptions) () + . PA.pattern_ (matchTypeAtom defaultOptions) () typeAtomAsBox :: Int -> Type a -> Box typeAtomAsBox maxDepth = typeAtomAsBox' . convertPrettyPrintType maxDepth @@ -280,7 +280,7 @@ unicodeOptions = TypeRenderOptions False True False typeAsBoxImpl :: TypeRenderOptions -> PrettyPrintType -> Box typeAsBoxImpl tro = fromMaybe (internalError "Incomplete pattern") - . PA.pattern (matchType tro) () + . PA.pattern_ (matchType tro) () -- | Generate a pretty-printed string representing a 'Type' prettyPrintType :: Int -> Type a -> String diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs index d2f9aebf2b..835e775f81 100644 --- a/src/Language/PureScript/Sugar/BindingGroups.hs +++ b/src/Language/PureScript/Sugar/BindingGroups.hs @@ -114,8 +114,8 @@ createBindingGroups moduleName = mapM f <=< handleDecls valueDeclarationInfo = M.fromList $ swap <$> valueDeclarationKeys findDeclarationInfo i = (M.findWithDefault False i valueDeclarationInfo, i) - computeValueDependencies = (`intersect` valueDeclarationKeys) . fmap findDeclarationInfo . usedIdents moduleName - + computeValueDependencies = (`intersect` valueDeclarationKeys) . fmap findDeclarationInfo . usedIdents moduleName + makeValueDeclarationVert = (,,) <$> id <*> makeValueDeclarationKey <*> computeValueDependencies valueDeclarationVerts = makeValueDeclarationVert <$> values @@ -267,7 +267,7 @@ toDataBindingGroup -> m Declaration toDataBindingGroup (AcyclicSCC (d, _, _)) = return d toDataBindingGroup (CyclicSCC ds') - | Just kds@((ss, _):|_) <- nonEmpty $ concatMap (kindDecl . getDecl) ds' = throwError . errorMessage' ss . CycleInKindDeclaration $ fmap snd kds + | Just kds@((ss, _) :| _) <- nonEmpty $ concatMap (kindDecl . getDecl) ds' = throwError . errorMessage' ss . CycleInKindDeclaration $ fmap snd kds | not (null typeSynonymCycles) = throwError . MultipleErrors diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs index b6382e6707..b33127200d 100644 --- a/src/Language/PureScript/TypeChecker/Monad.hs +++ b/src/Language/PureScript/TypeChecker/Monad.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} -- | -- Monads for type checking and type inference and associated data types diff --git a/src/Language/PureScript/TypeChecker/Synonyms.hs b/src/Language/PureScript/TypeChecker/Synonyms.hs index 567ae415ef..8d2cf7886c 100644 --- a/src/Language/PureScript/TypeChecker/Synonyms.hs +++ b/src/Language/PureScript/TypeChecker/Synonyms.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} -- | -- Functions for replacing fully applied type synonyms diff --git a/stack.yaml b/stack.yaml index 88b27b1a46..afbac89bca 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,6 @@ # Please update Haskell image versions under .github/workflows/ci.yml together to use the same GHC version # (or the CI build will fail) -resolver: lts-20.26 +resolver: lts-22.43 pvp-bounds: both packages: - '.' @@ -13,20 +13,14 @@ extra-deps: # `async` to be used as an object key: # https://github.com/erikd/language-javascript/issues/131 - language-javascript-0.7.0.0 -# Fix issue with libtinfo. -# See https://github.com/purescript/purescript/issues/4253 -- process-1.6.13.1 -# The Cabal library is not in Stackage -- Cabal-3.6.3.0 -# hspec versions 2.9.3 to 2.10.6 depend on ghc -# ghc depends on terminfo by default, but that can be ignored -# if one uses the '-terminfo' flag. -# Unfortunately, hspec doesn't expose a similar flag. -# -# Using hspec >= 2.10.7 addresses this. -- hspec-2.10.9 -- hspec-core-2.10.9 -- hspec-discover-2.10.9 +- bower-json-1.1.0.0 +- haskeline-0.8.2 +- these-1.2.1 +- aeson-better-errors-0.9.1.3 + +- github: purescript/cheapskate + commit: 8bfaf4beeb108e97a274ed51303f278905979e87 + nix: packages: - zlib @@ -37,8 +31,10 @@ nix: flags: aeson-pretty: lib-only: true - these: - assoc: false haskeline: # Avoids a libtinfo dynamic library dependency terminfo: false + +allow-newer: true +allow-newer-deps: +- haskeline diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000000..0af2cebb41 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,58 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/topics/lock_files + +packages: +- completed: + hackage: language-javascript-0.7.0.0@sha256:3eab0262b8ac5621936a4beab6a0f97d0e00a63455a8b0e3ac1547b4088dae7d,3898 + pantry-tree: + sha256: b0f28d836cb3fbde203fd7318a896c3a20acd8653a905e1950ae2d9a64bccebf + size: 2244 + original: + hackage: language-javascript-0.7.0.0 +- completed: + hackage: bower-json-1.1.0.0@sha256:a136aaca67bf0d15c336f5864f7e9d40ebe046ca2cb4b25bc4895617ea35f9f6,1864 + pantry-tree: + sha256: 3acd48e7012f246ad44c7c17cd6340362b1dc448c1d93156280814e76d9e0589 + size: 419 + original: + hackage: bower-json-1.1.0.0 +- completed: + hackage: haskeline-0.8.2@sha256:3b4b594095d64f5fa199b07bdca7d6b790313ed7f380a1b061845507e6563880,6005 + pantry-tree: + sha256: 17ee6b093c5135399b8e6bc3a63d9c6a4b0bc2100b495d2d974bc1464769de39 + size: 2955 + original: + hackage: haskeline-0.8.2 +- completed: + hackage: these-1.2.1@sha256:35c57aede96c15ea1fed559ac287b1168eb2b2869d79e62ed8c845780b7ea136,2294 + pantry-tree: + sha256: dc6366ac715dfdf5338a615f71b9ed0542c403a6afcbedcddbc879e947aea6b3 + size: 351 + original: + hackage: these-1.2.1 +- completed: + hackage: aeson-better-errors-0.9.1.3@sha256:1bfdda3982368cafc7317b9f0c1f7267a6b0bbac9515ae1fad37f2b19178f567,2071 + pantry-tree: + sha256: 1c14247866dfb8052506c179e4725b8a7ce1472a4fb227d61576d862d9494551 + size: 492 + original: + hackage: aeson-better-errors-0.9.1.3 +- completed: + name: cheapskate + pantry-tree: + sha256: a2253619f50d26f0137a802e51e5e7103ee52b1f71bc060d93a0979dcbefa2c8 + size: 12069 + sha256: 959fc7a6ca7e0a743b06b0c287aa4a1c3ec7fc740e5830a4a841d43e925a6d73 + size: 62502 + url: https://github.com/purescript/cheapskate/archive/8bfaf4beeb108e97a274ed51303f278905979e87.tar.gz + version: 0.1.1.2 + original: + url: https://github.com/purescript/cheapskate/archive/8bfaf4beeb108e97a274ed51303f278905979e87.tar.gz +snapshots: +- completed: + sha256: 08bd13ce621b41a8f5e51456b38d5b46d7783ce114a50ab604d6bbab0d002146 + size: 720271 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/43.yaml + original: lts-22.43 diff --git a/update-changelog.hs b/update-changelog.hs index b9296440d4..291160ceca 100755 --- a/update-changelog.hs +++ b/update-changelog.hs @@ -25,7 +25,8 @@ , RecordWildCards , TupleSections , ViewPatterns -#-} + #-} -- Hlint requires this leading space + -- | -- This script updates CHANGELOG.md with the contents of CHANGELOG.d, and -- empties CHANGELOG.d. It takes care of: diff --git a/weeder.dhall b/weeder.dhall deleted file mode 100644 index 95686c45e8..0000000000 --- a/weeder.dhall +++ /dev/null @@ -1,41 +0,0 @@ -{ roots = - [ "^Main\\.main$" - , "^PscIdeSpec\\.main$" - - -- These declarations are used in Pursuit. (The Types declarations are - -- reexported in the L.P.Docs module, and referenced from there, but Weeder - -- isn't that smart.) - , "^Language\\.PureScript\\.Docs\\.AsHtml\\.packageAsHtml$" - , "^Language\\.PureScript\\.Docs\\.Types\\.asUploadedPackage$" - , "^Language\\.PureScript\\.Docs\\.Types\\.getLink$" - , "^Language\\.PureScript\\.Docs\\.Types\\.getLinksContext$" - , "^Language\\.PureScript\\.Docs\\.Types\\.packageName$" - , "^Language\\.PureScript\\.Docs\\.Types\\.verifyPackage$" - - -- These declarations are believed to be used in other projects that we want - -- to continue to support. - , "^Language\\.PureScript\\.CoreFn\\.FromJSON\\.moduleFromJSON$" - , "^Language\\.PureScript\\.CST\\.Print\\.printModule$" - - -- These declarations are there to be used during development or testing. - , "^Language\\.PureScript\\.Ide\\.Imports\\.parseImport$" - , "^Language\\.PureScript\\.TypeChecker\\.Monad\\.debug" - - -- These declarations are used by Template Haskell code. - , "^Language\\.PureScript\\.Constants\\.TH\\." - - -- These declarations are produced by Template Haskell when generating - -- pattern synonyms; this confuses Weeder. - , "^Language\\.PureScript\\.Constants\\..*\\.\\$[bm]" - - -- These declarations are unprincipled exceptions that we don't mind - -- supporting just in case they're used now or in the future. - , "^Language\\.PureScript\\.CST\\.Parser\\.parseExpr$" - - -- These declarations are generated by tools; it doesn't matter if they're - -- unused because we can't do anything about them. - , "^Language\\.PureScript\\.CST\\.Parser\\.happy" - , "^Paths_purescript?\\." - ] -, type-class-roots = True -} diff --git a/weeder.toml b/weeder.toml new file mode 100644 index 0000000000..1a8249a2e2 --- /dev/null +++ b/weeder.toml @@ -0,0 +1,40 @@ +roots = [ + "^Main\\.main$", + "^PscIdeSpec\\.main$", + + # These declarations are used in Pursuit. (The Types declarations are + # reexported in the L.P.Docs module, and referenced from there, but Weeder + # isn't that smart.) + "^Language\\.PureScript\\.Docs\\.AsHtml\\.packageAsHtml$", + "^Language\\.PureScript\\.Docs\\.Types\\.asUploadedPackage$", + "^Language\\.PureScript\\.Docs\\.Types\\.getLink$", + "^Language\\.PureScript\\.Docs\\.Types\\.getLinksContext$", + "^Language\\.PureScript\\.Docs\\.Types\\.packageName$", + "^Language\\.PureScript\\.Docs\\.Types\\.verifyPackage$", + + # These declarations are believed to be used in other projects that we want + # to continue to support. + "^Language\\.PureScript\\.CoreFn\\.FromJSON\\.moduleFromJSON$", + "^Language\\.PureScript\\.CST\\.Print\\.printModule$", + + # These declarations are there to be used during development or testing. + "^Language\\.PureScript\\.Ide\\.Imports\\.parseImport$", + "^Language\\.PureScript\\.TypeChecker\\.Monad\\.debug", + + # These declarations are used by Template Haskell code. + "^Language\\.PureScript\\.Constants\\.TH\\.", + + # These declarations are produced by Template Haskell when generating + # pattern synonyms; this confuses Weeder. + "^Language\\.PureScript\\.Constants\\..*\\.\\$[bm]", + + # These declarations are unprincipled exceptions that we don't mind + # supporting just in case they're used now or in the future. + "^Language\\.PureScript\\.CST\\.Parser\\.parseExpr$", + + # These declarations are generated by tools; it doesn't matter if they're + # unused because we can't do anything about them. + "^Language\\.PureScript\\.CST\\.Parser\\.happy", + "^Paths_purescript?\\.", +] +type-class-roots = true From 377bdbde43d5aea46debbb9e90aa833ab6442f41 Mon Sep 17 00:00:00 2001 From: Adrian Sieber <36796532+ad-si@users.noreply.github.com> Date: Wed, 14 May 2025 19:21:26 +0000 Subject: [PATCH 61/68] Upgrade to GHC 9.8.4 (#4574) * Use latest HLint version in CI workflow * Upgrade to latest version of Cheapskate * Allow newer deps for weeder * Use `NonEmpty String` for `directiveStrings` --- .github/workflows/ci.yml | 10 +- CHANGELOG.d/internal_upgrade_to_ghc_9.8.md | 2 + INSTALL.md | 4 +- cabal.project | 2 +- purescript.cabal | 102 +++++++++--------- src/Language/PureScript/CST/Convert.hs | 5 +- src/Language/PureScript/CST/Monad.hs | 8 +- src/Language/PureScript/CST/Utils.hs | 13 ++- src/Language/PureScript/CodeGen/JS.hs | 5 +- .../PureScript/CoreImp/Optimizer/TCO.hs | 6 +- src/Language/PureScript/Docs/AsHtml.hs | 4 +- src/Language/PureScript/Docs/Types.hs | 2 +- .../PureScript/Interactive/Directive.hs | 35 +++--- src/Language/PureScript/Linter/Imports.hs | 6 +- src/Language/PureScript/Sugar/Names/Env.hs | 13 +-- .../PureScript/Sugar/Names/Exports.hs | 4 +- .../PureScript/Sugar/Names/Imports.hs | 4 +- src/Language/PureScript/Sugar/TypeClasses.hs | 3 +- src/Language/PureScript/TypeChecker.hs | 10 +- .../PureScript/TypeChecker/Deriving.hs | 3 +- .../PureScript/TypeChecker/Entailment.hs | 22 ++-- src/Language/PureScript/TypeChecker/Kinds.hs | 7 +- stack.yaml | 5 +- stack.yaml.lock | 18 ++-- tests/Main.hs | 2 + tests/TestDocs.hs | 3 +- tests/TestInteractive.hs | 97 +++++++++++++++++ 27 files changed, 259 insertions(+), 136 deletions(-) create mode 100644 CHANGELOG.d/internal_upgrade_to_ghc_9.8.md create mode 100644 tests/TestInteractive.hs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 3557db1a6f..d3c9aca938 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -54,10 +54,10 @@ jobs: fail-fast: false # do not cancel builds for other OSes if one fails matrix: include: - - image: haskell:9.6.6 # Also upgrade version in the lint job below + - image: haskell:9.8.4 # Also upgrade version in the lint job below os: ubuntu-latest # Exact version is not important, as it's only the container host) - - image: haskell:9.6.6 + - image: haskell:9.8.4 os: ubuntu-24.04-arm # Exact version is not important, as it's only the container host - os: macos-13 # x64 @@ -92,7 +92,7 @@ jobs: if: startsWith(matrix.os, 'macos') || startsWith(matrix.os, 'windows') uses: "haskell-actions/setup@v2" with: - ghc-version: "9.6.6" + ghc-version: "9.8.4" enable-stack: true stack-version: "${{ env.STACK_VERSION }}" stack-no-global: true @@ -202,7 +202,7 @@ jobs: run: "gh release upload --clobber ${{ github.ref_name }} sdist-test/bundle/*.{tar.gz,sha}" lint: - container: haskell:9.6.6 + container: haskell:9.8.4 runs-on: ubuntu-latest # Exact version is not important, as it's only the container host steps: @@ -220,7 +220,7 @@ jobs: - run: "ci/fix-home ci/run-hlint.sh --git" env: - VERSION: "3.5" + VERSION: "3.10" - name: Install weeder run: | diff --git a/CHANGELOG.d/internal_upgrade_to_ghc_9.8.md b/CHANGELOG.d/internal_upgrade_to_ghc_9.8.md new file mode 100644 index 0000000000..7f3fb0e074 --- /dev/null +++ b/CHANGELOG.d/internal_upgrade_to_ghc_9.8.md @@ -0,0 +1,2 @@ +* Upgrade GHC to [`9.8.4`](https://downloads.haskell.org/~ghc/9.8.4/docs/users_guide/9.8.4-notes.html), Stackage LTS `23.18` +* Use [HLint 3.10](https://github.com/ndmitchell/hlint/blob/master/CHANGES.txt) in CI diff --git a/INSTALL.md b/INSTALL.md index 03f7748636..6854652cb3 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -4,13 +4,13 @@ If you are having difficulty installing the PureScript compiler, feel free to as ## Requirements -The PureScript compiler is built using GHC 9.6.6, and should be able to run on any operating system supported by GHC 9.6.6. +The PureScript compiler is built using GHC 9.8.4, and should be able to run on any operating system supported by GHC 9.8.4. In particular: * for Windows users, versions predating Vista are not officially supported, * for macOS / OS X users, versions predating Mac OS X 10.7 (Lion) are not officially supported. -See also for more details about the operating systems which GHC 9.6.6 supports. +See also for more details about the operating systems which GHC 9.8.4 supports. ## Official prebuilt binaries diff --git a/cabal.project b/cabal.project index 61c5c9bd35..453d64732d 100644 --- a/cabal.project +++ b/cabal.project @@ -4,4 +4,4 @@ packages: source-repository-package type: git location: https://github.com/purescript/cheapskate.git - tag: 8bfaf4beeb108e97a274ed51303f278905979e87 + tag: 633c69024e061ad956f1aecfc137fb99a7a7a20b diff --git a/purescript.cabal b/purescript.cabal index 93b02ebbc9..5cecca41fc 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -86,6 +86,7 @@ common defaults -Wno-missing-export-lists -Wno-missing-kind-signatures -Wno-partial-fields + -Wno-missing-role-annotations default-language: Haskell2010 default-extensions: BangPatterns @@ -118,8 +119,6 @@ common defaults TupleSections TypeFamilies ViewPatterns - build-tool-depends: - happy:happy ==1.20.1.1 build-depends: -- NOTE: Please do not edit these version constraints manually. They are -- deliberately made narrow because changing the dependency versions in @@ -153,61 +152,61 @@ common defaults -- modules must be parseable by this library otherwise the compiler -- will reject them. It should therefore always be pinned to a single -- specific version. - aeson >=2.0.3.0 && <2.2, + aeson >=2.2.3.0 && <2.3, aeson-better-errors >=0.9.1.3 && <0.10, - ansi-terminal >=0.11.3 && <1.1, - array >=0.5.4.0 && <0.6, - base >=4.16.2.0 && <4.19, - blaze-html >=0.9.1.2 && <0.10, + ansi-terminal >=1.1.2 && <1.2, + array >=0.5.8.0 && <0.6, + base >=4.19.2.0 && <4.20, + blaze-html >=0.9.2.0 && <0.10, bower-json >=1.1.0.0 && <1.2, boxes >=0.1.5 && <0.2, - bytestring >=0.11.3.1 && <0.12, + bytestring >=0.12.1.0 && <0.13, Cabal >=3.10.3.0 && <3.11, - cborg >=0.2.7.0 && <0.3, + cborg >=0.2.10.0 && <0.3, cheapskate >=0.1.1.2 && <0.2, - clock >=0.8.3 && <0.9, - containers >=0.6.5.1 && <0.7, - cryptonite ==0.30.*, + clock >=0.8.4 && <0.9, + containers >=0.6.8 && <0.7, + cryptonite >=0.30 && <0.31, data-ordlist >=0.4.7.0 && <0.5, - deepseq >=1.4.6.1 && <1.5, - directory >=1.3.6.2 && <1.4, - dlist ==1.0.*, + deepseq >=1.5.1.0 && <1.6, + directory >=1.3.8.5 && <1.4, + dlist >=1.0 && <1.1, edit-distance >=0.2.2.1 && <0.3, - file-embed >=0.0.15.0 && <0.1, - filepath >=1.4.2.2 && <1.5, + file-embed >=0.0.16.0 && <0.1, + filepath >=1.4.301.0 && <1.5, Glob >=0.10.2 && <0.11, haskeline ==0.8.2, language-javascript ==0.7.0.0, - lens >=5.1.1 && <5.3, - lifted-async >=0.10.2.2 && <0.11, + lens >=5.3.4 && <5.4, + lifted-async >=0.10.2.7 && <0.11, lifted-base >=0.2.3.12 && <0.3, - memory >=0.17.0 && <0.19, + memory >=0.18.0 && <0.19, monad-control >=1.0.3.1 && <1.1, - monad-logger >=0.3.36 && <0.4, - monoidal-containers >=0.6.2.0 && <0.7, - mtl >=2.2.2 && <2.4, + monad-logger >=0.3.42 && <0.4, + monoidal-containers >=0.6.6.0 && <0.7, + mtl >=2.3.1 && <2.4, parallel >=3.2.2.0 && <3.3, - parsec >=3.1.15.0 && <3.2, - process >=1.6.19.0 && <1.7, - protolude >=0.3.1 && <0.4, - regex-tdfa >=1.3.1.2 && <1.4, - safe >=0.3.19 && <0.4, - scientific >=0.3.7.0 && <0.4, - semialign >=1.2.0.1 && <1.4, - semigroups ==0.20.*, - serialise >=0.2.5.0 && <0.3, + parsec >=3.1.17.0 && <3.2, + process >=1.6.25.0 && <1.7, + protolude >=0.3.4 && <0.4, + regex-tdfa >=1.3.2.3 && <1.4, + safe >=0.3.21 && <0.4, + scientific >=0.3.8.0 && <0.4, + semialign >=1.3.1 && <1.4, + semigroups >=0.20 && <0.21, + serialise >=0.2.6.1 && <0.3, sourcemap >=0.1.7 && <0.2, - stm >=2.5.0.2 && <2.6, + stm >=2.5.3.1 && <2.6, stringsearch >=0.3.6.6 && <0.4, - template-haskell >=2.18.0.0 && <2.21, - text >=1.2.5.0 && <2.1, - these >=1.1.1.1 && <1.3, - time >=1.11.1.1 && <1.13, - transformers >=0.5.6.2 && <0.7, + template-haskell >=2.21.0.0 && <2.22, + text >=2.1.1 && <2.2, + these >=1.2.1 && <1.3, + time >=1.12.2 && <1.13, + transformers >=0.6.1.0 && <0.7, transformers-base >=0.4.6 && <0.5, utf8-string >=1.0.2 && <1.1, - vector >=0.12.3.1 && <0.14, - witherable >=0.4.2 && <0.5, + vector >=0.13.2.0 && <0.14, + witherable >=0.5 && <0.6, library import: defaults @@ -403,17 +402,17 @@ executable purs main-is: Main.hs ghc-options: -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N -Wno-unused-packages build-depends: - prettyprinter >=1.6 && <1.8, - prettyprinter-ansi-terminal >=1.1.1 && <1.2, - exceptions >=0.10.4 && <0.11, - network >=3.1.2.7 && <3.2, - optparse-applicative >=0.17.0.0 && <0.19, + prettyprinter >=1.7.1 && <1.8, + prettyprinter-ansi-terminal >=1.1.3 && <1.2, + exceptions >=0.10.7 && <0.11, + network >=3.2.7.0 && <3.3, + optparse-applicative >=0.18.1.0 && <0.19, purescript if flag(release) cpp-options: -DRELEASE else build-depends: - gitrev >=1.2.0 && <1.4 + gitrev >=1.3.1 && <1.4, other-modules: Command.Bundle Command.Compile @@ -441,13 +440,13 @@ test-suite tests build-depends: purescript, generic-random >=1.5.0.1 && <1.6, - hspec >= 2.11.10 && < 3, + hspec >=2.11.12 && <2.12, 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.2 && <0.95, - split >=0.2.3.4 && <0.3, - typed-process >=0.2.10.1 && <0.3 + QuickCheck >=2.14.3 && <2.15, + regex-base >=0.94.0.3 && <0.95, + split >=0.2.5 && <0.3, + typed-process >=0.2.12.0 && <0.3, build-tool-depends: hspec-discover:hspec-discover -any -- we need the compiler's executable available for the ide tests @@ -472,6 +471,7 @@ test-suite tests TestGraph TestHierarchy TestIde + TestInteractive TestMake TestPrimDocs TestPsci diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs index c75d333dcc..59b68adf1d 100644 --- a/src/Language/PureScript/CST/Convert.hs +++ b/src/Language/PureScript/CST/Convert.hs @@ -16,6 +16,7 @@ module Language.PureScript.CST.Convert ) where import Prelude hiding (take) +import Protolude (headDef) import Data.Bifunctor (bimap, first) import Data.Char (toLower) @@ -446,7 +447,7 @@ convertDeclaration :: String -> Declaration a -> [AST.Declaration] convertDeclaration fileName decl = case decl of DeclData _ (DataHead _ a vars) bd -> do let - ctrs :: SourceToken -> DataCtor a -> [(SourceToken, DataCtor a)] -> [AST.DataConstructorDeclaration] + ctrs :: SourceToken -> DataCtor b -> [(SourceToken, DataCtor b)] -> [AST.DataConstructorDeclaration] ctrs st (DataCtor _ name fields) tl = AST.DataConstructorDeclaration (sourceAnnCommented fileName st (nameTok name)) (nameValue name) (zip ctrFields $ convertType fileName <$> fields) : (case tl of @@ -460,7 +461,7 @@ convertDeclaration fileName decl = case decl of (goTypeVar <$> vars) (convertType fileName bd) DeclNewtype _ (DataHead _ a vars) st x ys -> do - let ctrs = [AST.DataConstructorDeclaration (sourceAnnCommented fileName st (snd $ declRange decl)) (nameValue x) [(head ctrFields, convertType fileName ys)]] + let ctrs = [AST.DataConstructorDeclaration (sourceAnnCommented fileName st (snd $ declRange decl)) (nameValue x) [(headDef (internalError "No constructor name") ctrFields, convertType fileName ys)]] pure $ AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs DeclClass _ (ClassHead _ sup name vars fdeps) bd -> do let diff --git a/src/Language/PureScript/CST/Monad.hs b/src/Language/PureScript/CST/Monad.hs index 31887c890a..2b79f1a9b3 100644 --- a/src/Language/PureScript/CST/Monad.hs +++ b/src/Language/PureScript/CST/Monad.hs @@ -102,9 +102,11 @@ mkParserError stack toks ty = , errType = ty } where - range = case toks of - [] -> SourceRange (SourcePos 0 0) (SourcePos 0 0) - _ -> widen (tokRange . tokAnn $ head toks) (tokRange . tokAnn $ last toks) + range = case NE.nonEmpty toks of + Nothing -> SourceRange (SourcePos 0 0) (SourcePos 0 0) + Just neToks -> widen + (tokRange . tokAnn $ NE.head neToks) + (tokRange . tokAnn $ NE.last neToks) addFailure :: [SourceToken] -> ParserErrorType -> Parser () addFailure toks ty = Parser $ \st _ ksucc -> diff --git a/src/Language/PureScript/CST/Utils.hs b/src/Language/PureScript/CST/Utils.hs index b941cf5fcf..68dcf7d87c 100644 --- a/src/Language/PureScript/CST/Utils.hs +++ b/src/Language/PureScript/CST/Utils.hs @@ -1,6 +1,7 @@ module Language.PureScript.CST.Utils where import Prelude +import Protolude (headDef) import Control.Monad (unless) import Data.Coerce (coerce) @@ -86,16 +87,20 @@ unexpectedLabel :: SourceToken -> Label unexpectedLabel tok = Label tok "" unexpectedExpr :: Monoid a => [SourceToken] -> Expr a -unexpectedExpr toks = ExprIdent mempty (unexpectedQual (head toks)) +unexpectedExpr toks = + ExprIdent mempty (unexpectedQual (headDef placeholder toks)) unexpectedBinder :: Monoid a => [SourceToken] -> Binder a -unexpectedBinder toks = BinderVar mempty (unexpectedName (head toks)) +unexpectedBinder toks = + BinderVar mempty (unexpectedName (headDef placeholder toks)) unexpectedRecordUpdate :: Monoid a => [SourceToken] -> RecordUpdate a -unexpectedRecordUpdate toks = RecordUpdateLeaf (unexpectedLabel (head toks)) (head toks) (unexpectedExpr toks) +unexpectedRecordUpdate toks = + RecordUpdateLeaf (unexpectedLabel (headDef placeholder toks)) (headDef placeholder toks) (unexpectedExpr toks) unexpectedRecordLabeled :: [SourceToken] -> RecordLabeled a -unexpectedRecordLabeled toks = RecordPun (unexpectedName (head toks)) +unexpectedRecordLabeled toks = + RecordPun (unexpectedName (headDef placeholder toks)) rangeToks :: TokenRange -> [SourceToken] rangeToks (a, b) = [a, b] diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 3a4e371187..890cc1cd27 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -7,7 +7,7 @@ module Language.PureScript.CodeGen.JS ) where import Prelude -import Protolude (ordNub) +import Protolude (ordNub, headDef) import Control.Monad (forM, replicateM, void) import Control.Monad.Except (MonadError, throwError) @@ -310,7 +310,8 @@ moduleBindToJs mn = bindToJs let (f, args) = unApp e [] args' <- mapM valueToJs args case f of - Var (_, _, Just IsNewtype) _ -> return (head args') + Var (_, _, Just IsNewtype) _ -> + return (headDef (internalError "Newtype constructor without constructor name") args') Var (_, _, Just (IsConstructor _ fields)) name | length args == length fields -> return $ AST.Unary Nothing AST.New $ AST.App Nothing (qualifiedToJS id name) args' _ -> flip (foldl (\fn a -> AST.App Nothing fn [a])) args' <$> valueToJs f diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs index a1d4a47c2b..db133f5ac8 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs @@ -5,8 +5,8 @@ import Prelude import Control.Applicative (empty) import Control.Monad (guard) -import Control.Monad.State (State, evalState, get, modify) -import Data.Functor (($>), (<&>)) +import Control.Monad.State (State, evalState, gets, modify) +import Data.Functor (($>)) import Data.Set qualified as S import Data.Text (Text, pack) import Language.PureScript.CoreImp.AST (AST(..), InitializerEffects(..), UnaryOperator(..), everything, everywhereTopDownM) @@ -23,7 +23,7 @@ tco = flip evalState 0 . everywhereTopDownM convert where copyVar arg = "$copy_" <> arg tcoDoneM :: State Int Text - tcoDoneM = get <&> \count -> "$tco_done" <> + tcoDoneM = gets $ \count -> "$tco_done" <> if count == 0 then "" else pack . show $ count tcoLoop :: Text diff --git a/src/Language/PureScript/Docs/AsHtml.hs b/src/Language/PureScript/Docs/AsHtml.hs index e4460183af..e03ccabc31 100644 --- a/src/Language/PureScript/Docs/AsHtml.hs +++ b/src/Language/PureScript/Docs/AsHtml.hs @@ -67,7 +67,7 @@ nullRenderContext = HtmlRenderContext packageAsHtml :: (InPackage P.ModuleName -> Maybe HtmlRenderContext) - -> Package a + -> Package x -> HtmlOutput Html packageAsHtml getHtmlCtx Package{..} = HtmlOutput indexFile modules @@ -242,7 +242,7 @@ codeAsHtml r = outputWith elemAsHtml isOp = isRight . runParser CST.parseOperator - runParser :: CST.Parser a -> Text -> Either String a + runParser :: CST.Parser x -> Text -> Either String x runParser p' = bimap (CST.prettyPrintError . NE.head) snd . CST.runTokenParser p' diff --git a/src/Language/PureScript/Docs/Types.hs b/src/Language/PureScript/Docs/Types.hs index c4e6cbecaa..ea13066556 100644 --- a/src/Language/PureScript/Docs/Types.hs +++ b/src/Language/PureScript/Docs/Types.hs @@ -875,7 +875,7 @@ instance A.ToJSON a => A.ToJSON (InPackage a) where Local y -> withPackage (Nothing :: Maybe ()) y FromDep pn y -> withPackage (Just pn) y where - withPackage :: (A.ToJSON p, A.ToJSON x) => p -> x -> A.Value + withPackage :: (A.ToJSON p, A.ToJSON y) => p -> y -> A.Value withPackage p y = A.object [ "package" .= p , "item" .= y diff --git a/src/Language/PureScript/Interactive/Directive.hs b/src/Language/PureScript/Interactive/Directive.hs index 4a75f0f362..a8a0ce1307 100644 --- a/src/Language/PureScript/Interactive/Directive.hs +++ b/src/Language/PureScript/Interactive/Directive.hs @@ -8,6 +8,8 @@ import Prelude import Data.Maybe (fromJust) import Data.List (isPrefixOf) import Data.Tuple (swap) +import Data.List.NonEmpty (NonEmpty(..)) +import Data.List.NonEmpty qualified as NEL import Language.PureScript.Interactive.Types (Directive(..)) @@ -15,40 +17,40 @@ import Language.PureScript.Interactive.Types (Directive(..)) -- A mapping of directives to the different strings that can be used to invoke -- them. -- -directiveStrings :: [(Directive, [String])] +directiveStrings :: [(Directive, NonEmpty String)] directiveStrings = - [ (Help , ["?", "help"]) - , (Quit , ["quit"]) - , (Reload , ["reload"]) - , (Clear , ["clear"]) - , (Browse , ["browse"]) - , (Type , ["type"]) - , (Kind , ["kind"]) - , (Show , ["show"]) - , (Paste , ["paste"]) - , (Complete , ["complete"]) - , (Print , ["print"]) + [ (Help , NEL.fromList ["?", "help"]) + , (Quit , NEL.singleton "quit") + , (Reload , NEL.singleton "reload") + , (Clear , NEL.singleton "clear") + , (Browse , NEL.singleton "browse") + , (Type , NEL.singleton "type") + , (Kind , NEL.singleton "kind") + , (Show , NEL.singleton "show") + , (Paste , NEL.singleton "paste") + , (Complete , NEL.singleton "complete") + , (Print , NEL.singleton "print") ] -- | --- Like directiveStrings, but the other way around. +-- Like `directiveStrings`, but the other way around. -- directiveStrings' :: [(String, Directive)] directiveStrings' = concatMap go directiveStrings where - go (dir, strs) = map (, dir) strs + go (dir, strs) = map (, dir) $ NEL.toList strs -- | -- Returns all possible string representations of a directive. -- -stringsFor :: Directive -> [String] +stringsFor :: Directive -> NonEmpty String stringsFor d = fromJust (lookup d directiveStrings) -- | -- Returns the default string representation of a directive. -- stringFor :: Directive -> String -stringFor = head . stringsFor +stringFor = NEL.head . stringsFor -- | -- Returns the list of directives which could be expanded from the string @@ -84,4 +86,3 @@ help = , (Complete, "", "Show completions for as if pressing tab") , (Print, "", "Set the repl's printing function to (which must be fully qualified)") ] - diff --git a/src/Language/PureScript/Linter/Imports.hs b/src/Language/PureScript/Linter/Imports.hs index e8a2eb0f2c..10f0aec7a7 100644 --- a/src/Language/PureScript/Linter/Imports.hs +++ b/src/Language/PureScript/Linter/Imports.hs @@ -5,7 +5,7 @@ module Language.PureScript.Linter.Imports ) where import Prelude -import Protolude (ordNub) +import Protolude (ordNub, tailDef, headDef) import Control.Monad (join, unless, foldM, (<=<)) import Control.Monad.Writer.Class (MonadWriter(..)) @@ -91,7 +91,7 @@ lintImports (Module _ _ mn mdecls (Just mexports)) env usedImps = do let unwarned = imps \\ warned duplicates = join - . map tail + . map (tailDef $ internalError "lintImports: duplicates") . filter ((> 1) . length) . groupBy ((==) `on` defQual) . sortOn defQual @@ -195,7 +195,7 @@ lintImports (Module _ _ mn mdecls (Just mexports)) env usedImps = do Just (Qualified _ name) -> Just (k, Qualified mnq (toName name)) _ -> Nothing | isQualifiedWith k q = - case importName (head is) of + case importName (headDef (internalError "extractByQual: empty import list") is) of Qualified (ByModuleName mn') name -> Just (mn', Qualified mnq (toName name)) _ -> internalError "unqualified name in extractByQual" go _ = Nothing diff --git a/src/Language/PureScript/Sugar/Names/Env.hs b/src/Language/PureScript/Sugar/Names/Env.hs index 2ab8b00d5c..092b8e2478 100644 --- a/src/Language/PureScript/Sugar/Names/Env.hs +++ b/src/Language/PureScript/Sugar/Names/Env.hs @@ -20,7 +20,7 @@ module Language.PureScript.Sugar.Names.Env import Prelude -import Control.Monad (forM_, when) +import Control.Monad (forM_, when, (>=>)) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Writer.Class (MonadWriter(..)) @@ -28,7 +28,7 @@ import Data.Function (on) import Data.Foldable (find) import Data.List (groupBy, sortOn, delete) import Data.Maybe (mapMaybe) -import Safe (headMay) +import Safe (headMay, headDef) import Data.Map qualified as M import Data.Set qualified as S @@ -482,8 +482,9 @@ checkImportConflicts ss currentModule toName xs = byOrig = sortOn importSourceModule xs groups = groupBy ((==) `on` importSourceModule) byOrig nonImplicit = filter ((/= FromImplicit) . importProvenance) xs - name = toName . disqualify . importName $ head xs - conflictModules = mapMaybe (getQual . importName . head) groups + name = toName . disqualify . importName $ + headDef (internalError "checkImportConflicts: No imports found") xs + conflictModules = mapMaybe (headMay >=> (getQual . importName)) groups in if length groups > 1 then case nonImplicit of @@ -494,8 +495,8 @@ checkImportConflicts ss currentModule toName xs = return (mnNew, mnOrig) _ -> throwError . errorMessage' ss $ ScopeConflict name conflictModules else - case head byOrig of - ImportRecord (Qualified (ByModuleName mnNew) _) mnOrig _ _ -> + case headMay byOrig of + Just (ImportRecord (Qualified (ByModuleName mnNew) _) mnOrig _ _) -> return (mnNew, mnOrig) _ -> internalError "checkImportConflicts: ImportRecord should be qualified" diff --git a/src/Language/PureScript/Sugar/Names/Exports.hs b/src/Language/PureScript/Sugar/Names/Exports.hs index cbe273f828..67b1560a77 100644 --- a/src/Language/PureScript/Sugar/Names/Exports.hs +++ b/src/Language/PureScript/Sugar/Names/Exports.hs @@ -4,6 +4,7 @@ module Language.PureScript.Sugar.Names.Exports ) where import Prelude +import Protolude (headDef) import Control.Monad (filterM, foldM, liftM2, unless, void, when) import Control.Monad.Writer.Class (MonadWriter(..)) @@ -127,7 +128,8 @@ resolveExports env ss mn imps exps refs = -> (a -> Name) -> M.Map (Qualified a) [ImportRecord a] -> m [Qualified a] - extract ss' useQual name toName = fmap (map (importName . head . snd)) . go . M.toList + extract ss' useQual name toName = + fmap (map (importName . headDef (internalError "Missing value in extract") . snd)) . go . M.toList where go = filterM $ \(name', options) -> do let isMatch = if useQual then isQualifiedWith name name' else any (checkUnqual name') options diff --git a/src/Language/PureScript/Sugar/Names/Imports.hs b/src/Language/PureScript/Sugar/Names/Imports.hs index 3a43faf7fd..77c65ba3c5 100644 --- a/src/Language/PureScript/Sugar/Names/Imports.hs +++ b/src/Language/PureScript/Sugar/Names/Imports.hs @@ -7,7 +7,7 @@ module Language.PureScript.Sugar.Names.Imports import Prelude -import Control.Monad (foldM, when) +import Control.Monad (foldM, when, unless) import Control.Monad.Error.Class (MonadError(..)) import Data.Foldable (for_, traverse_) @@ -147,7 +147,7 @@ resolveImport importModule exps imps impQual = resolveByType -> ProperName 'ConstructorName -> m () checkDctorExists ss tcon exports dctor - = when (dctor `notElem` exports) + = unless (dctor `elem` exports) . throwError . errorMessage' ss $ UnknownImportDataConstructor importModule tcon dctor diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs index 4f3129baf8..d24485e044 100644 --- a/src/Language/PureScript/Sugar/TypeClasses.hs +++ b/src/Language/PureScript/Sugar/TypeClasses.hs @@ -237,7 +237,8 @@ desugarDecl mn exps = go expRef :: Ident -> Qualified (ProperName 'ClassName) -> [SourceType] -> Maybe DeclarationRef expRef name className tys - | isExportedClass className && all isExportedType (getConstructors `concatMap` tys) = Just $ TypeInstanceRef genSpan name UserNamed + | isExportedClass className && all (all isExportedType . getConstructors) tys = + Just $ TypeInstanceRef genSpan name UserNamed | otherwise = Nothing isExportedClass :: Qualified (ProperName 'ClassName) -> Bool diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index 479a01f012..d0d122206a 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -8,7 +8,7 @@ module Language.PureScript.TypeChecker ) where import Prelude -import Protolude (headMay, maybeToLeft, ordNub) +import Protolude (headMay, maybeToLeft, ordNub, headDef) import Control.Lens ((^..), _2) import Control.Monad (when, unless, void, forM, zipWithM_) @@ -422,7 +422,9 @@ typeCheckAll moduleName = traverse go checkInstanceMembers :: [Declaration] -> m [Declaration] checkInstanceMembers instDecls = do - let idents = sort . map head . group . map memberName $ instDecls + let idents = sort + . map (headDef $ internalError "checkInstanceMembers: Empty instance declaration list") + . group . map memberName $ instDecls for_ (firstDuplicate idents) $ \ident -> throwError . errorMessage $ DuplicateValueDeclaration ident return instDecls @@ -747,7 +749,9 @@ typeCheckModule modulesExports (Module ss coms mn decls (Just exps)) = checkClassMembersAreExported :: DeclarationRef -> m () checkClassMembersAreExported dr@(TypeClassRef ss' name) = do - let members = ValueRef ss' `map` head (mapMaybe findClassMembers decls) + let members = ValueRef ss' `map` + (headDef $ internalError "checkClassMembersAreExported: Empty class member list") + (mapMaybe findClassMembers decls) let missingMembers = members \\ exps unless (null missingMembers) . throwError . errorMessage' ss' $ TransitiveExportError dr missingMembers where diff --git a/src/Language/PureScript/TypeChecker/Deriving.hs b/src/Language/PureScript/TypeChecker/Deriving.hs index 8d5dcde9b6..eaac3cff51 100644 --- a/src/Language/PureScript/TypeChecker/Deriving.hs +++ b/src/Language/PureScript/TypeChecker/Deriving.hs @@ -1,6 +1,7 @@ {- HLINT ignore "Unused LANGUAGE pragma" -} -- HLint doesn't recognize that TypeApplications is used in a pattern {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeAbstractions #-} module Language.PureScript.TypeChecker.Deriving (deriveInstance) where import Protolude hiding (Type) @@ -529,7 +530,7 @@ validateParamsInTypeConstructors derivingClass utc isBi CovariantClasses{..} con hasInstance :: InstanceContext -> Qualified (Either Text (ProperName 'TypeName)) -> Qualified (ProperName 'ClassName) -> Bool hasInstance tcds ht@(Qualified qb _) cn@(Qualified cqb _) = - any tcdAppliesToType $ concatMap (findDicts tcds cn) (ordNub [ByNullSourcePos, cqb, qb]) + any (any tcdAppliesToType . findDicts tcds cn) (ordNub [ByNullSourcePos, cqb, qb]) where tcdAppliesToType tcd = case tcdInstanceTypes tcd of [headOfType -> ht'] -> ht == ht' diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index 85bdfee4aa..6cdd98c407 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -11,7 +11,7 @@ module Language.PureScript.TypeChecker.Entailment ) where import Prelude -import Protolude (ordNub, headMay) +import Protolude (ordNub, headMay, headDef) import Control.Arrow (second, (&&&)) import Control.Monad.Error.Class (MonadError(..)) @@ -257,7 +257,7 @@ entails SolverOptions{..} constraint context hints = , typeClassDependencies , typeClassIsEmpty , typeClassCoveringSets - , typeClassMembers + , typeClassMembers } <- case M.lookup className' classesInScope of Nothing -> throwError . errorMessage $ UnknownClass className' Just tcd -> pure tcd @@ -281,8 +281,8 @@ entails SolverOptions{..} constraint context hints = else Left (Left (tcdToInstanceDescription tcd)) -- can't continue with this chain yet, need proof of apartness lefts [found] - solution <- lift . lift - $ unique kinds'' tys'' ambiguous instances + solution <- lift . lift + $ unique kinds'' tys'' ambiguous instances $ unknownsInAllCoveringSets (fst . (typeClassArguments !!)) typeClassMembers tys'' typeClassCoveringSets case solution of Solved substs tcd -> do @@ -293,7 +293,7 @@ entails SolverOptions{..} constraint context hints = -- Now enforce any functional dependencies, using unification -- Note: we need to generate fresh types for any unconstrained -- type variables before unifying. - let subst = fmap head substs + let subst = fmap (headDef $ internalError "entails: empty substitution") substs currentSubst <- lift . lift $ gets checkSubstitution subst' <- lift . lift $ withFreshTypes tcd (fmap (substituteType currentSubst) subst) lift . lift $ zipWithM_ (\t1 t2 -> do @@ -431,9 +431,9 @@ entails SolverOptions{..} constraint context hints = unknownsInAllCoveringSets :: (Int -> Text) -> [(Ident, SourceType, Maybe (S.Set (NEL.NonEmpty Int)))] -> [SourceType] -> S.Set (S.Set Int) -> UnknownsHint unknownsInAllCoveringSets indexToArgText tyClassMembers tyArgs coveringSets = do let unkIndices = findIndices containsUnknowns tyArgs - if all (\s -> any (`S.member` s) unkIndices) coveringSets then + if all (\s -> any (`S.member` s) unkIndices) coveringSets then fromMaybe Unknowns unknownsRequiringVtas - else + else NoUnknowns where unknownsRequiringVtas = do @@ -452,15 +452,15 @@ entails SolverOptions{..} constraint context hints = (_, getVars, _, _, _) = everythingOnValues (++) ignore getVarIdents ignore ignore ignore ignore = const [] getVarIdents = \case - Var _ ident | Just vtas <- M.lookup ident tyClassMemberVta -> + Var _ ident | Just vtas <- M.lookup ident tyClassMemberVta -> [(ident, vtas)] - _ -> + _ -> [] getECTExpr = \case ErrorCheckingType expr _ -> Just expr _ -> Nothing - + tyClassMembers' <- headMay $ mapMaybe (fmap tyClassMembersInExpr . getECTExpr) hints membersWithVtas <- NEL.nonEmpty tyClassMembers' pure $ UnknownsWithVtaRequiringArgs membersWithVtas @@ -668,7 +668,7 @@ entails SolverOptions{..} constraint context hints = , l, r , rowFromList (fixed, rowVar) , Just [ srcConstraint C.RowUnion kinds [rest, r, rowVar] Nothing ] - , [("r", kindRow (head kinds))] + , [("r", kindRow (headDef (internalError "unionRows: empty kinds") kinds))] ) solveRowCons :: [SourceType] -> [SourceType] -> Maybe [TypeClassDict] diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs index 5be87c0057..1a758aab48 100644 --- a/src/Language/PureScript/TypeChecker/Kinds.hs +++ b/src/Language/PureScript/TypeChecker/Kinds.hs @@ -26,6 +26,7 @@ module Language.PureScript.TypeChecker.Kinds ) where import Prelude +import Protolude (headDef) import Control.Arrow ((***)) import Control.Lens ((^.), _1, _2, _3) @@ -633,7 +634,7 @@ kindOfData -> DataDeclarationArgs -> m DataDeclarationResult kindOfData moduleName dataDecl = - head . (^. _2) <$> kindsOfAll moduleName [] [dataDecl] [] + headDef (internalError "kindOfData: empty list") . (^. _2) <$> kindsOfAll moduleName [] [dataDecl] [] inferDataDeclaration :: forall m. (MonadError MultipleErrors m, MonadState CheckState m) @@ -685,7 +686,7 @@ kindOfTypeSynonym -> TypeDeclarationArgs -> m TypeDeclarationResult kindOfTypeSynonym moduleName typeDecl = - head . (^. _1) <$> kindsOfAll moduleName [typeDecl] [] [] + headDef (internalError "kindOfTypeSynonym: empty list") . (^. _1) <$> kindsOfAll moduleName [typeDecl] [] [] inferTypeSynonym :: forall m. (MonadError MultipleErrors m, MonadState CheckState m) @@ -802,7 +803,7 @@ kindOfClass -> ClassDeclarationArgs -> m ClassDeclarationResult kindOfClass moduleName clsDecl = - head . (^. _3) <$> kindsOfAll moduleName [] [] [clsDecl] + headDef (internalError "kindOfClass: empty list") . (^. _3) <$> kindsOfAll moduleName [] [] [clsDecl] inferClassDeclaration :: forall m. (MonadError MultipleErrors m, MonadState CheckState m) diff --git a/stack.yaml b/stack.yaml index afbac89bca..500fd823cf 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,6 @@ # Please update Haskell image versions under .github/workflows/ci.yml together to use the same GHC version # (or the CI build will fail) -resolver: lts-22.43 +resolver: lts-23.18 pvp-bounds: both packages: - '.' @@ -19,7 +19,7 @@ extra-deps: - aeson-better-errors-0.9.1.3 - github: purescript/cheapskate - commit: 8bfaf4beeb108e97a274ed51303f278905979e87 + commit: 633c69024e061ad956f1aecfc137fb99a7a7a20b nix: packages: @@ -38,3 +38,4 @@ flags: allow-newer: true allow-newer-deps: - haskeline +- weeder diff --git a/stack.yaml.lock b/stack.yaml.lock index 0af2cebb41..8a4853c3fa 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -42,17 +42,17 @@ packages: - completed: name: cheapskate pantry-tree: - sha256: a2253619f50d26f0137a802e51e5e7103ee52b1f71bc060d93a0979dcbefa2c8 + sha256: b130a35ad29a61ac64c2d29bb09309ddf07b139342c67ef01ccc59ad4167d529 size: 12069 - sha256: 959fc7a6ca7e0a743b06b0c287aa4a1c3ec7fc740e5830a4a841d43e925a6d73 - size: 62502 - url: https://github.com/purescript/cheapskate/archive/8bfaf4beeb108e97a274ed51303f278905979e87.tar.gz + sha256: 2b495e2b6d571c33b91ebb76c1b7fe9c9b56ff90ca0804106a3260f2bbdc9a9a + size: 62489 + url: https://github.com/purescript/cheapskate/archive/633c69024e061ad956f1aecfc137fb99a7a7a20b.tar.gz version: 0.1.1.2 original: - url: https://github.com/purescript/cheapskate/archive/8bfaf4beeb108e97a274ed51303f278905979e87.tar.gz + url: https://github.com/purescript/cheapskate/archive/633c69024e061ad956f1aecfc137fb99a7a7a20b.tar.gz snapshots: - completed: - sha256: 08bd13ce621b41a8f5e51456b38d5b46d7783ce114a50ab604d6bbab0d002146 - size: 720271 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/43.yaml - original: lts-22.43 + sha256: d133abe75e408a407cce3f032c96ac1bbadf474a93b5156ebf4135b53382d56b + size: 683827 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/18.yaml + original: lts-23.18 diff --git a/tests/Main.hs b/tests/Main.hs index b8f6ea979e..a01dc09e1b 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -12,6 +12,7 @@ import TestCoreFn qualified import TestCst qualified import TestDocs qualified import TestHierarchy qualified +import TestInteractive qualified import TestPrimDocs qualified import TestPsci qualified import TestIde qualified @@ -40,6 +41,7 @@ main = do describe "sourcemaps" TestSourceMaps.spec describe "make" TestMake.spec describe "psci" TestPsci.spec + describe "interactive" TestInteractive.spec describe "corefn" TestCoreFn.spec describe "docs" TestDocs.spec describe "prim-docs" TestPrimDocs.spec diff --git a/tests/TestDocs.hs b/tests/TestDocs.hs index d2b805ff0e..09a76ceb7a 100644 --- a/tests/TestDocs.hs +++ b/tests/TestDocs.hs @@ -1,6 +1,7 @@ module TestDocs where import Prelude +import Protolude (tailDef) import Data.Bifunctor (first) import Data.List (findIndex) @@ -952,7 +953,7 @@ testCases = codeToString (Docs.renderType ty) == expected shouldBeOrdered mn declNames = - zipWith (ShouldComeBefore mn) declNames (tail declNames) + zipWith (ShouldComeBefore mn) declNames (tailDef mempty declNames) testTagsCases :: [(Text, [TagsAssertion])] testTagsCases = diff --git a/tests/TestInteractive.hs b/tests/TestInteractive.hs new file mode 100644 index 0000000000..13fdb806ce --- /dev/null +++ b/tests/TestInteractive.hs @@ -0,0 +1,97 @@ +module TestInteractive where + +import Prelude + +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) +import Data.List.NonEmpty qualified as NEL +import Data.List (nub) + +import Language.PureScript.Interactive.Directive + ( directiveStrings + , directiveStrings' + , stringsFor + , stringFor + , directivesFor + , directivesFor' + , help + ) +import Language.PureScript.Interactive.Types (Directive(..)) + +spec :: Spec +spec = do + describe "Interactive.Directive" $ do + directiveStringsTests + directiveStrings'Tests + stringsForTests + stringForTests + directivesFor'Tests + directivesForTests + helpTests + +directiveStringsTests :: Spec +directiveStringsTests = describe "directiveStrings" $ do + it "should have non-empty string lists for each directive" $ do + let allHaveElements = not (any (null . NEL.toList . snd) directiveStrings) + allHaveElements `shouldBe` True + +directiveStrings'Tests :: Spec +directiveStrings'Tests = describe "directiveStrings'" $ do + it "should be a flattened version of directiveStrings" $ do + let expectedLength = sum (length . NEL.toList . snd <$> directiveStrings) + length directiveStrings' `shouldBe` expectedLength + + it "should contain appropriate directives" $ do + lookup "help" directiveStrings' `shouldBe` Just Help + lookup "?" directiveStrings' `shouldBe` Just Help + lookup "quit" directiveStrings' `shouldBe` Just Quit + lookup "reload" directiveStrings' `shouldBe` Just Reload + +stringsForTests :: Spec +stringsForTests = describe "stringsFor" $ do + it "should return all strings for a directive" $ do + NEL.toList (stringsFor Help) `shouldBe` ["?", "help"] + NEL.toList (stringsFor Quit) `shouldBe` ["quit"] + NEL.toList (stringsFor Reload) `shouldBe` ["reload"] + +stringForTests :: Spec +stringForTests = describe "stringFor" $ do + it "should return the first string for a directive" $ do + stringFor Help `shouldBe` "?" + stringFor Quit `shouldBe` "quit" + stringFor Reload `shouldBe` "reload" + +directivesFor'Tests :: Spec +directivesFor'Tests = describe "directivesFor'" $ do + it "should return matching directives and their string representations" $ do + directivesFor' "h" `shouldBe` [(Help, "help")] + directivesFor' "he" `shouldBe` [(Help, "help")] + directivesFor' "?" `shouldBe` [(Help, "?")] + directivesFor' "q" `shouldBe` [(Quit, "quit")] + + it "should handle ambiguous prefixes" $ do + directivesFor' "" `shouldSatisfy` (not . null) + length (directivesFor' "") `shouldBe` length directiveStrings' + + it "should return empty list for non-matching prefixes" $ do + directivesFor' "xyz" `shouldBe` [] + +directivesForTests :: Spec +directivesForTests = describe "directivesFor" $ do + it "should return just the directive part" $ do + directivesFor "h" `shouldBe` [Help] + directivesFor "q" `shouldBe` [Quit] + directivesFor "xyz" `shouldBe` [] + +helpTests :: Spec +helpTests = describe "help" $ do + it "should contain help for all directives" $ do + let helpDirectives = map (\(d, _, _) -> d) help + length (nub helpDirectives) `shouldBe` length directiveStrings + + it "should contain descriptive help text" $ do + let helpTexts = map (\(_, _, text) -> text) help + not (any null helpTexts) `shouldBe` True + + it "should include parameters where needed" $ do + lookup Browse (map (\(d, a, _) -> (d, a)) help) `shouldBe` Just "" + lookup Type (map (\(d, a, _) -> (d, a)) help) `shouldBe` Just "" From 94cec4f3292add490be0d935b43b90dc5a750883 Mon Sep 17 00:00:00 2001 From: Adrian Sieber <36796532+ad-si@users.noreply.github.com> Date: Sun, 8 Jun 2025 11:40:52 +0000 Subject: [PATCH 62/68] Fix double click select of titles in documentation (#4579) Full explanation: https://stackoverflow.com/questions/69291860 --- src/Language/PureScript/Docs/AsHtml.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Language/PureScript/Docs/AsHtml.hs b/src/Language/PureScript/Docs/AsHtml.hs index e03ccabc31..df7b55f3e3 100644 --- a/src/Language/PureScript/Docs/AsHtml.hs +++ b/src/Language/PureScript/Docs/AsHtml.hs @@ -133,8 +133,7 @@ declAsHtml r d@Declaration{..} = do h3 ! A.class_ "decl__title clearfix" $ do a ! A.class_ "decl__anchor" ! A.href (v declFragment) $ "#" H.span $ text declTitle - text " " -- prevent browser from treating - -- declTitle + linkToSource as one word + text "\x200b" -- Zero-width space to allow double-click selection of title for_ declSourceSpan (linkToSource r) H.div ! A.class_ "decl__body" $ do From 2b7164ff852b7243cd6d25529bc43a37162099ef Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Sun, 22 Jun 2025 19:01:01 +0300 Subject: [PATCH 63/68] Move to windows-2022 in CI (#4583) GitHub is sunsetting the `windows-2019` runner that we use in CI --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d3c9aca938..149fe63496 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -62,7 +62,7 @@ jobs: - os: macos-13 # x64 - os: macos-14 # arm64 - - os: windows-2019 # x64 + - os: windows-2022 # x64 runs-on: "${{ matrix.os }}" container: "${{ matrix.image }}" From 9dd761a3805a0c04b90db915599c1c6d8a3bb68e Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Fri, 27 Jun 2025 13:21:06 +0800 Subject: [PATCH 64/68] Build fully static compiler binary using ghc-musl (#4573) * Build statically-linked binaries with ghc-musl * Compliance for LGPL terms * Add changelog entry * Update dependencies * Update LICENSE * Update weeder * Fix weeder * Add more changelog entries * Argument passthrough * Update license * Update license * Build images for ARM * Checkout after Node installation * Only mount volumes for static * Drop static prefix for now * Force purge cache * Remove builds against ubuntu * Use matrix.os for cache key * Fix linux only * Set CI_STATIC to true * CI_STATIC on Linux only * Fix more linux only checks --- .github/workflows/ci.yml | 77 +- CHANGELOG.d/internal_tool_updates.md | 2 + CHANGELOG.d/misc_static_linking.md | 4 + LICENSE | 1057 +++++++++++++++++++------- ci/build.sh | 6 +- license-generator/generate.hs | 5 + license-generator/header.txt | 13 + license-generator/lgpl.txt | 158 ++++ purescript.cabal | 11 +- stack.yaml | 9 - stack.yaml.lock | 7 - 11 files changed, 1027 insertions(+), 322 deletions(-) create mode 100644 CHANGELOG.d/internal_tool_updates.md create mode 100644 CHANGELOG.d/misc_static_linking.md create mode 100644 license-generator/lgpl.txt diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 149fe63496..15532faa32 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -54,38 +54,52 @@ jobs: fail-fast: false # do not cancel builds for other OSes if one fails matrix: include: - - image: haskell:9.8.4 # Also upgrade version in the lint job below - os: ubuntu-latest # Exact version is not important, as it's only the container host) + - image: quay.io/benz0li/ghc-musl:9.8.4 + os: ubuntu-latest - - image: haskell:9.8.4 - os: ubuntu-24.04-arm # Exact version is not important, as it's only the container host + - image: quay.io/benz0li/ghc-musl:9.8.4 + os: ubuntu-24.04-arm - os: macos-13 # x64 - os: macos-14 # arm64 - os: windows-2022 # x64 runs-on: "${{ matrix.os }}" - container: "${{ matrix.image }}" + container: + image: "${{ matrix.image }}" + # https://github.com/actions/runner/issues/801#issuecomment-2976165281 + # This workaround also requires a special installation step for Node.js on arm64 + volumes: + - "${{ contains(matrix.os, 'arm') && '/opt:/opt:rw,rshared' || ' ' }}" + - "${{ contains(matrix.os, 'arm') && '/opt:/__e/node20:ro,rshared' || ' ' }}" + env: + CI_STATIC: "${{ startsWith(matrix.os, 'ubuntu') }}" outputs: do-not-prerelease: "${{ steps.build.outputs.do-not-prerelease }}" version: "${{ steps.build.outputs.version }}" steps: - - # We need `gh` installed on the Linux version. Otherwise, release artifacts won't be uploaded. - name: "(Linux only) Install gh" - if: startsWith(matrix.image, 'haskell') + # We need `gh` installed on the Linux version. Otherwise, release artifacts won't be uploaded. + - name: "(Linux only) Install gh" + if: "${{ startsWith(matrix.os, 'ubuntu') }}" run: | - curl -fsSL https://cli.github.com/packages/githubcli-archive-keyring.gpg | dd of=/usr/share/keyrings/githubcli-archive-keyring.gpg - chmod go+r /usr/share/keyrings/githubcli-archive-keyring.gpg - echo "deb [arch=$(dpkg --print-architecture) signed-by=/usr/share/keyrings/githubcli-archive-keyring.gpg] https://cli.github.com/packages stable main" | tee /etc/apt/sources.list.d/github-cli.list > /dev/null - apt-get update - apt-get install -y gh + apk add github-cli + + - name: "(Linux only / x64) Install Node" + if: "${{ startsWith(matrix.os, 'ubuntu') && ! contains(matrix.os, 'arm') }}" + run: | + apk add nodejs npm + + - name: "(Linux only / arm64) Install Node" + if: "${{ startsWith(matrix.os, 'ubuntu') && contains(matrix.os, 'arm') }}" + run: | + sed -i "/^ID=/s/alpine/NotpineForGHA/" /etc/os-release + apk add nodejs npm --update-cache + mkdir /opt/bin + ln -s /usr/bin/node /opt/bin/node - uses: "actions/checkout@v4" - - uses: "actions/setup-node@v4" - with: - node-version: "22" - id: "haskell" name: "(Non-Linux only) Install Haskell" @@ -98,7 +112,7 @@ jobs: stack-no-global: true - name: "(Linux only) Fix working directory ownership" - if: startsWith(matrix.image, 'haskell') + if: "${{ startsWith(matrix.os, 'ubuntu') }}" run: | chown root:root . @@ -107,7 +121,7 @@ jobs: path: | /root/.stack ${{ steps.haskell.outputs.stack-root }} - key: "${{ matrix.image || runner.os }}--MdyPsf-${{ hashFiles('stack.yaml.lock', 'purescript.cabal') }}" + key: "${{ matrix.image || matrix.os }}-v3-${{ hashFiles('stack.yaml.lock', 'purescript.cabal') }}" - name: "(Windows only) Configure Stack to store its programs in STACK_ROOT" # This ensures that the local GHC and MSYS binaries that Stack installs @@ -118,20 +132,26 @@ jobs: mkdir -p "$STACK_ROOT" echo "local-programs-path: $STACK_ROOT/programs" > $STACK_ROOT/config.yaml + - name: "(Linux only) Configure Stack" + if: "${{ startsWith(matrix.os, 'ubuntu') }}" + run: | + ci/fix-home stack config set system-ghc --global true + ci/fix-home stack config set install-ghc --global false + - id: "build" run: "ci/fix-home ci/build.sh" - name: "(Linux only) Glob tests" - if: startsWith(matrix.image, 'haskell') + if: "${{ startsWith(matrix.os, 'ubuntu') }}" working-directory: "sdist-test" # We build in this directory in build.sh, so this is where we need to # launch `stack exec`. The actual glob checks happen in a temporary directory. run: | - apt-get install -y tree + apk add tree ../ci/fix-home stack exec bash ../glob-test.sh - name: "(Linux only) Build the entire package set" - if: startsWith(matrix.image, 'haskell') + if: "${{ startsWith(matrix.os, 'ubuntu') }}" # We build in this directory in build.sh, so this is where we need to # launch `stack exec`. The actual package-set building happens in a # temporary directory. @@ -144,11 +164,11 @@ jobs: # Moreover, npm has a hook issue that will cause spago to fail to install # We upgrade npm to fix this run: | - apt-get install -y jq + apk add jq ../ci/fix-home stack --haddock exec ../ci/build-package-set.sh - name: Verify that 'libtinfo' isn't in binary - if: runner.os == 'Linux' + if: ${{ runner.os == 'Linux' }} working-directory: "sdist-test" run: | if [ $(ldd $(../ci/fix-home stack path --local-doc-root)/../bin/purs | grep 'libtinfo' | wc -l) -ge 1 ]; then @@ -157,6 +177,11 @@ jobs: exit 1 fi + - name: "(Linux only) Install perl-utils" + if: "${{ startsWith(matrix.os, 'ubuntu') }}" + run: | + apk add perl-utils + - name: "(Release/prerelease only) Create bundle" if: "${{ env.CI_RELEASE == 'true' || env.CI_PRERELEASE == 'true' && steps.build.outputs.do-not-prerelease != 'true' }}" run: | @@ -225,13 +250,13 @@ jobs: - name: Install weeder run: | ci/fix-home stack --no-terminal --jobs=2 \ - build --copy-compiler-tool weeder-2.8.0 + build --copy-compiler-tool weeder-2.9.0 - run: | ci/fix-home stack --no-terminal --jobs=2 \ build --fast --ghc-options -fwrite-ide-info - - run: "ci/fix-home stack exec weeder" + - run: "ci/fix-home stack exec weeder -- --hie-directory .stack-work" # Now do it again, with the test suite included. We don't want a # reference from our test suite to count in the above check; the fact @@ -241,7 +266,7 @@ jobs: ci/fix-home stack --no-terminal --jobs=2 \ build --fast --test --no-run-tests --ghc-options -fwrite-ide-info - - run: "ci/fix-home stack exec weeder" + - run: "ci/fix-home stack exec weeder -- --hie-directory .stack-work" make-prerelease: runs-on: ubuntu-latest diff --git a/CHANGELOG.d/internal_tool_updates.md b/CHANGELOG.d/internal_tool_updates.md new file mode 100644 index 0000000000..3dcd762162 --- /dev/null +++ b/CHANGELOG.d/internal_tool_updates.md @@ -0,0 +1,2 @@ +* Update weeder version in CI to 2.9.0 +* Add happy ==2.0.2 as build-tool-depends diff --git a/CHANGELOG.d/misc_static_linking.md b/CHANGELOG.d/misc_static_linking.md new file mode 100644 index 0000000000..3a4ec56549 --- /dev/null +++ b/CHANGELOG.d/misc_static_linking.md @@ -0,0 +1,4 @@ +* Enable statically-linked binaries using [ghc-musl](https://github.com/benz0li/ghc-musl) +* Update haskeline version bounds to >=0.8.2.1 && <0.9 + + Consequently, this fixes Cabal-based builds on GHC 9.8.4 diff --git a/LICENSE b/LICENSE index 713d3371a3..86b917570e 100644 --- a/LICENSE +++ b/LICENSE @@ -12,9 +12,23 @@ Redistribution and use in source and binary forms, with or without modification, 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 HOLDER 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. +PureScript executables for Linux distributed under the Releases tab of its GitHub +repository (https://github.com/purescript/purescript) may be statically-linked to +a version of GMP, licensed under the GNU Lesser General Public License Version 3, +29 June 2007. + +The full source code of PureScript is available in the aforementioned repository, +https://github.com/purescript/purescript, allowing you to modify and relink the +GMP portion if desired. + +GMP source code is available at: https://gmplib.org/ + +A copy of the LGPL is reproduced below. + PureScript uses the following Haskell library packages. Their license files follow. Cabal + Cabal-syntax Glob OneTuple QuickCheck @@ -24,27 +38,28 @@ PureScript uses the following Haskell library packages. Their license files foll aeson-better-errors alex ansi-terminal - ansi-wl-pprint + ansi-terminal-types array assoc async attoparsec auto-update base - base-compat - base-compat-batteries base-orphans basement bifunctors binary + bitvec blaze-builder blaze-html blaze-markup + boring bower-json boxes bytestring call-stack cborg + character-ps cheapskate clock colour @@ -56,7 +71,6 @@ PureScript uses the following Haskell library packages. Their license files foll contravariant cryptonite css-text - data-array-byte data-default data-default-class data-default-instances-containers @@ -75,14 +89,17 @@ PureScript uses the following Haskell library packages. Their license files foll file-embed filepath free + generically ghc-bignum ghc-prim half happy + happy-lib hashable haskeline indexed-traversable indexed-traversable-instances + integer-conversion integer-gmp integer-logarithms invariant @@ -105,9 +122,12 @@ PureScript uses the following Haskell library packages. Their license files foll old-locale old-time optparse-applicative + os-string parallel parsec pretty + prettyprinter + prettyprinter-ansi-terminal primitive process profunctors @@ -134,8 +154,11 @@ PureScript uses the following Haskell library packages. Their license files foll syb tagged tagsoup + tasty template-haskell + terminfo text + text-iso8601 text-short th-abstraction th-compat @@ -145,7 +168,6 @@ PureScript uses the following Haskell library packages. Their license files foll transformers transformers-base transformers-compat - type-equality typed-process uniplate unix @@ -157,6 +179,7 @@ PureScript uses the following Haskell library packages. Their license files foll uuid-types vector vector-algorithms + vector-stream void witherable xss-sanitize @@ -164,7 +187,44 @@ PureScript uses the following Haskell library packages. Their license files foll Cabal LICENSE file: - Copyright (c) 2003-2020, Cabal Development Team. + Copyright (c) 2003-2023, Cabal Development Team. + See the AUTHORS file for the full list of copyright holders. + + See */LICENSE for the copyright holders of the subcomponents. + + 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 Isaac Jones 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. + +Cabal-syntax LICENSE file: + + Copyright (c) 2003-2023, Cabal Development Team. See the AUTHORS file for the full list of copyright holders. See */LICENSE for the copyright holders of the subcomponents. @@ -454,53 +514,56 @@ ansi-terminal LICENSE file: Copyright (c) 2008, Maximilian Bolingbroke 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 Maximilian Bolingbroke nor the names of other contributors may be used to - endorse or promote products derived from this software without specific prior written permission. + Redistribution and use in source and binary forms, with or without modification, + are permitted provided that the following conditions are met: - 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. + * 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 Maximilian Bolingbroke nor the names of other contributors + may be used to endorse or promote products derived from this software without + specific prior written permission. -ansi-wl-pprint LICENSE file: + 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. - Copyright 2008, Daan Leijen and Max Bolingbroke. All rights reserved. +ansi-terminal-types LICENSE file: - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions are - met: + Copyright (c) 2008, Maximilian Bolingbroke + All rights reserved. - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. + Redistribution and use in source and binary forms, with or without modification, + are permitted provided that the following conditions are met: - * 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. + * 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 Maximilian Bolingbroke 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 "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 holders 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. + 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. array LICENSE file: @@ -797,50 +860,6 @@ base LICENSE file: ----------------------------------------------------------------------------- -base-compat LICENSE file: - - Copyright (c) 2012-2018 Simon Hengel and Ryan Scott - - Permission is hereby granted, free of charge, to any person obtaining a copy - of this software and associated documentation files (the "Software"), to deal - in the Software without restriction, including without limitation the rights - to use, copy, modify, merge, publish, distribute, sublicense, and/or sell - copies of the Software, and to permit persons to whom the Software is - furnished to do so, subject to the following conditions: - - The above copyright notice and this permission notice shall be included in - all copies or substantial portions of the Software. - - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, - OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN - THE SOFTWARE. - -base-compat-batteries LICENSE file: - - Copyright (c) 2012-2018 Simon Hengel and Ryan Scott - - Permission is hereby granted, free of charge, to any person obtaining a copy - of this software and associated documentation files (the "Software"), to deal - in the Software without restriction, including without limitation the rights - to use, copy, modify, merge, publish, distribute, sublicense, and/or sell - copies of the Software, and to permit persons to whom the Software is - furnished to do so, subject to the following conditions: - - The above copyright notice and this permission notice shall be included in - all copies or substantial portions of the Software. - - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, - OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN - THE SOFTWARE. - base-orphans LICENSE file: Copyright (c) 2015-2017 Simon Hengel , João Cristóvão , Ryan Scott @@ -957,6 +976,39 @@ binary LICENSE file: ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +bitvec LICENSE file: + + Copyright (c) 2019-2022 Andrew Lelechenko, 2012-2016 James Cook + + 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. + + * The names of the contributors may not be used to endorse 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. + blaze-builder LICENSE file: Copyright Jasper Van der Jeugt 2010, Simon Meier 2010 & 2011 @@ -1056,6 +1108,39 @@ blaze-markup LICENSE file: (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +boring LICENSE file: + + Copyright (c) 2017, Oleg Grenrus + + 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 Oleg Grenrus 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. + bower-json LICENSE file: Copyright (c) 2015 Harry Garrood @@ -1201,6 +1286,39 @@ cborg LICENSE file: (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +character-ps LICENSE file: + + Copyright (c) 2023, Oleg Grenrus + + 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 Oleg Grenrus 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. + cheapskate LICENSE file: Copyright (c) 2013, John MacFarlane @@ -1236,8 +1354,7 @@ cheapskate LICENSE file: clock LICENSE file: - Copyright (c) 2009-2012, Cetin Sert - Copyright (c) 2010, Eugene Kirpichov + Copyright (c) 2009-2022, Clock Contributors All rights reserved. @@ -1518,183 +1635,170 @@ css-text LICENSE file: OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -data-array-byte LICENSE file: +data-default LICENSE file: + + Copyright (c) 2013, Lukas Mai - Copyright (c) 2008-2009, Roman Leshchinskiy 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 name of the University nor the names of its contributors may be - used to endorse or promote products derived from this software without - specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF - GLASGOW AND THE 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 - UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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. - - -data-default LICENSE file: - - Copyright (c) 2013 Lukas Mai - - All rights reserved. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. - Redistribution and use in source and binary forms, with or without modification, - are permitted provided that the following conditions are met: + * 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. - * 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 the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. + * Neither the name of Lukas Mai 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 HOLDERS 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 + 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. data-default-class LICENSE file: - Copyright (c) 2013 Lukas Mai + Copyright (c) 2013, Lukas Mai All rights reserved. - Redistribution and use in source and binary forms, with or without modification, - are permitted provided that the following conditions are met: + 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 the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. - 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 HOLDERS 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 + * 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 Lukas Mai 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. data-default-instances-containers LICENSE file: - Copyright (c) 2013 Lukas Mai + Copyright (c) 2013, Lukas Mai All rights reserved. - Redistribution and use in source and binary forms, with or without modification, - are permitted provided that the following conditions are met: + 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 the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. - THIS SOFTWARE IS PROVIDED BY LUKAS MAI 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 REGENTS 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. + * 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 Lukas Mai 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. data-default-instances-dlist LICENSE file: - Copyright (c) 2013 Lukas Mai + Copyright (c) 2013, Lukas Mai All rights reserved. - Redistribution and use in source and binary forms, with or without modification, - are permitted provided that the following conditions are met: + 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 the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. - THIS SOFTWARE IS PROVIDED BY LUKAS MAI 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 REGENTS 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. + * 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 Lukas Mai 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. data-default-instances-old-locale LICENSE file: - Copyright (c) 2013 Lukas Mai + Copyright (c) 2013, Lukas Mai All rights reserved. - Redistribution and use in source and binary forms, with or without modification, - are permitted provided that the following conditions are met: + 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 the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. - THIS SOFTWARE IS PROVIDED BY LUKAS MAI 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 REGENTS 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. + * 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 Lukas Mai 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. data-fix LICENSE file: @@ -2127,6 +2231,37 @@ free LICENSE file: ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +generically LICENSE file: + + 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 Herbert Valerio Riedel 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. + ghc-bignum LICENSE file: The Glasgow Haskell Compiler License @@ -2392,21 +2527,54 @@ indexed-traversable-instances LICENSE file: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - 2. 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. + 2. 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. + + THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. + +integer-conversion LICENSE file: + + Copyright (c) 2023, Oleg Grenrus + + 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 Oleg Grenrus 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 AUTHORS ``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 AUTHORS 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. + 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. integer-gmp LICENSE file: @@ -3119,6 +3287,39 @@ optparse-applicative LICENSE file: (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +os-string LICENSE file: + + Copyright Neil Mitchell 2005-2020. + 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 Neil Mitchell 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. + parallel LICENSE file: This library (libraries/parallel) is derived from code from @@ -3227,6 +3428,58 @@ pretty LICENSE file: ----------------------------------------------------------------------------- +prettyprinter LICENSE file: + + Copyright 2008, Daan Leijen and Max Bolingbroke, 2016 David Luposchainsky. 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. + + This software is provided by the copyright holders "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 holders 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. + +prettyprinter-ansi-terminal LICENSE file: + + Copyright 2008, Daan Leijen and Max Bolingbroke, 2016 David Luposchainsky. 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. + + This software is provided by the copyright holders "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 holders 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. + primitive LICENSE file: Copyright (c) 2008-2009, Roman Leshchinskiy @@ -3497,7 +3750,7 @@ regex-base LICENSE file: regex-tdfa LICENSE file: - This modile is under this "3 clause" BSD license: + This module is under this "3 clause" BSD license: Copyright (c) 2007-2009, Christopher Kuklewicz All rights reserved. @@ -3545,7 +3798,7 @@ resourcet LICENSE file: safe LICENSE file: - Copyright Neil Mitchell 2007-2020. + Copyright Neil Mitchell 2007-2024. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -4139,6 +4392,28 @@ tagsoup LICENSE file: (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +tasty LICENSE file: + + Copyright (c) 2013 Roman Cheplyaka + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + template-haskell LICENSE file: @@ -4175,6 +4450,35 @@ template-haskell LICENSE file: DAMAGE. +terminfo LICENSE file: + + Copyright 2007, Judah Jacobson. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + 1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + + 2. 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. + + 3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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. + text LICENSE file: Copyright (c) 2008-2009, Tom Harper @@ -4204,6 +4508,39 @@ text LICENSE file: (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +text-iso8601 LICENSE file: + + Copyright (c) 2023 Oleg Grenrus + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + + 3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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. + text-short LICENSE file: Copyright (c) 2017, Herbert Valerio Riedel @@ -4321,7 +4658,7 @@ these LICENSE file: time LICENSE file: - TimeLib is Copyright (c) Ashley Yakeley and contributors, 2004-2020. All rights reserved. + TimeLib is Copyright (c) Ashley Yakeley and contributors, 2004-2022. All rights reserved. Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: @@ -4462,39 +4799,6 @@ transformers-compat LICENSE file: ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -type-equality LICENSE file: - - Copyright (c) 2009 Erik Hesselink, 2019 Oleg Grenrus, Ryan Scott - - 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 authors 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. - typed-process LICENSE file: Copyright (c) 2016 FP Complete, https://www.fpcomplete.com/ @@ -4587,6 +4891,8 @@ unix LICENSE file: unix-compat LICENSE file: + BSD 3-Clause License + Copyright (c) 2007-2008, Björn Bringert Copyright (c) 2007-2009, Duncan Coutts Copyright (c) 2010-2011, Jacob Stanley @@ -4766,6 +5072,9 @@ uuid-types LICENSE file: vector LICENSE file: Copyright (c) 2008-2012, Roman Leshchinskiy + 2020-2022, Alexey Kuleshevich + 2020-2022, Aleksey Khudyakov + 2020-2022, Andrew Lelechenko All rights reserved. Redistribution and use in source and binary forms, with or without @@ -4795,7 +5104,6 @@ vector LICENSE file: OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - vector-algorithms LICENSE file: Copyright (c) 2015 Dan Doel @@ -4833,7 +5141,7 @@ vector-algorithms LICENSE file: ------------------------------------------------------------------------------ The code in Data.Array.Vector.Algorithms.Mutable.Optimal is adapted from a C - algorithm for the same purpose. The folowing is the copyright notice for said + algorithm for the same purpose. The following is the copyright notice for said C code: Copyright (c) 2004 Paul Hsieh @@ -4865,6 +5173,41 @@ vector-algorithms LICENSE file: ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +vector-stream LICENSE file: + + Copyright (c) 2008-2012, Roman Leshchinskiy + 2020-2022, Alexey Kuleshevich + 2020-2022, Aleksey Khudyakov + 2020-2022, Andrew Lelechenko + 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 name of the University nor the names of its contributors may be + used to endorse or promote products derived from this software without + specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF + GLASGOW AND THE 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 + UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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. + void LICENSE file: Copyright 2015 Edward Kmett @@ -4986,3 +5329,161 @@ zlib LICENSE file: ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +============================================================================ + +GNU LESSER GENERAL PUBLIC LICENSE +Version 3, 29 June 2007 + +Copyright (C) 2007 Free Software Foundation, Inc. + +Everyone is permitted to copy and distribute verbatim copies of this license +document, but changing it is not allowed. + +This version of the GNU Lesser General Public License incorporates the terms +and conditions of version 3 of the GNU General Public License, supplemented +by the additional permissions listed below. + +0. Additional Definitions. + +As used herein, “this License” refers to version 3 of the GNU Lesser General +Public License, and the “GNU GPL” refers to version 3 of the +GNU General Public License. + +“The Library” refers to a covered work governed by this License, other than +an Application or a Combined Work as defined below. + +An “Application” is any work that makes use of an interface provided by the +Library, but which is not otherwise based on the Library. Defining a subclass +of a class defined by the Library is deemed a mode of using an interface +provided by the Library. + +A “Combined Work” is a work produced by combining or linking an Application +with the Library. The particular version of the Library with which the +Combined Work was made is also called the “Linked Version”. + +The “Minimal Corresponding Source” for a Combined Work means the Corresponding +Source for the Combined Work, excluding any source code for portions of the +Combined Work that, considered in isolation, are based on the Application, +and not on the Linked Version. + +The “Corresponding Application Code” for a Combined Work means the object code +and/or source code for the Application, including any data and utility programs +needed for reproducing the Combined Work from the Application, but excluding +the System Libraries of the Combined Work. + +1. Exception to Section 3 of the GNU GPL. + +You may convey a covered work under sections 3 and 4 of this License without +being bound by section 3 of the GNU GPL. + +2. Conveying Modified Versions. + +If you modify a copy of the Library, and, in your modifications, a facility +refers to a function or data to be supplied by an Application that uses the +facility (other than as an argument passed when the facility is invoked), +then you may convey a copy of the modified version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the function or + data, the facility still operates, and performs whatever part of its + purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of this + License applicable to that copy. + +3. Object Code Incorporating Material from Library Header Files. + +The object code form of an Application may incorporate material from a header +file that is part of the Library. You may convey such object code under terms +of your choice, provided that, if the incorporated material is not limited to +numerical parameters, data structure layouts and accessors, or small macros, +inline functions and templates (ten or fewer lines in length), +you do both of the following: + + a) Give prominent notice with each copy of the object code that the Library + is used in it and that the Library and its use are covered by this License. + + b) Accompany the object code with a copy of the GNU GPL + and this license document. + +4. Combined Works. + +You may convey a Combined Work under terms of your choice that, taken together, +effectively do not restrict modification of the portions of the Library +contained in the Combined Work and reverse engineering for debugging such +modifications, if you also do each of the following: + + a) Give prominent notice with each copy of the Combined Work that the + Library is used in it and that the Library and its use are covered + by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and + this license document. + + c) For a Combined Work that displays copyright notices during execution, + include the copyright notice for the Library among these notices, as well + as a reference directing the user to the copies of the GNU GPL + and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form suitable + for, and under terms that permit, the user to recombine or relink + the Application with a modified version of the Linked Version to + produce a modified Combined Work, in the manner specified by section 6 + of the GNU GPL for conveying Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time a + copy of the Library already present on the user's computer system, + and (b) will operate properly with a modified version of the Library + that is interface-compatible with the Linked Version. + + e) Provide Installation Information, but only if you would otherwise be + required to provide such information under section 6 of the GNU GPL, and + only to the extent that such information is necessary to install and + execute a modified version of the Combined Work produced by recombining + or relinking the Application with a modified version of the Linked Version. + (If you use option 4d0, the Installation Information must accompany the + Minimal Corresponding Source and Corresponding Application Code. If you + use option 4d1, you must provide the Installation Information in the + manner specified by section 6 of the GNU GPL for + conveying Corresponding Source.) + +5. Combined Libraries. + +You may place library facilities that are a work based on the Library side by +side in a single library together with other library facilities that are not +Applications and are not covered by this License, and convey such a combined +library under terms of your choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based on + the Library, uncombined with any other library facilities, conveyed under + the terms of this License. + + b) Give prominent notice with the combined library that part of it is a + work based on the Library, and explaining where to find the accompanying + uncombined form of the same work. + +6. Revised Versions of the GNU Lesser General Public License. + +The Free Software Foundation may publish revised and/or new versions of the +GNU Lesser General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Library as you +received it specifies that a certain numbered version of the GNU Lesser +General Public License “or any later version” applies to it, you have the +option of following the terms and conditions either of that published version +or of any later version published by the Free Software Foundation. If the +Library as you received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser General +Public License ever published by the Free Software Foundation. + +If the Library as you received it specifies that a proxy can decide whether +future versions of the GNU Lesser General Public License shall apply, that +proxy's public statement of acceptance of any version is permanent +authorization for you to choose that version for the Library. + diff --git a/ci/build.sh b/ci/build.sh index b2ef51251e..c551dfd51a 100755 --- a/ci/build.sh +++ b/ci/build.sh @@ -25,7 +25,7 @@ set -ex # We test with --haddock because haddock generation can fail if there is invalid doc-comment syntax, # and these failures are very easy to miss otherwise. -STACK="stack --no-terminal --haddock --jobs=2" +STACK="stack --no-terminal --haddock --jobs=4" STACK_OPTS="--test" if [ "$CI_RELEASE" = "true" -o "$CI_PRERELEASE" = "true" ] @@ -34,6 +34,10 @@ then else STACK_OPTS="$STACK_OPTS --fast" fi +if [ "$CI_STATIC" = "true" ] +then + STACK_OPTS="$STACK_OPTS --flag=purescript:static" +fi (echo "::endgroup::"; echo "::group::Set version number for build") 2>/dev/null diff --git a/license-generator/generate.hs b/license-generator/generate.hs index d000f2276c..f755ee8c2d 100644 --- a/license-generator/generate.hs +++ b/license-generator/generate.hs @@ -47,6 +47,7 @@ main = do putStrLn "" manager <- newManager tlsManagerSettings results <- traverse (\d -> (d,) <$> depsLicense manager d) deps + echoLgpl let failures = filter (not . snd) results if not (null failures) then do @@ -63,6 +64,10 @@ echoHeader :: IO () echoHeader = readFile "license-generator/header.txt" >>= putStr +echoLgpl :: IO () +echoLgpl = + readFile "license-generator/lgpl.txt" >>= putStr + depsNamesAndVersions :: IO [(String, String)] depsNamesAndVersions = do contents <- lines <$> getContents diff --git a/license-generator/header.txt b/license-generator/header.txt index cdebf0bb84..9ce87381dd 100644 --- a/license-generator/header.txt +++ b/license-generator/header.txt @@ -12,4 +12,17 @@ Redistribution and use in source and binary forms, with or without modification, 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 HOLDER 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. +PureScript executables for Linux distributed under the Releases tab of its GitHub +repository (https://github.com/purescript/purescript) may be statically-linked to +a version of GMP, licensed under the GNU Lesser General Public License Version 3, +29 June 2007. + +The full source code of PureScript is available in the aforementioned repository, +https://github.com/purescript/purescript, allowing you to modify and relink the +GMP portion if desired. + +GMP source code is available at: https://gmplib.org/ + +A copy of the LGPL is reproduced below. + PureScript uses the following Haskell library packages. Their license files follow. diff --git a/license-generator/lgpl.txt b/license-generator/lgpl.txt new file mode 100644 index 0000000000..12fad8bef5 --- /dev/null +++ b/license-generator/lgpl.txt @@ -0,0 +1,158 @@ +============================================================================ + +GNU LESSER GENERAL PUBLIC LICENSE +Version 3, 29 June 2007 + +Copyright (C) 2007 Free Software Foundation, Inc. + +Everyone is permitted to copy and distribute verbatim copies of this license +document, but changing it is not allowed. + +This version of the GNU Lesser General Public License incorporates the terms +and conditions of version 3 of the GNU General Public License, supplemented +by the additional permissions listed below. + +0. Additional Definitions. + +As used herein, “this License” refers to version 3 of the GNU Lesser General +Public License, and the “GNU GPL” refers to version 3 of the +GNU General Public License. + +“The Library” refers to a covered work governed by this License, other than +an Application or a Combined Work as defined below. + +An “Application” is any work that makes use of an interface provided by the +Library, but which is not otherwise based on the Library. Defining a subclass +of a class defined by the Library is deemed a mode of using an interface +provided by the Library. + +A “Combined Work” is a work produced by combining or linking an Application +with the Library. The particular version of the Library with which the +Combined Work was made is also called the “Linked Version”. + +The “Minimal Corresponding Source” for a Combined Work means the Corresponding +Source for the Combined Work, excluding any source code for portions of the +Combined Work that, considered in isolation, are based on the Application, +and not on the Linked Version. + +The “Corresponding Application Code” for a Combined Work means the object code +and/or source code for the Application, including any data and utility programs +needed for reproducing the Combined Work from the Application, but excluding +the System Libraries of the Combined Work. + +1. Exception to Section 3 of the GNU GPL. + +You may convey a covered work under sections 3 and 4 of this License without +being bound by section 3 of the GNU GPL. + +2. Conveying Modified Versions. + +If you modify a copy of the Library, and, in your modifications, a facility +refers to a function or data to be supplied by an Application that uses the +facility (other than as an argument passed when the facility is invoked), +then you may convey a copy of the modified version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the function or + data, the facility still operates, and performs whatever part of its + purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of this + License applicable to that copy. + +3. Object Code Incorporating Material from Library Header Files. + +The object code form of an Application may incorporate material from a header +file that is part of the Library. You may convey such object code under terms +of your choice, provided that, if the incorporated material is not limited to +numerical parameters, data structure layouts and accessors, or small macros, +inline functions and templates (ten or fewer lines in length), +you do both of the following: + + a) Give prominent notice with each copy of the object code that the Library + is used in it and that the Library and its use are covered by this License. + + b) Accompany the object code with a copy of the GNU GPL + and this license document. + +4. Combined Works. + +You may convey a Combined Work under terms of your choice that, taken together, +effectively do not restrict modification of the portions of the Library +contained in the Combined Work and reverse engineering for debugging such +modifications, if you also do each of the following: + + a) Give prominent notice with each copy of the Combined Work that the + Library is used in it and that the Library and its use are covered + by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and + this license document. + + c) For a Combined Work that displays copyright notices during execution, + include the copyright notice for the Library among these notices, as well + as a reference directing the user to the copies of the GNU GPL + and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form suitable + for, and under terms that permit, the user to recombine or relink + the Application with a modified version of the Linked Version to + produce a modified Combined Work, in the manner specified by section 6 + of the GNU GPL for conveying Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time a + copy of the Library already present on the user's computer system, + and (b) will operate properly with a modified version of the Library + that is interface-compatible with the Linked Version. + + e) Provide Installation Information, but only if you would otherwise be + required to provide such information under section 6 of the GNU GPL, and + only to the extent that such information is necessary to install and + execute a modified version of the Combined Work produced by recombining + or relinking the Application with a modified version of the Linked Version. + (If you use option 4d0, the Installation Information must accompany the + Minimal Corresponding Source and Corresponding Application Code. If you + use option 4d1, you must provide the Installation Information in the + manner specified by section 6 of the GNU GPL for + conveying Corresponding Source.) + +5. Combined Libraries. + +You may place library facilities that are a work based on the Library side by +side in a single library together with other library facilities that are not +Applications and are not covered by this License, and convey such a combined +library under terms of your choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based on + the Library, uncombined with any other library facilities, conveyed under + the terms of this License. + + b) Give prominent notice with the combined library that part of it is a + work based on the Library, and explaining where to find the accompanying + uncombined form of the same work. + +6. Revised Versions of the GNU Lesser General Public License. + +The Free Software Foundation may publish revised and/or new versions of the +GNU Lesser General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Library as you +received it specifies that a certain numbered version of the GNU Lesser +General Public License “or any later version” applies to it, you have the +option of following the terms and conditions either of that published version +or of any later version published by the Free Software Foundation. If the +Library as you received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser General +Public License ever published by the Free Software Foundation. + +If the Library as you received it specifies that a proxy can decide whether +future versions of the GNU Lesser General Public License shall apply, that +proxy's public statement of acceptance of any version is permanent +authorization for you to choose that version for the Library. + diff --git a/purescript.cabal b/purescript.cabal index 5cecca41fc..7601ec3954 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -175,7 +175,7 @@ common defaults file-embed >=0.0.16.0 && <0.1, filepath >=1.4.301.0 && <1.5, Glob >=0.10.2 && <0.11, - haskeline ==0.8.2, + haskeline >=0.8.2.1 && <0.9, language-javascript ==0.7.0.0, lens >=5.3.4 && <5.4, lifted-async >=0.10.2.7 && <0.11, @@ -395,6 +395,8 @@ library Paths_purescript autogen-modules: Paths_purescript + build-tool-depends: + happy:happy ==2.0.2 executable purs import: defaults @@ -429,6 +431,8 @@ executable purs Paths_purescript autogen-modules: Paths_purescript + if flag(static) + ld-options: -static -pthread test-suite tests import: defaults @@ -483,3 +487,8 @@ test-suite tests TestSourceMaps TestUtils Paths_purescript + +flag static + description: Builds a statically-linked version of the PureScript compiler. + manual: True + default: False diff --git a/stack.yaml b/stack.yaml index 500fd823cf..0fc0132869 100644 --- a/stack.yaml +++ b/stack.yaml @@ -14,7 +14,6 @@ extra-deps: # https://github.com/erikd/language-javascript/issues/131 - language-javascript-0.7.0.0 - bower-json-1.1.0.0 -- haskeline-0.8.2 - these-1.2.1 - aeson-better-errors-0.9.1.3 @@ -31,11 +30,3 @@ nix: flags: aeson-pretty: lib-only: true - haskeline: - # Avoids a libtinfo dynamic library dependency - terminfo: false - -allow-newer: true -allow-newer-deps: -- haskeline -- weeder diff --git a/stack.yaml.lock b/stack.yaml.lock index 8a4853c3fa..57dab5ca82 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -18,13 +18,6 @@ packages: size: 419 original: hackage: bower-json-1.1.0.0 -- completed: - hackage: haskeline-0.8.2@sha256:3b4b594095d64f5fa199b07bdca7d6b790313ed7f380a1b061845507e6563880,6005 - pantry-tree: - sha256: 17ee6b093c5135399b8e6bc3a63d9c6a4b0bc2100b495d2d974bc1464769de39 - size: 2955 - original: - hackage: haskeline-0.8.2 - completed: hackage: these-1.2.1@sha256:35c57aede96c15ea1fed559ac287b1168eb2b2869d79e62ed8c845780b7ea136,2294 pantry-tree: From 8ac0fb2962a7df318a74216872465dc2868c6064 Mon Sep 17 00:00:00 2001 From: seastian Date: Sat, 18 Oct 2025 16:24:57 +0200 Subject: [PATCH 65/68] Use -fspecialize-aggressively to improve performance by 30% on ACME build (#4584) * Use -fspecialize-aggressively to improve performance * add fspecialize to cabal project --- cabal.project | 9 ++++++--- stack.yaml | 2 +- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/cabal.project b/cabal.project index 453d64732d..d6a4a8e102 100644 --- a/cabal.project +++ b/cabal.project @@ -2,6 +2,9 @@ packages: purescript.cabal source-repository-package - type: git - location: https://github.com/purescript/cheapskate.git - tag: 633c69024e061ad956f1aecfc137fb99a7a7a20b + type: git + location: https://github.com/purescript/cheapskate.git + tag: 633c69024e061ad956f1aecfc137fb99a7a7a20b + +package purescript + ghc-options: -fspecialize-aggressively -fexpose-all-unfoldings diff --git a/stack.yaml b/stack.yaml index 0fc0132869..e87d094bcf 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,7 @@ packages: - '.' ghc-options: # Build with advanced optimizations enabled by default - "$locals": -O2 -Werror + "$locals": -O2 -Werror -fspecialize-aggressively -fexpose-all-unfoldings extra-deps: # As of 2021-11-08, the latest release of `language-javascript` is 0.7.1.0, # but it has a problem with parsing the `async` keyword. It doesn't allow From 4c66c05a59a08b698ba5c34b48e8bf7744ecb9f6 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Sat, 14 Mar 2026 12:28:12 +0200 Subject: [PATCH 66/68] Prepare 0.15.16 release (#4591) * Bump version to 0.15.16 * Add missing changelog entries * Prepare changelog and licenses for 0.15.16 * Add autogen modules for cabal>2.0 * Replace deprecated macos-13 with macos-15-intel * Update to latest spago 1.0.3 for the package-set build * Install coreutils on the Alpine CI to get GNU env --- .github/workflows/ci.yml | 4 +-- CHANGELOG.d/fix_issue-4535.md | 1 - CHANGELOG.d/fix_issue-4545.md | 1 - .../internal_remove-git-upgrade-step-in-ci.md | 1 - CHANGELOG.d/internal_tool_updates.md | 2 -- CHANGELOG.d/internal_upgrade_to_ghc_9.6.md | 2 -- CHANGELOG.d/internal_upgrade_to_ghc_9.8.md | 2 -- CHANGELOG.d/misc_ghc-bump.md | 1 - CHANGELOG.d/misc_static_linking.md | 4 --- CHANGELOG.md | 34 +++++++++++++++++++ LICENSE | 1 - ci/build-package-set.sh | 2 +- license-generator/generate.hs | 1 + npm-package/package.json | 4 +-- purescript.cabal | 4 ++- 15 files changed, 43 insertions(+), 21 deletions(-) delete mode 100644 CHANGELOG.d/fix_issue-4535.md delete mode 100644 CHANGELOG.d/fix_issue-4545.md delete mode 100644 CHANGELOG.d/internal_remove-git-upgrade-step-in-ci.md delete mode 100644 CHANGELOG.d/internal_tool_updates.md delete mode 100644 CHANGELOG.d/internal_upgrade_to_ghc_9.6.md delete mode 100644 CHANGELOG.d/internal_upgrade_to_ghc_9.8.md delete mode 100644 CHANGELOG.d/misc_ghc-bump.md delete mode 100644 CHANGELOG.d/misc_static_linking.md diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 15532faa32..b73b5cbdd3 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -60,7 +60,7 @@ jobs: - image: quay.io/benz0li/ghc-musl:9.8.4 os: ubuntu-24.04-arm - - os: macos-13 # x64 + - os: macos-15-intel # x64 - os: macos-14 # arm64 - os: windows-2022 # x64 @@ -164,7 +164,7 @@ jobs: # Moreover, npm has a hook issue that will cause spago to fail to install # We upgrade npm to fix this run: | - apk add jq + apk add jq coreutils ../ci/fix-home stack --haddock exec ../ci/build-package-set.sh - name: Verify that 'libtinfo' isn't in binary diff --git a/CHANGELOG.d/fix_issue-4535.md b/CHANGELOG.d/fix_issue-4535.md deleted file mode 100644 index 77341885a9..0000000000 --- a/CHANGELOG.d/fix_issue-4535.md +++ /dev/null @@ -1 +0,0 @@ -* Fix compiler crash when a type operator is used in a type argument diff --git a/CHANGELOG.d/fix_issue-4545.md b/CHANGELOG.d/fix_issue-4545.md deleted file mode 100644 index 1d6462ee9c..0000000000 --- a/CHANGELOG.d/fix_issue-4545.md +++ /dev/null @@ -1 +0,0 @@ -* Speed up IDE performance on large projects diff --git a/CHANGELOG.d/internal_remove-git-upgrade-step-in-ci.md b/CHANGELOG.d/internal_remove-git-upgrade-step-in-ci.md deleted file mode 100644 index f7f622a96e..0000000000 --- a/CHANGELOG.d/internal_remove-git-upgrade-step-in-ci.md +++ /dev/null @@ -1 +0,0 @@ -* Remove the step that upgraded Git from the CI workflow diff --git a/CHANGELOG.d/internal_tool_updates.md b/CHANGELOG.d/internal_tool_updates.md deleted file mode 100644 index 3dcd762162..0000000000 --- a/CHANGELOG.d/internal_tool_updates.md +++ /dev/null @@ -1,2 +0,0 @@ -* Update weeder version in CI to 2.9.0 -* Add happy ==2.0.2 as build-tool-depends diff --git a/CHANGELOG.d/internal_upgrade_to_ghc_9.6.md b/CHANGELOG.d/internal_upgrade_to_ghc_9.6.md deleted file mode 100644 index 6622b6baed..0000000000 --- a/CHANGELOG.d/internal_upgrade_to_ghc_9.6.md +++ /dev/null @@ -1,2 +0,0 @@ -* Upgrade GHC to [`9.6.6`](https://downloads.haskell.org/~ghc/9.6.6/docs/users_guide/9.6.6-notes.html), Stackage LTS `22.43` -* Minimum required glibc version is bumped from [`2.28` to `2.31`](https://sourceware.org/glibc/wiki/Glibc%20Timeline) diff --git a/CHANGELOG.d/internal_upgrade_to_ghc_9.8.md b/CHANGELOG.d/internal_upgrade_to_ghc_9.8.md deleted file mode 100644 index 7f3fb0e074..0000000000 --- a/CHANGELOG.d/internal_upgrade_to_ghc_9.8.md +++ /dev/null @@ -1,2 +0,0 @@ -* Upgrade GHC to [`9.8.4`](https://downloads.haskell.org/~ghc/9.8.4/docs/users_guide/9.8.4-notes.html), Stackage LTS `23.18` -* Use [HLint 3.10](https://github.com/ndmitchell/hlint/blob/master/CHANGES.txt) in CI diff --git a/CHANGELOG.d/misc_ghc-bump.md b/CHANGELOG.d/misc_ghc-bump.md deleted file mode 100644 index a1222cf6d0..0000000000 --- a/CHANGELOG.d/misc_ghc-bump.md +++ /dev/null @@ -1 +0,0 @@ -* Update Stackage snapshot to lts-20.26 and GHC to 9.2.8 diff --git a/CHANGELOG.d/misc_static_linking.md b/CHANGELOG.d/misc_static_linking.md deleted file mode 100644 index 3a4ec56549..0000000000 --- a/CHANGELOG.d/misc_static_linking.md +++ /dev/null @@ -1,4 +0,0 @@ -* Enable statically-linked binaries using [ghc-musl](https://github.com/benz0li/ghc-musl) -* Update haskeline version bounds to >=0.8.2.1 && <0.9 - - Consequently, this fixes Cabal-based builds on GHC 9.8.4 diff --git a/CHANGELOG.md b/CHANGELOG.md index 27a87cc478..d2dbd016b3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,40 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## 0.15.16 + +Bugfixes: + +* Fix compiler crash when a type operator is used in a type argument (#4536 by @purefunctor) + +* Speed up IDE performance on large projects (#4546 by @roryc89) + +* Fix double click select of titles in generated documentation (#4579 by @ad-si) + +Other improvements: + +* Update Stackage snapshot to lts-20.26 and GHC to 9.2.8 (#4537 by @purefunctor) + +* Enable statically-linked binaries using [ghc-musl](https://github.com/benz0li/ghc-musl) (#4573 by @purefunctor) +* Update haskeline version bounds to >=0.8.2.1 && <0.9 + + Consequently, this fixes Cabal-based builds on GHC 9.8.4 + +Internal: + +* Remove the step that upgraded Git from the CI workflow (#4541 by @rhendric) + +* Upgrade GHC to [`9.6.6`](https://downloads.haskell.org/~ghc/9.6.6/docs/users_guide/9.6.6-notes.html), Stackage LTS `22.43` (#4568 by @ad-si) +* Minimum required glibc version is bumped from [`2.28` to `2.31`](https://sourceware.org/glibc/wiki/Glibc%20Timeline) + +* Upgrade GHC to [`9.8.4`](https://downloads.haskell.org/~ghc/9.8.4/docs/users_guide/9.8.4-notes.html), Stackage LTS `23.18` (#4574 by @ad-si) +* Use [HLint 3.10](https://github.com/ndmitchell/hlint/blob/master/CHANGES.txt) in CI + +* Update weeder version in CI to 2.9.0 (#4573 by @purefunctor) +* Add happy ==2.0.2 as build-tool-depends + +* Use `-fspecialize-aggressively` GHC option to improve compiler performance by ~30% on large builds (#4584 by @seastian) + ## 0.15.15 New features: diff --git a/LICENSE b/LICENSE index 86b917570e..6b8251ded8 100644 --- a/LICENSE +++ b/LICENSE @@ -94,7 +94,6 @@ PureScript uses the following Haskell library packages. Their license files foll ghc-prim half happy - happy-lib hashable haskeline indexed-traversable diff --git a/ci/build-package-set.sh b/ci/build-package-set.sh index f11b556871..174757d384 100755 --- a/ci/build-package-set.sh +++ b/ci/build-package-set.sh @@ -16,7 +16,7 @@ export PATH="$tmpdir/node_modules/.bin:$PATH" cd "$tmpdir" echo ::group::Ensure Spago is available -which spago || npm install spago@0.93.43 +which spago || npm install spago echo ::endgroup:: echo ::group::Create dummy project diff --git a/license-generator/generate.hs b/license-generator/generate.hs index f755ee8c2d..09f7ab89b6 100644 --- a/license-generator/generate.hs +++ b/license-generator/generate.hs @@ -79,6 +79,7 @@ depsNamesAndVersions = do name == "purescript" || name == "rts" || name == "ghc-boot-th" + || name == "happy-lib" parse line = case splitOn " " line of diff --git a/npm-package/package.json b/npm-package/package.json index 56772d2b55..a1bbc7f452 100644 --- a/npm-package/package.json +++ b/npm-package/package.json @@ -1,6 +1,6 @@ { "name": "purescript", - "version": "0.15.15", + "version": "0.15.16", "license": "ISC", "description": "PureScript wrapper that makes it available as a local dependency", "author": { @@ -43,7 +43,7 @@ ], "scripts": { "prepublishOnly": "node -e \"require('fs').copyFileSync('purs.bin.placeholder', 'purs.bin');\"", - "postinstall": "install-purescript --purs-ver=0.15.15", + "postinstall": "install-purescript --purs-ver=0.15.16", "test": "echo 'Error: no test specified' && exit 1" } } diff --git a/purescript.cabal b/purescript.cabal index 7601ec3954..0a36e8c0b4 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- Note: don't add prerelease identifiers here! Add them in app/Version.hs and npm-package/package.json instead. -version: 0.15.15 +version: 0.15.16 synopsis: PureScript Programming Language Compiler description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript. category: Language @@ -487,6 +487,8 @@ test-suite tests TestSourceMaps TestUtils Paths_purescript + autogen-modules: + Paths_purescript flag static description: Builds a statically-linked version of the PureScript compiler. From c4a35b34b99af5feaa706ca0dadcb568788aff33 Mon Sep 17 00:00:00 2001 From: drathier Date: Wed, 25 Mar 2026 00:27:47 +0100 Subject: [PATCH 67/68] Fix typo in CoreFn traversal function (#4561) --- CHANGELOG.d/internal_fix-typo-in-traversal.md | 1 + CONTRIBUTORS.md | 1 + src/Language/PureScript/CoreFn/Traversals.hs | 2 +- 3 files changed, 3 insertions(+), 1 deletion(-) create mode 100644 CHANGELOG.d/internal_fix-typo-in-traversal.md diff --git a/CHANGELOG.d/internal_fix-typo-in-traversal.md b/CHANGELOG.d/internal_fix-typo-in-traversal.md new file mode 100644 index 0000000000..98dfa19747 --- /dev/null +++ b/CHANGELOG.d/internal_fix-typo-in-traversal.md @@ -0,0 +1 @@ +* Fix typo in CoreFn.Traversals.traverseCoreFn which caused it to not recurse into Let bodies diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index cfbb98e362..3a4fb44ab8 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -169,6 +169,7 @@ If you would prefer to use different terms, please use the section below instead | [@xgrommx](https://github.com/xgrommx) | Denis Stoyanov | [MIT license] | | [@zudov](https://github.com/zudov) | Konstantin Zudov | [MIT license] | | [@roryc89](https://github.com/roryc89) | Rory Campbell | [MIT license] | +| [@drathier](https://github.com/drathier) | Drathier | [MIT license] | ### Contributors using Modified Terms diff --git a/src/Language/PureScript/CoreFn/Traversals.hs b/src/Language/PureScript/CoreFn/Traversals.hs index f0684d34d5..4b5faa10cd 100644 --- a/src/Language/PureScript/CoreFn/Traversals.hs +++ b/src/Language/PureScript/CoreFn/Traversals.hs @@ -70,7 +70,7 @@ traverseCoreFn f g h i = (f', g', h', i') g' (Abs ann name e) = Abs ann name <$> g e g' (App ann v1 v2) = App ann <$> g v1 <*> g v2 g' (Case ann vs alts) = Case ann <$> traverse g vs <*> traverse i alts - g' (Let ann ds e) = Let ann <$> traverse f ds <*> g' e + g' (Let ann ds e) = Let ann <$> traverse f ds <*> g e g' e = pure e h' (LiteralBinder a b) = LiteralBinder a <$> handleLiteral h b From cb3c4965c8468d26c9b14cf0319db6dbd06ee4ff Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Sun, 7 Jun 2026 17:31:51 +0200 Subject: [PATCH 68/68] Add attached derive clauses to data and newtype declarations (#4594) --- ci/build.sh | 8 ++- src/Language/PureScript/CST/Convert.hs | 59 ++++++++++++------- src/Language/PureScript/CST/Flatten.hs | 19 ++++-- src/Language/PureScript/CST/Parser.y | 12 +++- src/Language/PureScript/CST/Positions.hs | 11 +++- src/Language/PureScript/CST/Types.hs | 13 +++- .../PureScript/Sugar/TypeClasses/Deriving.hs | 24 ++++++-- .../purs/failing/DeriveClauseCannotDerive.out | 14 +++++ .../failing/DeriveClauseCannotDerive.purs | 7 +++ tests/purs/failing/DeriveClauseEither2.out | 24 ++++++++ tests/purs/failing/DeriveClauseEither2.purs | 7 +++ .../purs/failing/DeriveClauseKindMismatch.out | 24 ++++++++ .../failing/DeriveClauseKindMismatch.purs | 7 +++ .../failing/DeriveClauseNewtypeOverlap.out | 24 ++++++++ .../failing/DeriveClauseNewtypeOverlap.purs | 13 ++++ tests/purs/passing/DerivingClause.purs | 53 +++++++++++++++++ 16 files changed, 279 insertions(+), 40 deletions(-) create mode 100644 tests/purs/failing/DeriveClauseCannotDerive.out create mode 100644 tests/purs/failing/DeriveClauseCannotDerive.purs create mode 100644 tests/purs/failing/DeriveClauseEither2.out create mode 100644 tests/purs/failing/DeriveClauseEither2.purs create mode 100644 tests/purs/failing/DeriveClauseKindMismatch.out create mode 100644 tests/purs/failing/DeriveClauseKindMismatch.purs create mode 100644 tests/purs/failing/DeriveClauseNewtypeOverlap.out create mode 100644 tests/purs/failing/DeriveClauseNewtypeOverlap.purs create mode 100644 tests/purs/passing/DerivingClause.purs diff --git a/ci/build.sh b/ci/build.sh index c551dfd51a..180c3545a3 100755 --- a/ci/build.sh +++ b/ci/build.sh @@ -176,9 +176,11 @@ tar -xzf sdist-test/purescript-*.tar.gz -C sdist-test --strip-components=1 (echo "::endgroup::"; echo "::group::Build and test PureScript") 2>/dev/null pushd sdist-test -# Haddock -Werror goes here to keep us honest but prevent failing on -# documentation errors in dependencies -$STACK build $STACK_OPTS --haddock-arguments --optghc=-Werror +# --ghc-options -Werror applies only to local packages, catching our own +# haddock doc-comment errors without failing on warnings in dependencies. +# (--haddock-arguments --optghc=-Werror would pass -Werror to all packages +# via haddock, which breaks when the dependency cache is cold.) +$STACK build $STACK_OPTS --ghc-options -Werror if [ "$do_prerelease" ] then diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs index 59b68adf1d..db1a5ff5ff 100644 --- a/src/Language/PureScript/CST/Convert.hs +++ b/src/Language/PureScript/CST/Convert.hs @@ -445,7 +445,7 @@ convertBinder fileName = go convertDeclaration :: String -> Declaration a -> [AST.Declaration] convertDeclaration fileName decl = case decl of - DeclData _ (DataHead _ a vars) bd -> do + DeclData _ (DataHead _ a vars) bd deriveClauses -> do let ctrs :: SourceToken -> DataCtor b -> [(SourceToken, DataCtor b)] -> [AST.DataConstructorDeclaration] ctrs st (DataCtor _ name fields) tl @@ -454,15 +454,17 @@ convertDeclaration fileName decl = case decl of [] -> [] (st', ctor) : tl' -> ctrs st' ctor tl' ) - pure $ AST.DataDeclaration ann Env.Data (nameValue a) (goTypeVar <$> vars) (maybe [] (\(st, Separated hd tl) -> ctrs st hd tl) bd) + AST.DataDeclaration ann Env.Data (nameValue a) (goTypeVar <$> vars) (maybe [] (\(st, Separated hd tl) -> ctrs st hd tl) bd) + : convertDeriveClauses fileName (nameValue a) deriveClauses DeclType _ (DataHead _ a vars) _ bd -> pure $ AST.TypeSynonymDeclaration ann (nameValue a) (goTypeVar <$> vars) (convertType fileName bd) - DeclNewtype _ (DataHead _ a vars) st x ys -> do + DeclNewtype _ (DataHead _ a vars) st x ys deriveClauses -> do let ctrs = [AST.DataConstructorDeclaration (sourceAnnCommented fileName st (snd $ declRange decl)) (nameValue x) [(headDef (internalError "No constructor name") ctrFields, convertType fileName ys)]] - pure $ AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs + AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs + : convertDeriveClauses fileName (nameValue a) deriveClauses DeclClass _ (ClassHead _ sup name vars fdeps) bd -> do let goTyVar (TypeVarKinded (Wrapped _ (Labeled (_, a) _ _) _)) = nameValue a @@ -553,25 +555,8 @@ convertDeclaration fileName decl = case decl of mkPartialInstanceName :: Maybe (Name Ident, SourceToken) -> QualifiedName (N.ProperName 'N.ClassName) -> [Type a] -> Either Text.Text N.Ident mkPartialInstanceName nameSep cls args = - maybe (Left genName) (Right . ident . nameValue . fst) nameSep + maybe (Left (genInstanceName cls (foldMap argName args))) (Right . ident . nameValue . fst) nameSep where - -- truncate to 25 chars to reduce verbosity - -- of name and still keep it readable - -- name will be used to create a GenIdent - -- in desugaring process - genName :: Text.Text - genName = Text.take 25 (className <> typeArgs) - - className :: Text.Text - className - = foldMap (uncurry Text.cons . first toLower) - . Text.uncons - . N.runProperName - $ qualName cls - - typeArgs :: Text.Text - typeArgs = foldMap argName args - argName :: Type a -> Text.Text argName = \case -- These are only useful to disambiguate between overlapping instances @@ -619,6 +604,36 @@ convertDeclaration fileName decl = case decl of else (fst $ qualRange cls, snd $ typeRange $ last args) +convertDeriveClauses + :: String + -> N.ProperName 'N.TypeName + -> [DeriveClause] + -> [AST.Declaration] +convertDeriveClauses fileName tyName = concatMap go + where + go (DeriveClause _ (Wrapped _ classes _)) = map convertClass (toList classes) + convertClass (DeriveClass cls) = + AST.TypeInstanceDeclaration clsAnn clsAnn chainId 0 (Left genName) + [] + (qualified cls) + [tyCon] + AST.DerivedInstance + where + clsAnn = uncurry (sourceAnnCommented fileName) (qualRange cls) + chainId = mkChainId fileName (Pos.spanStart (fst clsAnn)) + tyCon = T.TypeConstructor clsAnn (N.Qualified N.ByNullSourcePos tyName) + genName = genInstanceName cls (N.runProperName tyName) + +genInstanceName :: QualifiedName (N.ProperName 'N.ClassName) -> Text.Text -> Text.Text +genInstanceName cls typeArgs = Text.take 25 (className <> typeArgs) + where + className :: Text.Text + className + = foldMap (uncurry Text.cons . first toLower) + . Text.uncons + . N.runProperName + $ qualName cls + convertSignature :: String -> Labeled (Name Ident) (Type a) -> AST.Declaration convertSignature fileName (Labeled a _ b) = do let diff --git a/src/Language/PureScript/CST/Flatten.hs b/src/Language/PureScript/CST/Flatten.hs index 890614070d..3f2e4cda94 100644 --- a/src/Language/PureScript/CST/Flatten.hs +++ b/src/Language/PureScript/CST/Flatten.hs @@ -205,11 +205,12 @@ flattenRole = pure . roleTok flattenDeclaration :: Declaration a -> DList SourceToken flattenDeclaration = \case - DeclData _ a b -> + DeclData _ a b drvs -> flattenDataHead a <> - foldMap (\(t, cs) -> pure t <> flattenSeparated flattenDataCtor cs) b - DeclType _ a b c ->flattenDataHead a <> pure b <> flattenType c - DeclNewtype _ a b c d -> flattenDataHead a <> pure b <> flattenName c <> flattenType d + foldMap (\(t, ctrs) -> pure t <> flattenSeparated flattenDataCtor ctrs) b <> + foldMap flattenDeriveClause drvs + DeclType _ a b c -> flattenDataHead a <> pure b <> flattenType c + DeclNewtype _ a b c d drvs -> flattenDataHead a <> pure b <> flattenName c <> flattenType d <> foldMap flattenDeriveClause drvs DeclClass _ a b -> flattenClassHead a <> foldMap (\(c, d) -> pure c <> foldMap (flattenLabeled flattenName flattenType) d) b @@ -222,6 +223,16 @@ flattenDeclaration = \case DeclRole _ a b c d -> pure a <> pure b <> flattenName c <> foldMap flattenRole d DeclValue _ a -> flattenValueBindingFields a + where + flattenDeriveClass :: DeriveClass -> DList SourceToken + flattenDeriveClass (DeriveClass cls) = + flattenQualifiedName cls + + flattenDeriveClause :: DeriveClause -> DList SourceToken + flattenDeriveClause (DeriveClause kw classes) = + pure kw <> + flattenWrapped (flattenSeparated flattenDeriveClass) classes + flattenQualifiedName :: QualifiedName a -> DList SourceToken flattenQualifiedName = pure . qualTok diff --git a/src/Language/PureScript/CST/Parser.y b/src/Language/PureScript/CST/Parser.y index 55aa95da79..9560619a4a 100644 --- a/src/Language/PureScript/CST/Parser.y +++ b/src/Language/PureScript/CST/Parser.y @@ -661,10 +661,10 @@ import :: { Import () } | 'class' properName { ImportClass () $1 (getProperName $2) } decl :: { Declaration () } - : dataHead { DeclData () $1 Nothing } - | dataHead '=' sep(dataCtor, '|') { DeclData () $1 (Just ($2, $3)) } + : dataHead manyOrEmpty(deriveClause) { DeclData () $1 Nothing $2 } + | dataHead '=' sep(dataCtor, '|') manyOrEmpty(deriveClause) { DeclData () $1 (Just ($2, $3)) $4 } | typeHead '=' type {% checkNoWildcards $3 *> pure (DeclType () $1 $2 $3) } - | newtypeHead '=' properName typeAtom {% checkNoWildcards $4 *> pure (DeclNewtype () $1 $2 (getProperName $3) $4) } + | newtypeHead '=' properName typeAtom manyOrEmpty(deriveClause) {% checkNoWildcards $4 *> pure (DeclNewtype () $1 $2 (getProperName $3) $4 $5) } | classHead { either id (\h -> DeclClass () h Nothing) $1 } | classHead 'where' '\{' manySep(classMember, '\;') '\}' {% either (const (parseError $2)) (\h -> pure $ DeclClass () h (Just ($2, $4))) $1 } | instHead { DeclInstanceChain () (Separated (Instance $1 Nothing) []) } @@ -681,6 +681,12 @@ decl :: { Declaration () } | 'foreign' 'import' 'data' properName '::' type { DeclForeign () $1 $2 (ForeignData $3 (Labeled (getProperName $4) $5 $6)) } | 'type' 'role' properName many(role) { DeclRole () $1 $2 (getProperName $3) $4 } +deriveClause :: { DeriveClause } + : 'derive' '(' sep(deriveClass, ',') ')' { DeriveClause $1 (Wrapped $2 $3 $4) } + +deriveClass :: { DeriveClass } + : qualProperName { DeriveClass (getQualifiedProperName $1) } + dataHead :: { DataHead () } : 'data' properName manyOrEmpty(typeVarBindingPlain) { DataHead $1 (getProperName $2) $3 } diff --git a/src/Language/PureScript/CST/Positions.hs b/src/Language/PureScript/CST/Positions.hs index 20d5724271..63282e4bef 100644 --- a/src/Language/PureScript/CST/Positions.hs +++ b/src/Language/PureScript/CST/Positions.hs @@ -157,14 +157,21 @@ dataMembersRange = \case DataAll _ a -> (a, a) DataEnumerated _ (Wrapped a _ b) -> (a, b) +deriveClauseRange :: DeriveClause -> TokenRange +deriveClauseRange (DeriveClause kw classes) = (kw, wrpClose classes) + declRange :: Declaration a -> TokenRange declRange = \case - DeclData _ hd ctors + DeclData _ hd ctors drvs + | _:_ <- drvs -> (fst start, snd . deriveClauseRange $ last drvs) | Just (_, cs) <- ctors -> (fst start, snd . dataCtorRange $ sepLast cs) | otherwise -> start where start = dataHeadRange hd DeclType _ a _ b -> (fst $ dataHeadRange a, snd $ typeRange b) - DeclNewtype _ a _ _ b -> (fst $ dataHeadRange a, snd $ typeRange b) + DeclNewtype _ a _ _ b drvs + | _:_ <- drvs -> (fst start, snd . deriveClauseRange $ last drvs) + | otherwise -> start + where start = (fst $ dataHeadRange a, snd $ typeRange b) DeclClass _ hd body | Just (_, ts) <- body -> (fst start, snd . typeRange . lblValue $ NE.last ts) | otherwise -> start diff --git a/src/Language/PureScript/CST/Types.hs b/src/Language/PureScript/CST/Types.hs index ba90f7e95b..cf4345e5de 100644 --- a/src/Language/PureScript/CST/Types.hs +++ b/src/Language/PureScript/CST/Types.hs @@ -194,10 +194,19 @@ data DataMembers a | DataEnumerated a (Delimited (Name (N.ProperName 'N.ConstructorName))) deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) +data DeriveClass = DeriveClass + { dcClass :: QualifiedName (N.ProperName 'N.ClassName) + } deriving (Show, Eq, Ord, Generic) + +data DeriveClause = DeriveClause + { dclKeyword :: SourceToken + , dclClasses :: Wrapped (Separated DeriveClass) + } deriving (Show, Eq, Ord, Generic) + data Declaration a - = DeclData a (DataHead a) (Maybe (SourceToken, Separated (DataCtor a))) + = DeclData a (DataHead a) (Maybe (SourceToken, Separated (DataCtor a))) [DeriveClause] | DeclType a (DataHead a) SourceToken (Type a) - | DeclNewtype a (DataHead a) SourceToken (Name (N.ProperName 'N.ConstructorName)) (Type a) + | DeclNewtype a (DataHead a) SourceToken (Name (N.ProperName 'N.ConstructorName)) (Type a) [DeriveClause] | DeclClass a (ClassHead a) (Maybe (SourceToken, NonEmpty (Labeled (Name Ident) (Type a)))) | DeclInstanceChain a (Separated (Instance a)) | DeclDerive a SourceToken (Maybe SourceToken) (InstanceHead a) diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs index 3b4c019521..ddbc9097a0 100755 --- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs @@ -15,7 +15,7 @@ import Language.PureScript.Environment (DataDeclType(..), NameKind(..)) import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage') import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), freshIdent) import Language.PureScript.PSString (mkString) -import Language.PureScript.Types (SourceType, Type(..), WildcardData(..), replaceAllTypeVars, srcTypeApp, srcTypeConstructor, srcTypeLevelString) +import Language.PureScript.Types (SourceType, Type(..), WildcardData(..), replaceAllTypeVars, srcTypeApp, srcTypeConstructor, srcTypeLevelString, srcTypeVar) import Language.PureScript.TypeChecker (checkNewtype) -- | Elaborates deriving instance declarations by code generation. @@ -46,16 +46,32 @@ deriveInstance deriveInstance mn ds decl = case decl of TypeInstanceDeclaration sa@(ss, _) na ch idx nm deps className tys DerivedInstance -> let + -- Attached `derive (Generic)` / `derive (Newtype)` produces `[T]`. + -- These two classes need the fully-applied type plus a trailing + -- wildcard, so pad the args before falling into the standard handler. + paddedTys = case tys of + [bareTy] + | className == Libs.Generic || className == Libs.Newtype + , Just utc <- unwrapTypeConstructor bareTy + , mn == utcModuleName utc + , null (utcArgs utc) + , Just (DataDeclaration _ _ _ tyVars _) <- find (matchesTyName (utcTyCon utc)) ds -> + let applied = foldl srcTypeApp bareTy (map (srcTypeVar . fst) tyVars) + in [applied, TypeWildcard sa UnnamedWildcard] + _ -> tys + matchesTyName n (DataDeclaration _ _ n' _ _) = n == n' + matchesTyName _ _ = False + binaryWildcardClass :: (Declaration -> [SourceType] -> m ([Declaration], SourceType)) -> m Declaration - binaryWildcardClass f = case tys of + binaryWildcardClass f = case paddedTys of [ty1, ty2] -> case unwrapTypeConstructor ty1 of Just UnwrappedTypeConstructor{..} | mn == utcModuleName -> do checkIsWildcard ss utcTyCon ty2 tyConDecl <- findTypeDecl ss utcTyCon ds (members, ty2') <- f tyConDecl utcArgs pure $ TypeInstanceDeclaration sa na ch idx nm deps className [ty1, ty2'] (ExplicitInstance members) - _ -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty1 - _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2 + _ -> throwError . errorMessage' ss $ ExpectedTypeConstructor className paddedTys ty1 + _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className paddedTys 2 in case className of Libs.Generic -> binaryWildcardClass (deriveGenericRep ss mn) diff --git a/tests/purs/failing/DeriveClauseCannotDerive.out b/tests/purs/failing/DeriveClauseCannotDerive.out new file mode 100644 index 0000000000..a654d7db7e --- /dev/null +++ b/tests/purs/failing/DeriveClauseCannotDerive.out @@ -0,0 +1,14 @@ +Error found: +in module Main +at tests/purs/failing/DeriveClauseCannotDerive.purs:7:11 - 7:18 (line 7, column 11 - line 7, column 18) + + Cannot derive a type class instance for +   +  Main.MyClass Foo +   + since instances of this type class are not derivable. + + +See https://github.com/purescript/documentation/blob/master/errors/CannotDerive.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/DeriveClauseCannotDerive.purs b/tests/purs/failing/DeriveClauseCannotDerive.purs new file mode 100644 index 0000000000..7ca01a293e --- /dev/null +++ b/tests/purs/failing/DeriveClauseCannotDerive.purs @@ -0,0 +1,7 @@ +-- @shouldFailWith CannotDerive +module Main where + +class MyClass a + +data Foo a = Foo a + derive (MyClass) diff --git a/tests/purs/failing/DeriveClauseEither2.out b/tests/purs/failing/DeriveClauseEither2.out new file mode 100644 index 0000000000..9ed2a40315 --- /dev/null +++ b/tests/purs/failing/DeriveClauseEither2.out @@ -0,0 +1,24 @@ +Error found: +in module Main +at tests/purs/failing/DeriveClauseEither2.purs:7:11 - 7:13 (line 7, column 11 - line 7, column 13) + + Could not match kind +   +  Type -> Type -> Type +   + with kind +   +  Type +   + +while checking that type Either2 + has kind Type +while inferring the kind of Eq Either2 +in type class instance +  + Data.Eq.Eq Either2 +  + +See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/DeriveClauseEither2.purs b/tests/purs/failing/DeriveClauseEither2.purs new file mode 100644 index 0000000000..24a0c00053 --- /dev/null +++ b/tests/purs/failing/DeriveClauseEither2.purs @@ -0,0 +1,7 @@ +-- @shouldFailWith KindsDoNotUnify +module Main where + +import Prelude + +data Either2 a b = Left2 a | Right2 b + derive (Eq) diff --git a/tests/purs/failing/DeriveClauseKindMismatch.out b/tests/purs/failing/DeriveClauseKindMismatch.out new file mode 100644 index 0000000000..65799ec128 --- /dev/null +++ b/tests/purs/failing/DeriveClauseKindMismatch.out @@ -0,0 +1,24 @@ +Error found: +in module Main +at tests/purs/failing/DeriveClauseKindMismatch.purs:7:11 - 7:13 (line 7, column 11 - line 7, column 13) + + Could not match kind +   +  Type -> Type +   + with kind +   +  Type +   + +while checking that type Box + has kind Type +while inferring the kind of Eq Box +in type class instance +  + Data.Eq.Eq Box +  + +See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/DeriveClauseKindMismatch.purs b/tests/purs/failing/DeriveClauseKindMismatch.purs new file mode 100644 index 0000000000..5404a49dee --- /dev/null +++ b/tests/purs/failing/DeriveClauseKindMismatch.purs @@ -0,0 +1,7 @@ +-- @shouldFailWith KindsDoNotUnify +module Main where + +import Prelude + +data Box a = Box a + derive (Eq) diff --git a/tests/purs/failing/DeriveClauseNewtypeOverlap.out b/tests/purs/failing/DeriveClauseNewtypeOverlap.out new file mode 100644 index 0000000000..fcbfbb733e --- /dev/null +++ b/tests/purs/failing/DeriveClauseNewtypeOverlap.out @@ -0,0 +1,24 @@ +Error found: +in module Main +at tests/purs/failing/DeriveClauseNewtypeOverlap.purs:10:1 - 10:34 (line 10, column 1 - line 10, column 34) + + Overlapping type class instances found for +   +  Data.Newtype.Newtype Wrapper +  String  +   + The following instances were found: + + instance in module Main with type Newtype Wrapper String (line 8, column 11 - line 8, column 18) + instance in module Main with type Newtype Wrapper String (line 10, column 1 - line 10, column 34) + + +in type class instance +  + Data.Newtype.Newtype Wrapper + String  +  + +See https://github.com/purescript/documentation/blob/master/errors/OverlappingInstances.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/DeriveClauseNewtypeOverlap.purs b/tests/purs/failing/DeriveClauseNewtypeOverlap.purs new file mode 100644 index 0000000000..0ba9b83cfb --- /dev/null +++ b/tests/purs/failing/DeriveClauseNewtypeOverlap.purs @@ -0,0 +1,13 @@ +-- @shouldFailWith OverlappingInstances +module Main where + +import Prelude +import Data.Newtype (class Newtype, unwrap) + +newtype Wrapper = Wrapper String + derive (Newtype) + +derive instance Newtype Wrapper _ + +value :: String +value = unwrap (Wrapper "hi") diff --git a/tests/purs/passing/DerivingClause.purs b/tests/purs/passing/DerivingClause.purs new file mode 100644 index 0000000000..a7f5ed2adb --- /dev/null +++ b/tests/purs/passing/DerivingClause.purs @@ -0,0 +1,53 @@ +module Main where + +import Prelude + +import Data.Bifunctor (class Bifunctor, bimap) +import Data.Generic.Rep (class Generic) +import Data.Newtype (class Newtype) +import Data.Foldable (class Foldable, foldMap) +import Data.Traversable (class Traversable) +import Effect (Effect) +import Effect.Console (log) +import Test.Assert + +data Color = Red | Green | Blue + derive (Eq, Ord) + +newtype Name = Name String + derive (Eq, Ord) + +data List a = Nil | Cons a (List a) + derive (Functor, Foldable, Traversable) + +data Either2 a b = Left2 a | Right2 b + derive (Bifunctor) + +derive instance Eq a => Eq (Either2 a a) + +data Direction = North | South | East | West + derive (Generic) + +newtype Wrapper = Wrapper String + derive (Newtype) + +data Pair a = Pair a a + derive (Functor) + +data Box a = Empty | Full a + derive (Functor) + +derive instance Eq a => Eq (Box a) + +main :: Effect Unit +main = do + assert $ Red == Red + assert $ Red < Green + assert $ Name "Alice" == Name "Alice" + assert $ foldMap show (Cons 1 (Cons 2 Nil)) == "12" + assert $ bimap (_ + 1) (_ * 2) (Left2 3) == Left2 4 + assert $ map (_ + 1) (Full 1) == Full 2 + assert $ case map (_ + 1) (Pair 1 2) of + Pair 2 3 -> true + _ -> false + log "Done"