@@ -17,14 +17,16 @@
1717
1818module Language.PureScript.CodeGen.JS (
1919 module AST,
20+ ModuleType(..),
2021 declToJs,
2122 moduleToJs,
22− wrapExportsContainer,
2323 isIdent
2424) where
2525
2626import Data.Maybe (fromMaybe, mapMaybe)
2727import Data.Function (on)
28+import Data.List (nub, (\\))
29+import Data.Generics (mkQ, everything)
2830
2931import Control.Arrow (second)
3032import Control.Monad (replicateM, forM)
@@ -41,26 +43,45 @@ import Language.PureScript.Types
4143import Language.PureScript.Optimizer
4244import Language.PureScript.CodeGen.Common
4345import Language.PureScript.Environment
44−import qualified Language.PureScript.Constants as C
46+
47+-- |
48+-- Different types of modules which are supported
49+--
50+data ModuleType = CommonJS | Globals
4551
4652-- |
4753-- Generate code in the simplified Javascript intermediate representation for all declarations in a
4854-- module.
4955--
50−moduleToJs :: Options -> Module -> Environment -> Maybe JS
51−moduleToJs opts (Module name decls (Just exps)) env =
52− case jsDecls of
53− [] -> Nothing
54− _ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar C._ps)) $
55− JSApp (JSFunction Nothing [] (JSBlock $
56− JSVariableIntroduction "module" (Just $ JSObjectLiteral []) :
57− jsDecls ++
58− jsExports ++
59− [JSReturn $ JSVar "module"])) []
56+moduleToJs :: ModuleType -> Options -> Module -> Environment -> [JS]
57+moduleToJs mt opts (Module name decls (Just exps)) env = case mt of
58+ CommonJS -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) moduleExports]
59+ Globals ->
60+ [ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar (optionsBrowserNamespace opts))) (
61+ JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn moduleExports]))) []
62+ )
63+ ]
6064 where
65+ moduleBody = JSStringLiteral "use strict" : jsImports ++ jsDecls
66+ moduleExports = JSObjectLiteral $ concatMap exportToJs exps
6167 jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts name decl env) decls)
62− jsExports = concatMap exportToJs exps
63−moduleToJs _ _ _ = error "Exports should have been elaborated in name desugaring"
68+ jsImports = map (importToJs mt opts) . (\\ [name]) . nub $ concatMap imports decls
69+moduleToJs _ _ _ _ = error "Exports should have been elaborated in name desugaring"
70+
71+importToJs :: ModuleType -> Options -> ModuleName -> JS
72+importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)
73+ where
74+ moduleBody = case mt of
75+ CommonJS -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]
76+ Globals -> JSAccessor (runModuleName mn) (JSVar (optionsBrowserNamespace opts))
77+
78+imports :: Declaration -> [ModuleName]
79+imports = everything (++) (mkQ [] collect)
80+ where
81+ collect :: Value -> [ModuleName]
82+ collect (Var (Qualified (Just mn) _)) = [mn]
83+ collect (Constructor (Qualified (Just mn) _)) = [mn]
84+ collect _ = []
6485
6586-- |
6687-- Generate code in the simplified Javascript intermediate representation for a declaration
@@ -87,22 +108,14 @@ declToJs opts mp (PositionedDeclaration _ d) e = declToJs opts mp d e
87108declToJs _ _ _ _ = Nothing
88109
89110-- |
90−-- Generate code in the simplified Javascript intermediate representation for an export from a
91−-- module.
111+-- Generate key//value pairs for an object literal exporting values from a module.
92112--
93−exportToJs :: DeclarationRef -> [JS]
94−exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Ident . runProperName)
95−exportToJs (ValueRef name) = [export name]
96−exportToJs (TypeInstanceRef name) = [export name]
113+exportToJs :: DeclarationRef -> [(String, JS)]
114+exportToJs (TypeRef _ (Just dctors)) = map ((\n -> (n, var (Ident n))) . runProperName) dctors
115+exportToJs (ValueRef name) = [(runIdent name, var name)]
116+exportToJs (TypeInstanceRef name) = [(runIdent name, var name)]
97117exportToJs _ = []
98118
99−-- |
100−-- Generate code in the simplified Javascript intermediate representation for assigning an exported
101−-- value to the current module object.
102−--
103−export :: Ident -> JS
104−export ident = JSAssignment (accessor ident (JSVar "module")) (var ident)
105−
106119-- |
107120-- Generate code in the simplified Javascript intermediate representation for a variable based on a
108121-- PureScript identifier.
@@ -225,7 +238,7 @@ varToJs m qual = qualifiedToJS m id qual
225238-- variable that may have a qualified name.
226239--
227240qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS
228−qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSAccessor (moduleNameToJs m') $ JSVar C._ps)
241+qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSVar (moduleNameToJs m'))
229242qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)
230243
231244-- |
@@ -328,13 +341,3 @@ isOnlyConstructor e ctor =
328341 numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e
329342 typeConstructor (Qualified (Just moduleName) _, (tyCtor, _)) = (moduleName, tyCtor)
330343 typeConstructor _ = error "Invalid argument to isOnlyConstructor"
331−
332−wrapExportsContainer :: Options -> [JS] -> JS
333−wrapExportsContainer opts modules = JSApp (JSFunction Nothing [C._ps] $ JSBlock $ JSStringLiteral "use strict" : modules) [exportSelector]
334− where
335− exportSelector = JSConditional (JSBinary And (JSBinary NotEqualTo (JSTypeOf $ JSVar "module") (JSStringLiteral "undefined")) (JSAccessor "exports" (JSVar "module")))
336− (JSAccessor "exports" (JSVar "module"))
337− (JSConditional (JSBinary NotEqualTo (JSTypeOf $ JSVar "window") (JSStringLiteral "undefined"))
338− (JSAssignment (JSAccessor browserNamespace (JSVar "window")) (JSBinary Or (JSAccessor browserNamespace (JSVar "window")) (JSObjectLiteral [])))
339− (JSApp (JSFunction Nothing [] $ JSBlock [JSThrow $ JSStringLiteral "PureScript doesn't know how to export modules in the current environment"]) []))
340− browserNamespace = optionsBrowserNamespace opts