diff --git a/.gitignore b/.gitignore index 06ddeaa54b..024b39a525 100644 --- a/.gitignore +++ b/.gitignore @@ -30,3 +30,6 @@ TAGS *.prof *.ps *.svg + +# macOS +.DS_Store diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs index adf235f81e..bd1e182ae2 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) @@ -19,6 +18,7 @@ import Data.List ((\\), intersect) import qualified Data.Foldable as F import qualified Data.Map as M import Data.Maybe (fromMaybe, isNothing) +import qualified Data.List.NonEmpty as NEL import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T @@ -55,23 +55,33 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ = let mnLookup = renameImports usedNames imps jsImports <- traverse (importToJs mnLookup) . (\\ (mn : C.primModules)) $ ordNub $ map snd imps + -- TODO: Determine if FFI (foreign) imports are used before generating this: + let jsForeignImport = [AST.Import Nothing "$foreign" "./foreign.js" | not $ null foreigns || isNothing foreign_] let decls' = renameModules mnLookup decls jsDecls <- mapM bindToJs decls' optimized <- traverse (traverse optimize) jsDecls F.traverse_ (F.traverse_ checkIntegers) optimized comments <- not <$> asks optionsNoComments - let strict = AST.StringLiteral Nothing "use strict" + let strict = AST.StringLiteral Nothing "" 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 moduleBody = header : foreign' ++ jsImports ++ concat optimized + let moduleBody = header : jsImports ++ jsForeignImport ++ 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 <> + (toExport standardExps Nothing) <> + (if not $ null foreigns || isNothing foreign_ + then toExport foreignExps (Just "./foreign.js") + else [] + ) where + toExport :: [Ident] -> Maybe PSString -> [AST.AST] + toExport xs from_ = + case NEL.nonEmpty xs of + Just nxs -> [AST.Export Nothing (mkString . runIdent <$> nxs) from_] + Nothing -> [] + -- | Extracts all declaration names from a binding group. getNames :: Bind Ann -> [Ident] getNames (NonRec _ ident _) = [ident] @@ -103,9 +113,9 @@ 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) + let moduleName = fromString . T.unpack $ moduleNameToJs mnSafe + let modulePath = fromString $ ".." T.unpack (runModuleName mn') "index.js" + withPos ss $ AST.Import Nothing moduleName modulePath -- | Replaces the `ModuleName`s in the AST so that the generated code refers to -- the collision-avoiding renamed module imports. diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs index da67fa78eb..d5513a835d 100644 --- a/src/Language/PureScript/CodeGen/JS/Printer.hs +++ b/src/Language/PureScript/CodeGen/JS/Printer.hs @@ -13,6 +13,7 @@ import Control.PatternArrows import qualified Control.Arrow as A import Data.Maybe (fromMaybe) +import qualified Data.List.NonEmpty as NEL import Data.Text (Text) import qualified Data.Text as T @@ -53,14 +54,6 @@ literals = mkPattern' match' , currentIndent , return $ emit "}" ] - where - objectPropertyToString :: (Emit gen) => PSString -> gen - objectPropertyToString s = - emit $ case decodeString s of - Just s' | not (identNeedsEscaping s') -> - s' - _ -> - prettyPrintStringJS s match (Block _ sts) = mconcat <$> sequence [ return $ emit "{\n" , withIndent $ prettyStatements sts @@ -119,6 +112,28 @@ literals = mkPattern' match' , mconcat <$> forM com comment , prettyPrintJS' js ] + match (Export _ ns mFrom) = fmap mconcat $ sequence $ + [ return $ emit "export {\n" + , withIndent $ do + let jss = objectPropertyToString <$> ns + indentString <- currentIndent + return $ intercalate (emit ",\n") $ NEL.toList $ (indentString <>) <$> jss + , return $ emit "\n" + , currentIndent + , return $ emit "}" + ] ++ fromClause + where + fromClause = maybe [] (\path -> + [ return $ emit " from " + , return $ objectPropertyToString path + ] + ) mFrom + match (Import _ name path) = mconcat <$> sequence + [ return $ emit "import * as " + , return $ emit name + , return $ emit " from " + , return $ emit $ prettyPrintStringJS path + ] match _ = mzero comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen @@ -149,6 +164,14 @@ literals = mkPattern' match' Just (x, xs) -> x `T.cons` removeComments xs Nothing -> "" +objectPropertyToString :: (Emit gen) => PSString -> gen +objectPropertyToString s = + emit $ case decodeString s of + Just s' | not (identNeedsEscaping s') -> + s' + _ -> + prettyPrintStringJS s + accessor :: Pattern PrinterState AST (Text, AST) accessor = mkPattern match where diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs index b6dcad1446..cba909dcf2 100644 --- a/src/Language/PureScript/CoreImp/AST.hs +++ b/src/Language/PureScript/CoreImp/AST.hs @@ -5,6 +5,7 @@ import Prelude.Compat import Control.Monad ((>=>)) import Control.Monad.Identity (Identity(..), runIdentity) +import qualified Data.List.NonEmpty as NEL import Data.Text (Text) import Language.PureScript.AST (SourceSpan(..)) @@ -92,6 +93,10 @@ data AST -- ^ instanceof check | Comment (Maybe SourceSpan) [Comment] AST -- ^ Commented JavaScript + | Import (Maybe SourceSpan) Text PSString + -- ^ Import statement with name and `from` path + | Export (Maybe SourceSpan) (NEL.NonEmpty PSString) (Maybe PSString) + -- ^ Export statement with exported names and optional `from` path deriving (Show, Eq) withSourceSpan :: SourceSpan -> AST -> AST @@ -123,6 +128,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 _ name path) = Import ss name path + go (Export _ js from_) = Export ss js from_ getSourceSpan :: AST -> Maybe SourceSpan getSourceSpan = go where @@ -150,6 +157,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 diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index f7c6d5eaee..8ed753c82d 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -159,12 +159,15 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = when (S.member JS codegenTargets) $ do foreignInclude <- case mn `M.lookup` foreigns of Just _ - | not $ requiresForeign m -> do + | not $ requiresForeign m -> return Nothing - | otherwise -> do + | otherwise -> return $ Just $ Imp.App Nothing (Imp.Var Nothing "require") [Imp.StringLiteral Nothing "./foreign.js"] - Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn - | otherwise -> return Nothing + Nothing + | requiresForeign m -> + throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn + | otherwise -> + return Nothing rawJs <- J.moduleToJs m foreignInclude dir <- lift $ makeIO (const (ErrorMessage [] $ CannotGetFileInfo ".")) getCurrentDirectory let sourceMaps = S.member JSSourceMap codegenTargets diff --git a/tests/es2015-codegen/output/Main/index.js b/tests/es2015-codegen/output/Main/index.js index 14a07172c2..c8403f33cb 100644 --- a/tests/es2015-codegen/output/Main/index.js +++ b/tests/es2015-codegen/output/Main/index.js @@ -1,15 +1,17 @@ // Generated by purs version 0.12.1 -"use strict"; -var $foreign = require("./foreign.js"); -var Quux = require("../Quux/index.js"); +""; +import * as Quux from "../Quux/index.js"; +import * as $foreign from "./foreign.js"; var quux = Quux.quux; var importedBaz = $foreign.baz; var foo = "foo"; var bar = "bar"; -module.exports = { - foo: foo, - bar: bar, - quux: quux, - importedBaz: importedBaz, - baz: $foreign.baz +export { + foo, + bar, + quux, + importedBaz }; +export { + baz +} from "./foreign.js"; diff --git a/tests/es2015-codegen/output/Quux/index.js b/tests/es2015-codegen/output/Quux/index.js index a028819ff1..f8a0725348 100644 --- a/tests/es2015-codegen/output/Quux/index.js +++ b/tests/es2015-codegen/output/Quux/index.js @@ -1,6 +1,6 @@ // Generated by purs version 0.12.1 -"use strict"; +""; var quux = "quux"; -module.exports = { - quux: quux +export { + quux };