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