From 6c481c890e0aa32a02b880b8621865debb8c00b6 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Thu, 6 Feb 2020 22:19:50 +0100 Subject: [PATCH 01/62] Add ES imports/exports to CoreImp AST --- src/Language/PureScript/CoreImp/AST.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs index b6dcad1446..b036588652 100644 --- a/src/Language/PureScript/CoreImp/AST.hs +++ b/src/Language/PureScript/CoreImp/AST.hs @@ -92,6 +92,10 @@ data AST -- ^ instanceof check | Comment (Maybe SourceSpan) [Comment] AST -- ^ Commented JavaScript + | Import (Maybe SourceSpan) Text PSString + -- ^ Imported identifier and path to its module + | Export (Maybe SourceSpan) [Text] (Maybe PSString) + -- ^ Exported identifiers and optional path to their module (for re-exports) deriving (Show, Eq) withSourceSpan :: SourceSpan -> AST -> AST @@ -123,6 +127,8 @@ withSourceSpan withSpan = go where go (Throw _ js) = Throw ss js go (InstanceOf _ j1 j2) = InstanceOf ss j1 j2 go (Comment _ com j) = Comment ss com j + go (Import _ ident from) = Import ss ident from + go (Export _ idents from) = Export ss idents from getSourceSpan :: AST -> Maybe SourceSpan getSourceSpan = go where @@ -150,6 +156,8 @@ getSourceSpan = go where go (Throw ss _) = ss go (InstanceOf ss _ _) = ss go (Comment ss _ _) = ss + go (Import ss _ _) = ss + go (Export ss _ _) = ss everywhere :: (AST -> AST) -> AST -> AST everywhere f = go where From 52a692b67d66c092bab15619ab0900c8ee7805ed Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Thu, 6 Feb 2020 22:21:08 +0100 Subject: [PATCH 02/62] Print ES imports/exports --- src/Language/PureScript/CodeGen/JS/Printer.hs | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index b69270cdac..d602149c49 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -119,6 +119,27 @@ literals = mkPattern' match' , mconcat <$> forM com comment , prettyPrintJS' js ] + match (Import _ ident from) = return . emit $ + "import * as " <> ident <> " from " <> prettyPrintStringJS from + match (Export _ [] _) = return $ emit "" + match (Export _ idents from) = mconcat <$> sequence + [ return $ emit "export {\n" + , withIndent $ do + let exportsStrings = emit . exportedIdentToString from <$> idents + indentString <- currentIndent + return . intercalate (emit ",\n") $ (indentString <>) <$> exportsStrings + , return $ emit "\n" + , currentIndent + , return . emit $ "}" <> maybe "" ((" from " <>) . prettyPrintStringJS) from + ] + where + exportedIdentToString Nothing ident + | nameIsJsReserved ident || nameIsJsBuiltIn ident + = "$$" <> ident <> " as " <> ident + exportedIdentToString _ "$main" + = T.concatMap identCharToText "$main" <> " as $main" + exportedIdentToString _ ident + = T.concatMap identCharToText ident match _ = mzero comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen From cd40596f35ebb53f5fdf6b3786bf45d2d91b2e0c Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Thu, 6 Feb 2020 22:27:07 +0100 Subject: [PATCH 03/62] Codegen ES imports for PureScript modules --- src/Language/PureScript/CodeGen/JS.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 2f8a9d3c06..4d6d44ddc6 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -107,9 +107,7 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ = importToJs :: M.Map ModuleName (Ann, ModuleName) -> ModuleName -> m AST importToJs mnLookup mn' = do let ((ss, _, _, _), mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup - let moduleBody = AST.App Nothing (AST.Var Nothing "require") - [AST.StringLiteral Nothing (fromString (".." T.unpack (runModuleName mn') "index.js"))] - withPos ss $ AST.VariableIntroduction Nothing (moduleNameToJs mnSafe) (Just moduleBody) + withPos ss $ AST.Import Nothing (moduleNameToJs mnSafe) (fromString (".." T.unpack (runModuleName mn') "index.js")) -- | Replaces the `ModuleName`s in the AST so that the generated code refers to -- the collision-avoiding renamed module imports. From 607dd3dad33fb7611f36eed4df6f82c8c3323e24 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Thu, 6 Feb 2020 22:38:40 +0100 Subject: [PATCH 04/62] Codegen ES imports for foreign modules --- src/Language/PureScript/CodeGen/JS.hs | 8 ++++---- src/Language/PureScript/Make/Actions.hs | 3 +-- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 4d6d44ddc6..7e05d688b6 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -19,7 +19,7 @@ import Data.List ((\\), intersect) import qualified Data.Foldable as F import qualified Data.Map as M import qualified Data.Set as S -import Data.Maybe (fromMaybe, isNothing) +import Data.Maybe (fromMaybe) import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T @@ -48,9 +48,9 @@ moduleToJs :: forall m . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m) => Module Ann - -> Maybe AST + -> Maybe PSString -> m [AST] -moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ = +moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreignInclude = rethrow (addHint (ErrorInModule mn)) $ do let usedNames = concatMap getNames decls let mnLookup = renameImports usedNames imps @@ -66,7 +66,7 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ = comments <- not <$> asks optionsNoComments let strict = AST.StringLiteral Nothing "use strict" let header = if comments && not (null coms) then AST.Comment Nothing coms strict else strict - let foreign' = [AST.VariableIntroduction Nothing "$foreign" foreign_ | not $ null foreigns || isNothing foreign_] + let foreign' = maybe [] (pure . AST.Import Nothing "$foreign") $ if null foreigns then Nothing else foreignInclude let moduleBody = header : foreign' ++ jsImports ++ concat optimized let foreignExps = exps `intersect` foreigns let standardExps = exps \\ foreignExps diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 1fb4ed52ff..16385a4721 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -36,7 +36,6 @@ 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 qualified Language.PureScript.CoreImp.AST as Imp import Language.PureScript.Crash import qualified Language.PureScript.CST as CST import qualified Language.PureScript.Docs.Prim as Docs.Prim @@ -207,7 +206,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = | not $ requiresForeign m -> do return Nothing | otherwise -> do - return $ Just $ Imp.App Nothing (Imp.Var Nothing "require") [Imp.StringLiteral Nothing "./foreign.js"] + return $ Just "./foreign.js" Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn | otherwise -> return Nothing rawJs <- J.moduleToJs m foreignInclude From 19878e38f39a9df4617e2eff51b4b5d2655802ed Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Thu, 6 Feb 2020 22:52:36 +0100 Subject: [PATCH 05/62] Codegen ES exports --- src/Language/PureScript/CodeGen/JS.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 7e05d688b6..73e2843638 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.Compat import Protolude (ordNub) -import Control.Arrow ((&&&)) import Control.Monad (forM, replicateM, void) import Control.Monad.Except (MonadError, throwError) import Control.Monad.Reader (MonadReader, asks) @@ -70,9 +69,9 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreignInclude = let moduleBody = header : foreign' ++ jsImports ++ concat optimized let foreignExps = exps `intersect` foreigns let standardExps = exps \\ foreignExps - let exps' = AST.ObjectLiteral Nothing $ map (mkString . runIdent &&& AST.Var Nothing . identToJs) standardExps - ++ map (mkString . runIdent &&& foreignIdent) foreignExps - return $ moduleBody ++ [AST.Assignment Nothing (accessorString "exports" (AST.Var Nothing "module")) exps'] + return $ moduleBody ++ [ AST.Export Nothing (map runIdent foreignExps) foreignInclude + , AST.Export Nothing (map runIdent standardExps) Nothing + ] where From 48898619f5f067b4ab5dd002837495c65a17ff3f Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 8 Feb 2020 11:25:23 +0100 Subject: [PATCH 06/62] Extract both CJS and ES exports from foreign modules --- src/Language/PureScript/Bundle.hs | 48 ++++++++++++++++++++++--- src/Language/PureScript/Make/Actions.hs | 2 +- 2 files changed, 44 insertions(+), 6 deletions(-) diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 82bf1cb234..7ff6d9cbd9 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -31,7 +31,7 @@ import Data.Foldable (fold) import Data.Generics (GenericM, everything, everythingWithContext, everywhere, gmapMo, mkMp, mkQ, mkT) import Data.Graph import Data.List (stripPrefix, (\\)) -import Data.Maybe (catMaybes, fromMaybe, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList) import Data.Version (showVersion) import qualified Data.Aeson as A import qualified Data.Map as M @@ -421,19 +421,22 @@ getExportedIdentifiers :: forall m. (MonadError ErrorMessage m) -> JSAST -> m [String] getExportedIdentifiers mname top - | JSAstProgram stmts _ <- top = concat <$> traverse go stmts + | JSAstModule jsModuleItems _ <- top = concat <$> traverse go jsModuleItems | otherwise = err InvalidTopLevel where err :: ErrorMessage -> m a err = throwError . ErrorInModule (ModuleIdentifier mname Foreign) - go stmt - | Just props <- matchExportsAssignment stmt + go (JSModuleStatementListItem jsStatement) + | Just props <- matchExportsAssignment jsStatement = traverse toIdent (trailingCommaList props) - | Just (Public, name, _) <- matchMember stmt + | Just (Public, name, _) <- matchMember jsStatement = pure [name] | otherwise = pure [] + go (JSModuleExportDeclaration _ jsExportDeclaration) = + pure $ exportDeclarationIdentifiers jsExportDeclaration + go _ = pure [] toIdent (JSPropertyNameandValue name _ [_]) = extractLabel' name @@ -442,6 +445,41 @@ getExportedIdentifiers mname top extractLabel' = maybe (err UnsupportedExport) pure . extractLabel + exportDeclarationIdentifiers (JSExportFrom jsExportClause _ _) = + exportClauseIdentifiers jsExportClause + exportDeclarationIdentifiers (JSExportLocals jsExportClause _) = + exportClauseIdentifiers jsExportClause + exportDeclarationIdentifiers (JSExport jsStatement _) = + exportStatementIdentifiers jsStatement + + exportClauseIdentifiers (JSExportClause _ jsExportsSpecifiers _) = + mapMaybe exportSpecifierName $ commaList jsExportsSpecifiers + + exportSpecifierName (JSExportSpecifier jsIdent) = identName jsIdent + exportSpecifierName (JSExportSpecifierAs _ _ jsIdentAs) = identName jsIdentAs + + exportStatementIdentifiers (JSVariable _ jsExpressions _) = + varNames jsExpressions + exportStatementIdentifiers (JSConstant _ jsExpressions _) = + varNames jsExpressions + exportStatementIdentifiers (JSLet _ jsExpressions _) = + varNames jsExpressions + exportStatementIdentifiers (JSClass _ jsIdent _ _ _ _ _) = + maybeToList . identName $ jsIdent + exportStatementIdentifiers (JSFunction _ jsIdent _ _ _ _ _) = + maybeToList . identName $ jsIdent + exportStatementIdentifiers (JSGenerator _ _ jsIdent _ _ _ _ _) = + maybeToList . identName $ jsIdent + exportStatementIdentifiers _ = [] + + varNames = mapMaybe varName . commaList + + varName (JSVarInitExpression (JSIdentifier _ ident) _) = Just ident + varName _ = Nothing + + identName (JSIdentName _ ident) = Just ident + identName _ = Nothing + -- Matches JS statements like this: -- var ModuleName = require("file"); matchRequire :: S.Set String diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 16385a4721..738644b8c9 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -281,7 +281,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = checkForeignDecls :: CF.Module ann -> FilePath -> Make () checkForeignDecls m path = do jsStr <- T.unpack <$> readTextFile path - js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parse jsStr path + js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parseModule jsStr path foreignIdentsStrs <- either errorParsingModule pure $ getExps js From c03399f3691a137579bddd6d687cf78655494ed4 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 8 Feb 2020 19:56:21 +0100 Subject: [PATCH 07/62] Remove the redundant "use strict;" pragma from modules header ES modules are already parsed in strict mode. --- src/Language/PureScript/CodeGen/JS.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 73e2843638..c90013ee17 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -14,7 +14,8 @@ import Control.Monad.Except (MonadError, throwError) import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Supply.Class -import Data.List ((\\), intersect) +import Data.Bifunctor (first) +import Data.List ((\\), intersect, uncons) import qualified Data.Foldable as F import qualified Data.Map as M import qualified Data.Set as S @@ -63,10 +64,9 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreignInclude = . (\\ (mn : C.primModules)) $ ordNub $ map snd imps F.traverse_ (F.traverse_ checkIntegers) optimized comments <- not <$> asks optionsNoComments - let strict = AST.StringLiteral Nothing "use strict" - let header = if comments && not (null coms) then AST.Comment Nothing coms strict else strict + let header = if comments && not (null coms) then AST.Comment Nothing coms else id let foreign' = maybe [] (pure . AST.Import Nothing "$foreign") $ if null foreigns then Nothing else foreignInclude - let moduleBody = header : foreign' ++ jsImports ++ concat optimized + let moduleBody = maybe [] (uncurry (:)) . fmap (first header) . uncons $ foreign' ++ jsImports ++ concat optimized let foreignExps = exps `intersect` foreigns let standardExps = exps \\ foreignExps return $ moduleBody ++ [ AST.Export Nothing (map runIdent foreignExps) foreignInclude From 71c2de372d91e4bf9dcbf4327fe189afc912b4fa Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 8 Feb 2020 20:37:53 +0100 Subject: [PATCH 08/62] =?UTF-8?q?Don=E2=80=99t=20emit=20empty=20statements?= =?UTF-8?q?=20for=20empty=20exports=20lists?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Language/PureScript/CodeGen/JS.hs | 14 ++++++++++---- src/Language/PureScript/CodeGen/JS/Printer.hs | 4 ++-- src/Language/PureScript/CoreImp/AST.hs | 3 ++- 3 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index c90013ee17..9995dd66f3 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -16,10 +16,11 @@ import Control.Monad.Supply.Class import Data.Bifunctor (first) import Data.List ((\\), intersect, uncons) +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.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, maybeToList) import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T @@ -69,9 +70,9 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreignInclude = let moduleBody = maybe [] (uncurry (:)) . fmap (first header) . uncons $ foreign' ++ jsImports ++ concat optimized let foreignExps = exps `intersect` foreigns let standardExps = exps \\ foreignExps - return $ moduleBody ++ [ AST.Export Nothing (map runIdent foreignExps) foreignInclude - , AST.Export Nothing (map runIdent standardExps) Nothing - ] + return $ moduleBody + ++ (maybeToList . exportsToJs foreignInclude $ foreignExps) + ++ (maybeToList . exportsToJs Nothing $ standardExps) where @@ -108,6 +109,11 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreignInclude = let ((ss, _, _, _), mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup withPos ss $ AST.Import Nothing (moduleNameToJs mnSafe) (fromString (".." T.unpack (runModuleName mn') "index.js")) + -- | Generates JavaScript code for exporting at least one identifier, + -- eventually from another module. + exportsToJs :: Maybe PSString -> [Ident] -> Maybe AST + exportsToJs from = fmap (flip (AST.Export Nothing) from) . NEL.nonEmpty . fmap runIdent + -- | Replaces the `ModuleName`s in the AST so that the generated code refers to -- the collision-avoiding renamed module imports. renameModules :: M.Map ModuleName (Ann, ModuleName) -> [Bind Ann] -> [Bind Ann] diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index d602149c49..8eef0fd017 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -15,6 +15,7 @@ import qualified Control.Arrow 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 Language.PureScript.AST (SourceSpan(..)) import Language.PureScript.CodeGen.JS.Common @@ -121,13 +122,12 @@ literals = mkPattern' match' ] match (Import _ ident from) = return . emit $ "import * as " <> ident <> " from " <> prettyPrintStringJS from - match (Export _ [] _) = return $ emit "" match (Export _ idents from) = mconcat <$> sequence [ return $ emit "export {\n" , withIndent $ do let exportsStrings = emit . exportedIdentToString from <$> idents indentString <- currentIndent - return . intercalate (emit ",\n") $ (indentString <>) <$> exportsStrings + return . intercalate (emit ",\n") . NEL.toList $ (indentString <>) <$> exportsStrings , return $ emit "\n" , currentIndent , return . emit $ "}" <> maybe "" ((" from " <>) . prettyPrintStringJS) from diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs index b036588652..4753daeee1 100644 --- a/src/Language/PureScript/CoreImp/AST.hs +++ b/src/Language/PureScript/CoreImp/AST.hs @@ -6,6 +6,7 @@ import Prelude.Compat import Control.Monad ((>=>)) import Control.Monad.Identity (Identity(..), runIdentity) import Data.Text (Text) +import qualified Data.List.NonEmpty as NEL (NonEmpty) import Language.PureScript.AST (SourceSpan(..)) import Language.PureScript.Comments @@ -94,7 +95,7 @@ data AST -- ^ Commented JavaScript | Import (Maybe SourceSpan) Text PSString -- ^ Imported identifier and path to its module - | Export (Maybe SourceSpan) [Text] (Maybe PSString) + | Export (Maybe SourceSpan) (NEL.NonEmpty Text) (Maybe PSString) -- ^ Exported identifiers and optional path to their module (for re-exports) deriving (Show, Eq) From 7d4ef3df3b1d777b30ad67066cff58bdf1bbe645 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sun, 9 Feb 2020 22:07:42 +0100 Subject: [PATCH 09/62] Bundle ES modules --- src/Language/PureScript/Bundle.hs | 253 +++++++++++++++++++----------- 1 file changed, 160 insertions(+), 93 deletions(-) diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 7ff6d9cbd9..eb635b76c9 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -54,6 +54,7 @@ data ErrorMessage = UnsupportedModulePath String | InvalidTopLevel | UnableToParseModule String + | UnsupportedImport | UnsupportedExport | ErrorInModule ModuleIdentifier ErrorMessage | MissingEntryPoint String @@ -111,7 +112,7 @@ data ExportType -- | There are four types of module element we are interested in: -- --- 1) Require statements +-- 1) Import declarations and require statements -- 2) Member declarations -- 3) Export lists -- 4) Everything else @@ -119,22 +120,22 @@ data ExportType -- Each is labelled with the original AST node which generated it, so that we can dump it back -- into the output during codegen. data ModuleElement - = Require JSStatement String (Either String ModuleIdentifier) + = Import JSModuleItem String (Either String ModuleIdentifier) | Member JSStatement Visibility String JSExpression [Key] | ExportsList [(ExportType, String, JSExpression, [Key])] | Other JSStatement - | Skip JSStatement + | Skip JSModuleItem deriving (Show) instance A.ToJSON ModuleElement where toJSON = \case - (Require _ name (Right target)) -> - A.object [ "type" .= A.String "Require" + (Import _ name (Right target)) -> + A.object [ "type" .= A.String "Import" , "name" .= name , "target" .= target ] - (Require _ name (Left targetPath)) -> - A.object [ "type" .= A.String "Require" + (Import _ name (Left targetPath)) -> + A.object [ "type" .= A.String "Import" , "name" .= name , "targetPath" .= targetPath ] @@ -150,11 +151,11 @@ instance A.ToJSON ModuleElement where ] (Other stmt) -> A.object [ "type" .= A.String "Other" - , "js" .= getFragment stmt + , "js" .= getFragment (JSAstStatement stmt JSNoAnnot) ] - (Skip stmt) -> + (Skip item) -> A.object [ "type" .= A.String "Skip" - , "js" .= getFragment stmt + , "js" .= getFragment (JSAstModule [item] JSNoAnnot) ] where @@ -177,7 +178,7 @@ instance A.ToJSON ModuleElement where , "dependsOn" .= map keyToJSON dependsOn ] - getFragment = ellipsize . renderToText . minifyJS . flip JSAstStatement JSNoAnnot + getFragment = ellipsize . renderToText . minifyJS where ellipsize text = if T.compareLength text 20 == GT then T.take 19 text `T.snoc` ellipsis else text ellipsis = '\x2026' @@ -195,7 +196,7 @@ instance A.ToJSON Module where -- | Prepare an error message for consumption by humans. printErrorMessage :: ErrorMessage -> [String] printErrorMessage (UnsupportedModulePath s) = - [ "A CommonJS module has an unsupported name (" ++ show s ++ ")." + [ "An ES or CommonJS module has an unsupported name (" ++ show s ++ ")." , "The following file names are supported:" , " 1) index.js (PureScript native modules)" , " 2) foreign.js (PureScript foreign modules)" @@ -206,10 +207,24 @@ printErrorMessage (UnableToParseModule err) = [ "The module could not be parsed:" , err ] +printErrorMessage UnsupportedImport = + [ "An import was unsupported." + , "Modules can be imported with ES namespace imports declarations:" + , " import * as module from \"Module.Name\"" + , "Alternatively, they can be also be imported with the CommonJS require function:" + , " var module = require(\"Module.Name\")" + ] printErrorMessage UnsupportedExport = - [ "An export was unsupported. Exports can be defined in one of two ways: " - , " 1) exports.name = ..." - , " 2) exports = { ... }" + [ "An export was unsupported." + , "Declarations can be exported as ES named exports:" + , " export decl" + , "Existing identifiers can be exported as well:" + , " export { name }" + , "They can also be renamed on export:" + , " export { name as alias }" + , "Alternatively, CommonJS exports can be defined in one of two ways:" + , " 1) exports.name = value" + , " 2) exports = { name: value }" ] printErrorMessage (ErrorInModule mid e) = ("Error in module " ++ displayIdentifier mid ++ ":") @@ -219,13 +234,13 @@ printErrorMessage (ErrorInModule mid e) = displayIdentifier (ModuleIdentifier name ty) = name ++ " (" ++ showModuleType ty ++ ")" printErrorMessage (MissingEntryPoint mName) = - [ "Couldn't find a CommonJS module for the specified entry point: " ++ mName + [ "Couldn't find neither an ES nor CommonJS module for the specified entry point: " ++ mName ] printErrorMessage (MissingMainModule mName) = - [ "Couldn't find a CommonJS module for the specified main module: " ++ mName + [ "Couldn't find neither an ES nor CommonJS module for the specified main module: " ++ mName ] --- | Calculate the ModuleIdentifier which a require(...) statement imports. +-- | Calculate the ModuleIdentifier imported by an import declaration or a require(...) statement. checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Either String ModuleIdentifier checkImportPath "./foreign.js" m _ = Right (ModuleIdentifier (moduleName m) Foreign) @@ -247,10 +262,14 @@ stripSuffix suffix xs = -- -- 1) module.name or member["name"] -- --- where module was imported using +-- where module was imported using require -- -- var module = require("Module.Name"); -- +-- or an import declaration +-- +-- import * as module from "Module.Name"; +-- -- 2) name -- -- where name is the name of a member defined in the current module. @@ -262,7 +281,7 @@ withDeps (Module modulePath fn es) = Module modulePath fn (map expandDeps es) imports = mapMaybe toImport es where toImport :: ModuleElement -> Maybe (String, ModuleIdentifier) - toImport (Require _ nm (Right mid)) = Just (nm, mid) + toImport (Import _ nm (Right mid)) = Just (nm, mid) toImport _ = Nothing -- | Collects all member names in scope, so that we can identify dependencies of the second type. @@ -369,48 +388,125 @@ trailingCommaList :: JSCommaTrailingList a -> [a] trailingCommaList (JSCTLComma l _) = commaList l trailingCommaList (JSCTLNone l) = commaList l +identName :: JSIdent -> Maybe String +identName (JSIdentName _ ident) = Just ident +identName _ = Nothing + +exportStatementIdentifiers :: JSStatement -> [String] +exportStatementIdentifiers (JSVariable _ jsExpressions _) = + varNames jsExpressions +exportStatementIdentifiers (JSConstant _ jsExpressions _) = + varNames jsExpressions +exportStatementIdentifiers (JSLet _ jsExpressions _) = + varNames jsExpressions +exportStatementIdentifiers (JSClass _ jsIdent _ _ _ _ _) = + maybeToList . identName $ jsIdent +exportStatementIdentifiers (JSFunction _ jsIdent _ _ _ _ _) = + maybeToList . identName $ jsIdent +exportStatementIdentifiers (JSGenerator _ _ jsIdent _ _ _ _ _) = + maybeToList . identName $ jsIdent +exportStatementIdentifiers _ = [] + +varNames :: JSCommaList JSExpression -> [String] +varNames = mapMaybe varName . commaList + where + varName (JSVarInitExpression (JSIdentifier _ ident) _) = Just ident + varName _ = Nothing + +sp :: JSAnnot +sp = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ] + +stringLiteral :: String -> JSExpression +stringLiteral s = JSStringLiteral JSNoAnnot $ "\"" ++ s ++ "\"" + -- | Attempt to create a Module from a JavaScript AST. -- -- Each type of module element is matched using pattern guards, and everything else is bundled into the -- Other constructor. toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> Maybe FilePath -> JSAST -> m Module toModule mids mid filename top - | JSAstProgram smts _ <- top = Module mid filename <$> traverse toModuleElement smts + | JSAstModule jsModuleItems _ <- top = Module mid filename . mconcat <$> traverse toModuleElements jsModuleItems | otherwise = err InvalidTopLevel where err :: ErrorMessage -> m a err = throwError . ErrorInModule mid - toModuleElement :: JSStatement -> m ModuleElement - toModuleElement stmt - | Just (importName, importPath) <- matchRequire mids mid stmt - = pure (Require stmt importName importPath) - toModuleElement stmt - | Just (visibility, name, decl) <- matchMember stmt - = pure (Member stmt visibility name decl []) - toModuleElement stmt - | Just props <- matchExportsAssignment stmt - = ExportsList <$> traverse toExport (trailingCommaList props) + toModuleElements :: JSModuleItem -> m [ModuleElement] + toModuleElements item@(JSModuleImportDeclaration _ jsImportDeclaration) + | JSImportDeclaration jsImportClause jsFromClause _ <- jsImportDeclaration + , JSImportClauseNameSpace jsImportNameSpace <- jsImportClause + , JSImportNameSpace _ _ jsIdent <- jsImportNameSpace + , JSFromClause _ _ importPath <- jsFromClause + , importPath' <- checkImportPath (strValue importPath) mid mids + = fromMaybe (err UnsupportedImport) (pure <$> identName jsIdent) >>= \name -> + pure [Import item name importPath'] + toModuleElements (JSModuleImportDeclaration _ _) + = err UnsupportedImport + + toModuleElements (JSModuleExportDeclaration _ jsExportDeclaration) + | JSExportFrom jsExportClause jsFromClause _ <- jsExportDeclaration + , JSFromClause _ _ from <- jsFromClause + , JSExportClause _ jsExportSpecifiers _ <- jsExportClause + = pure . ExportsList <$> exportSpecifiersList (Just (strValue from)) jsExportSpecifiers + toModuleElements (JSModuleExportDeclaration _ jsExportDeclaration) + | JSExportLocals jsExportClause _ <- jsExportDeclaration + , JSExportClause _ jsExportSpecifiers _ <- jsExportClause + = pure . ExportsList <$> exportSpecifiersList Nothing jsExportSpecifiers + toModuleElements (JSModuleExportDeclaration _ jsExportDeclaration) + | JSExport jsStatement _ <- jsExportDeclaration + = traverse (toExport' Nothing) (exportStatementIdentifiers jsStatement) >>= \exports -> + pure [ Other jsStatement + , ExportsList exports + ] + + toModuleElements item@(JSModuleStatementListItem jsStatement) + | Just (importName, importPath) <- matchRequire mids mid jsStatement + = pure [Import item importName importPath] + toModuleElements (JSModuleStatementListItem jsStatement) + | Just (visibility, name, decl) <- matchMember jsStatement + = pure [Member jsStatement visibility name decl []] + toModuleElements (JSModuleStatementListItem jsStatement) + | Just props <- matchExportsAssignment jsStatement + = pure . ExportsList <$> traverse objectPropertyToExport (trailingCommaList props) where - toExport :: JSObjectProperty -> m (ExportType, String, JSExpression, [Key]) - toExport (JSPropertyNameandValue name _ [val]) = - (,,val,[]) <$> exportType val + objectPropertyToExport :: JSObjectProperty -> m (ExportType, String, JSExpression, [Key]) + objectPropertyToExport (JSPropertyNameandValue name _ [val]) = + (,,val,[]) <$> expressionExportType val <*> extractLabel' name - toExport _ = err UnsupportedExport + objectPropertyToExport _ = err UnsupportedExport - exportType :: JSExpression -> m ExportType - exportType (JSMemberDot f _ _) + expressionExportType :: JSExpression -> m ExportType + expressionExportType (JSMemberDot f _ _) | JSIdentifier _ "$foreign" <- f = pure ForeignReexport - exportType (JSMemberSquare f _ _ _) + expressionExportType (JSMemberSquare f _ _ _) | JSIdentifier _ "$foreign" <- f = pure ForeignReexport - exportType (JSIdentifier _ s) = pure (RegularExport s) - exportType _ = err UnsupportedExport + expressionExportType (JSIdentifier _ s) = pure (RegularExport s) + expressionExportType _ = err UnsupportedExport extractLabel' = maybe (err UnsupportedExport) pure . extractLabel - toModuleElement other = pure (Other other) + toModuleElements (JSModuleStatementListItem other) = pure [Other other] + + exportSpecifiersList from = + fmap catMaybes . traverse (exportSpecifier from) . commaList + + exportSpecifier from (JSExportSpecifier jsIdent) + = traverse (toExport' from) $ identName jsIdent + exportSpecifier from (JSExportSpecifierAs jsIdent _ jsIdentAs) + = sequence $ toExport from <$> identName jsIdent <*> identName jsIdentAs + + toExport :: Maybe String -> String -> String -> m (ExportType, String, JSExpression, [Key]) + toExport (Just "./foreign.js") name as = + pure . (ForeignReexport, as,, []) $ + (JSMemberSquare (JSIdentifier sp "$foreign") JSNoAnnot + (stringLiteral name) JSNoAnnot) + toExport (Just _) _ _ = err UnsupportedExport + toExport Nothing name as = + pure (RegularExport name, as, JSIdentifier sp name, []) + + toExport' from name = toExport from name name -- Get a list of all the exported identifiers from a foreign module. -- @@ -458,28 +554,6 @@ getExportedIdentifiers mname top exportSpecifierName (JSExportSpecifier jsIdent) = identName jsIdent exportSpecifierName (JSExportSpecifierAs _ _ jsIdentAs) = identName jsIdentAs - exportStatementIdentifiers (JSVariable _ jsExpressions _) = - varNames jsExpressions - exportStatementIdentifiers (JSConstant _ jsExpressions _) = - varNames jsExpressions - exportStatementIdentifiers (JSLet _ jsExpressions _) = - varNames jsExpressions - exportStatementIdentifiers (JSClass _ jsIdent _ _ _ _ _) = - maybeToList . identName $ jsIdent - exportStatementIdentifiers (JSFunction _ jsIdent _ _ _ _ _) = - maybeToList . identName $ jsIdent - exportStatementIdentifiers (JSGenerator _ _ jsIdent _ _ _ _ _) = - maybeToList . identName $ jsIdent - exportStatementIdentifiers _ = [] - - varNames = mapMaybe varName . commaList - - varName (JSVarInitExpression (JSIdentifier _ ident) _) = Just ident - varName _ = Nothing - - identName (JSIdentName _ ident) = Just ident - identName _ = Nothing - -- Matches JS statements like this: -- var ModuleName = require("file"); matchRequire :: S.Set String @@ -560,8 +634,8 @@ compile modules entryPoints = filteredModules where -- | Create a set of vertices for a module element. -- - -- Require statements don't contribute towards dependencies, since they effectively get - -- inlined wherever they are used inside other module elements. + -- Imports declarations and require statements don't contribute towards dependencies, + -- since they effectively get inlined wherever they are used inside other module elements. toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])] toVertices p m@(Member _ visibility nm _ deps) = [(m, (p, nm, visibility), deps)] toVertices p m@(ExportsList exps) = map toVertex exps @@ -601,11 +675,11 @@ compile modules entryPoints = filteredModules | otherwise = d : go rest skipDecl :: ModuleElement -> ModuleElement - skipDecl (Require s _ _) = Skip s - skipDecl (Member s _ _ _ _) = Skip s - skipDecl (ExportsList _) = Skip (JSEmptyStatement JSNoAnnot) - skipDecl (Other s) = Skip s - skipDecl (Skip s) = Skip s + skipDecl (Import item _ _) = Skip item + skipDecl (Member stmt _ _ _ _) = Skip $ JSModuleStatementListItem stmt + skipDecl (ExportsList _) = Skip . JSModuleStatementListItem $ JSEmptyStatement JSNoAnnot + skipDecl (Other stmt) = Skip $ JSModuleStatementListItem stmt + skipDecl (Skip item) = Skip item -- | Filter out the exports for members which aren't used. filterExports :: ModuleElement -> ModuleElement @@ -614,7 +688,7 @@ compile modules entryPoints = filteredModules isDeclUsed :: ModuleElement -> Bool isDeclUsed (Member _ visibility nm _ _) = isKeyUsed (mid, nm, visibility) - isDeclUsed (Require _ _ (Right midRef)) = midRef `S.member` modulesReferenced + isDeclUsed (Import _ _ (Right midRef)) = midRef `S.member` modulesReferenced isDeclUsed _ = True isKeyUsed :: Key -> Bool @@ -635,7 +709,7 @@ sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (top return (m, mid, mapMaybe getKey els) getKey :: ModuleElement -> Maybe ModuleIdentifier - getKey (Require _ _ (Right mi)) = Just mi + getKey (Import _ _ (Right mi)) = Just mi getKey _ = Nothing -- | A module is empty if it contains no exported members (in other words, @@ -648,7 +722,7 @@ isModuleEmpty (Module _ _ els) = all isElementEmpty els where isElementEmpty :: ModuleElement -> Bool isElementEmpty (ExportsList exps) = null exps - isElementEmpty Require{} = True + isElementEmpty Import{} = True isElementEmpty (Other _) = True isElementEmpty (Skip _) = True isElementEmpty _ = False @@ -689,7 +763,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o }) (offsets (0,0) (Right 1 : positions))) moduleFns - (scanl (+) (3 + moduleLength [prelude]) (map (3+) moduleLengths)) -- 3 lines between each module & at top + (scanl (+) (3 + moduleLength [JSModuleStatementListItem prelude]) (map (3+) moduleLengths)) -- 3 lines between each module & at top (map snd modulesJS) } where @@ -699,7 +773,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o offsets (m, n) (Right d:rest) = map ((m+) &&& (n+)) [0 .. d - 1] ++ offsets (m+d, n+d) rest offsets _ _ = [] - moduleLength :: [JSStatement] -> Int + moduleLength :: [JSModuleItem] -> Int moduleLength = everything (+) (mkQ 0 countw) where countw :: CommentAnnotation -> Int @@ -718,13 +792,13 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o (jsDecls, lengths) = unzip $ map declToJS ds withLength :: [JSStatement] -> ([JSStatement], Either Int Int) - withLength n = (n, Right $ moduleLength n) + withLength n = (n, Right . moduleLength $ JSModuleStatementListItem <$> n) declToJS :: ModuleElement -> ([JSStatement], Either Int Int) declToJS (Member n _ _ _ _) = withLength [n] declToJS (Other n) = withLength [n] declToJS (Skip n) = ([], Left $ moduleLength [n]) - declToJS (Require _ nm req) = withLength + declToJS (Import _ nm req) = withLength [ JSVariable lfsp (cList [ @@ -732,15 +806,15 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o (JSVarInit sp $ either require (innerModuleReference sp . moduleName) req ) ]) (JSSemi JSNoAnnot) ] - declToJS (ExportsList exps) = withLength $ map toExport exps + declToJS (ExportsList exps) = withLength $ map toCommonJSExport exps where - toExport :: (ExportType, String, JSExpression, [Key]) -> JSStatement - toExport (_, nm, val, _) = + toCommonJSExport :: (ExportType, String, JSExpression, [Key]) -> JSStatement + toCommonJSExport (_, nm, val, _) = JSAssignStatement (JSMemberSquare (JSIdentifier lfsp "exports") JSNoAnnot - (str nm) JSNoAnnot) + (stringLiteral nm) JSNoAnnot) (JSAssign sp) val (JSSemi JSNoAnnot) @@ -778,22 +852,18 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o require :: String -> JSExpression require mn = - JSMemberExpression (JSIdentifier JSNoAnnot "require") JSNoAnnot (cList [ str mn ]) JSNoAnnot + JSMemberExpression (JSIdentifier JSNoAnnot "require") JSNoAnnot + (cList [ stringLiteral mn ]) JSNoAnnot moduleReference :: JSAnnot -> String -> JSExpression moduleReference a mn = JSMemberSquare (JSIdentifier a optionsNamespace) JSNoAnnot - (str mn) JSNoAnnot + (stringLiteral mn) JSNoAnnot innerModuleReference :: JSAnnot -> String -> JSExpression innerModuleReference a mn = JSMemberSquare (JSIdentifier a "$PS") JSNoAnnot - (str mn) JSNoAnnot - - - str :: String -> JSExpression - str s = JSStringLiteral JSNoAnnot $ "\"" ++ s ++ "\"" - + (stringLiteral mn) JSNoAnnot emptyObj :: JSAnnot -> JSExpression emptyObj a = JSObjectLiteral a (JSCTLNone JSLNil) JSNoAnnot @@ -861,9 +931,6 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o lfsp :: JSAnnot lfsp = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] - sp :: JSAnnot - sp = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ] - -- | The bundling function. -- This function performs dead code elimination, filters empty modules -- and generates and prints the final JavaScript bundle. @@ -882,7 +949,7 @@ bundleSM inputStrs entryPoints mainModule namespace outFilename reportRawModules forM_ entryPoints $ \mIdent -> when (mIdent `notElem` map mid inputStrs) (throwError (MissingEntryPoint (moduleName mIdent))) input <- forM inputStrs $ \(ident, filename, js) -> do - ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident) + ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parseModule js (moduleName ident) return (ident, filename, ast) let mids = S.fromList (map (moduleName . mid) input) From 7f0c07e98b616e4a931964d210c7059a65b1a6fd Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 15 Feb 2020 17:33:55 +0100 Subject: [PATCH 10/62] Load ES modules with `esm` in the Node.js REPL and tests --- app/Command/REPL.hs | 2 +- tests/TestCompiler.hs | 8 ++++++-- tests/TestPsci/TestEnv.hs | 7 +++++-- tests/support/package.json | 1 + 4 files changed, 13 insertions(+), 5 deletions(-) diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index f44c1e8abe..c0b8a81f89 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -289,7 +289,7 @@ nodeBackend nodePath nodeArgs = Backend setup eval reload shutdown eval _ _ = do writeFile indexFile "require('$PSCI')['$main']();" process <- maybe findNodeProcess (pure . pure) nodePath - result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process + result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ ["--require", "esm", indexFile]) "") process case result of Just (ExitSuccess, out, _) -> putStrLn out Just (ExitFailure _, _, err) -> putStrLn err diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs index 46502077da..fe252feecd 100644 --- a/tests/TestCompiler.hs +++ b/tests/TestCompiler.hs @@ -43,8 +43,9 @@ import qualified Data.ByteString.Lazy as BS import Control.Monad +import System.Directory (getCurrentDirectory) import System.Exit -import System.Process +import System.Process (readProcessWithExitCode) import System.FilePath import System.IO import System.IO.UTF8 (readUTF8File) @@ -167,7 +168,10 @@ assertCompiles supportModules supportExterns supportForeigns inputFiles outputFi process <- findNodeProcess let entryPoint = modulesDir "index.js" writeFile entryPoint "require('Main').main()" - result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process + result <- forM process $ \node -> do + cwd <- getCurrentDirectory + let esm = cwd "tests" "support" "node_modules" "esm" + readProcessWithExitCode node ["--require", esm, entryPoint] "" hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":" case result of Just (ExitSuccess, out, err) diff --git a/tests/TestPsci/TestEnv.hs b/tests/TestPsci/TestEnv.hs index 31d5fdc591..4ba4d93b9e 100644 --- a/tests/TestPsci/TestEnv.hs +++ b/tests/TestPsci/TestEnv.hs @@ -6,7 +6,7 @@ import Prelude () import Prelude.Compat import Control.Exception.Lifted (bracket_) -import Control.Monad (void, when) +import Control.Monad (forM, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS.Strict (evalRWST, asks, local, RWST) import Data.Foldable (traverse_) @@ -59,7 +59,10 @@ jsEval :: TestPSCi String jsEval = liftIO $ do writeFile indexFile "require('$PSCI')['$main']();" process <- findNodeProcess - result <- traverse (\node -> readProcessWithExitCode node [indexFile] "") process + result <- forM process $ \node -> do + cwd <- getCurrentDirectory + let esm = cwd "tests" "support" "node_modules" "esm" + readProcessWithExitCode node ["--require", esm, indexFile] "" case result of Just (ExitSuccess, out, _) -> return out Just (ExitFailure _, _, err) -> putStrLn err >> exitFailure diff --git a/tests/support/package.json b/tests/support/package.json index 0e54c5ed3a..7fc3144c4d 100644 --- a/tests/support/package.json +++ b/tests/support/package.json @@ -2,6 +2,7 @@ "private": true, "dependencies": { "bower": "^1.8.8", + "esm": "^3.2.25", "glob": "^5.0.14", "rimraf": "^2.5.2" } From e00695360d3eeeb64423962a104c166673fb3097 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 15 Feb 2020 17:45:51 +0100 Subject: [PATCH 11/62] Escape primes in modules accessors --- src/Language/PureScript/CodeGen/JS.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 9995dd66f3..294cef113c 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -178,10 +178,13 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreignInclude = -- | Generate code in the simplified JavaScript intermediate representation for an accessor based on -- a PureScript identifier. If the name is not valid in JavaScript (symbol based, reserved name) an -- indexer is returned. - accessor :: Ident -> AST -> AST - accessor (Ident prop) = accessorString $ mkString prop - accessor (GenIdent _ _) = internalError "GenIdent in accessor" - accessor UnusedIdent = internalError "UnusedIdent in accessor" + moduleAccessor :: Ident -> AST -> AST + moduleAccessor (Ident prop) = moduleAccessorString prop + moduleAccessor (GenIdent _ _) = internalError "GenIdent in moduleAccessor" + moduleAccessor UnusedIdent = internalError "UnusedIdent in moduleAccessor" + + moduleAccessorString :: Text -> AST -> AST + moduleAccessorString = accessorString . mkString . T.replace "'" "$prime" accessorString :: PSString -> AST -> AST accessorString prop = AST.Indexer Nothing (AST.StringLiteral Nothing prop) @@ -311,7 +314,7 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreignInclude = -- variable that may have a qualified name. qualifiedToJS :: (a -> Ident) -> Qualified a -> AST qualifiedToJS f (Qualified (Just C.Prim) a) = AST.Var Nothing . runIdent $ f a - qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (AST.Var Nothing (moduleNameToJs mn')) + qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = moduleAccessor (f a) (AST.Var Nothing (moduleNameToJs mn')) qualifiedToJS f (Qualified _ a) = AST.Var Nothing $ identToJs (f a) foreignIdent :: Ident -> AST From 243ec5ef16e8f08f4f20516f2cd20574303bf2ec Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 15 Feb 2020 17:46:56 +0100 Subject: [PATCH 12/62] Forbid unescaped primes in foreign modules exports --- src/Language/PureScript/Errors.hs | 2 +- src/Language/PureScript/Make/Actions.hs | 8 ++--- .../DeprecatedFFIPrime.js | 0 .../DeprecatedFFIPrime.out | 32 +++++++++---------- tests/purs/failing/DeprecatedFFIPrime.purs | 10 ++++++ tests/purs/warning/DeprecatedFFIPrime.purs | 10 ------ 6 files changed, 31 insertions(+), 31 deletions(-) rename tests/purs/{warning => failing}/DeprecatedFFIPrime.js (100%) rename tests/purs/{warning => failing}/DeprecatedFFIPrime.out (51%) create mode 100644 tests/purs/failing/DeprecatedFFIPrime.purs delete mode 100644 tests/purs/warning/DeprecatedFFIPrime.purs diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 90dfc43fdd..afe7f31dcd 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -675,7 +675,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl paras [ line $ "In the FFI module for " <> markCode (runModuleName mn) <> ":" , indent . paras $ [ line $ "The identifier " <> markCode ident <> " contains a prime (" <> markCode "'" <> ")." - , line $ "Primes in identifiers exported from FFI modules are deprecated and won’t be supported in the future." + , line $ "Primes are not allowed in identifiers exported from FFI modules." ] ] renderSimpleErrorMessage InvalidDoBind = diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 738644b8c9..6be4bdebc7 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -287,7 +287,7 @@ checkForeignDecls m path = do let deprecatedFFI = filter (any (== '\'')) foreignIdentsStrs unless (null deprecatedFFI) $ - warningDeprecatedForeignPrimes deprecatedFFI + errorDeprecatedForeignPrimes deprecatedFFI foreignIdents <- either errorInvalidForeignIdentifiers @@ -319,9 +319,9 @@ checkForeignDecls m path = do errorInvalidForeignIdentifiers = throwError . mconcat . map (errorMessage . InvalidFFIIdentifier mname . T.pack) - warningDeprecatedForeignPrimes :: [String] -> Make () - warningDeprecatedForeignPrimes = - tell . mconcat . map (errorMessage' modSS . DeprecatedFFIPrime mname . T.pack) + errorDeprecatedForeignPrimes :: [String] -> Make a + errorDeprecatedForeignPrimes = + throwError . mconcat . map (errorMessage' modSS . DeprecatedFFIPrime mname . T.pack) parseIdents :: [String] -> Either [String] [Ident] parseIdents strs = diff --git a/tests/purs/warning/DeprecatedFFIPrime.js b/tests/purs/failing/DeprecatedFFIPrime.js similarity index 100% rename from tests/purs/warning/DeprecatedFFIPrime.js rename to tests/purs/failing/DeprecatedFFIPrime.js diff --git a/tests/purs/warning/DeprecatedFFIPrime.out b/tests/purs/failing/DeprecatedFFIPrime.out similarity index 51% rename from tests/purs/warning/DeprecatedFFIPrime.out rename to tests/purs/failing/DeprecatedFFIPrime.out index 94e1912e92..fd22d4708b 100644 --- a/tests/purs/warning/DeprecatedFFIPrime.out +++ b/tests/purs/failing/DeprecatedFFIPrime.out @@ -1,56 +1,56 @@ -Warning 1 of 4: +Error 1 of 4: - at tests/purs/warning/DeprecatedFFIPrime.purs:5:1 - 10:28 (line 5, column 1 - line 10, column 28) + at tests/purs/failing/DeprecatedFFIPrime.purs:5:1 - 10:28 (line 5, column 1 - line 10, column 28) In the FFI module for Main: The identifier a' contains a prime ('). - Primes in identifiers exported from FFI modules are deprecated and won’t be supported in the future. + Primes are not allowed in identifiers exported from FFI modules. See https://github.com/purescript/documentation/blob/master/errors/DeprecatedFFIPrime.md for more information, - or to contribute content related to this warning. + or to contribute content related to this error. -Warning 2 of 4: +Error 2 of 4: - at tests/purs/warning/DeprecatedFFIPrime.purs:5:1 - 10:28 (line 5, column 1 - line 10, column 28) + at tests/purs/failing/DeprecatedFFIPrime.purs:5:1 - 10:28 (line 5, column 1 - line 10, column 28) In the FFI module for Main: The identifier b' contains a prime ('). - Primes in identifiers exported from FFI modules are deprecated and won’t be supported in the future. + Primes are not allowed in identifiers exported from FFI modules. See https://github.com/purescript/documentation/blob/master/errors/DeprecatedFFIPrime.md for more information, - or to contribute content related to this warning. + or to contribute content related to this error. -Warning 3 of 4: +Error 3 of 4: - at tests/purs/warning/DeprecatedFFIPrime.purs:5:1 - 10:28 (line 5, column 1 - line 10, column 28) + at tests/purs/failing/DeprecatedFFIPrime.purs:5:1 - 10:28 (line 5, column 1 - line 10, column 28) In the FFI module for Main: The identifier c' contains a prime ('). - Primes in identifiers exported from FFI modules are deprecated and won’t be supported in the future. + Primes are not allowed in identifiers exported from FFI modules. See https://github.com/purescript/documentation/blob/master/errors/DeprecatedFFIPrime.md for more information, - or to contribute content related to this warning. + or to contribute content related to this error. -Warning 4 of 4: +Error 4 of 4: - at tests/purs/warning/DeprecatedFFIPrime.purs:5:1 - 10:28 (line 5, column 1 - line 10, column 28) + at tests/purs/failing/DeprecatedFFIPrime.purs:5:1 - 10:28 (line 5, column 1 - line 10, column 28) In the FFI module for Main: The identifier d' contains a prime ('). - Primes in identifiers exported from FFI modules are deprecated and won’t be supported in the future. + Primes are not allowed in identifiers exported from FFI modules. See https://github.com/purescript/documentation/blob/master/errors/DeprecatedFFIPrime.md for more information, - or to contribute content related to this warning. + or to contribute content related to this error. diff --git a/tests/purs/failing/DeprecatedFFIPrime.purs b/tests/purs/failing/DeprecatedFFIPrime.purs new file mode 100644 index 0000000000..0100e1fad8 --- /dev/null +++ b/tests/purs/failing/DeprecatedFFIPrime.purs @@ -0,0 +1,10 @@ +-- @shouldFailWith DeprecatedFFIPrime +-- @shouldFailWith DeprecatedFFIPrime +-- @shouldFailWith DeprecatedFFIPrime +-- @shouldFailWith DeprecatedFFIPrime +module Main where + +foreign import a' :: Number +foreign import b' :: Number +foreign import c' :: Number +foreign import d' :: Number diff --git a/tests/purs/warning/DeprecatedFFIPrime.purs b/tests/purs/warning/DeprecatedFFIPrime.purs deleted file mode 100644 index 3c57a19d92..0000000000 --- a/tests/purs/warning/DeprecatedFFIPrime.purs +++ /dev/null @@ -1,10 +0,0 @@ --- @shouldWarnWith DeprecatedFFIPrime --- @shouldWarnWith DeprecatedFFIPrime --- @shouldWarnWith DeprecatedFFIPrime --- @shouldWarnWith DeprecatedFFIPrime -module Main where - -foreign import a' :: Number -foreign import b' :: Number -foreign import c' :: Number -foreign import d' :: Number From ddbb2ad5fe81d77ade6ae74d79faf0b03bec707c Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 15 Feb 2020 17:47:20 +0100 Subject: [PATCH 13/62] Run tests against patched dependencies --- tests/support/bower.json | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/tests/support/bower.json b/tests/support/bower.json index 850a61c429..8bacfbbf66 100644 --- a/tests/support/bower.json +++ b/tests/support/bower.json @@ -1,8 +1,8 @@ { "name": "purescript-test-suite-support", "dependencies": { - "purescript-arrays": "5.0.0", - "purescript-assert": "4.0.0", + "purescript-arrays": "#55cb9e6d6766c74c275924324f520b368931c5e6", + "purescript-assert": "https://github.com/kl0tl/purescript-assert.git#no-foreign-primes", "purescript-bifunctors": "4.0.0", "purescript-console": "4.1.0", "purescript-control": "4.0.0", @@ -27,10 +27,10 @@ "purescript-prelude": "#c932361d008379958f14ca8cc2fe32e06cc2647d", "purescript-proxy": "3.0.0", "purescript-psci-support": "4.0.0", - "purescript-refs": "4.1.0", + "purescript-refs": "#0fc21a8476f74139cf220084166d1e1822ed0d3a", "purescript-safe-coerce": "0.0.2", - "purescript-st": "4.0.0", - "purescript-strings": "4.0.0", + "purescript-st": "https://github.com/kl0tl/purescript-st.git#no-foreign-primes", + "purescript-strings": "#eefc8b04c16bce4669ffe88f9d5eeb6333bb2382", "purescript-tailrec": "4.0.0", "purescript-tuples": "5.0.0", "purescript-type-equality": "3.0.0", @@ -40,6 +40,9 @@ }, "resolutions": { "purescript-prelude": "c932361d008379958f14ca8cc2fe32e06cc2647d", - "purescript-typelevel-prelude": "52ac4bcf9a38941606b3d928127089bd363ee946" + "purescript-typelevel-prelude": "52ac4bcf9a38941606b3d928127089bd363ee946", + "purescript-st": "no-foreign-primes", + "purescript-refs": "0fc21a8476f74139cf220084166d1e1822ed0d3a", + "purescript-arrays": "55cb9e6d6766c74c275924324f520b368931c5e6" } } From e5b1798d3d3770bca57d79b0d78f1839332695bf Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Thu, 23 Apr 2020 18:27:59 +0200 Subject: [PATCH 14/62] Rewrite ES modules in the browser REPL client --- app/static/index.js | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/app/static/index.js b/app/static/index.js index 1d0714fd71..f496540c4c 100644 --- a/app/static/index.js +++ b/app/static/index.js @@ -16,13 +16,24 @@ var evaluate = function evaluate(js) { // which will be returned to PSCi. buffer.push(s); }; - // Replace any require(...) statements with lookups on the PSCI object. + // Replace any require and import statements with lookups on the PSCI object + // and export statements with assignments to module.exports. var replaced = js.replace(/require\("[^"]*"\)/g, function(s) { return "PSCI['" + s.split('/')[1] + "']"; + }).replace(/import \* as ([^\s]+) from "([^"]*)"/g, function (_, as, from) { + return "var " + as + " = PSCI['" + from.split('/')[1] + "']"; + }).replace(/export \{([^}]+)\} from "\.\/foreign\.js";?/g, function (_, exports) { + return exports.replace(/^\s*([^,\s]+),?\s*$/gm, function (_, exported) { + return "module.exports." + exported + " = $foreign." + exported + ";"; + }); + }).replace(/export \{([^}]+)\};?/g, function (_, exports) { + return exports.replace(/^\s*([^,\s]+)(?: as ([^\s]+))?,?\s*$/gm, function (_, exported, as) { + return "module.exports." + (as || exported) + " = " + exported + ";"; + }); }); // Wrap the module and evaluate it. var wrapped = - [ 'var module = {};' + [ 'var module = { exports: {} };' , '(function(module) {' , replaced , '})(module);' From c5ffab6a27c0ae4c07a20bb36c0e4ef0d7008143 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 17:01:32 +0100 Subject: [PATCH 15/62] Revert "Load ES modules with `esm` in the Node.js REPL and tests" This reverts commit 7f0c07e98b616e4a931964d210c7059a65b1a6fd. --- app/Command/REPL.hs | 2 +- tests/TestCompiler.hs | 8 ++------ tests/TestPsci/TestEnv.hs | 7 ++----- tests/support/package.json | 1 - 4 files changed, 5 insertions(+), 13 deletions(-) diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index c0b8a81f89..f44c1e8abe 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -289,7 +289,7 @@ nodeBackend nodePath nodeArgs = Backend setup eval reload shutdown eval _ _ = do writeFile indexFile "require('$PSCI')['$main']();" process <- maybe findNodeProcess (pure . pure) nodePath - result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ ["--require", "esm", indexFile]) "") process + result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process case result of Just (ExitSuccess, out, _) -> putStrLn out Just (ExitFailure _, _, err) -> putStrLn err diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs index fe252feecd..46502077da 100644 --- a/tests/TestCompiler.hs +++ b/tests/TestCompiler.hs @@ -43,9 +43,8 @@ import qualified Data.ByteString.Lazy as BS import Control.Monad -import System.Directory (getCurrentDirectory) import System.Exit -import System.Process (readProcessWithExitCode) +import System.Process import System.FilePath import System.IO import System.IO.UTF8 (readUTF8File) @@ -168,10 +167,7 @@ assertCompiles supportModules supportExterns supportForeigns inputFiles outputFi process <- findNodeProcess let entryPoint = modulesDir "index.js" writeFile entryPoint "require('Main').main()" - result <- forM process $ \node -> do - cwd <- getCurrentDirectory - let esm = cwd "tests" "support" "node_modules" "esm" - readProcessWithExitCode node ["--require", esm, entryPoint] "" + result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":" case result of Just (ExitSuccess, out, err) diff --git a/tests/TestPsci/TestEnv.hs b/tests/TestPsci/TestEnv.hs index 4ba4d93b9e..31d5fdc591 100644 --- a/tests/TestPsci/TestEnv.hs +++ b/tests/TestPsci/TestEnv.hs @@ -6,7 +6,7 @@ import Prelude () import Prelude.Compat import Control.Exception.Lifted (bracket_) -import Control.Monad (forM, void, when) +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_) @@ -59,10 +59,7 @@ jsEval :: TestPSCi String jsEval = liftIO $ do writeFile indexFile "require('$PSCI')['$main']();" process <- findNodeProcess - result <- forM process $ \node -> do - cwd <- getCurrentDirectory - let esm = cwd "tests" "support" "node_modules" "esm" - readProcessWithExitCode node ["--require", esm, indexFile] "" + result <- traverse (\node -> readProcessWithExitCode node [indexFile] "") process case result of Just (ExitSuccess, out, _) -> return out Just (ExitFailure _, _, err) -> putStrLn err >> exitFailure diff --git a/tests/support/package.json b/tests/support/package.json index 7fc3144c4d..0e54c5ed3a 100644 --- a/tests/support/package.json +++ b/tests/support/package.json @@ -2,7 +2,6 @@ "private": true, "dependencies": { "bower": "^1.8.8", - "esm": "^3.2.25", "glob": "^5.0.14", "rimraf": "^2.5.2" } From 4713b2a4efbd9f0be58f50d415bc0c74ddf21e93 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 17:06:16 +0100 Subject: [PATCH 16/62] Allow Node.js to load .js files in the output directory as ES modules Node.js loads JavaScript files with a .js extension as CommonJS modules unless they're within a directory with a `"type": "module"` package.json, in which case it loads them as ES modules. --- src/Language/PureScript/Make.hs | 2 ++ src/Language/PureScript/Make/Actions.hs | 18 +++++++++++++++++- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index b481b11791..a2affb922b 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -161,6 +161,8 @@ make ma@MakeActions{..} ms = do -- Write the updated build cache database to disk writeCacheDb $ Cache.removeModules (M.keysSet failures) newCacheDb + writePackageJson + -- If generating docs, also generate them for the Prim modules outputPrimDocs diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index f9865baefc..b679b655d3 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -18,6 +18,7 @@ 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) import Data.Either (partitionEithers) import Data.Foldable (for_, minimum) @@ -105,6 +106,9 @@ data MakeActions m = MakeActions , writeCacheDb :: CacheDb -> m () -- ^ Write the given cache database to some external source (e.g. a file on -- disk). + , writePackageJson :: m () + -- ^ Write to the output directory the package.json file allowing Node.js to + -- load .js files as ES modules. , outputPrimDocs :: m () -- ^ If generating docs, output the documentation for the Prim modules } @@ -131,6 +135,15 @@ writeCacheDb' -> m () writeCacheDb' = writeJSONFile . cacheDbFile +writePackageJson' + :: (MonadIO m, MonadError MultipleErrors m) + => FilePath + -- ^ The path to the output directory + -> m () +writePackageJson' outputDir = writeJSONFile (outputDir "package.json") $ object + [ "type" .= String "module" + ] + -- | A set of make actions that read and write modules from the given directory. buildMakeActions :: FilePath @@ -143,7 +156,7 @@ buildMakeActions -- ^ Generate a prefix comment? -> MakeActions Make buildMakeActions outputDir filePathMap foreigns usePrefix = - MakeActions getInputTimestampsAndHashes getOutputTimestamp readExterns codegen ffiCodegen progress readCacheDb writeCacheDb outputPrimDocs + MakeActions getInputTimestampsAndHashes getOutputTimestamp readExterns codegen ffiCodegen progress readCacheDb writeCacheDb writePackageJson outputPrimDocs where getInputTimestampsAndHashes @@ -278,6 +291,9 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = writeCacheDb :: CacheDb -> Make () writeCacheDb = writeCacheDb' outputDir + writePackageJson :: Make () + writePackageJson = writePackageJson' outputDir + -- | Check that the declarations in a given PureScript module match with those -- in its corresponding foreign module. checkForeignDecls :: CF.Module ann -> FilePath -> Make () From 7784dd1d326d7a1890429c009892f92e50919e8f Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 17:39:09 +0100 Subject: [PATCH 17/62] Import CommonJS foreign modules through an ES module wrapper --- app/Command/REPL.hs | 6 +- purescript.cabal | 2 + src/Language/JavaScript/AST/JSCommaList.hs | 19 ++++++ src/Language/PureScript/Bundle.hs | 75 +++++++++++----------- src/Language/PureScript/Make/Actions.hs | 52 +++++++++++---- tests/TestBundle.hs | 2 +- 6 files changed, 105 insertions(+), 51 deletions(-) create mode 100644 src/Language/JavaScript/AST/JSCommaList.hs diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index f44c1e8abe..2ae72b2cde 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -51,7 +51,7 @@ import System.IO.UTF8 (readUTF8File) import System.Exit import System.Directory (doesFileExist, getCurrentDirectory) import System.FilePath (()) -import System.FilePath.Glob (glob) +import qualified System.FilePath.Glob as Glob import System.Process (readProcessWithExitCode) import qualified Data.ByteString.Lazy.UTF8 as U @@ -115,7 +115,7 @@ pasteMode = -- | Make a JavaScript bundle for the browser. bundle :: IO (Either Bundle.ErrorMessage String) bundle = runExceptT $ do - inputFiles <- liftIO (glob (".psci_modules" "node_modules" "*" "*.js")) + inputFiles <- liftIO $ concat <$> Glob.globDir [Glob.compile "*/*.js", Glob.compile "*/foreign.cjs"] modulesDir input <- for inputFiles $ \filename -> do js <- liftIO (readUTF8File filename) mid <- Bundle.guessModuleIdentifier filename @@ -310,7 +310,7 @@ command = loop <$> options where loop :: PSCiOptions -> IO () loop PSCiOptions{..} = do - inputFiles <- concat <$> traverse glob psciInputGlob + inputFiles <- concat <$> traverse Glob.glob psciInputGlob e <- runExceptT $ do modules <- ExceptT (loadAllModules inputFiles) when (null modules) . liftIO $ do diff --git a/purescript.cabal b/purescript.cabal index ded50103e1..6c8be98e3c 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -121,6 +121,7 @@ common defaults array >=0.5.3.0 && <0.6, base >=4.12.0.0 && <4.13, base-compat >=0.10.5 && <0.11, + blaze-builder >=0.2 && <0.5, blaze-html >=0.9.1.1 && <0.10, bower-json >=1.0.0.1 && <1.1, boxes >=0.1.5 && <0.2, @@ -183,6 +184,7 @@ library hs-source-dirs: src exposed-modules: Control.Monad.Logger + Language.JavaScript.AST.JSCommaList Language.PureScript Language.PureScript.Bundle Language.PureScript.CodeGen diff --git a/src/Language/JavaScript/AST/JSCommaList.hs b/src/Language/JavaScript/AST/JSCommaList.hs new file mode 100644 index 0000000000..df7c982f14 --- /dev/null +++ b/src/Language/JavaScript/AST/JSCommaList.hs @@ -0,0 +1,19 @@ +module Language.JavaScript.AST.JSCommaList where + +import Prelude +import Language.JavaScript.Parser.AST (JSCommaList(JSLNil, JSLOne, JSLCons), JSAnnot(JSNoAnnot)) + +fromCommaList :: JSCommaList a -> [a] +fromCommaList JSLNil = [] +fromCommaList (JSLOne x) = [x] +fromCommaList (JSLCons l _ x) = fromCommaList l ++ [x] + +-- comma lists are reverse-consed +toCommaList :: [a] -> JSCommaList a +toCommaList [] = JSLNil +toCommaList [x] = JSLOne x +toCommaList l = go $ reverse l + where + go [x] = JSLOne x + go (h:t)= JSLCons (go t) JSNoAnnot h + go [] = error "Invalid case in comma-list" diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 44c21c9ebf..1b7d8b98cb 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -13,6 +13,7 @@ module Language.PureScript.Bundle , ModuleType(..) , ErrorMessage(..) , printErrorMessage + , ForeignModuleExports(..) , getExportedIdentifiers , Module ) where @@ -38,6 +39,7 @@ import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text.Lazy as T +import Language.JavaScript.AST.JSCommaList (fromCommaList, toCommaList) import Language.JavaScript.Parser import Language.JavaScript.Parser.AST import Language.JavaScript.Process.Minify @@ -90,6 +92,7 @@ guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory f where guessModuleType "index.js" = pure Regular guessModuleType "foreign.js" = pure Foreign + guessModuleType "foreign.cjs" = pure Foreign guessModuleType name = throwError $ UnsupportedModulePath name data Visibility @@ -199,7 +202,8 @@ printErrorMessage (UnsupportedModulePath s) = [ "An ES or CommonJS module has an unsupported name (" ++ show s ++ ")." , "The following file names are supported:" , " 1) index.js (PureScript native modules)" - , " 2) foreign.js (PureScript foreign modules)" + , " 2) foreign.js (PureScript ES foreign modules)" + , " 3) foreign.cjs (PureScript CommonJS foreign modules)" ] printErrorMessage InvalidTopLevel = [ "Expected a list of source elements at the top level." ] @@ -332,7 +336,7 @@ withDeps (Module modulePath fn es) = Module modulePath fn (map expandDeps es) in (map (\name -> (m, name, Internal)) shorthandNames, bn) toReference (JSFunctionExpression _ _ _ params _ _) bn - = ([], bn \\ (mapMaybe unIdentifier $ commaList params)) + = ([], bn \\ (mapMaybe unIdentifier $ fromCommaList params)) toReference e bn | Just nm <- exportsAccessor e -- exports.foo means there's a dependency on the public member "foo" of @@ -379,14 +383,9 @@ strValue str = go $ drop 1 str go (x : xs) = x : go xs go "" = "" -commaList :: JSCommaList a -> [a] -commaList JSLNil = [] -commaList (JSLOne x) = [x] -commaList (JSLCons l _ x) = commaList l ++ [x] - trailingCommaList :: JSCommaTrailingList a -> [a] -trailingCommaList (JSCTLComma l _) = commaList l -trailingCommaList (JSCTLNone l) = commaList l +trailingCommaList (JSCTLComma l _) = fromCommaList l +trailingCommaList (JSCTLNone l) = fromCommaList l identName :: JSIdent -> Maybe String identName (JSIdentName _ ident) = Just ident @@ -408,7 +407,7 @@ exportStatementIdentifiers (JSGenerator _ _ jsIdent _ _ _ _ _) = exportStatementIdentifiers _ = [] varNames :: JSCommaList JSExpression -> [String] -varNames = mapMaybe varName . commaList +varNames = mapMaybe varName . fromCommaList where varName (JSVarInitExpression (JSIdentifier _ ident) _) = Just ident varName _ = Nothing @@ -493,8 +492,9 @@ toModule mids mid filename top toModuleElements (JSModuleStatementListItem other) = pure [Other other] + exportSpecifiersList (Just "./foreign.cjs") = const $ pure [] exportSpecifiersList from = - fmap catMaybes . traverse (exportSpecifier from) . commaList + fmap catMaybes . traverse (exportSpecifier from) . fromCommaList exportSpecifier from (JSExportSpecifier jsIdent) = traverse (toExport' from) $ identName jsIdent @@ -512,6 +512,18 @@ toModule mids mid filename top toExport' from name = toExport from name name +data ForeignModuleExports = + ForeignModuleExports + { cjsExports :: [String] + , esExports :: [String] + } deriving (Show) + +instance Semigroup ForeignModuleExports where + (ForeignModuleExports cjsExports esExports) <> (ForeignModuleExports cjsExports' esExports') = + ForeignModuleExports (cjsExports <> cjsExports') (esExports <> esExports') +instance Monoid ForeignModuleExports where + mempty = ForeignModuleExports [] [] + -- Get a list of all the exported identifiers from a foreign module. -- -- TODO: what if we assign to exports.foo and then later assign to @@ -519,9 +531,9 @@ toModule mids mid filename top getExportedIdentifiers :: forall m. (MonadError ErrorMessage m) => String -> JSAST - -> m [String] + -> m ForeignModuleExports getExportedIdentifiers mname top - | JSAstModule jsModuleItems _ <- top = concat <$> traverse go jsModuleItems + | JSAstModule jsModuleItems _ <- top = fold <$> traverse go jsModuleItems | otherwise = err InvalidTopLevel where err :: ErrorMessage -> m a @@ -529,14 +541,15 @@ getExportedIdentifiers mname top go (JSModuleStatementListItem jsStatement) | Just props <- matchExportsAssignment jsStatement - = traverse toIdent (trailingCommaList props) + = do cjsExports <- traverse toIdent (trailingCommaList props) + pure ForeignModuleExports{ cjsExports, esExports = [] } | Just (Public, name, _) <- matchMember jsStatement - = pure [name] + = pure ForeignModuleExports{ cjsExports = [name], esExports = [] } | otherwise - = pure [] + = pure mempty go (JSModuleExportDeclaration _ jsExportDeclaration) = - pure $ exportDeclarationIdentifiers jsExportDeclaration - go _ = pure [] + pure ForeignModuleExports{ cjsExports = [], esExports = exportDeclarationIdentifiers jsExportDeclaration } + go _ = pure mempty toIdent (JSPropertyNameandValue name _ [_]) = extractLabel' name @@ -553,7 +566,7 @@ getExportedIdentifiers mname top exportStatementIdentifiers jsStatement exportClauseIdentifiers (JSExportClause _ jsExportsSpecifiers _) = - mapMaybe exportSpecifierName $ commaList jsExportsSpecifiers + mapMaybe exportSpecifierName $ fromCommaList jsExportsSpecifiers exportSpecifierName (JSExportSpecifier jsIdent) = identName jsIdent exportSpecifierName (JSExportSpecifierAs _ _ jsIdentAs) = identName jsIdentAs @@ -566,12 +579,12 @@ matchRequire :: S.Set String -> Maybe (String, Either String ModuleIdentifier) matchRequire mids mid stmt | JSVariable _ jsInit _ <- stmt - , [JSVarInitExpression var varInit] <- commaList jsInit + , [JSVarInitExpression var varInit] <- fromCommaList jsInit , JSIdentifier _ importName <- var , JSVarInit _ jsInitEx <- varInit , JSMemberExpression req _ argsE _ <- jsInitEx , JSIdentifier _ "require" <- req - , [ Just importPath ] <- map fromStringLiteral (commaList argsE) + , [ Just importPath ] <- map fromStringLiteral (fromCommaList argsE) , importPath' <- checkImportPath importPath mid mids = Just (importName, importPath') | otherwise @@ -582,7 +595,7 @@ matchMember :: JSStatement -> Maybe (Visibility, String, JSExpression) matchMember stmt -- var foo = expr; | JSVariable _ jsInit _ <- stmt - , [JSVarInitExpression var varInit] <- commaList jsInit + , [JSVarInitExpression var varInit] <- fromCommaList jsInit , JSIdentifier _ name <- var , JSVarInit _ decl <- varInit = Just (Internal, name, decl) @@ -805,7 +818,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o declToJS (Import _ nm req) = withLength [ JSVariable lfsp - (cList [ + (toCommaList [ JSVarInitExpression (JSIdentifier sp nm) (JSVarInit sp $ either require (innerModuleReference sp . moduleName) req ) ]) (JSSemi JSNoAnnot) @@ -823,16 +836,6 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o val (JSSemi JSNoAnnot) - -- comma lists are reverse-consed - cList :: [a] -> JSCommaList a - cList [] = JSLNil - cList [x] = JSLOne x - cList l = go $ reverse l - where - go [x] = JSLOne x - go (h:t)= JSLCons (go t) JSNoAnnot h - go [] = error "Invalid case in comma-list" - indent :: [JSStatement] -> [JSStatement] indent = everywhere (mkT squash) where @@ -849,7 +852,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o prelude :: JSStatement prelude = JSVariable (JSAnnot tokenPosnEmpty [ CommentA tokenPosnEmpty $ "// Generated by purs bundle " ++ showVersion Paths.version , WhiteSpace tokenPosnEmpty "\n" ]) - (cList [ + (toCommaList [ JSVarInitExpression (JSIdentifier sp optionsNamespace) (JSVarInit sp (emptyObj sp)) ]) (JSSemi JSNoAnnot) @@ -857,7 +860,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o require :: String -> JSExpression require mn = JSMemberExpression (JSIdentifier JSNoAnnot "require") JSNoAnnot - (cList [ stringLiteral mn ]) JSNoAnnot + (toCommaList [ stringLiteral mn ]) JSNoAnnot moduleReference :: JSAnnot -> String -> JSExpression moduleReference a mn = @@ -926,7 +929,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o [JSMethodCall (JSMemberDot (moduleReference lf mn) JSNoAnnot (JSIdentifier JSNoAnnot "main")) - JSNoAnnot (cList []) JSNoAnnot (JSSemi JSNoAnnot)] + JSNoAnnot (toCommaList []) JSNoAnnot (JSSemi JSNoAnnot)] lf :: JSAnnot lf = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ] diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index b679b655d3..ea1e15757a 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -11,6 +11,7 @@ module Language.PureScript.Make.Actions import Prelude +import Blaze.ByteString.Builder (toByteString) import Control.Monad hiding (sequence) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.IO.Class @@ -31,8 +32,11 @@ 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.AST.JSCommaList as JSAST (toCommaList) import qualified Language.JavaScript.Parser as JS import Language.PureScript.AST +import qualified Language.JavaScript.Parser.AST as JSAST +import Language.JavaScript.Pretty.Printer (renderJS) import qualified Language.PureScript.Bundle as Bundle import qualified Language.PureScript.CodeGen.JS as J import Language.PureScript.CodeGen.JS.Printer @@ -248,12 +252,29 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = Just path | not $ requiresForeign m -> tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path - | otherwise -> - checkForeignDecls m path + | otherwise -> do + (foreignModuleType, foreignIdents) <- checkForeignDecls m path + case foreignModuleType of + ESModule -> copyFile path (outputFilename mn "foreign.js") + CJSModule -> do + copyFile path (outputFilename mn "foreign.cjs") + writeESForeignModuleWrapper mn foreignIdents + Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn | otherwise -> return () - for_ (mn `M.lookup` foreigns) $ \path -> - copyFile path (outputFilename mn "foreign.js") + + writeESForeignModuleWrapper :: ModuleName -> S.Set Ident -> Make () + writeESForeignModuleWrapper mn idents = + writeTextFile (outputFilename mn "foreign.js") . toByteString . renderJS $ + JSAST.JSAstModule + [ JSAST.JSModuleExportDeclaration JSAST.JSNoAnnot + (JSAST.JSExportFrom + (JSAST.JSExportClause JSAST.JSAnnotSpace + (JSAST.toCommaList $ JSAST.JSExportSpecifier . JSAST.JSIdentName JSAST.JSAnnotSpace . T.unpack . runIdent <$> S.toList idents) + JSAST.JSAnnotSpace) + (JSAST.JSFromClause JSAST.JSAnnotSpace JSAST.JSAnnotSpace "\"./foreign.cjs\"") + (JSAST.JSSemi JSAST.JSNoAnnot)) + ] JSAST.JSNoAnnot genSourceMap :: String -> String -> Int -> [SMap] -> Make () genSourceMap dir mapFile extraLines mappings = do @@ -294,18 +315,26 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = writePackageJson :: Make () writePackageJson = writePackageJson' outputDir +data ForeignModuleType = ESModule | CJSModule deriving (Show) + -- | Check that the declarations in a given PureScript module match with those -- in its corresponding foreign module. -checkForeignDecls :: CF.Module ann -> FilePath -> Make () +checkForeignDecls :: CF.Module ann -> FilePath -> Make (ForeignModuleType, S.Set Ident) checkForeignDecls m path = do jsStr <- T.unpack <$> readTextFile path js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parseModule jsStr path - foreignIdentsStrs <- either errorParsingModule pure $ getExps js + (foreignModuleType, foreignIdentsStrs) <- case getForeignModuleExports js of + Left reason -> errorParsingModule reason + Right (Bundle.ForeignModuleExports{..}) + | null esExports -> do + let deprecatedFFI = filter (elem '\'') cjsExports + unless (null deprecatedFFI) $ + errorDeprecatedForeignPrimes deprecatedFFI - let deprecatedFFI = filter (elem '\'') foreignIdentsStrs - unless (null deprecatedFFI) $ - errorDeprecatedForeignPrimes deprecatedFFI + pure (CJSModule, cjsExports) + | otherwise -> + pure (ESModule, esExports) foreignIdents <- either errorInvalidForeignIdentifiers @@ -323,6 +352,7 @@ checkForeignDecls m path = do throwError . errorMessage' modSS . MissingFFIImplementations mname $ S.toList missingFFI + pure (foreignModuleType, foreignIdents) where mname = CF.moduleName m modSS = CF.moduleSourceSpan m @@ -330,8 +360,8 @@ checkForeignDecls m path = do errorParsingModule :: Bundle.ErrorMessage -> Make a errorParsingModule = throwError . errorMessage' modSS . ErrorParsingFFIModule path . Just - getExps :: JS.JSAST -> Either Bundle.ErrorMessage [String] - getExps = Bundle.getExportedIdentifiers (T.unpack (runModuleName mname)) + getForeignModuleExports :: JS.JSAST -> Either Bundle.ErrorMessage Bundle.ForeignModuleExports + getForeignModuleExports = Bundle.getExportedIdentifiers (T.unpack (runModuleName mname)) errorInvalidForeignIdentifiers :: [String] -> Make a errorInvalidForeignIdentifiers = diff --git a/tests/TestBundle.hs b/tests/TestBundle.hs index ab209d5989..55ab1b3744 100644 --- a/tests/TestBundle.hs +++ b/tests/TestBundle.hs @@ -66,7 +66,7 @@ assertBundles supportModules supportExterns supportForeigns inputFiles outputFil Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs Right _ -> do process <- findNodeProcess - jsFiles <- Glob.globDir1 (Glob.compile "**/*.js") modulesDir + jsFiles <- concat <$> Glob.globDir [Glob.compile "*/*.js", Glob.compile "*/foreign.cjs"] modulesDir let entryPoint = modulesDir "index.js" let entryModule = map (`ModuleIdentifier` Regular) ["Main"] bundled <- runExceptT $ do From 158774938a8748414836e25a8e7c41d553c66edf Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 17:52:57 +0100 Subject: [PATCH 18/62] Don't let tests nor the REPL compile into a node_modules directory Node.js ignores the package.json file of the output directory otherwise and loads .js files as CommonJS modules. --- app/Command/REPL.hs | 2 +- src/Language/PureScript/Interactive/Module.hs | 2 +- tests/TestCompiler.hs | 2 +- tests/TestPsci/TestEnv.hs | 2 +- tests/TestUtils.hs | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index 2ae72b2cde..9597a9538e 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -287,7 +287,7 @@ nodeBackend nodePath nodeArgs = Backend setup eval reload shutdown eval :: () -> String -> IO () eval _ _ = do - writeFile indexFile "require('$PSCI')['$main']();" + writeFile indexFile "import('./$PSCI/index.js').then(({ $main }) => $main());" process <- maybe findNodeProcess (pure . pure) nodePath result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process case result of diff --git a/src/Language/PureScript/Interactive/Module.hs b/src/Language/PureScript/Interactive/Module.hs index 1ceeedf446..28ac295477 100644 --- a/src/Language/PureScript/Interactive/Module.hs +++ b/src/Language/PureScript/Interactive/Module.hs @@ -98,7 +98,7 @@ indexFile :: FilePath indexFile = ".psci_modules" ++ pathSeparator : "index.js" modulesDir :: FilePath -modulesDir = ".psci_modules" ++ pathSeparator : "node_modules" +modulesDir = ".psci_modules" internalSpan :: P.SourceSpan internalSpan = P.internalModuleSourceSpan "" diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs index 46502077da..5a0a09ae5a 100644 --- a/tests/TestCompiler.hs +++ b/tests/TestCompiler.hs @@ -166,7 +166,7 @@ assertCompiles supportModules supportExterns supportForeigns inputFiles outputFi Right _ -> do process <- findNodeProcess let entryPoint = modulesDir "index.js" - writeFile entryPoint "require('Main').main()" + writeFile entryPoint "import('./Main/index.js').then(({ main }) => main());" result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":" case result of diff --git a/tests/TestPsci/TestEnv.hs b/tests/TestPsci/TestEnv.hs index 31d5fdc591..7a9c0c6d12 100644 --- a/tests/TestPsci/TestEnv.hs +++ b/tests/TestPsci/TestEnv.hs @@ -57,7 +57,7 @@ execTestPSCi i = do -- command evaluation. jsEval :: TestPSCi String jsEval = liftIO $ do - writeFile indexFile "require('$PSCI')['$main']();" + writeFile indexFile "import('./$PSCI/index.js').then(({ $main }) => $main());" process <- findNodeProcess result <- traverse (\node -> readProcessWithExitCode node [indexFile] "") process case result of diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs index dfacc8a107..6b086fcacd 100644 --- a/tests/TestUtils.hs +++ b/tests/TestUtils.hs @@ -236,7 +236,7 @@ trim :: String -> String trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse modulesDir :: FilePath -modulesDir = ".test_modules" "node_modules" +modulesDir = ".test_modules" logpath :: FilePath logpath = "purescript-output" From ba9f084dc5081bf4794c9563a9554a37102328e7 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 18:07:05 +0100 Subject: [PATCH 19/62] Bundle re-exports --- src/Language/PureScript/Bundle.hs | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 1b7d8b98cb..a1e2321b81 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -37,12 +37,15 @@ import Data.Version (showVersion) import qualified Data.Aeson as A import qualified Data.Map as M import qualified Data.Set as S -import qualified Data.Text.Lazy as T +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT import Language.JavaScript.AST.JSCommaList (fromCommaList, toCommaList) import Language.JavaScript.Parser import Language.JavaScript.Parser.AST import Language.JavaScript.Process.Minify +import Language.PureScript.Names (ModuleName(..)) +import Language.PureScript.CodeGen.JS.Common (moduleNameToJs) import qualified Paths_purescript as Paths @@ -183,7 +186,7 @@ instance A.ToJSON ModuleElement where getFragment = ellipsize . renderToText . minifyJS where - ellipsize text = if T.compareLength text 20 == GT then T.take 19 text `T.snoc` ellipsis else text + ellipsize text = if LT.compareLength text 20 == GT then LT.take 19 text `LT.snoc` ellipsis else text ellipsis = '\x2026' -- | A module is just a list of elements of the types listed above. @@ -502,11 +505,16 @@ toModule mids mid filename top = sequence $ toExport from <$> identName jsIdent <*> identName jsIdentAs toExport :: Maybe String -> String -> String -> m (ExportType, String, JSExpression, [Key]) - toExport (Just "./foreign.js") name as = - pure . (ForeignReexport, as,, []) $ - (JSMemberSquare (JSIdentifier sp "$foreign") JSNoAnnot - (stringLiteral name) JSNoAnnot) - toExport (Just _) _ _ = err UnsupportedExport + toExport (Just from) name as + | from == "./foreign.js" = + pure . (ForeignReexport, as,, []) $ + (JSMemberSquare (JSIdentifier sp "$foreign") JSNoAnnot + (stringLiteral name) JSNoAnnot) + | Just from' <- stripSuffix "/index.js" =<< stripPrefix "../" from = + pure . (RegularExport name, as,, []) $ + (JSMemberSquare (JSIdentifier sp (T.unpack . moduleNameToJs . ModuleName $ T.pack from')) JSNoAnnot + (stringLiteral name) JSNoAnnot) + | otherwise = err UnsupportedExport toExport Nothing name as = pure (RegularExport name, as, JSIdentifier sp name, []) From 65dab5dc8c2cced5fa4ca2fb487b8a3fcdcc5fb8 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 18:10:38 +0100 Subject: [PATCH 20/62] Load bundles as CommonJS modules in tests --- tests/TestBundle.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/TestBundle.hs b/tests/TestBundle.hs index 55ab1b3744..31b8452aee 100644 --- a/tests/TestBundle.hs +++ b/tests/TestBundle.hs @@ -67,7 +67,7 @@ assertBundles supportModules supportExterns supportForeigns inputFiles outputFil Right _ -> do process <- findNodeProcess jsFiles <- concat <$> Glob.globDir [Glob.compile "*/*.js", Glob.compile "*/foreign.cjs"] modulesDir - let entryPoint = modulesDir "index.js" + let entryPoint = modulesDir "index.cjs" let entryModule = map (`ModuleIdentifier` Regular) ["Main"] bundled <- runExceptT $ do input <- forM jsFiles $ \filename -> do From 830bbe27dbbf3829588e49832123a5b740212dd1 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 18:12:36 +0100 Subject: [PATCH 21/62] Update Node.js version on CI --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 7f0bbfb825..bc82733e74 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,6 @@ language: node_js node_js: - - "10" + - "14" branches: # Only build master and tagged versions, i.e. not feature branches; feature # branches already get built after opening a pull request. From 4976eee1599300511236b9a491b09ecb332cf852 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 18:19:45 +0100 Subject: [PATCH 22/62] Disallow CommonJS exports named `default` Node.js allows ES modules to import CommonJS modules by providing the module.exports object as their default export and named exports for statically discoverable properties of the module.exports object. This has an unpleasant consequence for foreign imports: CommonJS exports named `default` are only available as the default property of their default export so a `default :: String` identifier imported from a CommonJS foreign module would actually have type `{ default :: String }`! --- src/Language/PureScript/Errors.hs | 8 ++++++++ src/Language/PureScript/Make/Actions.hs | 7 +++++++ .../failing/DeprecatedFFIDefaultCommonJSExport.js | 1 + .../failing/DeprecatedFFIDefaultCommonJSExport.out | 12 ++++++++++++ .../failing/DeprecatedFFIDefaultCommonJSExport.purs | 4 ++++ tests/purs/passing/FFIDefaultESExport.js | 3 +++ tests/purs/passing/FFIDefaultESExport.purs | 7 +++++++ 7 files changed, 42 insertions(+) create mode 100644 tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.js create mode 100644 tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.out create mode 100644 tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs create mode 100644 tests/purs/passing/FFIDefaultESExport.js create mode 100644 tests/purs/passing/FFIDefaultESExport.purs diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 7bc52a59fe..6a82a3d3ac 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -65,6 +65,7 @@ data SimpleErrorMessage | UnusedFFIImplementations ModuleName [Ident] | InvalidFFIIdentifier ModuleName Text | DeprecatedFFIPrime ModuleName Text + | DeprecatedFFIDefaultCommonJSExport ModuleName | FileIOError Text IOError -- ^ A description of what we were trying to do, and the error which occurred | InfiniteType SourceType | InfiniteKind SourceType @@ -235,6 +236,7 @@ errorCode em = case unwrapErrorMessage em of UnusedFFIImplementations{} -> "UnusedFFIImplementations" InvalidFFIIdentifier{} -> "InvalidFFIIdentifier" DeprecatedFFIPrime{} -> "DeprecatedFFIPrime" + DeprecatedFFIDefaultCommonJSExport {} -> "DeprecatedFFIDefaultCommonJSExport" FileIOError{} -> "FileIOError" InfiniteType{} -> "InfiniteType" InfiniteKind{} -> "InfiniteKind" @@ -699,6 +701,12 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl , line $ "Primes are not allowed in identifiers exported from FFI modules." ] ] + renderSimpleErrorMessage (DeprecatedFFIDefaultCommonJSExport mn) = + paras [ line $ "In the FFI module for " <> markCode (runModuleName mn) <> ":" + , indent . paras $ + [ line $ "CommonJS exports named " <> markCode "default" <> " are not allowed." + ] + ] renderSimpleErrorMessage InvalidDoBind = line "The last statement in a 'do' block must be an expression, but this block ends with a binder." renderSimpleErrorMessage InvalidDoLet = diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index ea1e15757a..7a3b539196 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -332,6 +332,9 @@ checkForeignDecls m path = do unless (null deprecatedFFI) $ errorDeprecatedForeignPrimes deprecatedFFI + when (elem "default" cjsExports) $ + errorDeprecatedFFIDefaultCJSExport + pure (CJSModule, cjsExports) | otherwise -> pure (ESModule, esExports) @@ -371,6 +374,10 @@ checkForeignDecls m path = do errorDeprecatedForeignPrimes = throwError . mconcat . map (errorMessage' modSS . DeprecatedFFIPrime mname . T.pack) + errorDeprecatedFFIDefaultCJSExport :: Make a + errorDeprecatedFFIDefaultCJSExport = + throwError . errorMessage' modSS $ DeprecatedFFIDefaultCommonJSExport mname + parseIdents :: [String] -> Either [String] [Ident] parseIdents strs = case partitionEithers (map parseIdent strs) of diff --git a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.js b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.js new file mode 100644 index 0000000000..8f35a10f24 --- /dev/null +++ b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.js @@ -0,0 +1 @@ +exports.default = undefined; diff --git a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.out b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.out new file mode 100644 index 0000000000..943c7dc313 --- /dev/null +++ b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.out @@ -0,0 +1,12 @@ +Error found: +at tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs:2:1 - 4:38 (line 2, column 1 - line 4, column 38) + + In the FFI module for Main: + + CommonJS exports named default are not allowed. + + + +See https://github.com/purescript/documentation/blob/master/errors/DeprecatedFFIDefaultCommonJSExport.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs new file mode 100644 index 0000000000..ef70f75ac8 --- /dev/null +++ b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs @@ -0,0 +1,4 @@ +-- @shouldFailWith DeprecatedFFIDefaultCommonJSExport +module Main where + +foreign import default :: forall a. a diff --git a/tests/purs/passing/FFIDefaultESExport.js b/tests/purs/passing/FFIDefaultESExport.js new file mode 100644 index 0000000000..ab294f31ea --- /dev/null +++ b/tests/purs/passing/FFIDefaultESExport.js @@ -0,0 +1,3 @@ +var message = "Done"; + +export { message as default }; diff --git a/tests/purs/passing/FFIDefaultESExport.purs b/tests/purs/passing/FFIDefaultESExport.purs new file mode 100644 index 0000000000..1d084b6d8d --- /dev/null +++ b/tests/purs/passing/FFIDefaultESExport.purs @@ -0,0 +1,7 @@ +module Main where + +import Effect.Console (log) + +foreign import default :: String + +main = log default From f73c2bf461b0703a90fdeab335037b47e0b4b208 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 19:00:15 +0100 Subject: [PATCH 23/62] Disallow CommonJS exports and imports in ES foreign modules The require function and the exports object are not available in ES modules on Node.js. --- src/Language/PureScript/Bundle.hs | 50 +++++++++++++++---- src/Language/PureScript/Errors.hs | 12 +++++ src/Language/PureScript/Make/Actions.hs | 48 ++++++++++++------ .../failing/UnsupportedFFICommonJSExports1.js | 2 + .../UnsupportedFFICommonJSExports1.out | 12 +++++ .../UnsupportedFFICommonJSExports1.purs | 5 ++ .../failing/UnsupportedFFICommonJSExports2.js | 4 ++ .../UnsupportedFFICommonJSExports2.out | 13 +++++ .../UnsupportedFFICommonJSExports2.purs | 5 ++ .../failing/UnsupportedFFICommonJSImports1.js | 4 ++ .../UnsupportedFFICommonJSImports1.out | 12 +++++ .../UnsupportedFFICommonJSImports1.purs | 5 ++ .../failing/UnsupportedFFICommonJSImports2.js | 5 ++ .../UnsupportedFFICommonJSImports2.out | 12 +++++ .../UnsupportedFFICommonJSImports2.purs | 5 ++ 15 files changed, 171 insertions(+), 23 deletions(-) create mode 100644 tests/purs/failing/UnsupportedFFICommonJSExports1.js create mode 100644 tests/purs/failing/UnsupportedFFICommonJSExports1.out create mode 100644 tests/purs/failing/UnsupportedFFICommonJSExports1.purs create mode 100644 tests/purs/failing/UnsupportedFFICommonJSExports2.js create mode 100644 tests/purs/failing/UnsupportedFFICommonJSExports2.out create mode 100644 tests/purs/failing/UnsupportedFFICommonJSExports2.purs create mode 100644 tests/purs/failing/UnsupportedFFICommonJSImports1.js create mode 100644 tests/purs/failing/UnsupportedFFICommonJSImports1.out create mode 100644 tests/purs/failing/UnsupportedFFICommonJSImports1.purs create mode 100644 tests/purs/failing/UnsupportedFFICommonJSImports2.js create mode 100644 tests/purs/failing/UnsupportedFFICommonJSImports2.out create mode 100644 tests/purs/failing/UnsupportedFFICommonJSImports2.purs diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index a1e2321b81..996464542d 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -15,6 +15,8 @@ module Language.PureScript.Bundle , printErrorMessage , ForeignModuleExports(..) , getExportedIdentifiers + , ForeignModuleImports(..) + , getImportedModules , Module ) where @@ -462,8 +464,8 @@ toModule mids mid filename top ] toModuleElements item@(JSModuleStatementListItem jsStatement) - | Just (importName, importPath) <- matchRequire mids mid jsStatement - = pure [Import item importName importPath] + | Just (importName, importPath) <- matchRequire jsStatement + = pure [Import item importName $ checkImportPath importPath mid mids] toModuleElements (JSModuleStatementListItem jsStatement) | Just (visibility, name, decl) <- matchMember jsStatement = pure [Member jsStatement visibility name decl []] @@ -579,13 +581,44 @@ getExportedIdentifiers mname top exportSpecifierName (JSExportSpecifier jsIdent) = identName jsIdent exportSpecifierName (JSExportSpecifierAs _ _ jsIdentAs) = identName jsIdentAs +data ForeignModuleImports = + ForeignModuleImports + { cjsImports :: [String] + , esImports :: [String] + } deriving (Show) + +instance Semigroup ForeignModuleImports where + (ForeignModuleImports cjsImports esImports) <> (ForeignModuleImports cjsImports' esImports') = + ForeignModuleImports (cjsImports <> cjsImports') (esImports <> esImports') +instance Monoid ForeignModuleImports where + mempty = ForeignModuleImports [] [] + +-- Get a list of all the imported module identifiers from a foreign module. +getImportedModules :: forall m. (MonadError ErrorMessage m) + => String + -> JSAST + -> m ForeignModuleImports +getImportedModules mname top + | JSAstModule jsModuleItems _ <- top = pure $ foldMap go jsModuleItems + | otherwise = err InvalidTopLevel + where + err :: ErrorMessage -> m a + err = throwError . ErrorInModule (ModuleIdentifier mname Foreign) + + go (JSModuleStatementListItem jsStatement) + | Just (_, mid) <- matchRequire jsStatement + = ForeignModuleImports{ cjsImports = [mid], esImports = [] } + go (JSModuleImportDeclaration _ jsImportDeclaration) = + ForeignModuleImports{ cjsImports = [], esImports = [importDeclarationModuleId jsImportDeclaration] } + go _ = mempty + + importDeclarationModuleId (JSImportDeclaration _ (JSFromClause _ _ mid) _) = mid + importDeclarationModuleId (JSImportDeclarationBare _ mid _) = mid + -- Matches JS statements like this: -- var ModuleName = require("file"); -matchRequire :: S.Set String - -> ModuleIdentifier - -> JSStatement - -> Maybe (String, Either String ModuleIdentifier) -matchRequire mids mid stmt +matchRequire :: JSStatement -> Maybe (String, String) +matchRequire stmt | JSVariable _ jsInit _ <- stmt , [JSVarInitExpression var varInit] <- fromCommaList jsInit , JSIdentifier _ importName <- var @@ -593,8 +626,7 @@ matchRequire mids mid stmt , JSMemberExpression req _ argsE _ <- jsInitEx , JSIdentifier _ "require" <- req , [ Just importPath ] <- map fromStringLiteral (fromCommaList argsE) - , importPath' <- checkImportPath importPath mid mids - = Just (importName, importPath') + = Just (importName, importPath) | otherwise = Nothing diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 6a82a3d3ac..0749ae43dd 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -66,6 +66,8 @@ data SimpleErrorMessage | InvalidFFIIdentifier ModuleName Text | DeprecatedFFIPrime ModuleName Text | DeprecatedFFIDefaultCommonJSExport ModuleName + | UnsupportedFFICommonJSExports ModuleName [Text] + | UnsupportedFFICommonJSImports ModuleName [Text] | FileIOError Text IOError -- ^ A description of what we were trying to do, and the error which occurred | InfiniteType SourceType | InfiniteKind SourceType @@ -237,6 +239,8 @@ errorCode em = case unwrapErrorMessage em of InvalidFFIIdentifier{} -> "InvalidFFIIdentifier" DeprecatedFFIPrime{} -> "DeprecatedFFIPrime" DeprecatedFFIDefaultCommonJSExport {} -> "DeprecatedFFIDefaultCommonJSExport" + UnsupportedFFICommonJSExports {} -> "UnsupportedFFICommonJSExports" + UnsupportedFFICommonJSImports {} -> "UnsupportedFFICommonJSImports" FileIOError{} -> "FileIOError" InfiniteType{} -> "InfiniteType" InfiniteKind{} -> "InfiniteKind" @@ -707,6 +711,14 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl [ line $ "CommonJS exports named " <> markCode "default" <> " are not allowed." ] ] + renderSimpleErrorMessage (UnsupportedFFICommonJSExports mn idents) = + paras [ line $ "The following CommonJS exports are not supported in the ES foreign module for module " <> markCode (runModuleName mn) <> ": " + , indent . paras $ map line idents + ] + renderSimpleErrorMessage (UnsupportedFFICommonJSImports mn mids) = + paras [ line $ "The following CommonJS imports are no supported in the ES foreign module for module " <> markCode (runModuleName mn) <> ": " + , indent . paras $ map line mids + ] renderSimpleErrorMessage InvalidDoBind = line "The last statement in a 'do' block must be an expression, but this block ends with a binder." renderSimpleErrorMessage InvalidDoLet = diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 7a3b539196..5a08b1e4cc 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -324,20 +324,29 @@ checkForeignDecls m path = do jsStr <- T.unpack <$> readTextFile path js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parseModule jsStr path - (foreignModuleType, foreignIdentsStrs) <- case getForeignModuleExports js of - Left reason -> errorParsingModule reason - Right (Bundle.ForeignModuleExports{..}) - | null esExports -> do - let deprecatedFFI = filter (elem '\'') cjsExports - unless (null deprecatedFFI) $ - errorDeprecatedForeignPrimes deprecatedFFI - - when (elem "default" cjsExports) $ - errorDeprecatedFFIDefaultCJSExport - - pure (CJSModule, cjsExports) - | otherwise -> - pure (ESModule, esExports) + (foreignModuleType, foreignIdentsStrs) <- + case (,) <$> getForeignModuleExports js <*> getForeignModuleImports js of + Left reason -> errorParsingModule reason + Right (Bundle.ForeignModuleExports{..}, Bundle.ForeignModuleImports{..}) + | not (null cjsExports && null cjsImports) + , null esExports + , null esImports -> do + let deprecatedFFI = filter (elem '\'') cjsExports + unless (null deprecatedFFI) $ + errorDeprecatedForeignPrimes deprecatedFFI + + when (elem "default" cjsExports) $ + errorDeprecatedFFIDefaultCJSExport + + pure (CJSModule, cjsExports) + | otherwise -> do + unless (null cjsImports) $ + errorUnsupportedFFICommonJSImports cjsImports + + unless (null cjsExports) $ + errorUnsupportedFFICommonJSExports cjsExports + + pure (ESModule, esExports) foreignIdents <- either errorInvalidForeignIdentifiers @@ -366,6 +375,9 @@ checkForeignDecls m path = do getForeignModuleExports :: JS.JSAST -> Either Bundle.ErrorMessage Bundle.ForeignModuleExports getForeignModuleExports = Bundle.getExportedIdentifiers (T.unpack (runModuleName mname)) + getForeignModuleImports :: JS.JSAST -> Either Bundle.ErrorMessage Bundle.ForeignModuleImports + getForeignModuleImports = Bundle.getImportedModules (T.unpack (runModuleName mname)) + errorInvalidForeignIdentifiers :: [String] -> Make a errorInvalidForeignIdentifiers = throwError . mconcat . map (errorMessage . InvalidFFIIdentifier mname . T.pack) @@ -378,6 +390,14 @@ checkForeignDecls m path = do errorDeprecatedFFIDefaultCJSExport = throwError . errorMessage' modSS $ DeprecatedFFIDefaultCommonJSExport mname + errorUnsupportedFFICommonJSExports :: [String] -> Make a + errorUnsupportedFFICommonJSExports = + throwError . errorMessage' modSS . UnsupportedFFICommonJSExports mname . map T.pack + + errorUnsupportedFFICommonJSImports :: [String] -> Make a + errorUnsupportedFFICommonJSImports = + throwError . errorMessage' modSS . UnsupportedFFICommonJSImports mname . map T.pack + parseIdents :: [String] -> Either [String] [Ident] parseIdents strs = case partitionEithers (map parseIdent strs) of diff --git a/tests/purs/failing/UnsupportedFFICommonJSExports1.js b/tests/purs/failing/UnsupportedFFICommonJSExports1.js new file mode 100644 index 0000000000..a74e1904db --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSExports1.js @@ -0,0 +1,2 @@ +export var yes = true; +exports.no = false; diff --git a/tests/purs/failing/UnsupportedFFICommonJSExports1.out b/tests/purs/failing/UnsupportedFFICommonJSExports1.out new file mode 100644 index 0000000000..d39cd8ad0b --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSExports1.out @@ -0,0 +1,12 @@ +Error found: +at tests/purs/failing/UnsupportedFFICommonJSExports1.purs:2:1 - 5:29 (line 2, column 1 - line 5, column 29) + + The following CommonJS exports are not supported in the ES foreign module for module Main: + + no + + + +See https://github.com/purescript/documentation/blob/master/errors/UnsupportedFFICommonJSExports.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/UnsupportedFFICommonJSExports1.purs b/tests/purs/failing/UnsupportedFFICommonJSExports1.purs new file mode 100644 index 0000000000..fc64c41988 --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSExports1.purs @@ -0,0 +1,5 @@ +-- @shouldFailWith UnsupportedFFICommonJSExports +module Main where + +foreign import yes :: Boolean +foreign import no :: Boolean diff --git a/tests/purs/failing/UnsupportedFFICommonJSExports2.js b/tests/purs/failing/UnsupportedFFICommonJSExports2.js new file mode 100644 index 0000000000..10854c8a3b --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSExports2.js @@ -0,0 +1,4 @@ +import { yes, no } from "some ES module"; + +exports.yes = yes; +exports.no = no; diff --git a/tests/purs/failing/UnsupportedFFICommonJSExports2.out b/tests/purs/failing/UnsupportedFFICommonJSExports2.out new file mode 100644 index 0000000000..d06dad5f4d --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSExports2.out @@ -0,0 +1,13 @@ +Error found: +at tests/purs/failing/UnsupportedFFICommonJSExports2.purs:2:1 - 5:29 (line 2, column 1 - line 5, column 29) + + The following CommonJS exports are not supported in the ES foreign module for module Main: + + yes + no + + + +See https://github.com/purescript/documentation/blob/master/errors/UnsupportedFFICommonJSExports.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/UnsupportedFFICommonJSExports2.purs b/tests/purs/failing/UnsupportedFFICommonJSExports2.purs new file mode 100644 index 0000000000..fc64c41988 --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSExports2.purs @@ -0,0 +1,5 @@ +-- @shouldFailWith UnsupportedFFICommonJSExports +module Main where + +foreign import yes :: Boolean +foreign import no :: Boolean diff --git a/tests/purs/failing/UnsupportedFFICommonJSImports1.js b/tests/purs/failing/UnsupportedFFICommonJSImports1.js new file mode 100644 index 0000000000..c34d89c38c --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSImports1.js @@ -0,0 +1,4 @@ +var cjsImports = require("some CJS module"); + +export var yes = cjsImports.yes; +export var no = cjsImports.no; diff --git a/tests/purs/failing/UnsupportedFFICommonJSImports1.out b/tests/purs/failing/UnsupportedFFICommonJSImports1.out new file mode 100644 index 0000000000..8cc5f980a4 --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSImports1.out @@ -0,0 +1,12 @@ +Error found: +at tests/purs/failing/UnsupportedFFICommonJSImports1.purs:2:1 - 5:29 (line 2, column 1 - line 5, column 29) + + The following CommonJS imports are no supported in the ES foreign module for module Main: + + some CJS module + + + +See https://github.com/purescript/documentation/blob/master/errors/UnsupportedFFICommonJSImports.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/UnsupportedFFICommonJSImports1.purs b/tests/purs/failing/UnsupportedFFICommonJSImports1.purs new file mode 100644 index 0000000000..85e64dc9f3 --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSImports1.purs @@ -0,0 +1,5 @@ +-- @shouldFailWith UnsupportedFFICommonJSImports +module Main where + +foreign import yes :: Boolean +foreign import no :: Boolean diff --git a/tests/purs/failing/UnsupportedFFICommonJSImports2.js b/tests/purs/failing/UnsupportedFFICommonJSImports2.js new file mode 100644 index 0000000000..7d4b8973b5 --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSImports2.js @@ -0,0 +1,5 @@ +import { yes } from "some ES module"; +var cjsImports = require("some CJS module"); + +exports.yes = yes; +exports.no = cjsImports.no; diff --git a/tests/purs/failing/UnsupportedFFICommonJSImports2.out b/tests/purs/failing/UnsupportedFFICommonJSImports2.out new file mode 100644 index 0000000000..9be6007f69 --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSImports2.out @@ -0,0 +1,12 @@ +Error found: +at tests/purs/failing/UnsupportedFFICommonJSImports2.purs:2:1 - 5:29 (line 2, column 1 - line 5, column 29) + + The following CommonJS imports are no supported in the ES foreign module for module Main: + + some CJS module + + + +See https://github.com/purescript/documentation/blob/master/errors/UnsupportedFFICommonJSImports.md for more information, +or to contribute content related to this error. + diff --git a/tests/purs/failing/UnsupportedFFICommonJSImports2.purs b/tests/purs/failing/UnsupportedFFICommonJSImports2.purs new file mode 100644 index 0000000000..85e64dc9f3 --- /dev/null +++ b/tests/purs/failing/UnsupportedFFICommonJSImports2.purs @@ -0,0 +1,5 @@ +-- @shouldFailWith UnsupportedFFICommonJSImports +module Main where + +foreign import yes :: Boolean +foreign import no :: Boolean From c56d3f5b7a72f07b20263505b02fc4b30accfd67 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 18:41:37 +0100 Subject: [PATCH 24/62] Deprecate CommonJS foreign modules --- src/Language/PureScript/Errors.hs | 7 +++++++ src/Language/PureScript/Make/Actions.hs | 1 + tests/purs/warning/DeprecatedFFICommonJSModule.js | 4 ++++ tests/purs/warning/DeprecatedFFICommonJSModule.out | 13 +++++++++++++ tests/purs/warning/DeprecatedFFICommonJSModule.purs | 5 +++++ 5 files changed, 30 insertions(+) create mode 100644 tests/purs/warning/DeprecatedFFICommonJSModule.js create mode 100644 tests/purs/warning/DeprecatedFFICommonJSModule.out create mode 100644 tests/purs/warning/DeprecatedFFICommonJSModule.purs diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 0749ae43dd..5bc35e635a 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -65,6 +65,7 @@ data SimpleErrorMessage | UnusedFFIImplementations ModuleName [Ident] | InvalidFFIIdentifier ModuleName Text | DeprecatedFFIPrime ModuleName Text + | DeprecatedFFICommonJSModule ModuleName FilePath | DeprecatedFFIDefaultCommonJSExport ModuleName | UnsupportedFFICommonJSExports ModuleName [Text] | UnsupportedFFICommonJSImports ModuleName [Text] @@ -238,6 +239,7 @@ errorCode em = case unwrapErrorMessage em of UnusedFFIImplementations{} -> "UnusedFFIImplementations" InvalidFFIIdentifier{} -> "InvalidFFIIdentifier" DeprecatedFFIPrime{} -> "DeprecatedFFIPrime" + DeprecatedFFICommonJSModule {} -> "DeprecatedFFICommonJSModule" DeprecatedFFIDefaultCommonJSExport {} -> "DeprecatedFFIDefaultCommonJSExport" UnsupportedFFICommonJSExports {} -> "UnsupportedFFICommonJSExports" UnsupportedFFICommonJSImports {} -> "UnsupportedFFICommonJSImports" @@ -705,6 +707,11 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl , line $ "Primes are not allowed in identifiers exported from FFI modules." ] ] + renderSimpleErrorMessage (DeprecatedFFICommonJSModule mn path) = + paras [ line $ "A CommonJS foreign module implementation was provided for module " <> markCode (runModuleName mn) <> ": " + , indent . lineS $ path + , line $ "CommonJS foreign modules are deprecated and won't be supported in the future." + ] renderSimpleErrorMessage (DeprecatedFFIDefaultCommonJSExport mn) = paras [ line $ "In the FFI module for " <> markCode (runModuleName mn) <> ":" , indent . paras $ diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 5a08b1e4cc..a236f29dd1 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -257,6 +257,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = case foreignModuleType of ESModule -> copyFile path (outputFilename mn "foreign.js") CJSModule -> do + tell $ errorMessage' (CF.moduleSourceSpan m) $ DeprecatedFFICommonJSModule mn path copyFile path (outputFilename mn "foreign.cjs") writeESForeignModuleWrapper mn foreignIdents diff --git a/tests/purs/warning/DeprecatedFFICommonJSModule.js b/tests/purs/warning/DeprecatedFFICommonJSModule.js new file mode 100644 index 0000000000..45e5121ffc --- /dev/null +++ b/tests/purs/warning/DeprecatedFFICommonJSModule.js @@ -0,0 +1,4 @@ +"use strict"; + +exports.yes = true; +exports.no = true; diff --git a/tests/purs/warning/DeprecatedFFICommonJSModule.out b/tests/purs/warning/DeprecatedFFICommonJSModule.out new file mode 100644 index 0000000000..38fb74714a --- /dev/null +++ b/tests/purs/warning/DeprecatedFFICommonJSModule.out @@ -0,0 +1,13 @@ +Warning found: +at tests/purs/warning/DeprecatedFFICommonJSModule.purs:2:1 - 5:29 (line 2, column 1 - line 5, column 29) + + A CommonJS foreign module implementation was provided for module Main: + + tests/purs/warning/DeprecatedFFICommonJSModule.js + + CommonJS foreign modules are deprecated and won't be supported in the future. + + +See https://github.com/purescript/documentation/blob/master/errors/DeprecatedFFICommonJSModule.md for more information, +or to contribute content related to this warning. + diff --git a/tests/purs/warning/DeprecatedFFICommonJSModule.purs b/tests/purs/warning/DeprecatedFFICommonJSModule.purs new file mode 100644 index 0000000000..b91bed426b --- /dev/null +++ b/tests/purs/warning/DeprecatedFFICommonJSModule.purs @@ -0,0 +1,5 @@ +-- @shouldWarnWith DeprecatedFFICommonJSModule +module Main where + +foreign import yes :: Boolean +foreign import no :: Boolean From 94af221cd9e05392d5ba3be502cbbf948f51bdac Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 20 Mar 2021 19:35:58 +0100 Subject: [PATCH 25/62] Convert CommonJS foreign modules in tests to ES modules --- tests/TestMake.hs | 4 ++-- tests/purs/bundle/3551/ModuleWithDeadCode.js | 6 ++---- tests/purs/bundle/3727.js | 6 ++---- tests/purs/bundle/ObjectShorthand.js | 10 ++++------ tests/purs/failing/MissingFFIImplementations.js | 2 +- tests/purs/passing/EffFn.js | 2 +- tests/purs/passing/FunWithFunDeps.js | 10 +++++----- tests/purs/passing/PolyLabels.js | 6 ++---- tests/purs/passing/ReExportsExported.js | 4 +--- tests/purs/passing/RowUnion.js | 4 +--- .../warning/DeprecatedConstraintInForeignImport.js | 2 +- tests/purs/warning/UnnecessaryFFIModule.js | 2 +- tests/purs/warning/UnusedFFIImplementations.js | 4 ++-- tests/support/pscide/src/RebuildSpecWithForeign.js | 2 +- 14 files changed, 26 insertions(+), 38 deletions(-) diff --git a/tests/TestMake.hs b/tests/TestMake.hs index dadee27fd7..e73e95a35e 100644 --- a/tests/TestMake.hs +++ b/tests/TestMake.hs @@ -91,7 +91,7 @@ spec = do writeFileWithTimestamp modulePath timestampA moduleContent compile [modulePath] `shouldReturn` moduleNames ["Module"] - writeFileWithTimestamp moduleFFIPath timestampB "exports.bar = 1;\n" + writeFileWithTimestamp moduleFFIPath timestampB "export var bar = 1;\n" compile [modulePath] `shouldReturn` moduleNames ["Module"] it "recompiles if an FFI file was removed" $ do @@ -101,7 +101,7 @@ spec = do moduleContent = "module Module where\nfoo = 0\n" writeFileWithTimestamp modulePath timestampA moduleContent - writeFileWithTimestamp moduleFFIPath timestampB "exports.bar = 1;\n" + writeFileWithTimestamp moduleFFIPath timestampB "export var bar = 1;\n" compile [modulePath] `shouldReturn` moduleNames ["Module"] removeFile moduleFFIPath diff --git a/tests/purs/bundle/3551/ModuleWithDeadCode.js b/tests/purs/bundle/3551/ModuleWithDeadCode.js index ab7965286f..faa66d6178 100644 --- a/tests/purs/bundle/3551/ModuleWithDeadCode.js +++ b/tests/purs/bundle/3551/ModuleWithDeadCode.js @@ -1,10 +1,8 @@ -"use strict"; - -var fs = require('fs'); +import * as fs from 'fs'; var source = fs.readFileSync(__filename, 'utf-8'); -exports.results = { +export var results = { fooIsNotEliminated: /^ *var foo =/m.test(source), barIsExported: /^ *exports\["bar"\] =/m.test(source), barIsNotEliminated: /^ *var bar =/m.test(source), diff --git a/tests/purs/bundle/3727.js b/tests/purs/bundle/3727.js index 02e18d2982..d2148a0750 100644 --- a/tests/purs/bundle/3727.js +++ b/tests/purs/bundle/3727.js @@ -1,4 +1,2 @@ -'use strict'; - -exports.foo = 1; -exports.bar = exports.foo; +export var foo = 1; +export { foo as bar }; diff --git a/tests/purs/bundle/ObjectShorthand.js b/tests/purs/bundle/ObjectShorthand.js index 156ff0c9da..225e8bf063 100644 --- a/tests/purs/bundle/ObjectShorthand.js +++ b/tests/purs/bundle/ObjectShorthand.js @@ -1,15 +1,13 @@ -"use strict"; - var foo = 1; -exports.bar = { foo }; +export var bar = { foo }; var baz = 2; -exports.quux = function(baz) { +export var quux = function(baz) { return { baz }; }; -var fs = require('fs'); +import * as fs from 'fs'; var source = fs.readFileSync(__filename, 'utf-8'); -exports.bazIsEliminated = !/^ *var baz =/m.test(source); +export var bazIsEliminated = !/^ *var baz =/m.test(source); diff --git a/tests/purs/failing/MissingFFIImplementations.js b/tests/purs/failing/MissingFFIImplementations.js index d29ee4cff9..ccb7243f7e 100644 --- a/tests/purs/failing/MissingFFIImplementations.js +++ b/tests/purs/failing/MissingFFIImplementations.js @@ -1 +1 @@ -exports.yes = true; +export var yes = true; diff --git a/tests/purs/passing/EffFn.js b/tests/purs/passing/EffFn.js index b645b0527e..8360cbe7cd 100644 --- a/tests/purs/passing/EffFn.js +++ b/tests/purs/passing/EffFn.js @@ -1 +1 @@ -exports.add3 = function (a,b,c) { return a + b + c; }; \ No newline at end of file +export var add3 = function (a,b,c) { return a + b + c; }; diff --git a/tests/purs/passing/FunWithFunDeps.js b/tests/purs/passing/FunWithFunDeps.js index dea73d18fe..171f389176 100644 --- a/tests/purs/passing/FunWithFunDeps.js +++ b/tests/purs/passing/FunWithFunDeps.js @@ -1,15 +1,15 @@ //: forall e. FVect Z e -exports.fnil = []; +export var fnil = []; //: forall n e. e -> FVect n e -> FVect (S n) e -exports.fcons = function (hd) { +export var fcons = function (hd) { return function (tl) { return [hd].concat(tl); }; }; -exports.fappend = function (dict) { +export var fappend = function (dict) { return function (left) { return function (right) { return left.concat(right); @@ -17,7 +17,7 @@ exports.fappend = function (dict) { }; }; -exports.fflatten = function (dict) { +export var fflatten = function (dict) { return function (v) { var accRef = []; for (var indexRef = 0; indexRef < v.length; indexRef += 1) { @@ -27,6 +27,6 @@ exports.fflatten = function (dict) { }; }; -exports.ftoArray = function (vect) { +export var ftoArray = function (vect) { return vect; }; diff --git a/tests/purs/passing/PolyLabels.js b/tests/purs/passing/PolyLabels.js index b9900e4d3b..115375cd48 100644 --- a/tests/purs/passing/PolyLabels.js +++ b/tests/purs/passing/PolyLabels.js @@ -1,12 +1,10 @@ -"use strict"; - -exports.unsafeGet = function (s) { +export var unsafeGet = function (s) { return function (o) { return o[s]; }; }; -exports.unsafeSet = function(s) { +export var unsafeSet = function (s) { return function(a) { return function (o) { var o1 = {}; diff --git a/tests/purs/passing/ReExportsExported.js b/tests/purs/passing/ReExportsExported.js index b73154be1e..5ca086e78a 100644 --- a/tests/purs/passing/ReExportsExported.js +++ b/tests/purs/passing/ReExportsExported.js @@ -1,4 +1,2 @@ -"use strict"; - // Import `A.a` which was re-exported from `B` and then again from `C` -exports.a = require('../C').a; +export { a } from '../C/index.js'; diff --git a/tests/purs/passing/RowUnion.js b/tests/purs/passing/RowUnion.js index c002b18f57..4f037587a2 100644 --- a/tests/purs/passing/RowUnion.js +++ b/tests/purs/passing/RowUnion.js @@ -1,6 +1,4 @@ -"use strict"; - -exports.merge = function (dict) { +export var merge = function (dict) { return function (l) { return function (r) { var o = {}; diff --git a/tests/purs/warning/DeprecatedConstraintInForeignImport.js b/tests/purs/warning/DeprecatedConstraintInForeignImport.js index 3be8843e1f..8e629a2a03 100644 --- a/tests/purs/warning/DeprecatedConstraintInForeignImport.js +++ b/tests/purs/warning/DeprecatedConstraintInForeignImport.js @@ -1,4 +1,4 @@ -exports.show = function (showDict) { +export var show = function (showDict) { return function (a) { return showDict.show(a); }; diff --git a/tests/purs/warning/UnnecessaryFFIModule.js b/tests/purs/warning/UnnecessaryFFIModule.js index 346c8e9012..bd1835d69d 100644 --- a/tests/purs/warning/UnnecessaryFFIModule.js +++ b/tests/purs/warning/UnnecessaryFFIModule.js @@ -1 +1 @@ -exports.out = null; +export var out = null; diff --git a/tests/purs/warning/UnusedFFIImplementations.js b/tests/purs/warning/UnusedFFIImplementations.js index d50f2e60a8..78ab638547 100644 --- a/tests/purs/warning/UnusedFFIImplementations.js +++ b/tests/purs/warning/UnusedFFIImplementations.js @@ -1,2 +1,2 @@ -exports.yes = true; -exports.no = false; +export var yes = true; +export var no = false; diff --git a/tests/support/pscide/src/RebuildSpecWithForeign.js b/tests/support/pscide/src/RebuildSpecWithForeign.js index 8ea453ff71..577e8a5d5d 100644 --- a/tests/support/pscide/src/RebuildSpecWithForeign.js +++ b/tests/support/pscide/src/RebuildSpecWithForeign.js @@ -1 +1 @@ -exports.f = 5; +export var f = 5; From 15ebf0ddb1c2a856ed33372b101357a0b34dff09 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sun, 21 Mar 2021 14:22:36 +0100 Subject: [PATCH 26/62] Don't optimize away dependencies of named ES exports of declarations --- src/Language/PureScript/Bundle.hs | 36 +++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 996464542d..ca074c645a 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -226,7 +226,7 @@ printErrorMessage UnsupportedImport = printErrorMessage UnsupportedExport = [ "An export was unsupported." , "Declarations can be exported as ES named exports:" - , " export decl" + , " export var decl" , "Existing identifiers can be exported as well:" , " export { name }" , "They can also be renamed on export:" @@ -458,10 +458,12 @@ toModule mids mid filename top = pure . ExportsList <$> exportSpecifiersList Nothing jsExportSpecifiers toModuleElements (JSModuleExportDeclaration _ jsExportDeclaration) | JSExport jsStatement _ <- jsExportDeclaration - = traverse (toExport' Nothing) (exportStatementIdentifiers jsStatement) >>= \exports -> - pure [ Other jsStatement - , ExportsList exports - ] + , Just (visibility, name, decl) <- matchInternalMember jsStatement + = pure [ Member jsStatement visibility name decl [] + , ExportsList [toRegularExport' name] + ] + toModuleElements (JSModuleExportDeclaration _ JSExport{}) + = err UnsupportedExport toModuleElements item@(JSModuleStatementListItem jsStatement) | Just (importName, importPath) <- matchRequire jsStatement @@ -518,10 +520,15 @@ toModule mids mid filename top (stringLiteral name) JSNoAnnot) | otherwise = err UnsupportedExport toExport Nothing name as = - pure (RegularExport name, as, JSIdentifier sp name, []) + pure $ toRegularExport name as toExport' from name = toExport from name name + toRegularExport name as = + (RegularExport name, as, JSIdentifier sp name, []) + + toRegularExport' name = toRegularExport name name + data ForeignModuleExports = ForeignModuleExports { cjsExports :: [String] @@ -633,16 +640,23 @@ matchRequire stmt -- Matches JS member declarations. matchMember :: JSStatement -> Maybe (Visibility, String, JSExpression) matchMember stmt + | Just (visibility, name, decl) <- matchInternalMember stmt + = pure (visibility, name, decl) + -- exports.foo = expr; exports["foo"] = expr; + | JSAssignStatement e (JSAssign _) decl _ <- stmt + , Just name <- exportsAccessor e + = Just (Public, name, decl) + | otherwise + = Nothing + +matchInternalMember :: JSStatement -> Maybe (Visibility, String, JSExpression) +matchInternalMember stmt -- var foo = expr; | JSVariable _ jsInit _ <- stmt , [JSVarInitExpression var varInit] <- fromCommaList jsInit , JSIdentifier _ name <- var , JSVarInit _ decl <- varInit - = Just (Internal, name, decl) - -- exports.foo = expr; exports["foo"] = expr; - | JSAssignStatement e (JSAssign _) decl _ <- stmt - , Just name <- exportsAccessor e - = Just (Public, name, decl) + = pure (Internal, name, decl) | otherwise = Nothing From 8f19b7e8dfa745b1b19b8ebd1c583c051ddfbfd4 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 3 Apr 2021 16:38:01 +0200 Subject: [PATCH 27/62] fixup! Import CommonJS foreign modules through an ES module wrapper --- purescript.cabal | 2 - src/Language/JavaScript/AST/JSCommaList.hs | 19 --------- src/Language/PureScript/Bundle.hs | 49 +++++++++++++++------- src/Language/PureScript/Make/Actions.hs | 29 ++++++------- 4 files changed, 49 insertions(+), 50 deletions(-) delete mode 100644 src/Language/JavaScript/AST/JSCommaList.hs diff --git a/purescript.cabal b/purescript.cabal index 6c8be98e3c..ded50103e1 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -121,7 +121,6 @@ common defaults array >=0.5.3.0 && <0.6, base >=4.12.0.0 && <4.13, base-compat >=0.10.5 && <0.11, - blaze-builder >=0.2 && <0.5, blaze-html >=0.9.1.1 && <0.10, bower-json >=1.0.0.1 && <1.1, boxes >=0.1.5 && <0.2, @@ -184,7 +183,6 @@ library hs-source-dirs: src exposed-modules: Control.Monad.Logger - Language.JavaScript.AST.JSCommaList Language.PureScript Language.PureScript.Bundle Language.PureScript.CodeGen diff --git a/src/Language/JavaScript/AST/JSCommaList.hs b/src/Language/JavaScript/AST/JSCommaList.hs deleted file mode 100644 index df7c982f14..0000000000 --- a/src/Language/JavaScript/AST/JSCommaList.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Language.JavaScript.AST.JSCommaList where - -import Prelude -import Language.JavaScript.Parser.AST (JSCommaList(JSLNil, JSLOne, JSLCons), JSAnnot(JSNoAnnot)) - -fromCommaList :: JSCommaList a -> [a] -fromCommaList JSLNil = [] -fromCommaList (JSLOne x) = [x] -fromCommaList (JSLCons l _ x) = fromCommaList l ++ [x] - --- comma lists are reverse-consed -toCommaList :: [a] -> JSCommaList a -toCommaList [] = JSLNil -toCommaList [x] = JSLOne x -toCommaList l = go $ reverse l - where - go [x] = JSLOne x - go (h:t)= JSLCons (go t) JSNoAnnot h - go [] = error "Invalid case in comma-list" diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index ca074c645a..0fdcbb436b 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -42,7 +42,6 @@ import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Lazy as LT -import Language.JavaScript.AST.JSCommaList (fromCommaList, toCommaList) import Language.JavaScript.Parser import Language.JavaScript.Parser.AST import Language.JavaScript.Process.Minify @@ -341,7 +340,7 @@ withDeps (Module modulePath fn es) = Module modulePath fn (map expandDeps es) in (map (\name -> (m, name, Internal)) shorthandNames, bn) toReference (JSFunctionExpression _ _ _ params _ _) bn - = ([], bn \\ (mapMaybe unIdentifier $ fromCommaList params)) + = ([], bn \\ (mapMaybe unIdentifier $ commaList params)) toReference e bn | Just nm <- exportsAccessor e -- exports.foo means there's a dependency on the public member "foo" of @@ -388,9 +387,14 @@ strValue str = go $ drop 1 str go (x : xs) = x : go xs go "" = "" +commaList :: JSCommaList a -> [a] +commaList JSLNil = [] +commaList (JSLOne x) = [x] +commaList (JSLCons l _ x) = commaList l ++ [x] + trailingCommaList :: JSCommaTrailingList a -> [a] -trailingCommaList (JSCTLComma l _) = fromCommaList l -trailingCommaList (JSCTLNone l) = fromCommaList l +trailingCommaList (JSCTLComma l _) = commaList l +trailingCommaList (JSCTLNone l) = commaList l identName :: JSIdent -> Maybe String identName (JSIdentName _ ident) = Just ident @@ -412,7 +416,7 @@ exportStatementIdentifiers (JSGenerator _ _ jsIdent _ _ _ _ _) = exportStatementIdentifiers _ = [] varNames :: JSCommaList JSExpression -> [String] -varNames = mapMaybe varName . fromCommaList +varNames = mapMaybe varName . commaList where varName (JSVarInitExpression (JSIdentifier _ ident) _) = Just ident varName _ = Nothing @@ -429,6 +433,12 @@ stringLiteral s = JSStringLiteral JSNoAnnot $ "\"" ++ s ++ "\"" -- Other constructor. toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> Maybe FilePath -> JSAST -> m Module toModule mids mid filename top + | JSAstModule jsModuleItems _ <- top + , JSModuleImportDeclaration _ jsImportDeclaration : _ <- jsModuleItems + , JSImportDeclaration JSImportClauseDefault{} jsFromClause _ <- jsImportDeclaration + , JSFromClause _ _ importPath <- jsFromClause + , "./foreign.cjs" <- strValue importPath + = pure $ Module mid filename [] | JSAstModule jsModuleItems _ <- top = Module mid filename . mconcat <$> traverse toModuleElements jsModuleItems | otherwise = err InvalidTopLevel where @@ -499,9 +509,8 @@ toModule mids mid filename top toModuleElements (JSModuleStatementListItem other) = pure [Other other] - exportSpecifiersList (Just "./foreign.cjs") = const $ pure [] exportSpecifiersList from = - fmap catMaybes . traverse (exportSpecifier from) . fromCommaList + fmap catMaybes . traverse (exportSpecifier from) . commaList exportSpecifier from (JSExportSpecifier jsIdent) = traverse (toExport' from) $ identName jsIdent @@ -583,7 +592,7 @@ getExportedIdentifiers mname top exportStatementIdentifiers jsStatement exportClauseIdentifiers (JSExportClause _ jsExportsSpecifiers _) = - mapMaybe exportSpecifierName $ fromCommaList jsExportsSpecifiers + mapMaybe exportSpecifierName $ commaList jsExportsSpecifiers exportSpecifierName (JSExportSpecifier jsIdent) = identName jsIdent exportSpecifierName (JSExportSpecifierAs _ _ jsIdentAs) = identName jsIdentAs @@ -627,12 +636,12 @@ getImportedModules mname top matchRequire :: JSStatement -> Maybe (String, String) matchRequire stmt | JSVariable _ jsInit _ <- stmt - , [JSVarInitExpression var varInit] <- fromCommaList jsInit + , [JSVarInitExpression var varInit] <- commaList jsInit , JSIdentifier _ importName <- var , JSVarInit _ jsInitEx <- varInit , JSMemberExpression req _ argsE _ <- jsInitEx , JSIdentifier _ "require" <- req - , [ Just importPath ] <- map fromStringLiteral (fromCommaList argsE) + , [ Just importPath ] <- map fromStringLiteral (commaList argsE) = Just (importName, importPath) | otherwise = Nothing @@ -653,7 +662,7 @@ matchInternalMember :: JSStatement -> Maybe (Visibility, String, JSExpression) matchInternalMember stmt -- var foo = expr; | JSVariable _ jsInit _ <- stmt - , [JSVarInitExpression var varInit] <- fromCommaList jsInit + , [JSVarInitExpression var varInit] <- commaList jsInit , JSIdentifier _ name <- var , JSVarInit _ decl <- varInit = pure (Internal, name, decl) @@ -872,7 +881,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o declToJS (Import _ nm req) = withLength [ JSVariable lfsp - (toCommaList [ + (cList [ JSVarInitExpression (JSIdentifier sp nm) (JSVarInit sp $ either require (innerModuleReference sp . moduleName) req ) ]) (JSSemi JSNoAnnot) @@ -890,6 +899,16 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o val (JSSemi JSNoAnnot) + -- comma lists are reverse-consed + cList :: [a] -> JSCommaList a + cList [] = JSLNil + cList [x] = JSLOne x + cList l = go $ reverse l + where + go [x] = JSLOne x + go (h:t)= JSLCons (go t) JSNoAnnot h + go [] = error "Invalid case in comma-list" + indent :: [JSStatement] -> [JSStatement] indent = everywhere (mkT squash) where @@ -906,7 +925,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o prelude :: JSStatement prelude = JSVariable (JSAnnot tokenPosnEmpty [ CommentA tokenPosnEmpty $ "// Generated by purs bundle " ++ showVersion Paths.version , WhiteSpace tokenPosnEmpty "\n" ]) - (toCommaList [ + (cList [ JSVarInitExpression (JSIdentifier sp optionsNamespace) (JSVarInit sp (emptyObj sp)) ]) (JSSemi JSNoAnnot) @@ -914,7 +933,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o require :: String -> JSExpression require mn = JSMemberExpression (JSIdentifier JSNoAnnot "require") JSNoAnnot - (toCommaList [ stringLiteral mn ]) JSNoAnnot + (cList [ stringLiteral mn ]) JSNoAnnot moduleReference :: JSAnnot -> String -> JSExpression moduleReference a mn = @@ -983,7 +1002,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o [JSMethodCall (JSMemberDot (moduleReference lf mn) JSNoAnnot (JSIdentifier JSNoAnnot "main")) - JSNoAnnot (toCommaList []) JSNoAnnot (JSSemi JSNoAnnot)] + JSNoAnnot (cList []) JSNoAnnot (JSSemi JSNoAnnot)] lf :: JSAnnot lf = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ] diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index a236f29dd1..0205c4b3a1 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -11,7 +11,7 @@ module Language.PureScript.Make.Actions import Prelude -import Blaze.ByteString.Builder (toByteString) +import Control.Arrow ((&&&)) import Control.Monad hiding (sequence) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.IO.Class @@ -32,11 +32,8 @@ 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.AST.JSCommaList as JSAST (toCommaList) import qualified Language.JavaScript.Parser as JS import Language.PureScript.AST -import qualified Language.JavaScript.Parser.AST as JSAST -import Language.JavaScript.Pretty.Printer (renderJS) import qualified Language.PureScript.Bundle as Bundle import qualified Language.PureScript.CodeGen.JS as J import Language.PureScript.CodeGen.JS.Printer @@ -266,16 +263,20 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = writeESForeignModuleWrapper :: ModuleName -> S.Set Ident -> Make () writeESForeignModuleWrapper mn idents = - writeTextFile (outputFilename mn "foreign.js") . toByteString . renderJS $ - JSAST.JSAstModule - [ JSAST.JSModuleExportDeclaration JSAST.JSNoAnnot - (JSAST.JSExportFrom - (JSAST.JSExportClause JSAST.JSAnnotSpace - (JSAST.toCommaList $ JSAST.JSExportSpecifier . JSAST.JSIdentName JSAST.JSAnnotSpace . T.unpack . runIdent <$> S.toList idents) - JSAST.JSAnnotSpace) - (JSAST.JSFromClause JSAST.JSAnnotSpace JSAST.JSAnnotSpace "\"./foreign.cjs\"") - (JSAST.JSSemi JSAST.JSNoAnnot)) - ] JSAST.JSNoAnnot + writeTextFile (outputFilename mn "foreign.js") wrapper + where + xs = (J.identToJs &&& runIdent) <$> S.toList idents + wrapper = TE.encodeUtf8 . T.intercalate "\n" $ + "import $foreign from \"./foreign.cjs\";" : + fmap (uncurry toLocalDeclaration) xs ++ + [ "export { " <> T.intercalate ", " (uncurry toNamedExport <$> xs) <> " };" + , "" + ] + toLocalDeclaration local exported = + "var " <> local <> " = $foreign." <> exported <> ";" + toNamedExport local exported + | local == exported = local + | otherwise = local <> " as " <> exported genSourceMap :: String -> String -> Int -> [SMap] -> Make () genSourceMap dir mapFile extraLines mappings = do From 7727c986e29820954be0fb8d3d139186dd9993d8 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 3 Apr 2021 16:39:50 +0200 Subject: [PATCH 28/62] fixup! Don't optimize away dependencies of named ES exports of declarations --- src/Language/PureScript/Bundle.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 0fdcbb436b..aceb289d88 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -468,8 +468,8 @@ toModule mids mid filename top = pure . ExportsList <$> exportSpecifiersList Nothing jsExportSpecifiers toModuleElements (JSModuleExportDeclaration _ jsExportDeclaration) | JSExport jsStatement _ <- jsExportDeclaration - , Just (visibility, name, decl) <- matchInternalMember jsStatement - = pure [ Member jsStatement visibility name decl [] + , Just (name, decl) <- matchInternalMember jsStatement + = pure [ Member jsStatement Internal name decl [] , ExportsList [toRegularExport' name] ] toModuleElements (JSModuleExportDeclaration _ JSExport{}) @@ -649,8 +649,8 @@ matchRequire stmt -- Matches JS member declarations. matchMember :: JSStatement -> Maybe (Visibility, String, JSExpression) matchMember stmt - | Just (visibility, name, decl) <- matchInternalMember stmt - = pure (visibility, name, decl) + | Just (name, decl) <- matchInternalMember stmt + = pure (Internal, name, decl) -- exports.foo = expr; exports["foo"] = expr; | JSAssignStatement e (JSAssign _) decl _ <- stmt , Just name <- exportsAccessor e @@ -658,14 +658,14 @@ matchMember stmt | otherwise = Nothing -matchInternalMember :: JSStatement -> Maybe (Visibility, String, JSExpression) +matchInternalMember :: JSStatement -> Maybe (String, JSExpression) matchInternalMember stmt -- var foo = expr; | JSVariable _ jsInit _ <- stmt , [JSVarInitExpression var varInit] <- commaList jsInit , JSIdentifier _ name <- var , JSVarInit _ decl <- varInit - = pure (Internal, name, decl) + = pure (name, decl) | otherwise = Nothing From bd456029e95fcd6027d6942611c7d4dac15214d5 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Mon, 21 Jun 2021 20:25:28 +0200 Subject: [PATCH 29/62] Revert "Disallow CommonJS exports named `default`" This reverts commit 4976eee1599300511236b9a491b09ecb332cf852. --- src/Language/PureScript/Errors.hs | 8 -------- src/Language/PureScript/Make/Actions.hs | 7 ------- .../failing/DeprecatedFFIDefaultCommonJSExport.js | 1 - .../failing/DeprecatedFFIDefaultCommonJSExport.out | 12 ------------ .../failing/DeprecatedFFIDefaultCommonJSExport.purs | 4 ---- 5 files changed, 32 deletions(-) delete mode 100644 tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.js delete mode 100644 tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.out delete mode 100644 tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index 5bc35e635a..35e3558289 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -66,7 +66,6 @@ data SimpleErrorMessage | InvalidFFIIdentifier ModuleName Text | DeprecatedFFIPrime ModuleName Text | DeprecatedFFICommonJSModule ModuleName FilePath - | DeprecatedFFIDefaultCommonJSExport ModuleName | UnsupportedFFICommonJSExports ModuleName [Text] | UnsupportedFFICommonJSImports ModuleName [Text] | FileIOError Text IOError -- ^ A description of what we were trying to do, and the error which occurred @@ -240,7 +239,6 @@ errorCode em = case unwrapErrorMessage em of InvalidFFIIdentifier{} -> "InvalidFFIIdentifier" DeprecatedFFIPrime{} -> "DeprecatedFFIPrime" DeprecatedFFICommonJSModule {} -> "DeprecatedFFICommonJSModule" - DeprecatedFFIDefaultCommonJSExport {} -> "DeprecatedFFIDefaultCommonJSExport" UnsupportedFFICommonJSExports {} -> "UnsupportedFFICommonJSExports" UnsupportedFFICommonJSImports {} -> "UnsupportedFFICommonJSImports" FileIOError{} -> "FileIOError" @@ -712,12 +710,6 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl , indent . lineS $ path , line $ "CommonJS foreign modules are deprecated and won't be supported in the future." ] - renderSimpleErrorMessage (DeprecatedFFIDefaultCommonJSExport mn) = - paras [ line $ "In the FFI module for " <> markCode (runModuleName mn) <> ":" - , indent . paras $ - [ line $ "CommonJS exports named " <> markCode "default" <> " are not allowed." - ] - ] renderSimpleErrorMessage (UnsupportedFFICommonJSExports mn idents) = paras [ line $ "The following CommonJS exports are not supported in the ES foreign module for module " <> markCode (runModuleName mn) <> ": " , indent . paras $ map line idents diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 0205c4b3a1..f7d826c017 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -337,9 +337,6 @@ checkForeignDecls m path = do unless (null deprecatedFFI) $ errorDeprecatedForeignPrimes deprecatedFFI - when (elem "default" cjsExports) $ - errorDeprecatedFFIDefaultCJSExport - pure (CJSModule, cjsExports) | otherwise -> do unless (null cjsImports) $ @@ -388,10 +385,6 @@ checkForeignDecls m path = do errorDeprecatedForeignPrimes = throwError . mconcat . map (errorMessage' modSS . DeprecatedFFIPrime mname . T.pack) - errorDeprecatedFFIDefaultCJSExport :: Make a - errorDeprecatedFFIDefaultCJSExport = - throwError . errorMessage' modSS $ DeprecatedFFIDefaultCommonJSExport mname - errorUnsupportedFFICommonJSExports :: [String] -> Make a errorUnsupportedFFICommonJSExports = throwError . errorMessage' modSS . UnsupportedFFICommonJSExports mname . map T.pack diff --git a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.js b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.js deleted file mode 100644 index 8f35a10f24..0000000000 --- a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.js +++ /dev/null @@ -1 +0,0 @@ -exports.default = undefined; diff --git a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.out b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.out deleted file mode 100644 index 943c7dc313..0000000000 --- a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.out +++ /dev/null @@ -1,12 +0,0 @@ -Error found: -at tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs:2:1 - 4:38 (line 2, column 1 - line 4, column 38) - - In the FFI module for Main: - - CommonJS exports named default are not allowed. - - - -See https://github.com/purescript/documentation/blob/master/errors/DeprecatedFFIDefaultCommonJSExport.md for more information, -or to contribute content related to this error. - diff --git a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs b/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs deleted file mode 100644 index ef70f75ac8..0000000000 --- a/tests/purs/failing/DeprecatedFFIDefaultCommonJSExport.purs +++ /dev/null @@ -1,4 +0,0 @@ --- @shouldFailWith DeprecatedFFIDefaultCommonJSExport -module Main where - -foreign import default :: forall a. a From ca94c4bb8b9aa36f246c6b2835dec252ddeef178 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Mon, 21 Jun 2021 21:17:14 +0200 Subject: [PATCH 30/62] Add tests for foreign CommonJS exports named default --- tests/purs/passing/FFIDefaultCJSExport.js | 1 + tests/purs/passing/FFIDefaultCJSExport.purs | 7 +++++++ 2 files changed, 8 insertions(+) create mode 100644 tests/purs/passing/FFIDefaultCJSExport.js create mode 100644 tests/purs/passing/FFIDefaultCJSExport.purs diff --git a/tests/purs/passing/FFIDefaultCJSExport.js b/tests/purs/passing/FFIDefaultCJSExport.js new file mode 100644 index 0000000000..873a59a12b --- /dev/null +++ b/tests/purs/passing/FFIDefaultCJSExport.js @@ -0,0 +1 @@ +exports.default = "Done"; diff --git a/tests/purs/passing/FFIDefaultCJSExport.purs b/tests/purs/passing/FFIDefaultCJSExport.purs new file mode 100644 index 0000000000..1d084b6d8d --- /dev/null +++ b/tests/purs/passing/FFIDefaultCJSExport.purs @@ -0,0 +1,7 @@ +module Main where + +import Effect.Console (log) + +foreign import default :: String + +main = log default From ec4dce59153a8d48ea7100d4550fed1576cbf10a Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Fri, 2 Jul 2021 19:15:47 +0200 Subject: [PATCH 31/62] Extend support to Node.js v12.0.0 with --experimental-modules --- .travis.yml | 2 +- app/Command/REPL.hs | 10 ++--- src/Language/PureScript/Interactive/IO.hs | 45 ++++++++++++++++++++--- tests/TestBundle.hs | 13 +++---- tests/TestCompiler.hs | 11 +++--- tests/TestPsci/TestEnv.hs | 10 ++--- tests/TestUtils.hs | 16 +++----- 7 files changed, 65 insertions(+), 42 deletions(-) diff --git a/.travis.yml b/.travis.yml index bc82733e74..66e0280110 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,6 @@ language: node_js node_js: - - "14" + - "12" branches: # Only build master and tagged versions, i.e. not feature branches; feature # branches already get built after opening a pull request. diff --git a/app/Command/REPL.hs b/app/Command/REPL.hs index 9597a9538e..8a37df57c8 100644 --- a/app/Command/REPL.hs +++ b/app/Command/REPL.hs @@ -52,7 +52,6 @@ import System.Exit import System.Directory (doesFileExist, getCurrentDirectory) import System.FilePath (()) import qualified System.FilePath.Glob as Glob -import System.Process (readProcessWithExitCode) import qualified Data.ByteString.Lazy.UTF8 as U -- | Command line options @@ -288,12 +287,11 @@ nodeBackend nodePath nodeArgs = Backend setup eval reload shutdown eval :: () -> String -> IO () eval _ _ = do writeFile indexFile "import('./$PSCI/index.js').then(({ $main }) => $main());" - process <- maybe findNodeProcess (pure . pure) nodePath - result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process + result <- readNodeProcessWithExitCode nodePath (nodeArgs ++ [indexFile]) "" case result of - Just (ExitSuccess, out, _) -> putStrLn out - Just (ExitFailure _, _, err) -> putStrLn err - Nothing -> putStrLn "Could not find node.js. Do you have node.js installed and available in your PATH?" + Right (ExitSuccess, out, _) -> putStrLn out + Right (ExitFailure _, _, err) -> putStrLn err + Left err -> putStrLn err reload :: () -> IO () reload _ = return () diff --git a/src/Language/PureScript/Interactive/IO.hs b/src/Language/PureScript/Interactive/IO.hs index 92a2e8dc64..3eab68f020 100644 --- a/src/Language/PureScript/Interactive/IO.hs +++ b/src/Language/PureScript/Interactive/IO.hs @@ -1,13 +1,23 @@ -module Language.PureScript.Interactive.IO (findNodeProcess, getHistoryFilename) where +{-# LANGUAGE TypeApplications #-} + +module Language.PureScript.Interactive.IO (findNodeProcess, readNodeProcessWithExitCode, getHistoryFilename) where import Prelude.Compat -import Control.Monad (msum) +import Control.Monad (msum, void) +import Control.Monad.Error.Class (throwError) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT(..), runExceptT) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) +import Data.Functor ((<&>)) import System.Directory (XdgDirectory (..), createDirectoryIfMissing, getAppUserDataDirectory, getXdgDirectory, findExecutable, doesFileExist) +import System.Exit (ExitCode(ExitFailure, ExitSuccess)) import System.FilePath (takeDirectory, ()) +import System.Process (readProcessWithExitCode) +import Text.Parsec ((), many1, parse, sepBy) +import Text.Parsec.Char (char, digit) mkdirp :: FilePath -> IO () mkdirp = createDirectoryIfMissing True . takeDirectory @@ -21,9 +31,34 @@ onFirstFileMatching f pathVariants = runMaybeT . msum $ map (MaybeT . f) pathVar -- Locates the node executable. -- Checks for either @nodejs@ or @node@. -- -findNodeProcess :: IO (Maybe String) -findNodeProcess = onFirstFileMatching findExecutable names - where names = ["nodejs", "node"] +findNodeProcess :: IO (Either String String) +findNodeProcess = onFirstFileMatching findExecutable ["nodejs", "node"] <&> + maybe (throwError "Could not find node.js. Do you have node.js installed and available in your PATH?") pure + +findNodeVersion :: String -> IO (Maybe String) +findNodeVersion node = do + result <- readProcessWithExitCode node ["--version"] "" + return $ case result of + (ExitSuccess, version, _) -> Just version + (ExitFailure _, _, _) -> Nothing + +readNodeProcessWithExitCode :: Maybe FilePath -> [String] -> String -> IO (Either String (ExitCode, String, String)) +readNodeProcessWithExitCode nodePath nodeArgs stdin = runExceptT $ do + process <- maybe (ExceptT findNodeProcess) pure nodePath + (_, minor, _) <- lift (findNodeVersion process) >>= \case + Nothing -> throwError "Could not find node.js version." + Just version -> do + let semver = do + void $ char 'v' + major : minor : patch : _ <- fmap (read @Int) (many1 digit) `sepBy` void (char '.') + pure (major, minor, patch) + case parse (semver "Could not parse node.js version.") "" version of + Left err -> throwError $ show err + Right (major, minor, patch) + | major < 12 -> throwError "Unsupported node.js version." + | otherwise -> pure (major, minor, patch) + let nodeArgs' = if minor < 7 then "--experimental-modules" : nodeArgs else nodeArgs + lift $ readProcessWithExitCode process nodeArgs' stdin -- | -- Grabs the filename where the history is stored. diff --git a/tests/TestBundle.hs b/tests/TestBundle.hs index 31b8452aee..736cb3d008 100644 --- a/tests/TestBundle.hs +++ b/tests/TestBundle.hs @@ -10,7 +10,8 @@ import Prelude () import Prelude.Compat import qualified Language.PureScript as P -import Language.PureScript.Bundle +import Language.PureScript.Bundle +import Language.PureScript.Interactive.IO (readNodeProcessWithExitCode) import Data.Function (on) import Data.List (minimumBy) @@ -22,7 +23,6 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except import System.Exit -import System.Process import System.FilePath import System.IO import System.IO.UTF8 @@ -65,7 +65,6 @@ assertBundles supportModules supportExterns supportForeigns inputFiles outputFil case e of Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs Right _ -> do - process <- findNodeProcess jsFiles <- concat <$> Glob.globDir [Glob.compile "*/*.js", Glob.compile "*/foreign.cjs"] modulesDir let entryPoint = modulesDir "index.cjs" let entryModule = map (`ModuleIdentifier` Regular) ["Main"] @@ -78,17 +77,17 @@ assertBundles supportModules supportExterns supportForeigns inputFiles outputFil case bundled of Right (_, js) -> do writeUTF8File entryPoint js - result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process + result <- readNodeProcessWithExitCode Nothing [entryPoint] "" hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":" case result of - Just (ExitSuccess, out, err) + Right (ExitSuccess, out, err) | not (null err) -> return $ Just $ "Test wrote to stderr:\n\n" <> err | not (null out) && trim (last (lines out)) == "Done" -> do hPutStr outputFile out return Nothing | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out - Just (ExitFailure _, _, err) -> return $ Just err - Nothing -> return $ Just "Couldn't find node.js executable" + Right (ExitFailure _, _, err) -> return $ Just err + Left err -> return $ Just err Left err -> return . Just $ "Coud not bundle: " ++ show err logfile :: FilePath diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs index 5a0a09ae5a..18f43d12a1 100644 --- a/tests/TestCompiler.hs +++ b/tests/TestCompiler.hs @@ -29,6 +29,7 @@ import Prelude () import Prelude.Compat import qualified Language.PureScript as P +import Language.PureScript.Interactive.IO (readNodeProcessWithExitCode) import Control.Arrow ((>>>)) import Data.Function (on) @@ -44,7 +45,6 @@ import qualified Data.ByteString.Lazy as BS import Control.Monad import System.Exit -import System.Process import System.FilePath import System.IO import System.IO.UTF8 (readUTF8File) @@ -164,20 +164,19 @@ assertCompiles supportModules supportExterns supportForeigns inputFiles outputFi case e of Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs Right _ -> do - process <- findNodeProcess let entryPoint = modulesDir "index.js" writeFile entryPoint "import('./Main/index.js').then(({ main }) => main());" - result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process + result <- readNodeProcessWithExitCode Nothing [entryPoint] "" hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":" case result of - Just (ExitSuccess, out, err) + Right (ExitSuccess, out, err) | not (null err) -> return $ Just $ "Test wrote to stderr:\n\n" <> err | not (null out) && trim (last (lines out)) == "Done" -> do hPutStr outputFile out return Nothing | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out - Just (ExitFailure _, _, err) -> return $ Just err - Nothing -> return $ Just "Couldn't find node.js executable" + Right (ExitFailure _, _, err) -> return $ Just err + Left err -> return $ Just err assertCompilesWithWarnings :: [P.Module] diff --git a/tests/TestPsci/TestEnv.hs b/tests/TestPsci/TestEnv.hs index 7a9c0c6d12..c8f1de431b 100644 --- a/tests/TestPsci/TestEnv.hs +++ b/tests/TestPsci/TestEnv.hs @@ -19,7 +19,6 @@ import System.Directory (getCurrentDirectory, doesPathExist, removeFil import System.Exit import System.FilePath ((), pathSeparator) import qualified System.FilePath.Glob as Glob -import System.Process (readProcessWithExitCode) import Test.Hspec (shouldBe, Expectation) -- | A monad transformer for handle PSCi actions in tests @@ -58,12 +57,11 @@ execTestPSCi i = do jsEval :: TestPSCi String jsEval = liftIO $ do writeFile indexFile "import('./$PSCI/index.js').then(({ $main }) => $main());" - process <- findNodeProcess - result <- traverse (\node -> readProcessWithExitCode node [indexFile] "") process + result <- readNodeProcessWithExitCode Nothing [indexFile] "" case result of - Just (ExitSuccess, out, _) -> return out - Just (ExitFailure _, _, err) -> putStrLn err >> exitFailure - Nothing -> putStrLn "Couldn't find node.js" >> exitFailure + Right (ExitSuccess, out, _) -> return out + Right (ExitFailure _, _, err) -> putStrLn err >> exitFailure + Left err -> putStrLn err >> exitFailure -- | Run a PSCi command and evaluate its outputs: -- * jsOutputEval is used to evaluate compiled JS output by PSCi diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs index 6b086fcacd..140e5a570e 100644 --- a/tests/TestUtils.hs +++ b/tests/TestUtils.hs @@ -9,12 +9,12 @@ import Prelude.Compat import qualified Language.PureScript as P import qualified Language.PureScript.CST as CST +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.Writer.Class (tell) import Control.Exception import Data.Char (isSpace) @@ -34,12 +34,6 @@ import qualified System.FilePath.Glob as Glob import System.IO import Test.Tasty.Hspec - -findNodeProcess :: IO (Maybe String) -findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names - where - names = ["nodejs", "node"] - -- | -- Fetches code necessary to run the tests with. The resulting support code -- should then be checked in, so that npm/bower etc is not required to run the @@ -56,15 +50,15 @@ updateSupportCode = do else do callProcess "npm" ["install"] -- bower uses shebang "/usr/bin/env node", but we might have nodejs - node <- maybe cannotFindNode pure =<< findNodeProcess + node <- either cannotFindNode pure =<< findNodeProcess -- Sometimes we run as a root (e.g. in simple docker containers) -- And we are non-interactive: https://github.com/bower/bower/issues/1162 callProcess node ["node_modules/.bin/bower", "--allow-root", "install", "--config.interactive=false"] setCurrentDirectory "../.." where - cannotFindNode :: IO a - cannotFindNode = do - hPutStrLn stderr "Cannot find node (or nodejs) executable" + cannotFindNode :: String -> IO a + cannotFindNode message = do + hPutStrLn stderr message exitFailure readInput :: [FilePath] -> IO [(FilePath, T.Text)] From 0d6f928dc8c16f4ec6a36155a9c079d53c453e14 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Fri, 2 Jul 2021 19:09:57 +0200 Subject: [PATCH 32/62] Filter out Node.js experimental ES modules loader warning --- src/Language/PureScript/Interactive/IO.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Language/PureScript/Interactive/IO.hs b/src/Language/PureScript/Interactive/IO.hs index 3eab68f020..f1d61cb47a 100644 --- a/src/Language/PureScript/Interactive/IO.hs +++ b/src/Language/PureScript/Interactive/IO.hs @@ -10,6 +10,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT(..), runExceptT) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Data.Functor ((<&>)) +import Data.List (isInfixOf) import System.Directory (XdgDirectory (..), createDirectoryIfMissing, getAppUserDataDirectory, getXdgDirectory, findExecutable, doesFileExist) @@ -58,7 +59,15 @@ readNodeProcessWithExitCode nodePath nodeArgs stdin = runExceptT $ do | major < 12 -> throwError "Unsupported node.js version." | otherwise -> pure (major, minor, patch) let nodeArgs' = if minor < 7 then "--experimental-modules" : nodeArgs else nodeArgs - lift $ readProcessWithExitCode process nodeArgs' stdin + lift (readProcessWithExitCode process nodeArgs' stdin) <&> \case + (ExitSuccess, out, err) -> + (ExitSuccess, out, censorExperimentalWarnings err) + (ExitFailure code, out, err) -> + (ExitFailure code, out, err) + +censorExperimentalWarnings :: String -> String +censorExperimentalWarnings = + unlines . filter (not . ("ExperimentalWarning" `isInfixOf`)) . lines -- | -- Grabs the filename where the history is stored. From 8e1caf89786be2771f5f160ef4b7a0d318ab7308 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Fri, 2 Jul 2021 22:24:52 +0200 Subject: [PATCH 33/62] Update bundler error messages --- src/Language/PureScript/Bundle.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index aceb289d88..73ca90f55a 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -242,10 +242,10 @@ printErrorMessage (ErrorInModule mid e) = displayIdentifier (ModuleIdentifier name ty) = name ++ " (" ++ showModuleType ty ++ ")" printErrorMessage (MissingEntryPoint mName) = - [ "Couldn't find neither an ES nor CommonJS module for the specified entry point: " ++ mName + [ "Could not find an ES module or CommonJS module for the specified entry point: " ++ mName ] printErrorMessage (MissingMainModule mName) = - [ "Couldn't find neither an ES nor CommonJS module for the specified main module: " ++ mName + [ "Could not find an ES module or CommonJS module for the specified main module: " ++ mName ] -- | Calculate the ModuleIdentifier imported by an import declaration or a require(...) statement. From d5437e01fce02c8932d62f86efcaca9c46cbc2e9 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Sat, 3 Jul 2021 17:00:41 +0200 Subject: [PATCH 34/62] Fix HLint warnings --- src/Language/PureScript/Bundle.hs | 10 +++++----- src/Language/PureScript/CodeGen/JS.hs | 4 ++-- src/Language/PureScript/Errors.hs | 2 +- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs index 8f88b8416a..951f06859a 100644 --- a/src/Language/PureScript/Bundle.hs +++ b/src/Language/PureScript/Bundle.hs @@ -452,7 +452,7 @@ toModule mids mid filename top , JSImportNameSpace _ _ jsIdent <- jsImportNameSpace , JSFromClause _ _ importPath <- jsFromClause , importPath' <- checkImportPath (strValue importPath) mid mids - = fromMaybe (err UnsupportedImport) (pure <$> identName jsIdent) >>= \name -> + = maybe (err UnsupportedImport) pure (identName jsIdent) >>= \name -> pure [Import item name importPath'] toModuleElements (JSModuleImportDeclaration _ _) = err UnsupportedImport @@ -521,12 +521,12 @@ toModule mids mid filename top toExport (Just from) name as | from == "./foreign.js" = pure . (ForeignReexport, as,, []) $ - (JSMemberSquare (JSIdentifier sp "$foreign") JSNoAnnot - (stringLiteral name) JSNoAnnot) + JSMemberSquare (JSIdentifier sp "$foreign") JSNoAnnot + (stringLiteral name) JSNoAnnot | Just from' <- stripSuffix "/index.js" =<< stripPrefix "../" from = pure . (RegularExport name, as,, []) $ - (JSMemberSquare (JSIdentifier sp (T.unpack . moduleNameToJs . ModuleName $ T.pack from')) JSNoAnnot - (stringLiteral name) JSNoAnnot) + JSMemberSquare (JSIdentifier sp (T.unpack . moduleNameToJs . ModuleName $ T.pack from')) JSNoAnnot + (stringLiteral name) JSNoAnnot | otherwise = err UnsupportedExport toExport Nothing name as = pure $ toRegularExport name as diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 7133b7cf0f..d75ed5778c 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -68,14 +68,14 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = comments <- not <$> asks optionsNoComments let header = if comments && not (null coms) then AST.Comment Nothing coms else id let foreign' = maybe [] (pure . AST.Import Nothing "$foreign") $ if null foreigns then Nothing else foreignInclude - let moduleBody = maybe [] (uncurry (:)) . fmap (first header) . uncons $ foreign' ++ jsImports ++ concat optimized + let moduleBody = (maybe [] (uncurry (:) . first header) . uncons) $ foreign' ++ jsImports ++ concat optimized let foreignExps = exps `intersect` foreigns let standardExps = exps \\ foreignExps let reExps' = M.toList (M.withoutKeys reExps (S.fromList C.primModules)) return $ moduleBody ++ (maybeToList . exportsToJs foreignInclude $ foreignExps) ++ (maybeToList . exportsToJs Nothing $ standardExps) - ++ (mapMaybe reExportsToJs reExps') + ++ mapMaybe reExportsToJs reExps' where diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index df4eda2c9a..a0e55bfd4e 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -711,7 +711,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl renderSimpleErrorMessage (DeprecatedFFICommonJSModule mn path) = paras [ line $ "A CommonJS foreign module implementation was provided for module " <> markCode (runModuleName mn) <> ": " , indent . lineS $ path - , line $ "CommonJS foreign modules are deprecated and won't be supported in the future." + , line "CommonJS foreign modules are deprecated and won't be supported in the future." ] renderSimpleErrorMessage (UnsupportedFFICommonJSExports mn idents) = paras [ line $ "The following CommonJS exports are not supported in the ES foreign module for module " <> markCode (runModuleName mn) <> ": " From d3b6633125e47ae5ddf4e6b7e3850a07ef282382 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Mon, 19 Jul 2021 09:57:14 +0200 Subject: [PATCH 35/62] Add purity annotations to function applications and constructor instantations --- purescript.cabal | 1 + src/Language/PureScript/CodeGen/JS.hs | 12 ++++++++++-- src/Language/PureScript/CodeGen/JS/Printer.hs | 4 ++++ src/Language/PureScript/Constants/Effect/Unsafe.hs | 9 +++++++++ src/Language/PureScript/CoreImp/AST.hs | 7 +++++++ 5 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 src/Language/PureScript/Constants/Effect/Unsafe.hs diff --git a/purescript.cabal b/purescript.cabal index e3cb467064..fb86060041 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -194,6 +194,7 @@ library Language.PureScript.Constants.Prelude Language.PureScript.Constants.Data.Generic.Rep Language.PureScript.Constants.Data.Newtype + Language.PureScript.Constants.Effect.Unsafe Language.PureScript.CoreFn Language.PureScript.CoreFn.Ann Language.PureScript.CoreFn.Binders diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 7369b61984..1fadabce45 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -27,6 +27,7 @@ import qualified Data.Text as T import Language.PureScript.AST.SourcePos import Language.PureScript.CodeGen.JS.Common as Common +import Language.PureScript.Constants.Effect.Unsafe as EffectUnsafe import Language.PureScript.CoreImp.AST (AST, everywhereTopDownM, withSourceSpan) import qualified Language.PureScript.CoreImp.AST as AST import Language.PureScript.CoreImp.Optimizer @@ -175,9 +176,16 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = then nonRecToJS a i (modifyAnn removeComments e) else AST.Comment Nothing com <$> nonRecToJS a i (modifyAnn removeComments e) nonRecToJS (ss, _, _, _) ident val = do - js <- valueToJs val + js <- withPureAnnotation <$> valueToJs val withPos ss $ AST.VariableIntroduction Nothing (identToJs ident) (Just js) + withPureAnnotation :: AST -> AST + withPureAnnotation js = case js of + AST.App _ (AST.Indexer _ (AST.StringLiteral _ f) (AST.Var _ m)) _ + | m == EffectUnsafe.effectUnsafe && f == EffectUnsafe.unsafePerformEffect -> js + AST.App a f args -> AST.Pure Nothing $ AST.App a f $ map withPureAnnotation args + _ -> js + withPos :: SourceSpan -> AST -> m AST withPos ss js = do withSM <- asks (elem JSSourceMap . optionsCodegenTargets) @@ -235,7 +243,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = case f of 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' + return $ AST.Pure Nothing $ 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]) diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index 505b4d1150..b3fd9b3eea 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -120,6 +120,10 @@ literals = mkPattern' match' , mconcat <$> forM com comment , prettyPrintJS' js ] + match (Pure _ js) = mconcat <$> sequence + [ return $ emit "/* @__PURE__ */" + , prettyPrintJS' js + ] match (Import _ ident from) = return . emit $ "import * as " <> ident <> " from " <> prettyPrintStringJS from match (Export _ idents from) = mconcat <$> sequence diff --git a/src/Language/PureScript/Constants/Effect/Unsafe.hs b/src/Language/PureScript/Constants/Effect/Unsafe.hs new file mode 100644 index 0000000000..52eea995cf --- /dev/null +++ b/src/Language/PureScript/Constants/Effect/Unsafe.hs @@ -0,0 +1,9 @@ +module Language.PureScript.Constants.Effect.Unsafe where + +import Data.String (IsString) + +effectUnsafe :: forall a. (IsString a) => a +effectUnsafe = "Effect_Unsafe" + +unsafePerformEffect :: forall a. (IsString a) => a +unsafePerformEffect = "unsafePerformEffect" diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs index 4753daeee1..01ca44a944 100644 --- a/src/Language/PureScript/CoreImp/AST.hs +++ b/src/Language/PureScript/CoreImp/AST.hs @@ -93,6 +93,8 @@ data AST -- ^ instanceof check | Comment (Maybe SourceSpan) [Comment] AST -- ^ Commented JavaScript + | Pure (Maybe SourceSpan) AST + -- ^ Purity annotation | Import (Maybe SourceSpan) Text PSString -- ^ Imported identifier and path to its module | Export (Maybe SourceSpan) (NEL.NonEmpty Text) (Maybe PSString) @@ -128,6 +130,7 @@ withSourceSpan withSpan = go where go (Throw _ js) = Throw ss js go (InstanceOf _ j1 j2) = InstanceOf ss j1 j2 go (Comment _ com j) = Comment ss com j + go (Pure _ js) = Pure ss js go (Import _ ident from) = Import ss ident from go (Export _ idents from) = Export ss idents from @@ -157,6 +160,7 @@ getSourceSpan = go where go (Throw ss _) = ss go (InstanceOf ss _ _) = ss go (Comment ss _ _) = ss + go (Pure ss _) = ss go (Import ss _ _) = ss go (Export ss _ _) = ss @@ -181,6 +185,7 @@ everywhere f = go where go (Throw ss js) = f (Throw ss (go js)) go (InstanceOf ss j1 j2) = f (InstanceOf ss (go j1) (go j2)) go (Comment ss com j) = f (Comment ss com (go j)) + go (Pure ss j) = f (Pure ss (go j)) go other = f other everywhereTopDown :: (AST -> AST) -> AST -> AST @@ -207,6 +212,7 @@ everywhereTopDownM f = f >=> go where go (Throw ss j) = Throw ss <$> f' j go (InstanceOf ss j1 j2) = InstanceOf ss <$> f' j1 <*> f' j2 go (Comment ss com j) = Comment ss com <$> f' j + go (Pure ss j) = Pure ss <$> f' j go other = f other everything :: (r -> r -> r) -> (AST -> r) -> AST -> r @@ -230,4 +236,5 @@ everything (<>.) f = go where go j@(Throw _ j1) = f j <>. go j1 go j@(InstanceOf _ j1 j2) = f j <>. go j1 <>. go j2 go j@(Comment _ _ j1) = f j <>. go j1 + go j@(Pure _ j1) = f j <>. go j1 go other = f other From c6300520831ecc93c25ccf2c7f93951db5af3479 Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Tue, 28 Dec 2021 20:28:32 +0100 Subject: [PATCH 36/62] Surround purity annotations in parens --- src/Language/PureScript/CodeGen/JS/Printer.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index b3fd9b3eea..54d3833792 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -120,9 +120,10 @@ literals = mkPattern' match' , mconcat <$> forM com comment , prettyPrintJS' js ] - match (Pure _ js) = mconcat <$> sequence - [ return $ emit "/* @__PURE__ */" - , prettyPrintJS' js + match (Pure _ js) = mconcat <$> sequence + [ return $ emit "/* @__PURE__ */(" + , prettyPrintJS' js + , return $ emit ")" ] match (Import _ ident from) = return . emit $ "import * as " <> ident <> " from " <> prettyPrintStringJS from From 8a0779c9badbe8371f038c9ab439a073e12c5198 Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Tue, 28 Dec 2021 20:29:51 +0100 Subject: [PATCH 37/62] Mention es modules in version --- purescript.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/purescript.cabal b/purescript.cabal index ddf52ac1e1..dc1b24cc4b 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- note: When updating the prerelease identifier, update it in app/Version.hs too! -version: 0.14.5 +version: 0.14.5-es-modules-and-purity-annotations 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 593230b9d6f53790f25d5d9a93142dca942b8387 Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Tue, 28 Dec 2021 20:34:40 +0100 Subject: [PATCH 38/62] Bump version to 0.15.0 --- purescript.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/purescript.cabal b/purescript.cabal index dc1b24cc4b..27991c409c 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- note: When updating the prerelease identifier, update it in app/Version.hs too! -version: 0.14.5-es-modules-and-purity-annotations +version: 0.15.0 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 8a7b2205b11374dc2baac735abee13867e52fad1 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Wed, 26 Jan 2022 15:16:05 -0800 Subject: [PATCH 39/62] Add purity annotations to top-level applications only. --- src/Language/PureScript/CodeGen/JS.hs | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 3181e18be5..2fcb83acb1 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -27,7 +27,6 @@ import qualified Data.Text as T import Language.PureScript.AST.SourcePos import Language.PureScript.CodeGen.JS.Common as Common -import Language.PureScript.Constants.Effect.Unsafe as EffectUnsafe import Language.PureScript.CoreImp.AST (AST, everywhereTopDownM, withSourceSpan) import qualified Language.PureScript.CoreImp.AST as AST import Language.PureScript.CoreImp.Optimizer @@ -58,7 +57,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = let mnLookup = renameImports usedNames imps let decls' = renameModules mnLookup decls jsDecls <- mapM bindToJs decls' - optimized <- traverse (traverse optimize) jsDecls + optimized <- traverse (traverse (fmap annotatePure . optimize)) jsDecls let mnReverseLookup = M.fromList $ map (\(origName, (_, safeName)) -> (moduleNameToJs safeName, origName)) $ M.toList mnLookup let usedModuleNames = foldMap (foldMap (findModules mnReverseLookup)) optimized `S.union` M.keysSet reExps @@ -79,6 +78,11 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = ++ mapMaybe reExportsToJs reExps' where + -- | Adds purity annotations to top-level applications. + annotatePure :: AST -> AST + annotatePure (AST.VariableIntroduction ss name (Just app@(AST.App _ _ _))) = AST.VariableIntroduction ss name (Just (AST.Pure Nothing app)) + annotatePure (AST.Comment a b js) = AST.Comment a b (annotatePure js) + annotatePure js = js -- | Extracts all declaration names from a binding group. getNames :: Bind Ann -> [Ident] @@ -176,16 +180,9 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = then nonRecToJS a i (modifyAnn removeComments e) else AST.Comment Nothing com <$> nonRecToJS a i (modifyAnn removeComments e) nonRecToJS (ss, _, _, _) ident val = do - js <- withPureAnnotation <$> valueToJs val + js <- valueToJs val withPos ss $ AST.VariableIntroduction Nothing (identToJs ident) (Just js) - withPureAnnotation :: AST -> AST - withPureAnnotation js = case js of - AST.App _ (AST.Indexer _ (AST.StringLiteral _ f) (AST.Var _ m)) _ - | m == EffectUnsafe.effectUnsafe && f == EffectUnsafe.unsafePerformEffect -> js - AST.App a f args -> AST.Pure Nothing $ AST.App a f $ map withPureAnnotation args - _ -> js - withPos :: SourceSpan -> AST -> m AST withPos ss js = do withSM <- asks (elem JSSourceMap . optionsCodegenTargets) @@ -243,7 +240,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = case f of Var (_, _, _, Just IsNewtype) _ -> return (head args') Var (_, _, _, Just (IsConstructor _ fields)) name | length args == length fields -> - return $ AST.Pure Nothing $ AST.Unary Nothing AST.New $ AST.App Nothing (qualifiedToJS id name) args' + 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]) From a1258f2c68a03f52f10c1913386a4d46c148d47d Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Wed, 26 Jan 2022 16:40:51 -0800 Subject: [PATCH 40/62] Follow top-level literals as well --- src/Language/PureScript/CodeGen/JS.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 2fcb83acb1..89f8ccde4c 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -80,7 +80,10 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = where -- | Adds purity annotations to top-level applications. annotatePure :: AST -> AST - annotatePure (AST.VariableIntroduction ss name (Just app@(AST.App _ _ _))) = AST.VariableIntroduction ss name (Just (AST.Pure Nothing app)) + annotatePure app@(AST.App _ _ _) = AST.Pure Nothing app + annotatePure (AST.ObjectLiteral ss props) = AST.ObjectLiteral ss (fmap annotatePure <$> props) + annotatePure (AST.ArrayLiteral ss js) = AST.ArrayLiteral ss (annotatePure <$> js) + annotatePure (AST.VariableIntroduction ss name (Just js)) = AST.VariableIntroduction ss name (Just (annotatePure js)) annotatePure (AST.Comment a b js) = AST.Comment a b (annotatePure js) annotatePure js = js From f3b9d34ded94eb141bc9bcbd9b581239a9988a8c Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Wed, 26 Jan 2022 17:11:33 -0800 Subject: [PATCH 41/62] Annotate all top-level-reachable applications. --- src/Language/PureScript/CodeGen/JS.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 89f8ccde4c..705e6799a7 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -80,7 +80,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = where -- | Adds purity annotations to top-level applications. annotatePure :: AST -> AST - annotatePure app@(AST.App _ _ _) = AST.Pure Nothing app + annotatePure (AST.App ss a bs) = AST.Pure Nothing (AST.App ss (annotatePure a) (annotatePure <$> bs)) annotatePure (AST.ObjectLiteral ss props) = AST.ObjectLiteral ss (fmap annotatePure <$> props) annotatePure (AST.ArrayLiteral ss js) = AST.ArrayLiteral ss (annotatePure <$> js) annotatePure (AST.VariableIntroduction ss name (Just js)) = AST.VariableIntroduction ss name (Just (annotatePure js)) From b72f7f8601229bbb0ca24184ed5339f7f9364c02 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Wed, 26 Jan 2022 20:58:07 -0800 Subject: [PATCH 42/62] Traverse under lhs functions and operators --- src/Language/PureScript/CodeGen/JS.hs | 16 ++++++++++++++++ src/Language/PureScript/CodeGen/JS/Printer.hs | 3 +-- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 705e6799a7..24c91fad26 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -80,13 +80,29 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = where -- | Adds purity annotations to top-level applications. annotatePure :: AST -> AST + annotatePure (AST.App ss (AST.Function ss' n args body) bs) = AST.Pure Nothing (AST.App ss (AST.Function ss' n args (annotatePureFn body)) (annotatePure <$> bs)) + annotatePure (AST.App ss a@(AST.App _ _ _) bs) = AST.App ss (annotatePure a) (annotatePure <$> bs) annotatePure (AST.App ss a bs) = AST.Pure Nothing (AST.App ss (annotatePure a) (annotatePure <$> bs)) + annotatePure (AST.Unary ss AST.New js) = AST.Pure Nothing $ AST.Unary ss AST.New (annotatePure js) + annotatePure (AST.Unary ss op js) = AST.Unary ss op (annotatePure js) + annotatePure (AST.Binary ss op a b) = AST.Binary ss op (annotatePure a) (annotatePure b) + annotatePure (AST.Indexer ss a b) = AST.Indexer ss (annotatePure a) (annotatePure b) annotatePure (AST.ObjectLiteral ss props) = AST.ObjectLiteral ss (fmap annotatePure <$> props) annotatePure (AST.ArrayLiteral ss js) = AST.ArrayLiteral ss (annotatePure <$> js) annotatePure (AST.VariableIntroduction ss name (Just js)) = AST.VariableIntroduction ss name (Just (annotatePure js)) annotatePure (AST.Comment a b js) = AST.Comment a b (annotatePure js) annotatePure js = js + annotatePureFn :: AST -> AST + annotatePureFn (AST.Block ss js) = AST.Block ss (annotatePureFn <$> js) + annotatePureFn (AST.IfElse ss a b c) = AST.IfElse ss (annotatePureFn a) (annotatePureFn b) (annotatePureFn <$> c) + annotatePureFn (AST.While ss a b) = AST.While ss (annotatePureFn a) (annotatePureFn b) + annotatePureFn (AST.For ss n a b c) = AST.For ss n (annotatePureFn a) (annotatePureFn b) (annotatePureFn c) + annotatePureFn (AST.ForIn ss n a b) = AST.ForIn ss n (annotatePureFn a) (annotatePureFn b) + annotatePureFn (AST.Return ss a) = AST.Return ss (annotatePureFn a) + annotatePureFn (AST.InstanceOf ss a b) = AST.InstanceOf ss (annotatePureFn a) (annotatePureFn b) + annotatePureFn js = annotatePure js + -- | Extracts all declaration names from a binding group. getNames :: Bind Ann -> [Ident] getNames (NonRec _ ident _) = [ident] diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index 54d3833792..34005f4787 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -121,9 +121,8 @@ literals = mkPattern' match' , prettyPrintJS' js ] match (Pure _ js) = mconcat <$> sequence - [ return $ emit "/* @__PURE__ */(" + [ return $ emit "/* @__PURE__ */ " , prettyPrintJS' js - , return $ emit ")" ] match (Import _ ident from) = return . emit $ "import * as " <> ident <> " from " <> prettyPrintStringJS from From d67aa9e4aadaefdee6643a4c34a5194ea96e5e46 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Thu, 27 Jan 2022 09:08:39 -0800 Subject: [PATCH 43/62] Use # for annotation. --- src/Language/PureScript/CodeGen/JS/Printer.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index 34005f4787..5fa887a7f2 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -121,7 +121,7 @@ literals = mkPattern' match' , prettyPrintJS' js ] match (Pure _ js) = mconcat <$> sequence - [ return $ emit "/* @__PURE__ */ " + [ return $ emit "/* #__PURE__ */ " , prettyPrintJS' js ] match (Import _ ident from) = return . emit $ From 19f4bdc432859b2215a7f32b087cfa4896975aaf Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Thu, 27 Jan 2022 09:55:51 -0800 Subject: [PATCH 44/62] Add comments, remove potentially aggressive cases. --- src/Language/PureScript/CodeGen/JS.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 24c91fad26..5d24682824 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -78,7 +78,11 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = ++ mapMaybe reExportsToJs reExps' where - -- | Adds purity annotations to top-level applications. + -- | Adds purity annotations to top-level reachable applications 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 traverse top-level + -- ASTs, annotating applications that are obviously reachable during module initialization. + -- That is, we specifically do not traverse under function abstractions that aren't immediately invoked. annotatePure :: AST -> AST annotatePure (AST.App ss (AST.Function ss' n args body) bs) = AST.Pure Nothing (AST.App ss (AST.Function ss' n args (annotatePureFn body)) (annotatePure <$> bs)) annotatePure (AST.App ss a@(AST.App _ _ _) bs) = AST.App ss (annotatePure a) (annotatePure <$> bs) @@ -96,9 +100,6 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = annotatePureFn :: AST -> AST annotatePureFn (AST.Block ss js) = AST.Block ss (annotatePureFn <$> js) annotatePureFn (AST.IfElse ss a b c) = AST.IfElse ss (annotatePureFn a) (annotatePureFn b) (annotatePureFn <$> c) - annotatePureFn (AST.While ss a b) = AST.While ss (annotatePureFn a) (annotatePureFn b) - annotatePureFn (AST.For ss n a b c) = AST.For ss n (annotatePureFn a) (annotatePureFn b) (annotatePureFn c) - annotatePureFn (AST.ForIn ss n a b) = AST.ForIn ss n (annotatePureFn a) (annotatePureFn b) annotatePureFn (AST.Return ss a) = AST.Return ss (annotatePureFn a) annotatePureFn (AST.InstanceOf ss a b) = AST.InstanceOf ss (annotatePureFn a) (annotatePureFn b) annotatePureFn js = annotatePure js From ce9a906e7fe835f86f3f3ce8129af72242d8b152 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Thu, 27 Jan 2022 14:52:03 -0800 Subject: [PATCH 45/62] Simplify to uniform top-level IIFEs. --- src/Language/PureScript/CodeGen/JS.hs | 33 ++++++++++++--------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 5d24682824..a3f9c84ca7 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -78,31 +78,26 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = ++ mapMaybe reExportsToJs reExps' where - -- | Adds purity annotations to top-level reachable applications 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 traverse top-level - -- ASTs, annotating applications that are obviously reachable during module initialization. - -- That is, we specifically do not traverse under function abstractions that aren't immediately invoked. + -- us remove any unreferenced top-level declarations. To achieve this, we wrap any non-trivial + -- top-level values in an IIFE marked with a pure annotation. annotatePure :: AST -> AST - annotatePure (AST.App ss (AST.Function ss' n args body) bs) = AST.Pure Nothing (AST.App ss (AST.Function ss' n args (annotatePureFn body)) (annotatePure <$> bs)) - annotatePure (AST.App ss a@(AST.App _ _ _) bs) = AST.App ss (annotatePure a) (annotatePure <$> bs) - annotatePure (AST.App ss a bs) = AST.Pure Nothing (AST.App ss (annotatePure a) (annotatePure <$> bs)) - annotatePure (AST.Unary ss AST.New js) = AST.Pure Nothing $ AST.Unary ss AST.New (annotatePure js) - annotatePure (AST.Unary ss op js) = AST.Unary ss op (annotatePure js) - annotatePure (AST.Binary ss op a b) = AST.Binary ss op (annotatePure a) (annotatePure b) - annotatePure (AST.Indexer ss a b) = AST.Indexer ss (annotatePure a) (annotatePure b) - annotatePure (AST.ObjectLiteral ss props) = AST.ObjectLiteral ss (fmap annotatePure <$> props) - annotatePure (AST.ArrayLiteral ss js) = AST.ArrayLiteral ss (annotatePure <$> js) + annotatePure js@(AST.App _ (AST.Function _ _ _ _) _) = AST.Pure Nothing js + annotatePure js@(AST.App _ _ _) = pureIife js + annotatePure js@(AST.Unary _ _ _) = pureIife js + annotatePure js@(AST.Binary _ _ _ _) = pureIife js + annotatePure js@(AST.Indexer _ _ _) = pureIife js + annotatePure js@(AST.ObjectLiteral _ []) = js + annotatePure js@(AST.ObjectLiteral _ _) = pureIife js + annotatePure js@(AST.ArrayLiteral _ []) = js + annotatePure js@(AST.ArrayLiteral _ _) = pureIife js annotatePure (AST.VariableIntroduction ss name (Just js)) = AST.VariableIntroduction ss name (Just (annotatePure js)) annotatePure (AST.Comment a b js) = AST.Comment a b (annotatePure js) annotatePure js = js - annotatePureFn :: AST -> AST - annotatePureFn (AST.Block ss js) = AST.Block ss (annotatePureFn <$> js) - annotatePureFn (AST.IfElse ss a b c) = AST.IfElse ss (annotatePureFn a) (annotatePureFn b) (annotatePureFn <$> c) - annotatePureFn (AST.Return ss a) = AST.Return ss (annotatePureFn a) - annotatePureFn (AST.InstanceOf ss a b) = AST.InstanceOf ss (annotatePureFn a) (annotatePureFn b) - annotatePureFn js = annotatePure js + pureIife :: AST -> AST + pureIife val = AST.Pure Nothing $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing [AST.Return Nothing val])) [] -- | Extracts all declaration names from a binding group. getNames :: Bind Ann -> [Ident] From 9d997ea6a8fa4db32f7b800c9a48c55419b3f796 Mon Sep 17 00:00:00 2001 From: sigma-andex Date: Fri, 4 Feb 2022 20:07:33 +0000 Subject: [PATCH 46/62] Fix tests --- tests/purs/bundle/ObjectShorthand.js | 2 +- tests/purs/optimize/2866.out.js | 9 ++++---- tests/support/bower.json | 34 ++++++++++++++-------------- 3 files changed, 22 insertions(+), 23 deletions(-) diff --git a/tests/purs/bundle/ObjectShorthand.js b/tests/purs/bundle/ObjectShorthand.js index 225e8bf063..8ab71c994b 100644 --- a/tests/purs/bundle/ObjectShorthand.js +++ b/tests/purs/bundle/ObjectShorthand.js @@ -1,4 +1,4 @@ -var foo = 1; +export var foo = 1; export var bar = { foo }; diff --git a/tests/purs/optimize/2866.out.js b/tests/purs/optimize/2866.out.js index a8f0d51269..7165fd5e32 100644 --- a/tests/purs/optimize/2866.out.js +++ b/tests/purs/optimize/2866.out.js @@ -2,14 +2,13 @@ // Canonical test for #2866. This doesn't need to test whether `apply`s // defined from modules other than `Data.Function` are incorrectly // optimized since the rest of the test suite seemingly catches it. -"use strict"; var Area = function (x) { return x; }; var areaFlipped = 42; var area = 42; -module.exports = { - Area: Area, - area: area, - areaFlipped: areaFlipped +export { + Area, + area, + areaFlipped }; diff --git a/tests/support/bower.json b/tests/support/bower.json index 704c043a21..c86adddcab 100644 --- a/tests/support/bower.json +++ b/tests/support/bower.json @@ -1,38 +1,38 @@ { "name": "purescript-test-suite-support", "dependencies": { - "purescript-arrays": "6.0.0", + "purescript-arrays": "https://github.com/working-group-purescript-es/purescript-arrays.git#es-modules", "purescript-assert": "5.0.0", "purescript-bifunctors": "5.0.0", - "purescript-console": "5.0.0", - "purescript-control": "5.0.0", + "purescript-console": "https://github.com/working-group-purescript-es/purescript-console.git#es-modules", + "purescript-control": "https://github.com/working-group-purescript-es/purescript-control.git#es-modules", "purescript-distributive": "5.0.0", - "purescript-effect": "3.0.0", + "purescript-effect": "https://github.com/working-group-purescript-es/purescript-effect.git#es-modules", "purescript-either": "5.0.0", - "purescript-foldable-traversable": "5.0.0", - "purescript-functions": "5.0.0", + "purescript-foldable-traversable": "https://github.com/working-group-purescript-es/purescript-foldable-traversable.git#es-modules", + "purescript-functions": "https://github.com/working-group-purescript-es/purescript-functions.git#es-modules", "purescript-gen": "3.0.0", "purescript-identity": "5.0.0", - "purescript-integers": "5.0.0", + "purescript-integers": "https://github.com/working-group-purescript-es/purescript-integers.git#es-modules", "purescript-invariant": "5.0.0", - "purescript-lazy": "5.0.0", - "purescript-lists": "6.0.0", - "purescript-math": "3.0.0", + "purescript-lazy": "https://github.com/working-group-purescript-es/purescript-lazy.git#es-modules", + "purescript-lists": "https://github.com/working-group-purescript-es/purescript-lists.git#es-modules", + "purescript-math": "https://github.com/working-group-purescript-es/purescript-math.git#es-modules", "purescript-maybe": "5.0.0", "purescript-newtype": "4.0.0", "purescript-nonempty": "6.0.0", - "purescript-partial": "3.0.0", - "purescript-prelude": "5.0.0", + "purescript-partial": "https://github.com/working-group-purescript-es/purescript-partial.git#es-modules", + "purescript-prelude": "https://github.com/working-group-purescript-es/purescript-prelude.git#es-modules", "purescript-psci-support": "5.0.0", - "purescript-refs": "5.0.0", + "purescript-refs": "https://github.com/working-group-purescript-es/purescript-refs.git#es-modules", "purescript-safe-coerce": "1.0.0", - "purescript-st": "5.0.0", - "purescript-strings": "5.0.0", + "purescript-st": "https://github.com/working-group-purescript-es/purescript-st.git#es-modules", + "purescript-strings": "https://github.com/working-group-purescript-es/purescript-strings.git#es-modules", "purescript-tailrec": "5.0.0", "purescript-tuples": "6.0.0", "purescript-type-equality": "4.0.0", "purescript-typelevel-prelude": "6.0.0", - "purescript-unfoldable": "5.0.0", - "purescript-unsafe-coerce": "5.0.0" + "purescript-unfoldable": "https://github.com/working-group-purescript-es/purescript-unfoldable.git#es-modules", + "purescript-unsafe-coerce": "https://github.com/working-group-purescript-es/purescript-unsafe-coerce.git#es-modules" } } From 7a458fffe73d90355de2323831b244c5026acc10 Mon Sep 17 00:00:00 2001 From: sigma-andex Date: Tue, 8 Feb 2022 14:20:47 +0000 Subject: [PATCH 47/62] Add myself to contributors --- CONTRIBUTORS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 7f0b556ed7..14e19efb72 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -150,6 +150,7 @@ If you would prefer to use different terms, please use the section below instead | [@kl0tl](https://github.com/kl0tl) | Cyril Sobierajewicz | [MIT license](http://opensource.org/licenses/MIT) | | [@PureFunctor](https://github.com/PureFunctor) | Justin Garcia | [MIT license](http://opensource.org/licenses/MIT) | | [@xgrommx](https://github.com/xgrommx) | Denis Stoyanov | [MIT license](http://opensource.org/licenses/MIT) | +| [@sigma-andex](https://github.com/sigma-andex) | Jan Schulte | [MIT license](http://opensource.org/licenses/MIT) | ### Contributors using Modified Terms From 3a3abde268ccf8bad04e0321bfc4fc24e03b3534 Mon Sep 17 00:00:00 2001 From: sigma-andex <77549848+sigma-andex@users.noreply.github.com> Date: Fri, 11 Feb 2022 21:09:35 +0000 Subject: [PATCH 48/62] Fix experimental-modules flag required version (#11) Improve error message --- src/Language/PureScript/Interactive/IO.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Language/PureScript/Interactive/IO.hs b/src/Language/PureScript/Interactive/IO.hs index f1d61cb47a..8db87acc28 100644 --- a/src/Language/PureScript/Interactive/IO.hs +++ b/src/Language/PureScript/Interactive/IO.hs @@ -46,7 +46,7 @@ findNodeVersion node = do readNodeProcessWithExitCode :: Maybe FilePath -> [String] -> String -> IO (Either String (ExitCode, String, String)) readNodeProcessWithExitCode nodePath nodeArgs stdin = runExceptT $ do process <- maybe (ExceptT findNodeProcess) pure nodePath - (_, minor, _) <- lift (findNodeVersion process) >>= \case + (major, _, _) <- lift (findNodeVersion process) >>= \case Nothing -> throwError "Could not find node.js version." Just version -> do let semver = do @@ -56,9 +56,9 @@ readNodeProcessWithExitCode nodePath nodeArgs stdin = runExceptT $ do case parse (semver "Could not parse node.js version.") "" version of Left err -> throwError $ show err Right (major, minor, patch) - | major < 12 -> throwError "Unsupported node.js version." + | major < 12 -> throwError $ "Unsupported node.js version " <> show major <> ". Required node.js version >=12." | otherwise -> pure (major, minor, patch) - let nodeArgs' = if minor < 7 then "--experimental-modules" : nodeArgs else nodeArgs + let nodeArgs' = if major < 13 then "--experimental-modules" : nodeArgs else nodeArgs lift (readProcessWithExitCode process nodeArgs' stdin) <&> \case (ExitSuccess, out, err) -> (ExitSuccess, out, censorExperimentalWarnings err) From e535003a9f9a82f57b348bdccec696a87f03712f Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Sun, 13 Feb 2022 17:13:20 +0100 Subject: [PATCH 49/62] Add i-am-the-slime to contributors --- CONTRIBUTORS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 14e19efb72..6b77dc8f22 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -151,6 +151,7 @@ If you would prefer to use different terms, please use the section below instead | [@PureFunctor](https://github.com/PureFunctor) | Justin Garcia | [MIT license](http://opensource.org/licenses/MIT) | | [@xgrommx](https://github.com/xgrommx) | Denis Stoyanov | [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) | ### Contributors using Modified Terms From d57898d464d07bbd2a465c65dc0b1dcf4882adea Mon Sep 17 00:00:00 2001 From: sigma-andex <77549848+sigma-andex@users.noreply.github.com> Date: Mon, 14 Feb 2022 15:15:53 +0000 Subject: [PATCH 50/62] Fix pr comments (#12) * Rename node.js to Node.js * Remove unused Unsafe.hs --- purescript.cabal | 1 - src/Language/PureScript/Constants/Effect/Unsafe.hs | 9 --------- src/Language/PureScript/Interactive/IO.hs | 9 +++++---- 3 files changed, 5 insertions(+), 14 deletions(-) delete mode 100644 src/Language/PureScript/Constants/Effect/Unsafe.hs diff --git a/purescript.cabal b/purescript.cabal index 27991c409c..398b1ecf4c 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -194,7 +194,6 @@ library Language.PureScript.Constants.Prelude Language.PureScript.Constants.Data.Generic.Rep Language.PureScript.Constants.Data.Newtype - Language.PureScript.Constants.Effect.Unsafe Language.PureScript.CoreFn Language.PureScript.CoreFn.Ann Language.PureScript.CoreFn.Binders diff --git a/src/Language/PureScript/Constants/Effect/Unsafe.hs b/src/Language/PureScript/Constants/Effect/Unsafe.hs deleted file mode 100644 index 52eea995cf..0000000000 --- a/src/Language/PureScript/Constants/Effect/Unsafe.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Language.PureScript.Constants.Effect.Unsafe where - -import Data.String (IsString) - -effectUnsafe :: forall a. (IsString a) => a -effectUnsafe = "Effect_Unsafe" - -unsafePerformEffect :: forall a. (IsString a) => a -unsafePerformEffect = "unsafePerformEffect" diff --git a/src/Language/PureScript/Interactive/IO.hs b/src/Language/PureScript/Interactive/IO.hs index 8db87acc28..1b0ba2fc00 100644 --- a/src/Language/PureScript/Interactive/IO.hs +++ b/src/Language/PureScript/Interactive/IO.hs @@ -19,6 +19,7 @@ import System.FilePath (takeDirectory, ()) import System.Process (readProcessWithExitCode) import Text.Parsec ((), many1, parse, sepBy) import Text.Parsec.Char (char, digit) +import Protolude (note) mkdirp :: FilePath -> IO () mkdirp = createDirectoryIfMissing True . takeDirectory @@ -34,7 +35,7 @@ onFirstFileMatching f pathVariants = runMaybeT . msum $ map (MaybeT . f) pathVar -- findNodeProcess :: IO (Either String String) findNodeProcess = onFirstFileMatching findExecutable ["nodejs", "node"] <&> - maybe (throwError "Could not find node.js. Do you have node.js installed and available in your PATH?") pure + note "Could not find Node.js. Do you have Node.js installed and available in your PATH?" findNodeVersion :: String -> IO (Maybe String) findNodeVersion node = do @@ -47,16 +48,16 @@ readNodeProcessWithExitCode :: Maybe FilePath -> [String] -> String -> IO (Eithe readNodeProcessWithExitCode nodePath nodeArgs stdin = runExceptT $ do process <- maybe (ExceptT findNodeProcess) pure nodePath (major, _, _) <- lift (findNodeVersion process) >>= \case - Nothing -> throwError "Could not find node.js version." + Nothing -> throwError "Could not find Node.js version." Just version -> do let semver = do void $ char 'v' major : minor : patch : _ <- fmap (read @Int) (many1 digit) `sepBy` void (char '.') pure (major, minor, patch) - case parse (semver "Could not parse node.js version.") "" version of + case parse (semver "Could not parse Node.js version.") "" version of Left err -> throwError $ show err Right (major, minor, patch) - | major < 12 -> throwError $ "Unsupported node.js version " <> show major <> ". Required node.js version >=12." + | major < 12 -> throwError $ "Unsupported Node.js version " <> show major <> ". Required Node.js version >=12." | otherwise -> pure (major, minor, patch) let nodeArgs' = if major < 13 then "--experimental-modules" : nodeArgs else nodeArgs lift (readProcessWithExitCode process nodeArgs' stdin) <&> \case From efa6f8796b7365b6dfd15f1528fd96cef41dd416 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Fri, 18 Feb 2022 17:42:10 -0600 Subject: [PATCH 51/62] Add resolutions to fix dep conflicts --- tests/support/bower.json | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/tests/support/bower.json b/tests/support/bower.json index c86adddcab..ffe266fd1f 100644 --- a/tests/support/bower.json +++ b/tests/support/bower.json @@ -34,5 +34,22 @@ "purescript-typelevel-prelude": "6.0.0", "purescript-unfoldable": "https://github.com/working-group-purescript-es/purescript-unfoldable.git#es-modules", "purescript-unsafe-coerce": "https://github.com/working-group-purescript-es/purescript-unsafe-coerce.git#es-modules" + }, + "resolutions": { + "purescript-console": "es-modules", + "purescript-effect": "es-modules", + "purescript-control": "es-modules", + "purescript-foldable-traversable": "es-modules", + "purescript-functions": "es-modules", + "purescript-lazy": "es-modules", + "purescript-math": "es-modules", + "purescript-arrays": "es-modules", + "purescript-integers": "es-modules", + "purescript-partial": "es-modules", + "purescript-refs": "es-modules", + "purescript-st": "es-modules", + "purescript-unfoldable": "es-modules", + "purescript-prelude": "es-modules", + "purescript-unsafe-coerce": "es-modules" } } From c35d12be38a45d182344f521fe8b8fde44f8b697 Mon Sep 17 00:00:00 2001 From: sigma-andex <77549848+sigma-andex@users.noreply.github.com> Date: Sun, 20 Feb 2022 13:56:01 +0000 Subject: [PATCH 52/62] Add changelog.d entry for es modules (#14) --- CHANGELOG.d/break_switch-to-es-modules.md | 28 +++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 CHANGELOG.d/break_switch-to-es-modules.md diff --git a/CHANGELOG.d/break_switch-to-es-modules.md b/CHANGELOG.d/break_switch-to-es-modules.md new file mode 100644 index 0000000000..c8793c3acf --- /dev/null +++ b/CHANGELOG.d/break_switch-to-es-modules.md @@ -0,0 +1,28 @@ +* Switch from Common JS to ES modules + + Previously, Purescript used Common JS for FFI declarations. + + Before, FFI was declared like this... + + ```javascript + const mymodule = require('mymodule') + + exports.myvar = mymodule.myvar + ``` + + ...and will be changed to this... + + ```javascript + import * as M from 'mymodule'; + export const myvar = M.myvar + ``` + ...or using the short version... + + ```javascript + export { myvar } from 'mymodule'; + ``` + +* FFI is annotated with `/* #__PURE__ */` so that bundlers can perform DCE +* If CJS is detected a `Warning` is emitted +* The current LTS Node.js version `12` is now the required minimum version +* `purs bundle` has been rudimentarily updated but will be removed in a subsequent PR From ed3f494e8ce52a6d47e25116baa84f18d514d409 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Mon, 21 Feb 2022 08:21:39 -0600 Subject: [PATCH 53/62] Update prefix to match script's expected one --- ...k_switch-to-es-modules.md => breaking_switch-to-es-modules.md} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename CHANGELOG.d/{break_switch-to-es-modules.md => breaking_switch-to-es-modules.md} (100%) diff --git a/CHANGELOG.d/break_switch-to-es-modules.md b/CHANGELOG.d/breaking_switch-to-es-modules.md similarity index 100% rename from CHANGELOG.d/break_switch-to-es-modules.md rename to CHANGELOG.d/breaking_switch-to-es-modules.md From 970a8e6b671628e29d3b9dbdbe58eb5df84350bf Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Mon, 21 Feb 2022 08:21:52 -0600 Subject: [PATCH 54/62] Drop unneeded whitespace --- CHANGELOG.d/breaking_switch-to-es-modules.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.d/breaking_switch-to-es-modules.md b/CHANGELOG.d/breaking_switch-to-es-modules.md index c8793c3acf..209419c31d 100644 --- a/CHANGELOG.d/breaking_switch-to-es-modules.md +++ b/CHANGELOG.d/breaking_switch-to-es-modules.md @@ -1,5 +1,5 @@ * Switch from Common JS to ES modules - + Previously, Purescript used Common JS for FFI declarations. Before, FFI was declared like this... @@ -9,7 +9,7 @@ exports.myvar = mymodule.myvar ``` - + ...and will be changed to this... ```javascript From 16430f3be2e04899400e97f6d52fcbfcab3325fb Mon Sep 17 00:00:00 2001 From: sigma-andex <77549848+sigma-andex@users.noreply.github.com> Date: Mon, 21 Feb 2022 17:06:11 +0000 Subject: [PATCH 55/62] Update src/Language/PureScript/Errors.hs Co-authored-by: Nathan Faubion --- src/Language/PureScript/Errors.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index e7910adf50..1d6f56d295 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -720,7 +720,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl , indent . paras $ map line idents ] renderSimpleErrorMessage (UnsupportedFFICommonJSImports mn mids) = - paras [ line $ "The following CommonJS imports are no supported in the ES foreign module for module " <> markCode (runModuleName mn) <> ": " + paras [ line $ "The following CommonJS imports are not supported in the ES foreign module for module " <> markCode (runModuleName mn) <> ": " , indent . paras $ map line mids ] renderSimpleErrorMessage InvalidDoBind = From f861e5e39845297bfe5f1535722f4d21adae6b67 Mon Sep 17 00:00:00 2001 From: sigma-andex Date: Mon, 21 Feb 2022 21:06:32 +0000 Subject: [PATCH 56/62] Fix broken tests after spelling correction commit --- tests/purs/failing/UnsupportedFFICommonJSImports1.out | 2 +- tests/purs/failing/UnsupportedFFICommonJSImports2.out | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/purs/failing/UnsupportedFFICommonJSImports1.out b/tests/purs/failing/UnsupportedFFICommonJSImports1.out index 8cc5f980a4..59d0cf4351 100644 --- a/tests/purs/failing/UnsupportedFFICommonJSImports1.out +++ b/tests/purs/failing/UnsupportedFFICommonJSImports1.out @@ -1,7 +1,7 @@ Error found: at tests/purs/failing/UnsupportedFFICommonJSImports1.purs:2:1 - 5:29 (line 2, column 1 - line 5, column 29) - The following CommonJS imports are no supported in the ES foreign module for module Main: + The following CommonJS imports are not supported in the ES foreign module for module Main: some CJS module diff --git a/tests/purs/failing/UnsupportedFFICommonJSImports2.out b/tests/purs/failing/UnsupportedFFICommonJSImports2.out index 9be6007f69..605a493420 100644 --- a/tests/purs/failing/UnsupportedFFICommonJSImports2.out +++ b/tests/purs/failing/UnsupportedFFICommonJSImports2.out @@ -1,7 +1,7 @@ Error found: at tests/purs/failing/UnsupportedFFICommonJSImports2.purs:2:1 - 5:29 (line 2, column 1 - line 5, column 29) - The following CommonJS imports are no supported in the ES foreign module for module Main: + The following CommonJS imports are not supported in the ES foreign module for module Main: some CJS module From fba2a49a8ca7a33f0f9ad895482671d7b94412fb Mon Sep 17 00:00:00 2001 From: sigma-andex Date: Tue, 22 Feb 2022 17:11:35 +0000 Subject: [PATCH 57/62] Remove temporary entries from changelog --- CHANGELOG.d/breaking_switch-to-es-modules.md | 2 -- 1 file changed, 2 deletions(-) diff --git a/CHANGELOG.d/breaking_switch-to-es-modules.md b/CHANGELOG.d/breaking_switch-to-es-modules.md index 209419c31d..f65e8d9221 100644 --- a/CHANGELOG.d/breaking_switch-to-es-modules.md +++ b/CHANGELOG.d/breaking_switch-to-es-modules.md @@ -23,6 +23,4 @@ ``` * FFI is annotated with `/* #__PURE__ */` so that bundlers can perform DCE -* If CJS is detected a `Warning` is emitted * The current LTS Node.js version `12` is now the required minimum version -* `purs bundle` has been rudimentarily updated but will be removed in a subsequent PR From 993ade0d7c3ac533fb858d7a9be813a683c090a1 Mon Sep 17 00:00:00 2001 From: sigma-andex Date: Thu, 24 Feb 2022 11:18:02 +0000 Subject: [PATCH 58/62] Remove version update --- purescript.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/purescript.cabal b/purescript.cabal index 398b1ecf4c..765ddabdf3 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 name: purescript -- note: When updating the prerelease identifier, update it in app/Version.hs too! -version: 0.15.0 +version: 0.14.5 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 69df12916c4895b9f77b0c21513be1a057a85dcc Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 24 Feb 2022 09:37:57 -0600 Subject: [PATCH 59/62] Stop using es modules branch for lists dependency We found that the lists repo didn't have any FFI, so an `es-modules` branch was pointless. I deleted the branch after closing the PR I had opened for it, thinking there was some FFI to migrate. The branch no longer existing is what is breaking the build --- tests/support/bower.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/support/bower.json b/tests/support/bower.json index ffe266fd1f..667acb6679 100644 --- a/tests/support/bower.json +++ b/tests/support/bower.json @@ -16,7 +16,7 @@ "purescript-integers": "https://github.com/working-group-purescript-es/purescript-integers.git#es-modules", "purescript-invariant": "5.0.0", "purescript-lazy": "https://github.com/working-group-purescript-es/purescript-lazy.git#es-modules", - "purescript-lists": "https://github.com/working-group-purescript-es/purescript-lists.git#es-modules", + "purescript-lists": "6.0.0", "purescript-math": "https://github.com/working-group-purescript-es/purescript-math.git#es-modules", "purescript-maybe": "5.0.0", "purescript-newtype": "4.0.0", @@ -52,4 +52,4 @@ "purescript-prelude": "es-modules", "purescript-unsafe-coerce": "es-modules" } -} +} \ No newline at end of file From a1a1eff3abecaa9cfc59ea829199111a4dab9438 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Fri, 25 Feb 2022 03:47:31 -0500 Subject: [PATCH 60/62] Refactor Pure -> Comment in CoreImp --- src/Language/PureScript/CodeGen/JS.hs | 10 +++---- src/Language/PureScript/CodeGen/JS/Printer.hs | 6 ++--- src/Language/PureScript/CoreImp/AST.hs | 26 +++++++++---------- .../PureScript/CoreImp/Optimizer/TCO.hs | 2 +- 4 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index a3f9c84ca7..4dcdd49a52 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -66,7 +66,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = . (\\ (mn : C.primModules)) $ ordNub $ map snd imps F.traverse_ (F.traverse_ checkIntegers) optimized comments <- not <$> asks optionsNoComments - let header = if comments && not (null coms) then AST.Comment Nothing coms else id + let header = if comments && not (null coms) then AST.Comment (AST.SourceComments coms) else id let foreign' = maybe [] (pure . AST.Import Nothing "$foreign") $ if null foreigns then Nothing else foreignInclude let moduleBody = (maybe [] (uncurry (:) . first header) . uncons) $ foreign' ++ jsImports ++ concat optimized let foreignExps = exps `intersect` foreigns @@ -83,7 +83,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = -- us remove any unreferenced top-level declarations. To achieve this, we wrap any non-trivial -- top-level values in an IIFE marked with a pure annotation. annotatePure :: AST -> AST - annotatePure js@(AST.App _ (AST.Function _ _ _ _) _) = AST.Pure Nothing js + annotatePure js@(AST.App _ (AST.Function _ _ _ _) _) = AST.Comment AST.PureAnnotation js annotatePure js@(AST.App _ _ _) = pureIife js annotatePure js@(AST.Unary _ _ _) = pureIife js annotatePure js@(AST.Binary _ _ _ _) = pureIife js @@ -93,11 +93,11 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = annotatePure js@(AST.ArrayLiteral _ []) = js annotatePure js@(AST.ArrayLiteral _ _) = pureIife js annotatePure (AST.VariableIntroduction ss name (Just js)) = AST.VariableIntroduction ss name (Just (annotatePure js)) - annotatePure (AST.Comment a b js) = AST.Comment a b (annotatePure js) + annotatePure (AST.Comment c js) = AST.Comment c (annotatePure js) annotatePure js = js pureIife :: AST -> AST - pureIife val = AST.Pure Nothing $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing [AST.Return Nothing val])) [] + pureIife val = AST.Comment AST.PureAnnotation $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing [AST.Return Nothing val])) [] -- | Extracts all declaration names from a binding group. getNames :: Bind Ann -> [Ident] @@ -193,7 +193,7 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = withoutComment <- asks optionsNoComments if withoutComment then nonRecToJS a i (modifyAnn removeComments e) - else AST.Comment Nothing com <$> nonRecToJS a i (modifyAnn removeComments e) + else AST.Comment (AST.SourceComments com) <$> nonRecToJS a i (modifyAnn removeComments e) nonRecToJS (ss, _, _, _) ident val = do js <- valueToJs val withPos ss $ AST.VariableIntroduction Nothing (identToJs ident) (Just js) diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index 5fa887a7f2..fc3139f633 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -115,13 +115,13 @@ literals = mkPattern' match' [ return $ emit "throw " , prettyPrintJS' value ] - match (Comment _ com js) = mconcat <$> sequence + match (Comment (SourceComments com) js) = mconcat <$> sequence [ return $ emit "\n" , mconcat <$> forM com comment , prettyPrintJS' js ] - match (Pure _ js) = mconcat <$> sequence - [ return $ emit "/* #__PURE__ */ " + match (Comment PureAnnotation js) = mconcat <$> sequence + [ return $ emit "/* #__PURE__ */ " , prettyPrintJS' js ] match (Import _ ident from) = return . emit $ diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs index 01ca44a944..da40453d07 100644 --- a/src/Language/PureScript/CoreImp/AST.hs +++ b/src/Language/PureScript/CoreImp/AST.hs @@ -45,6 +45,13 @@ data BinaryOperator | ZeroFillShiftRight deriving (Show, Eq) +-- | Data type for CoreImp comments, which can come from either the PureScript +-- source or internal transformations. +data CIComments + = SourceComments [Comment] + | PureAnnotation + deriving (Show, Eq) + -- | Data type for simplified JavaScript expressions data AST = NumericLiteral (Maybe SourceSpan) (Either Integer Double) @@ -91,10 +98,8 @@ data AST -- ^ Throw statement | InstanceOf (Maybe SourceSpan) AST AST -- ^ instanceof check - | Comment (Maybe SourceSpan) [Comment] AST + | Comment CIComments AST -- ^ Commented JavaScript - | Pure (Maybe SourceSpan) AST - -- ^ Purity annotation | Import (Maybe SourceSpan) Text PSString -- ^ Imported identifier and path to its module | Export (Maybe SourceSpan) (NEL.NonEmpty Text) (Maybe PSString) @@ -129,8 +134,7 @@ withSourceSpan withSpan = go where go (ReturnNoResult _) = ReturnNoResult ss go (Throw _ js) = Throw ss js go (InstanceOf _ j1 j2) = InstanceOf ss j1 j2 - go (Comment _ com j) = Comment ss com j - go (Pure _ js) = Pure ss js + go c@Comment{} = c go (Import _ ident from) = Import ss ident from go (Export _ idents from) = Export ss idents from @@ -159,8 +163,7 @@ getSourceSpan = go where go (ReturnNoResult ss) = ss go (Throw ss _) = ss go (InstanceOf ss _ _) = ss - go (Comment ss _ _) = ss - go (Pure ss _) = ss + go (Comment _ _) = Nothing go (Import ss _ _) = ss go (Export ss _ _) = ss @@ -184,8 +187,7 @@ everywhere f = go where go (Return ss js) = f (Return ss (go js)) go (Throw ss js) = f (Throw ss (go js)) go (InstanceOf ss j1 j2) = f (InstanceOf ss (go j1) (go j2)) - go (Comment ss com j) = f (Comment ss com (go j)) - go (Pure ss j) = f (Pure ss (go j)) + go (Comment com j) = f (Comment com (go j)) go other = f other everywhereTopDown :: (AST -> AST) -> AST -> AST @@ -211,8 +213,7 @@ everywhereTopDownM f = f >=> go where go (Return ss j) = Return ss <$> f' j go (Throw ss j) = Throw ss <$> f' j go (InstanceOf ss j1 j2) = InstanceOf ss <$> f' j1 <*> f' j2 - go (Comment ss com j) = Comment ss com <$> f' j - go (Pure ss j) = Pure ss <$> f' j + go (Comment com j) = Comment com <$> f' j go other = f other everything :: (r -> r -> r) -> (AST -> r) -> AST -> r @@ -235,6 +236,5 @@ everything (<>.) f = go where go j@(Return _ j1) = f j <>. go j1 go j@(Throw _ j1) = f j <>. go j1 go j@(InstanceOf _ j1 j2) = f j <>. go j1 <>. go j2 - go j@(Comment _ _ j1) = f j <>. go j1 - go j@(Pure _ j1) = f j <>. go j1 + go j@(Comment _ j1) = f j <>. go j1 go other = f other diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs index f93c6a93df..1189d18c99 100644 --- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs +++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs @@ -121,7 +121,7 @@ tco = flip evalState 0 . everywhereTopDownM convert where | otherwise = empty allInTailPosition (Assignment _ _ js1) = guard (countSelfReferences js1 == 0) $> S.empty - allInTailPosition (Comment _ _ js1) + allInTailPosition (Comment _ js1) = allInTailPosition js1 allInTailPosition _ = empty From 9f29b4dab3c7a7730a1f1a357ff8570eee5ddde1 Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Fri, 25 Feb 2022 03:47:31 -0500 Subject: [PATCH 61/62] Refactor CoreImp modules --- purescript.cabal | 1 + src/Language/PureScript/CodeGen/JS.hs | 41 +++---- src/Language/PureScript/CodeGen/JS/Printer.hs | 105 ++++++++++-------- src/Language/PureScript/CoreImp/AST.hs | 9 -- src/Language/PureScript/CoreImp/Module.hs | 19 ++++ tests/purs/optimize/2866.out.js | 1 - 6 files changed, 102 insertions(+), 74 deletions(-) create mode 100644 src/Language/PureScript/CoreImp/Module.hs diff --git a/purescript.cabal b/purescript.cabal index de591de44f..3f64feed12 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -207,6 +207,7 @@ library Language.PureScript.CoreFn.Traversals Language.PureScript.CoreImp Language.PureScript.CoreImp.AST + Language.PureScript.CoreImp.Module Language.PureScript.CoreImp.Optimizer Language.PureScript.CoreImp.Optimizer.Blocks Language.PureScript.CoreImp.Optimizer.Common diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 4dcdd49a52..57e89eacb0 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -15,7 +15,7 @@ import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Supply.Class import Data.Bifunctor (first) -import Data.List ((\\), intersect, uncons) +import Data.List ((\\), intersect) import qualified Data.List.NonEmpty as NEL (nonEmpty) import qualified Data.Foldable as F import qualified Data.Map as M @@ -29,6 +29,7 @@ import Language.PureScript.AST.SourcePos import Language.PureScript.CodeGen.JS.Common as Common import Language.PureScript.CoreImp.AST (AST, everywhereTopDownM, withSourceSpan) import qualified Language.PureScript.CoreImp.AST as AST +import qualified Language.PureScript.CoreImp.Module as AST import Language.PureScript.CoreImp.Optimizer import Language.PureScript.CoreFn import Language.PureScript.Crash @@ -50,7 +51,7 @@ moduleToJs . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m) => Module Ann -> Maybe PSString - -> m [AST] + -> m AST.Module moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = rethrow (addHint (ErrorInModule mn)) $ do let usedNames = concatMap getNames decls @@ -61,21 +62,23 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = let mnReverseLookup = M.fromList $ map (\(origName, (_, safeName)) -> (moduleNameToJs safeName, origName)) $ M.toList mnLookup let usedModuleNames = foldMap (foldMap (findModules mnReverseLookup)) optimized `S.union` M.keysSet reExps - jsImports <- traverse (importToJs mnLookup) - . filter (flip S.member usedModuleNames) - . (\\ (mn : C.primModules)) $ ordNub $ map snd imps + let jsImports + = map (importToJs mnLookup) + . filter (flip S.member usedModuleNames) + . (\\ (mn : C.primModules)) $ ordNub $ map snd imps F.traverse_ (F.traverse_ checkIntegers) optimized comments <- not <$> asks optionsNoComments - let header = if comments && not (null coms) then AST.Comment (AST.SourceComments coms) else id - let foreign' = maybe [] (pure . AST.Import Nothing "$foreign") $ if null foreigns then Nothing else foreignInclude - let moduleBody = (maybe [] (uncurry (:) . first header) . uncons) $ foreign' ++ jsImports ++ concat optimized + let header = if comments then coms else [] + let foreign' = maybe [] (pure . AST.Import "$foreign") $ if null foreigns then Nothing else foreignInclude + let moduleBody = concat optimized let foreignExps = exps `intersect` foreigns let standardExps = exps \\ foreignExps let reExps' = M.toList (M.withoutKeys reExps (S.fromList C.primModules)) - return $ moduleBody - ++ (maybeToList . exportsToJs foreignInclude $ foreignExps) - ++ (maybeToList . exportsToJs Nothing $ standardExps) - ++ mapMaybe reExportsToJs reExps' + let jsExports + = (maybeToList . exportsToJs foreignInclude $ foreignExps) + ++ (maybeToList . exportsToJs Nothing $ standardExps) + ++ mapMaybe reExportsToJs reExps' + return $ AST.Module header (foreign' ++ jsImports) moduleBody jsExports where -- | Adds purity annotations to top-level values for bundlers. @@ -127,19 +130,19 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = -- | Generates JavaScript code for a module import, binding the required module -- to the alternative - importToJs :: M.Map ModuleName (Ann, ModuleName) -> ModuleName -> m AST - importToJs mnLookup mn' = do - let ((ss, _, _, _), mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup - withPos ss $ AST.Import Nothing (moduleNameToJs mnSafe) (moduleImportPath mn') + importToJs :: M.Map ModuleName (Ann, ModuleName) -> ModuleName -> AST.Import + importToJs mnLookup mn' = + let (_, mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup + in AST.Import (moduleNameToJs mnSafe) (moduleImportPath mn') -- | Generates JavaScript code for exporting at least one identifier, -- eventually from another module. - exportsToJs :: Maybe PSString -> [Ident] -> Maybe AST - exportsToJs from = fmap (flip (AST.Export Nothing) from) . NEL.nonEmpty . fmap runIdent + 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 -- from another module. - reExportsToJs :: (ModuleName, [Ident]) -> Maybe AST + reExportsToJs :: (ModuleName, [Ident]) -> Maybe AST.Export reExportsToJs = uncurry exportsToJs . first (Just . moduleImportPath) moduleImportPath :: ModuleName -> PSString diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index fc3139f633..8ffc0403d2 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -20,6 +20,7 @@ import qualified Data.List.NonEmpty 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 @@ -124,9 +125,44 @@ literals = mkPattern' match' [ return $ emit "/* #__PURE__ */ " , prettyPrintJS' js ] - match (Import _ ident from) = return . emit $ - "import * as " <> ident <> " from " <> prettyPrintStringJS from - match (Export _ idents from) = mconcat <$> sequence + match _ = mzero + +comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen +comment (LineComment com) = mconcat <$> sequence + [ currentIndent + , return $ emit "//" <> emit com <> emit "\n" + ] +comment (BlockComment com) = fmap mconcat $ sequence $ + [ currentIndent + , return $ emit "/**\n" + ] ++ + map asLine (T.lines com) ++ + [ currentIndent + , return $ emit " */\n" + , currentIndent + ] + where + asLine :: (Emit gen) => Text -> StateT PrinterState Maybe gen + asLine s = do + i <- currentIndent + return $ i <> emit " * " <> (emit . removeComments) s <> emit "\n" + + removeComments :: Text -> Text + removeComments t = + case T.stripPrefix "*/" t of + Just rest -> removeComments rest + Nothing -> case T.uncons t of + Just (x, xs) -> x `T.cons` removeComments xs + Nothing -> "" + +prettyImport :: (Emit gen) => Import -> StateT PrinterState Maybe gen +prettyImport (Import ident from) = + return . emit $ + "import * as " <> ident <> " from " <> prettyPrintStringJS from <> ";" + +prettyExport :: (Emit gen) => Export -> StateT PrinterState Maybe gen +prettyExport (Export idents from) = + mconcat <$> sequence [ return $ emit "export {\n" , withIndent $ do let exportsStrings = emit . exportedIdentToString from <$> idents @@ -134,45 +170,16 @@ literals = mkPattern' match' return . intercalate (emit ",\n") . NEL.toList $ (indentString <>) <$> exportsStrings , return $ emit "\n" , currentIndent - , return . emit $ "}" <> maybe "" ((" from " <>) . prettyPrintStringJS) from - ] - where - exportedIdentToString Nothing ident - | nameIsJsReserved ident || nameIsJsBuiltIn ident - = "$$" <> ident <> " as " <> ident - exportedIdentToString _ "$main" - = T.concatMap identCharToText "$main" <> " as $main" - exportedIdentToString _ ident - = T.concatMap identCharToText ident - match _ = mzero - - comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen - comment (LineComment com) = mconcat <$> sequence - [ currentIndent - , return $ emit "//" <> emit com <> emit "\n" - ] - comment (BlockComment com) = fmap mconcat $ sequence $ - [ currentIndent - , return $ emit "/**\n" - ] ++ - map asLine (T.lines com) ++ - [ currentIndent - , return $ emit " */\n" - , currentIndent + , return . emit $ "}" <> maybe "" ((" from " <>) . prettyPrintStringJS) from <> ";" ] - where - asLine :: (Emit gen) => Text -> StateT PrinterState Maybe gen - asLine s = do - i <- currentIndent - return $ i <> emit " * " <> (emit . removeComments) s <> emit "\n" - - removeComments :: Text -> Text - removeComments t = - case T.stripPrefix "*/" t of - Just rest -> removeComments rest - Nothing -> case T.uncons t of - Just (x, xs) -> x `T.cons` removeComments xs - Nothing -> "" + where + exportedIdentToString Nothing ident + | nameIsJsReserved ident || nameIsJsBuiltIn ident + = "$$" <> ident <> " as " <> ident + exportedIdentToString _ "$main" + = T.concatMap identCharToText "$main" <> " as $main" + exportedIdentToString _ ident + = T.concatMap identCharToText ident accessor :: Pattern PrinterState AST (Text, AST) accessor = mkPattern match @@ -242,14 +249,22 @@ prettyStatements sts = do indentString <- currentIndent return $ intercalate (emit "\n") $ map ((<> emit ";") . (indentString <>)) jss +prettyModule :: (Emit gen) => Module -> StateT PrinterState Maybe gen +prettyModule Module{..} = do + header <- mconcat <$> traverse comment modHeader + imps <- traverse prettyImport modImports + body <- prettyStatements modBody + exps <- traverse prettyExport modExports + pure $ header <> intercalate (emit "\n") (imps ++ body : exps) + -- | Generate a pretty-printed string representing a collection of JavaScript expressions at the same indentation level -prettyPrintJSWithSourceMaps :: [AST] -> (Text, [SMap]) +prettyPrintJSWithSourceMaps :: Module -> (Text, [SMap]) prettyPrintJSWithSourceMaps js = - let StrPos (_, s, mp) = (fromMaybe (internalError "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyStatements) js + let StrPos (_, s, mp) = (fromMaybe (internalError "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyModule) js in (s, mp) -prettyPrintJS :: [AST] -> Text -prettyPrintJS = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyStatements +prettyPrintJS :: Module -> Text +prettyPrintJS = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyModule -- | Generate an indented, pretty-printed string representing a JavaScript expression prettyPrintJS' :: (Emit gen) => AST -> StateT PrinterState Maybe gen diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs index da40453d07..87f3d004ba 100644 --- a/src/Language/PureScript/CoreImp/AST.hs +++ b/src/Language/PureScript/CoreImp/AST.hs @@ -6,7 +6,6 @@ import Prelude.Compat import Control.Monad ((>=>)) import Control.Monad.Identity (Identity(..), runIdentity) import Data.Text (Text) -import qualified Data.List.NonEmpty as NEL (NonEmpty) import Language.PureScript.AST (SourceSpan(..)) import Language.PureScript.Comments @@ -100,10 +99,6 @@ data AST -- ^ instanceof check | Comment CIComments AST -- ^ Commented JavaScript - | Import (Maybe SourceSpan) Text PSString - -- ^ Imported identifier and path to its module - | Export (Maybe SourceSpan) (NEL.NonEmpty Text) (Maybe PSString) - -- ^ Exported identifiers and optional path to their module (for re-exports) deriving (Show, Eq) withSourceSpan :: SourceSpan -> AST -> AST @@ -135,8 +130,6 @@ withSourceSpan withSpan = go where go (Throw _ js) = Throw ss js go (InstanceOf _ j1 j2) = InstanceOf ss j1 j2 go c@Comment{} = c - go (Import _ ident from) = Import ss ident from - go (Export _ idents from) = Export ss idents from getSourceSpan :: AST -> Maybe SourceSpan getSourceSpan = go where @@ -164,8 +157,6 @@ getSourceSpan = go where go (Throw ss _) = ss go (InstanceOf ss _ _) = ss go (Comment _ _) = Nothing - go (Import ss _ _) = ss - go (Export ss _ _) = ss everywhere :: (AST -> AST) -> AST -> AST everywhere f = go where diff --git a/src/Language/PureScript/CoreImp/Module.hs b/src/Language/PureScript/CoreImp/Module.hs new file mode 100644 index 0000000000..efd591508f --- /dev/null +++ b/src/Language/PureScript/CoreImp/Module.hs @@ -0,0 +1,19 @@ +module Language.PureScript.CoreImp.Module where + +import Protolude +import qualified Data.List.NonEmpty as NEL (NonEmpty) + +import Language.PureScript.Comments +import Language.PureScript.CoreImp.AST +import Language.PureScript.PSString (PSString) + +data Module = Module + { modHeader :: [Comment] + , modImports :: [Import] + , modBody :: [AST] + , modExports :: [Export] + } + +data Import = Import Text PSString + +data Export = Export (NEL.NonEmpty Text) (Maybe PSString) diff --git a/tests/purs/optimize/2866.out.js b/tests/purs/optimize/2866.out.js index 7165fd5e32..f0854cce7d 100644 --- a/tests/purs/optimize/2866.out.js +++ b/tests/purs/optimize/2866.out.js @@ -1,4 +1,3 @@ - // Canonical test for #2866. This doesn't need to test whether `apply`s // defined from modules other than `Data.Function` are incorrectly // optimized since the rest of the test suite seemingly catches it. From 038108e206c9d7649c67072a22f0ec0b625e35fa Mon Sep 17 00:00:00 2001 From: Ryan Hendrickson Date: Fri, 25 Feb 2022 05:41:03 -0500 Subject: [PATCH 62/62] Be less liberal with IIFEs --- src/Language/PureScript/CodeGen/JS.hs | 64 ++++++++++++++++++++------- 1 file changed, 47 insertions(+), 17 deletions(-) diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index 57e89eacb0..6a71a97dec 100644 --- a/src/Language/PureScript/CodeGen/JS.hs +++ b/src/Language/PureScript/CodeGen/JS.hs @@ -9,6 +9,7 @@ module Language.PureScript.CodeGen.JS import Prelude.Compat 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) @@ -58,8 +59,9 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = let mnLookup = renameImports usedNames imps let decls' = renameModules mnLookup decls jsDecls <- mapM bindToJs decls' - optimized <- traverse (traverse (fmap annotatePure . optimize)) jsDecls let mnReverseLookup = M.fromList $ map (\(origName, (_, safeName)) -> (moduleNameToJs safeName, origName)) $ M.toList mnLookup + let moduleObjectNames = "$foreign" `S.insert` M.keysSet mnReverseLookup + optimized <- traverse (traverse (fmap (annotatePure moduleObjectNames) . optimize)) jsDecls let usedModuleNames = foldMap (foldMap (findModules mnReverseLookup)) optimized `S.union` M.keysSet reExps let jsImports @@ -85,22 +87,50 @@ moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreignInclude = -- The semantics here derive from treating top-level module evaluation as pure, which lets -- us remove any unreferenced top-level declarations. To achieve this, we wrap any non-trivial -- top-level values in an IIFE marked with a pure annotation. - annotatePure :: AST -> AST - annotatePure js@(AST.App _ (AST.Function _ _ _ _) _) = AST.Comment AST.PureAnnotation js - annotatePure js@(AST.App _ _ _) = pureIife js - annotatePure js@(AST.Unary _ _ _) = pureIife js - annotatePure js@(AST.Binary _ _ _ _) = pureIife js - annotatePure js@(AST.Indexer _ _ _) = pureIife js - annotatePure js@(AST.ObjectLiteral _ []) = js - annotatePure js@(AST.ObjectLiteral _ _) = pureIife js - annotatePure js@(AST.ArrayLiteral _ []) = js - annotatePure js@(AST.ArrayLiteral _ _) = pureIife js - annotatePure (AST.VariableIntroduction ss name (Just js)) = AST.VariableIntroduction ss name (Just (annotatePure js)) - annotatePure (AST.Comment c js) = AST.Comment c (annotatePure js) - annotatePure js = js - - pureIife :: AST -> AST - pureIife val = AST.Comment AST.PureAnnotation $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing [AST.Return Nothing val])) [] + annotatePure :: S.Set Text -> AST -> AST + annotatePure moduleObjectNames = annotateOrWrap + where + annotateOrWrap = liftA2 fromMaybe pureIife maybePure + + -- | 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 + -- 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 + -- considered effect-free. + maybePure' :: AST -> Maybe AST + maybePure' = maybePureGen True + + maybePureGen alreadyAnnotated = \case + AST.VariableIntroduction ss name j -> Just (AST.VariableIntroduction ss name (annotateOrWrap <$> j)) + AST.App ss f args -> (if alreadyAnnotated then AST.App else pureApp) ss <$> maybePure' f <*> traverse maybePure args + -- In general, indexers can be effectful, but not when indexing into an + -- ES module object. + AST.Indexer ss idx v@(AST.Var _ name) + | name `S.member` moduleObjectNames -> (\idx' -> AST.Indexer ss idx' v) <$> maybePure idx + AST.ArrayLiteral ss jss -> AST.ArrayLiteral ss <$> traverse maybePure jss + AST.ObjectLiteral ss props -> AST.ObjectLiteral ss <$> traverse (traverse maybePure) props + AST.Comment c js -> AST.Comment c <$> maybePure js + + js@AST.NumericLiteral{} -> Just js + js@AST.StringLiteral{} -> Just js + js@AST.BooleanLiteral{} -> Just js + js@AST.Function{} -> Just js + js@AST.Var{} -> Just js + + _ -> Nothing + + pureIife :: AST -> AST + pureIife val = pureApp Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing [AST.Return Nothing val])) [] + + 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. getNames :: Bind Ann -> [Ident]