git.iko.soy/rowtype-yoga/purescript-native
on 9ed0974 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Bundle.hs
637 lines 24 kB history raw
1-- |
2-- Bundles compiled PureScript modules for the browser.
3--
4-- This module takes as input the individual generated modules from 'Language.PureScript.Make' and
5-- performs dead code elimination, filters empty modules,
6-- and generates the final Javascript bundle.
7module Language.PureScript.Bundle
8 ( bundle
9 , guessModuleIdentifier
10 , ModuleIdentifier(..)
11 , moduleName
12 , ModuleType(..)
13 , ErrorMessage(..)
14 , printErrorMessage
15 , getExportedIdentifiers
16 ) where
18import Prelude.Compat
20import Control.Monad
21import Control.Monad.Error.Class
23import Data.Char (chr, digitToInt)
24import Data.Generics (everything, everywhere, mkQ, mkT)
25import Data.Graph
26import Data.List (nub, stripPrefix)
27import Data.Maybe (mapMaybe, catMaybes)
28import Data.Version (showVersion)
29import qualified Data.Set as S
31import Language.JavaScript.Parser
32import Language.JavaScript.Parser.AST
34import qualified Paths_purescript as Paths
36import System.FilePath (takeFileName, takeDirectory)
38-- | The type of error messages. We separate generation and rendering of errors using a data
39-- type, in case we need to match on error types later.
40data ErrorMessage
41 = UnsupportedModulePath String
42 | InvalidTopLevel
43 | UnableToParseModule String
44 | UnsupportedExport
45 | ErrorInModule ModuleIdentifier ErrorMessage
46 | MissingEntryPoint String
47 | MissingMainModule String
48 deriving (Show)
50-- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.
51data ModuleType
52 = Regular
53 | Foreign
54 deriving (Show, Eq, Ord)
56showModuleType :: ModuleType -> String
57showModuleType Regular = "Regular"
58showModuleType Foreign = "Foreign"
60-- | A module is identified by its module name and its type.
61data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)
63moduleName :: ModuleIdentifier -> String
64moduleName (ModuleIdentifier name _) = name
66-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
67guessModuleIdentifier :: MonadError ErrorMessage m => FilePath -> m ModuleIdentifier
68guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)
69 where
70 guessModuleType "index.js" = pure Regular
71 guessModuleType "foreign.js" = pure Foreign
72 guessModuleType name = throwError $ UnsupportedModulePath name
74-- | A piece of code is identified by its module and its name. These keys are used to label vertices
75-- in the dependency graph.
76type Key = (ModuleIdentifier, String)
78-- | An export is either a "regular export", which exports a name from the regular module we are in,
79-- or a reexport of a declaration in the corresponding foreign module.
80--
81-- Regular exports are labelled, since they might re-export an operator with another name.
82data ExportType
83 = RegularExport String
84 | ForeignReexport
85 deriving (Show, Eq, Ord)
87-- | There are four types of module element we are interested in:
88--
89-- 1) Require statements
90-- 2) Member declarations
91-- 3) Export lists
92-- 4) Everything else
93--
94-- Each is labelled with the original AST node which generated it, so that we can dump it back
95-- into the output during codegen.
96data ModuleElement
97 = Require JSStatement String (Either String ModuleIdentifier)
98 | Member JSStatement Bool String JSExpression [Key]
99 | ExportsList [(ExportType, String, JSExpression, [Key])]
100 | Other JSStatement
101 deriving (Show)
103-- | A module is just a list of elements of the types listed above.
104data Module = Module ModuleIdentifier [ModuleElement] deriving (Show)
106-- | Prepare an error message for consumption by humans.
107printErrorMessage :: ErrorMessage -> [String]
108printErrorMessage (UnsupportedModulePath s) =
109 [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."
110 , "The following file names are supported:"
111 , " 1) index.js (psc native modules)"
112 , " 2) foreign.js (psc foreign modules)"
113 ]
114printErrorMessage InvalidTopLevel =
115 [ "Expected a list of source elements at the top level." ]
116printErrorMessage (UnableToParseModule err) =
117 [ "The module could not be parsed:"
118 , err
119 ]
120printErrorMessage UnsupportedExport =
121 [ "An export was unsupported. Exports can be defined in one of two ways: "
122 , " 1) exports.name = ..."
123 , " 2) exports = { ... }"
124 ]
125printErrorMessage (ErrorInModule mid e) =
126 ("Error in module " ++ displayIdentifier mid ++ ":")
127 : ""
128 : map (" " ++) (printErrorMessage e)
129 where
130 displayIdentifier (ModuleIdentifier name ty) =
131 name ++ " (" ++ showModuleType ty ++ ")"
132printErrorMessage (MissingEntryPoint mName) =
133 [ "Couldn't find a CommonJS module for the specified entry point: " ++ mName
134 ]
135printErrorMessage (MissingMainModule mName) =
136 [ "Couldn't find a CommonJS module for the specified main module: " ++ mName
137 ]
139-- | Calculate the ModuleIdentifier which a require(...) statement imports.
140checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Either String ModuleIdentifier
141checkImportPath "./foreign" m _ =
142 Right (ModuleIdentifier (moduleName m) Foreign)
143checkImportPath name _ names
144 | Just name' <- stripPrefix "../" name
145 , name' `S.member` names = Right (ModuleIdentifier name' Regular)
146checkImportPath name _ _ = Left name
148-- | Compute the dependencies of all elements in a module, and add them to the tree.
149--
150-- Members and exports can have dependencies. A dependency is of one of the following forms:
151--
152-- 1) module.name or member["name"]
153--
154-- where module was imported using
155--
156-- var module = require("Module.Name");
157--
158-- 2) name
159--
160-- where name is the name of a member defined in the current module.
161withDeps :: Module -> Module
162withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
163 where
164 -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
165 imports :: [(String, ModuleIdentifier)]
166 imports = mapMaybe toImport es
167 where
168 toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)
169 toImport (Require _ nm (Right mid)) = Just (nm, mid)
170 toImport _ = Nothing
172 -- | Collects all member names in scope, so that we can identify dependencies of the second type.
173 boundNames :: [String]
174 boundNames = mapMaybe toBoundName es
175 where
176 toBoundName :: ModuleElement -> Maybe String
177 toBoundName (Member _ _ nm _ _) = Just nm
178 toBoundName _ = Nothing
180 -- | Calculate dependencies and add them to the current element.
181 expandDeps :: ModuleElement -> ModuleElement
182 expandDeps (Member n f nm decl _) = Member n f nm decl (nub $ dependencies modulePath decl)
183 expandDeps (ExportsList exps) = ExportsList (map expand exps)
184 where
185 expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))
186 expandDeps other = other
188 dependencies :: ModuleIdentifier -> JSExpression -> [(ModuleIdentifier, String)]
189 dependencies m = everything (++) (mkQ [] toReference)
190 where
191 toReference :: JSExpression -> [(ModuleIdentifier, String)]
192 toReference (JSMemberDot mn _ nm)
193 | JSIdentifier _ mn' <- mn
194 , JSIdentifier _ nm' <- nm
195 , Just mid <- lookup mn' imports
196 = [(mid, nm')]
197 toReference (JSMemberSquare mn _ nm _)
198 | JSIdentifier _ mn' <- mn
199 , Just nm' <- fromStringLiteral nm
200 , Just mid <- lookup mn' imports
201 = [(mid, nm')]
202 toReference (JSIdentifier _ nm)
203 | nm `elem` boundNames
204 = [(m, nm)]
205 toReference _ = []
207-- String literals include the quote chars
208fromStringLiteral :: JSExpression -> Maybe String
209fromStringLiteral (JSStringLiteral _ str) = Just $ strValue str
210fromStringLiteral _ = Nothing
212strValue :: String -> String
213strValue str = go $ drop 1 str
214 where
215 go ('\\' : 'b' : xs) = '\b' : go xs
216 go ('\\' : 'f' : xs) = '\f' : go xs
217 go ('\\' : 'n' : xs) = '\n' : go xs
218 go ('\\' : 'r' : xs) = '\r' : go xs
219 go ('\\' : 't' : xs) = '\t' : go xs
220 go ('\\' : 'v' : xs) = '\v' : go xs
221 go ('\\' : '0' : xs) = '\0' : go xs
222 go ('\\' : 'x' : a : b : xs) = chr (a' + b') : go xs
223 where
224 a' = 16 * digitToInt a
225 b' = digitToInt b
226 go ('\\' : 'u' : a : b : c : d : xs) = chr (a' + b' + c' + d') : go xs
227 where
228 a' = 16 * 16 * 16 * digitToInt a
229 b' = 16 * 16 * digitToInt b
230 c' = 16 * digitToInt c
231 d' = digitToInt d
232 go ('\\' : x : xs) = x : go xs
233 go "\"" = ""
234 go "'" = ""
235 go (x : xs) = x : go xs
236 go "" = ""
238commaList :: JSCommaList a -> [a]
239commaList JSLNil = []
240commaList (JSLOne x) = [x]
241commaList (JSLCons l _ x) = commaList l ++ [x]
243trailingCommaList :: JSCommaTrailingList a -> [a]
244trailingCommaList (JSCTLComma l _) = commaList l
245trailingCommaList (JSCTLNone l) = commaList l
247-- | Attempt to create a Module from a Javascript AST.
248--
249-- Each type of module element is matched using pattern guards, and everything else is bundled into the
250-- Other constructor.
251toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSAST -> m Module
252toModule mids mid top
253 | JSAstProgram smts _ <- top = Module mid <$> traverse toModuleElement smts
254 | otherwise = err InvalidTopLevel
255 where
256 err = throwError . ErrorInModule mid
258 toModuleElement :: JSStatement -> m ModuleElement
259 toModuleElement stmt
260 | Just (importName, importPath) <- matchRequire mids mid stmt
261 = pure (Require stmt importName importPath)
262 toModuleElement stmt
263 | Just (exported, name, decl) <- matchMember stmt
264 = pure (Member stmt exported name decl [])
265 toModuleElement stmt
266 | Just props <- matchExportsAssignment stmt
267 = ExportsList <$> traverse toExport (trailingCommaList props)
268 where
269 toExport :: JSObjectProperty -> m (ExportType, String, JSExpression, [Key])
270 toExport (JSPropertyNameandValue name _ [val]) =
271 (,,val,[]) <$> exportType val
272 <*> extractLabel' name
273 toExport _ = err UnsupportedExport
275 exportType :: JSExpression -> m ExportType
276 exportType (JSMemberDot f _ _)
277 | JSIdentifier _ "$foreign" <- f
278 = pure ForeignReexport
279 exportType (JSMemberSquare f _ _ _)
280 | JSIdentifier _ "$foreign" <- f
281 = pure ForeignReexport
282 exportType (JSIdentifier _ s) = pure (RegularExport s)
283 exportType _ = err UnsupportedExport
285 extractLabel' = maybe (err UnsupportedExport) pure . extractLabel
287 toModuleElement other = pure (Other other)
289-- Get a list of all the exported identifiers from a foreign module.
290--
291-- TODO: what if we assign to exports.foo and then later assign to
292-- module.exports (presumably overwriting exports.foo)?
293getExportedIdentifiers :: (MonadError ErrorMessage m)
294 => String
295 -> JSAST
296 -> m [String]
297getExportedIdentifiers mname top
298 | JSAstProgram stmts _ <- top = concat <$> traverse go stmts
299 | otherwise = err InvalidTopLevel
300 where
301 err = throwError . ErrorInModule (ModuleIdentifier mname Foreign)
303 go stmt
304 | Just props <- matchExportsAssignment stmt
305 = traverse toIdent (trailingCommaList props)
306 | Just (True, name, _) <- matchMember stmt
307 = pure [name]
308 | otherwise
309 = pure []
311 toIdent (JSPropertyNameandValue name _ [_]) =
312 extractLabel' name
313 toIdent _ =
314 err UnsupportedExport
316 extractLabel' = maybe (err UnsupportedExport) pure . extractLabel
318-- Matches JS statements like this:
319-- var ModuleName = require("file");
320matchRequire :: S.Set String
321 -> ModuleIdentifier
322 -> JSStatement
323 -> Maybe (String, Either String ModuleIdentifier)
324matchRequire mids mid stmt
325 | JSVariable _ jsInit _ <- stmt
326 , [JSVarInitExpression var varInit] <- commaList jsInit
327 , JSIdentifier _ importName <- var
328 , JSVarInit _ jsInitEx <- varInit
329 , JSMemberExpression req _ argsE _ <- jsInitEx
330 , JSIdentifier _ "require" <- req
331 , [ Just importPath ] <- map fromStringLiteral (commaList argsE)
332 , importPath' <- checkImportPath importPath mid mids
333 = Just (importName, importPath')
334 | otherwise
335 = Nothing
337-- Matches JS member declarations.
338matchMember :: JSStatement -> Maybe (Bool, String, JSExpression)
339matchMember stmt
340 -- var foo = expr;
341 | JSVariable _ jsInit _ <- stmt
342 , [JSVarInitExpression var varInit] <- commaList jsInit
343 , JSIdentifier _ name <- var
344 , JSVarInit _ decl <- varInit
345 = Just (False, name, decl)
346 -- exports.foo = expr; exports["foo"] = expr;
347 | JSAssignStatement e (JSAssign _) decl _ <- stmt
348 , Just name <- accessor e
349 = Just (True, name, decl)
350 | otherwise
351 = Nothing
352 where
353 accessor :: JSExpression -> Maybe String
354 accessor (JSMemberDot exports _ nm)
355 | JSIdentifier _ "exports" <- exports
356 , JSIdentifier _ name <- nm
357 = Just name
358 accessor (JSMemberSquare exports _ nm _)
359 | JSIdentifier _ "exports" <- exports
360 , Just name <- fromStringLiteral nm
361 = Just name
362 accessor _ = Nothing
364-- Matches assignments to module.exports, like this:
365-- module.exports = { ... }
366matchExportsAssignment :: JSStatement -> Maybe JSObjectPropertyList
367matchExportsAssignment stmt
368 | JSAssignStatement e (JSAssign _) decl _ <- stmt
369 , JSMemberDot module' _ exports <- e
370 , JSIdentifier _ "module" <- module'
371 , JSIdentifier _ "exports" <- exports
372 , JSObjectLiteral _ props _ <- decl
373 = Just props
374 | otherwise
375 = Nothing
377extractLabel :: JSPropertyName -> Maybe String
378extractLabel (JSPropertyString _ nm) = Just $ strValue nm
379extractLabel (JSPropertyIdent _ nm) = Just nm
380extractLabel _ = Nothing
382-- | Eliminate unused code based on the specified entry point set.
383compile :: [Module] -> [ModuleIdentifier] -> [Module]
384compile modules [] = modules
385compile modules entryPoints = filteredModules
386 where
387 (graph, _, vertexFor) = graphFromEdges verts
389 -- | The vertex set
390 verts :: [(ModuleElement, Key, [Key])]
391 verts = do
392 Module mid els <- modules
393 concatMap (toVertices mid) els
394 where
395 -- | Create a set of vertices for a module element.
396 --
397 -- Some special cases worth commenting on:
398 --
399 -- 1) Regular exports which simply export their own name do not count as dependencies.
400 -- Regular exports which rename and reexport an operator do count, however.
401 --
402 -- 2) Require statements don't contribute towards dependencies, since they effectively get
403 -- inlined wherever they are used inside other module elements.
404 toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
405 toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]
406 toVertices p m@(ExportsList exps) = mapMaybe toVertex exps
407 where
408 toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)
409 toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)
410 toVertex _ = Nothing
411 toVertices _ _ = []
413 -- | The set of vertices whose connected components we are interested in keeping.
414 entryPointVertices :: [Vertex]
415 entryPointVertices = catMaybes $ do
416 (_, k@(mid, _), _) <- verts
417 guard $ mid `elem` entryPoints
418 return (vertexFor k)
420 -- | The set of vertices reachable from an entry point
421 reachableSet :: S.Set Vertex
422 reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)
424 filteredModules :: [Module]
425 filteredModules = map filterUsed modules
426 where
427 filterUsed :: Module -> Module
428 filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
429 where
430 go :: [ModuleElement] -> [ModuleElement]
431 go [] = []
432 go (d : rest)
433 | not (isDeclUsed d) = go rest
434 | otherwise = d : go rest
436 -- | Filter out the exports for members which aren't used.
437 filterExports :: ModuleElement -> ModuleElement
438 filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
439 filterExports me = me
441 isDeclUsed :: ModuleElement -> Bool
442 isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)
443 isDeclUsed _ = True
445 isKeyUsed :: Key -> Bool
446 isKeyUsed k
447 | Just me <- vertexFor k = me `S.member` reachableSet
448 | otherwise = False
450-- | Topologically sort the module dependency graph, so that when we generate code, modules can be
451-- defined in the right order.
452sortModules :: [Module] -> [Module]
453sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
454 where
455 (graph, nodeFor, _) = graphFromEdges $ do
456 m@(Module mid els) <- modules
457 return (m, mid, mapMaybe getKey els)
459 getKey :: ModuleElement -> Maybe ModuleIdentifier
460 getKey (Require _ _ (Right mi)) = Just mi
461 getKey _ = Nothing
463-- | A module is empty if it contains no exported members (in other words,
464-- if the only things left after dead code elimination are module imports and
465-- "other" foreign code).
466--
467-- If a module is empty, we don't want to generate code for it.
468isModuleEmpty :: Module -> Bool
469isModuleEmpty (Module _ els) = all isElementEmpty els
470 where
471 isElementEmpty :: ModuleElement -> Bool
472 isElementEmpty (ExportsList exps) = null exps
473 isElementEmpty Require{} = True
474 isElementEmpty (Other _) = True
475 isElementEmpty _ = False
477-- | Generate code for a set of modules, including a call to main().
478--
479-- Modules get defined on the global PS object, as follows:
480--
481-- var PS = { };
482-- (function(exports) {
483-- ...
484-- })(PS["Module.Name"] = PS["Module.Name"] || {});
485--
486-- In particular, a module and its foreign imports share the same namespace inside PS.
487-- This saves us from having to generate unique names for a module and its foreign imports,
488-- and is safe since a module shares a namespace with its foreign imports in PureScript as well
489-- (so there is no way to have overlaps in code generated by psc).
490codeGen :: Maybe String -- ^ main module
491 -> String -- ^ namespace
492 -> [Module] -- ^ input modules
493 -> String
494codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (prelude : concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule) JSNoAnnot)
495 where
496 moduleToJS :: Module -> [JSStatement]
497 moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
498 where
499 declToJS :: ModuleElement -> [JSStatement]
500 declToJS (Member n _ _ _ _) = [n]
501 declToJS (Other n) = [n]
502 declToJS (Require _ nm req) =
503 [
504 JSVariable lfsp
505 (cList [
506 JSVarInitExpression (JSIdentifier sp nm)
507 (JSVarInit sp $ either require (moduleReference sp . moduleName) req )
508 ]) (JSSemi JSNoAnnot)
509 ]
510 declToJS (ExportsList exps) = map toExport exps
512 where
513 toExport :: (ExportType, String, JSExpression, [Key]) -> JSStatement
514 toExport (_, nm, val, _) =
515 JSAssignStatement
516 (JSMemberSquare (JSIdentifier lfsp "exports") JSNoAnnot
517 (str nm) JSNoAnnot)
518 (JSAssign sp)
519 val
520 (JSSemi JSNoAnnot)
522 -- comma lists are reverse-consed
523 cList :: [a] -> JSCommaList a
524 cList [] = JSLNil
525 cList [x] = JSLOne x
526 cList l = go $ reverse l
527 where
528 go [x] = JSLOne x
529 go (h:t)= JSLCons (go t) JSNoAnnot h
530 go [] = error "Invalid case in comma-list"
532 indent :: [JSStatement] -> [JSStatement]
533 indent = everywhere (mkT squash)
534 where
535 squash JSNoAnnot = JSAnnot (TokenPn 0 0 2) []
536 squash (JSAnnot pos ann) = JSAnnot (keepCol pos) (map splat ann)
537 squash JSAnnotSpace = JSAnnot (TokenPn 0 0 2) []
539 splat (CommentA pos s) = CommentA (keepCol pos) s
540 splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w
541 splat ann = ann
543 keepCol (TokenPn _ _ c) = TokenPn 0 0 (if c >= 0 then c + 2 else 2)
545 prelude :: JSStatement
546 prelude = JSVariable (JSAnnot tokenPosnEmpty [ CommentA tokenPosnEmpty $ "// Generated by psc-bundle " ++ showVersion Paths.version
547 , WhiteSpace tokenPosnEmpty "\n" ])
548 (cList [
549 JSVarInitExpression (JSIdentifier sp optionsNamespace)
550 (JSVarInit sp (emptyObj sp))
551 ]) (JSSemi JSNoAnnot)
553 require :: String -> JSExpression
554 require mn =
555 JSMemberExpression (JSIdentifier JSNoAnnot "require") JSNoAnnot (cList [ str mn ]) JSNoAnnot
557 moduleReference :: JSAnnot -> String -> JSExpression
558 moduleReference a mn =
559 JSMemberSquare (JSIdentifier a optionsNamespace) JSNoAnnot
560 (str mn) JSNoAnnot
562 str :: String -> JSExpression
563 str s = JSStringLiteral JSNoAnnot $ "\"" ++ s ++ "\""
566 emptyObj :: JSAnnot -> JSExpression
567 emptyObj a = JSObjectLiteral a (JSCTLNone JSLNil) JSNoAnnot
569 wrap :: String -> [JSStatement] -> [JSStatement]
570 wrap mn ds =
571 [
572 JSMethodCall (JSExpressionParen lf (JSFunctionExpression JSNoAnnot JSIdentNone JSNoAnnot
573 (JSLOne (JSIdentName JSNoAnnot "exports")) JSNoAnnot
574 (JSBlock sp (lfHead ds) lf)) -- \n not quite in right place
575 JSNoAnnot)
576 JSNoAnnot
577 (JSLOne (JSAssignExpression (moduleReference JSNoAnnot mn) (JSAssign sp)
578 (JSExpressionBinary (moduleReference sp mn) (JSBinOpOr sp) (emptyObj sp))))
579 JSNoAnnot
580 (JSSemi JSNoAnnot)
581 ]
582 where
583 lfHead (h:t) = addAnn (WhiteSpace tokenPosnEmpty "\n ") h : t
584 lfHead x = x
586 addAnn :: CommentAnnotation -> JSStatement -> JSStatement
587 addAnn a (JSExpressionStatement (JSStringLiteral ann s) _) =
588 JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot)
589 addAnn _ x = x
591 appendAnn a JSNoAnnot = JSAnnot tokenPosnEmpty [a]
592 appendAnn a (JSAnnot _ anns) = JSAnnot tokenPosnEmpty (a:anns ++ [WhiteSpace tokenPosnEmpty " "])
593 appendAnn a JSAnnotSpace = JSAnnot tokenPosnEmpty [a]
595 runMain :: String -> [JSStatement]
596 runMain mn =
597 [JSMethodCall
598 (JSMemberDot (moduleReference lf mn) JSNoAnnot
599 (JSIdentifier JSNoAnnot "main"))
600 JSNoAnnot (cList []) JSNoAnnot (JSSemi JSNoAnnot)]
602 lf :: JSAnnot
603 lf = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
606 lfsp :: JSAnnot
607 lfsp = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ]
609 sp :: JSAnnot
610 sp = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]
612-- | The bundling function.
613-- This function performs dead code elimination, filters empty modules
614-- and generates and prints the final Javascript bundle.
615bundle :: (MonadError ErrorMessage m)
616 => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
617 -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination
618 -> Maybe String -- ^ An optional main module.
619 -> String -- ^ The namespace (e.g. PS).
620 -> m String
621bundle inputStrs entryPoints mainModule namespace = do
622 forM_ mainModule $ \mname ->
623 when (mname `notElem` map (moduleName . fst) inputStrs) (throwError (MissingMainModule mname))
624 forM_ entryPoints $ \mIdent ->
625 when (mIdent `notElem` map fst inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))
626 input <- forM inputStrs $ \(ident, js) -> do
627 ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)
628 return (ident, ast)
630 let mids = S.fromList (map (moduleName . fst) input)
632 modules <- traverse (fmap withDeps . uncurry (toModule mids)) input
634 let compiled = compile modules entryPoints
635 sorted = sortModules (filter (not . isModuleEmpty) compiled)
637 return (codeGen mainModule namespace sorted)