POC: ES2015 Modules Codegen (WIP)

.gitignore

@@ -30,3 +30,6 @@ TAGS
 *.prof
 *.ps
 *.svg
+
+# macOS
+.DS_Store

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.

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

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

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