@@ -0,0 +1,589 @@
1+-----------------------------------------------------------------------------
4+-- Copyright : (c) Phil Freeman 2015
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
11+-- | Bundles compiled PureScript modules for the browser.
13+-----------------------------------------------------------------------------
15+{-# LANGUAGE PatternGuards #-}
16+{-# LANGUAGE FlexibleContexts #-}
17+{-# LANGUAGE ScopedTypeVariables #-}
18+{-# LANGUAGE TupleSections #-}
19+{-# LANGUAGE RecordWildCards #-}
21+module Main (main) where
23+import Data.List (nub)
24+import Data.Maybe (mapMaybe, catMaybes)
25+import Data.Traversable (for)
26+import Data.Generics (everything, everywhere, mkQ, mkT)
28+import Data.Version (showVersion)
30+import qualified Data.Set as S
32+import Control.Applicative
33+import Control.Monad.Except
35+import System.FilePath (takeFileName, takeDirectory)
36+import System.Exit (exitFailure)
37+import System.IO (stderr, hPutStrLn)
39+import Language.JavaScript.Parser
41+import Options.Applicative as Opts
43+import qualified Paths_purescript as Paths
45+-- | The type of error messages. We separate generation and rendering of errors using a data
46+-- type, in case we need to match on error types later.
48+ = UnsupportedModulePath String
50+ | UnableToParseModule
52+ | ErrorInFile FilePath ErrorMessage
55+-- | Modules are either "regular modules" (i.e. those generated by psc-make) or foreign modules.
59+ deriving (Show, Eq, Ord)
61+-- | A module is identified by its module name and its type.
62+data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)
64+moduleName :: ModuleIdentifier -> String
65+moduleName (ModuleIdentifier name _) = name
67+-- | A piece of code is identified by its module and its name. These keys are used to label vertices
68+-- in the dependency graph.
69+type Key = (ModuleIdentifier, String)
71+-- | An export is either a "regular export", which exports a name from the regular module we are in,
72+-- or a reexport of a declaration in the corresponding foreign module.
74+-- Regular exports are labelled, since they might re-export an operator with another name.
76+ = RegularExport String
78+ deriving (Show, Eq, Ord)
80+-- | There are four types of module element we are interested in:
82+-- 1) Require statements
83+-- 2) Member declarations
87+-- Each is labelled with the original AST node which generated it, so that we can dump it back
88+-- into the output during codegen.
90+ = Require JSNode String ModuleIdentifier
91+ | Member JSNode Bool String [JSNode] [Key]
92+ | ExportsList [(ExportType, String, JSNode, [Key])]
96+-- | A module is just a list of elements of the types listed above.
97+data Module = Module ModuleIdentifier [ModuleElement] deriving Show
99+-- | Command line options.
100+data Options = Options
101+ { optionsInputFiles :: [FilePath]
102+ , optionsEntryPoints :: [String]
103+ , optionsMainModule :: Maybe String
104+ , optionsNamespace :: String
107+-- | Prepare an error message for consumption by humans.
108+printErrorMessage :: ErrorMessage -> [String]
109+printErrorMessage (UnsupportedModulePath s) =
110+ [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."
111+ , "The following file names are supported:"
112+ , " 1) index.js (psc-make native modules)"
113+ , " 2) foreign.js (psc-make foreign modules)"
115+printErrorMessage InvalidTopLevel =
116+ [ "Expected a list of source elements at the top level." ]
117+printErrorMessage UnableToParseModule =
118+ [ "The module could not be parsed." ]
119+printErrorMessage UnsupportedExport =
120+ [ "An export was unsupported. Exports can be defined in one of two ways: "
121+ , " 1) exports.name = ..."
122+ , " 2) exports = { ... }"
124+printErrorMessage (ErrorInFile filename e) =
125+ ("Error in file " ++ show filename ++ ":")
127+ : map (" " ++) (printErrorMessage e)
129+-- | Unpack the node inside a JSNode. This is useful when pattern matching.
130+node :: JSNode -> Node
134+-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
135+guessModuleIdentifier :: (Applicative m, MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier
136+guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> (guessModuleType (takeFileName filename))
138+ guessModuleType "index.js" = pure Regular
139+ guessModuleType "foreign.js" = pure Foreign
140+ guessModuleType name = throwError $ UnsupportedModulePath name
142+-- | Calculate the ModuleIdentifier which a require(...) statement imports.
143+checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier
144+checkImportPath "./foreign" m _ =
145+ Just (ModuleIdentifier (moduleName m) Foreign)
146+checkImportPath name _ names
147+ | name `S.member` names = Just (ModuleIdentifier name Regular)
148+checkImportPath _ _ _ = Nothing
150+-- | Compute the dependencies of all elements in a module, and add them to the tree.
152+-- Members and exports can have dependencies. A dependency is of one of the following forms:
154+-- 1) module.name or member["name"]
156+-- where module was imported using
158+-- var module = require("Module.Name");
162+-- where name is the name of a member defined in the current module.
163+withDeps :: Module -> Module
164+withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
166+ -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
167+ imports :: [(String, ModuleIdentifier)]
168+ imports = mapMaybe toImport es
170+ toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)
171+ toImport (Require _ nm mid) = Just (nm, mid)
172+ toImport _ = Nothing
174+ -- | Collects all member names in scope, so that we can identify dependencies of the second type.
175+ boundNames :: [String]
176+ boundNames = mapMaybe toBoundName es
178+ toBoundName :: ModuleElement -> Maybe String
179+ toBoundName (Member _ _ nm _ _) = Just nm
180+ toBoundName _ = Nothing
182+ -- | Calculate dependencies and add them to the current element.
183+ expandDeps :: ModuleElement -> ModuleElement
184+ expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))
185+ expandDeps (ExportsList exps) = ExportsList (map expand exps)
187+ expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))
188+ expandDeps other = other
190+ dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]
191+ dependencies m = everything (++) (mkQ [] toReference)
193+ toReference :: Node -> [(ModuleIdentifier, String)]
194+ toReference (JSMemberDot [ mn ] _ nm)
195+ | JSIdentifier mn' <- node mn
196+ , JSIdentifier nm' <- node nm
197+ , Just mid <- lookup mn' imports
199+ toReference (JSMemberSquare [ mn ] _ nm _)
200+ | JSIdentifier mn' <- node mn
201+ , JSExpression [ s ] <- node nm
202+ , JSStringLiteral _ nm' <- node s
203+ , Just mid <- lookup mn' imports
205+ toReference (JSIdentifier nm)
206+ | nm `elem` boundNames
210+-- | Attempt to create a Module from a Javascript AST.
212+-- Each type of module element is matched using pattern guards, and everything else is bundled into the
213+-- Other constructor.
214+toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module
215+toModule mids mid top
216+ | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns
217+ | otherwise = throwError InvalidTopLevel
219+ toModuleElement :: JSNode -> m ModuleElement
221+ | JSVariables var [ varIntro ] _ <- node n
222+ , JSLiteral "var" <- node var
223+ , JSVarDecl impN [ eq, req, impP ] <- node varIntro
224+ , JSIdentifier importName <- node impN
225+ , JSLiteral "=" <- node eq
226+ , JSIdentifier "require" <- node req
227+ , JSArguments _ [ impS ] _ <- node impP
228+ , JSStringLiteral _ importPath <- node impS
229+ , Just importPath' <- checkImportPath importPath mid mids
230+ = pure (Require n importName importPath')
232+ | JSVariables var [ varIntro ] _ <- node n
233+ , JSLiteral "var" <- node var
234+ , JSVarDecl declN (eq : decl) <- node varIntro
235+ , JSIdentifier name <- node declN
236+ , JSLiteral "=" <- node eq
237+ = pure (Member n False name decl [])
239+ | JSExpression (e : op : decl) <- node n
240+ , JSMemberDot [ exports ] _ nm <- node e
241+ , JSIdentifier "exports" <- node exports
242+ , JSOperator eq <- node op
243+ , JSLiteral "=" <- node eq
244+ , JSIdentifier name <- node nm
245+ = pure (Member n True name decl [])
247+ | JSExpression (mnExp : op : obj: _) <- node n
248+ , JSMemberDot [ mn ] _ e <- node mnExp
249+ , JSIdentifier "module" <- node mn
250+ , JSIdentifier "exports" <- node e
251+ , JSOperator eq <- node op
252+ , JSLiteral "=" <- node eq
253+ , JSObjectLiteral _ props _ <- node obj
254+ = ExportsList <$> mapM toExport (filter (not . isSeparator) (map node props))
256+ toExport :: Node -> m (ExportType, String, JSNode, [Key])
257+ toExport (JSPropertyNameandValue name _ [val] ) =
258+ (,,val,[]) <$> exportType (node val)
259+ <*> extractLabel (node name)
260+ toExport _ = throwError UnsupportedExport
262+ exportType :: Node -> m ExportType
263+ exportType (JSMemberDot [f] _ _)
264+ | JSIdentifier "$foreign" <- node f
265+ = pure ForeignReexport
266+ exportType (JSMemberSquare [f] _ _ _)
267+ | JSIdentifier "$foreign" <- node f
268+ = pure ForeignReexport
269+ exportType (JSIdentifier s) = pure (RegularExport s)
270+ exportType _ = throwError UnsupportedExport
272+ extractLabel :: Node -> m String
273+ extractLabel (JSStringLiteral _ nm) = pure nm
274+ extractLabel (JSIdentifier nm) = pure nm
275+ extractLabel _ = throwError UnsupportedExport
277+ isSeparator :: Node -> Bool
278+ isSeparator (JSLiteral ",") = True
279+ isSeparator _ = False
280+ toModuleElement other = pure (Other other)
282+-- | Eliminate unused code based on the specified entry point set.
283+compile :: [Module] -> [ModuleIdentifier] -> [Module]
284+compile modules entryPoints = filteredModules
286+ (graph, _, vertexFor) = graphFromEdges verts
289+ verts :: [(ModuleElement, Key, [Key])]
291+ Module mid els <- modules
292+ concatMap (toVertices mid) els
294+ -- | Create a set of vertices for a module element.
296+ -- Some special cases worth commenting on:
298+ -- 1) Regular exports which simply export their own name do not count as dependencies.
299+ -- Regular exports which rename and reexport an operator do count, however.
301+ -- 2) Require statements don't contribute towards dependencies, since they effectively get
302+ -- inlined wherever they are used inside other module elements.
303+ toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
304+ toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]
305+ toVertices p m@(ExportsList exps) = mapMaybe toVertex exps
307+ toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)
308+ toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)
309+ toVertex _ = Nothing
312+ -- | The set of vertices whose connected components we are interested in keeping.
313+ entryPointVertices :: [Vertex]
314+ entryPointVertices = catMaybes $ do
315+ (_, k@(mid, _), _) <- verts
316+ guard $ mid `elem` entryPoints
317+ return (vertexFor k)
319+ -- | The set of vertices reachable from an entry point
320+ reachableSet :: S.Set Vertex
321+ reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)
323+ filteredModules :: [Module]
324+ filteredModules = map filterUsed modules
326+ filterUsed :: Module -> Module
327+ filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
329+ go :: [ModuleElement] -> [ModuleElement]
331+ go (d : Other semi : rest)
332+ | JSLiteral ";" <- node semi
333+ , not (isDeclUsed d)
336+ | not (isDeclUsed d) = go rest
337+ | otherwise = d : go rest
339+ -- | Filter out the exports for members which aren't used.
340+ filterExports :: ModuleElement -> ModuleElement
341+ filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
342+ filterExports me = me
344+ isDeclUsed :: ModuleElement -> Bool
345+ isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)
348+ isKeyUsed :: Key -> Bool
350+ | Just me <- vertexFor k = me `S.member` reachableSet
353+-- | Topologically sort the module dependency graph, so that when we generate code, modules can be
354+-- defined in the right order.
355+sortModules :: [Module] -> [Module]
356+sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
358+ (graph, nodeFor, _) = graphFromEdges $ do
359+ m@(Module mid els) <- modules
360+ return (m, mid, mapMaybe getKey els)
362+ getKey :: ModuleElement -> Maybe ModuleIdentifier
363+ getKey (Require _ _ mi) = Just mi
366+-- | A module is empty if it contains no exported members (in other words,
367+-- if the only things left after dead code elimination are module imports and
368+-- "other" foreign code).
370+-- If a module is empty, we don't want to generate code for it.
371+isModuleEmpty :: Module -> Bool
372+isModuleEmpty (Module _ els) = all isElementEmpty els
374+ isElementEmpty :: ModuleElement -> Bool
375+ isElementEmpty (ExportsList exps) = null exps
376+ isElementEmpty (Require _ _ _) = True
377+ isElementEmpty (Other _) = True
378+ isElementEmpty _ = False
380+-- | Generate code for a set of modules, including a call to main().
382+-- Modules get defined on the global PS object, as follows:
385+-- (function(exports) {
387+-- })(PS["Module.Name"] = PS["Module.Name"] || {});
389+-- In particular, a module and its foreign imports share the same namespace inside PS.
390+-- This saves us from having to generate unique names for a module and its foreign imports,
391+-- and is safe since a module shares a namespace with its foreign imports in PureScript as well
392+-- (so there is no way to have overlaps in code generated by psc-make).
393+codeGen :: Options -> [Module] -> String
394+codeGen Options{..} ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))
396+ moduleToJS :: Module -> [JSNode]
397+ moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
399+ declToJS :: ModuleElement -> [JSNode]
400+ declToJS (Member n _ _ _ _) = [n]
401+ declToJS (Other n) = [n]
402+ declToJS (Require _ nm req) =
403+ [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ])
404+ [ NN (JSVarDecl (sp (JSIdentifier nm))
405+ [ sp (JSLiteral "=")
406+ , moduleReference sp (moduleName req)
409+ (nt (JSLiteral ";"))) ]
410+ declToJS (ExportsList exps) = map toExport exps
413+ toExport :: (ExportType, String, JSNode, [Key]) -> JSNode
414+ toExport (_, nm, val, _) =
415+ NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] ]
416+ (nt (JSLiteral "["))
417+ (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))
418+ (nt (JSLiteral "]")))
419+ , NN (JSOperator (sp (JSLiteral "=")))
421+ , nt (JSLiteral ";")
424+ reindent :: JSNode -> JSNode
425+ reindent (NT n _ _) = sp n
428+ indent :: [JSNode] -> [JSNode]
429+ indent = everywhere (mkT squash)
431+ squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)
434+ splat (CommentA pos s) = CommentA (keepCol pos) s
435+ splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w
438+ keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)
442+ [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty "// Generated by psc-bundle"
443+ , WhiteSpace tokenPosnEmpty "\n"
445+ [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))
446+ [ sp (JSLiteral "=")
447+ , NN (JSObjectLiteral (sp (JSLiteral "{"))
449+ (sp (JSLiteral "}")))
452+ (nt (JSLiteral ";")))
456+ moduleReference :: (Node -> JSNode) -> String -> JSNode
457+ moduleReference f mn =
458+ NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]
459+ (nt (JSLiteral "["))
460+ (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
461+ (nt (JSLiteral "]")))
463+ wrap :: String -> [JSNode] -> [JSNode]
465+ [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))
466+ (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))
468+ (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))
469+ (NN (JSBlock [sp (JSLiteral "{")]
471+ [nl (JSLiteral "}")])))]))
472+ (nt (JSLiteral ")")))
473+ , NN (JSArguments (nt (JSLiteral "("))
474+ [ NN (JSExpression [ moduleReference nt mn
475+ , NN (JSOperator (sp (JSLiteral "=")))
476+ , NN (JSExpressionBinary "||"
477+ [ moduleReference sp mn ]
478+ (sp (JSLiteral "||"))
482+ (nt (JSLiteral ")")))
484+ , nt (JSLiteral ";")
488+ emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))
490+ runMain :: String -> [JSNode]
492+ [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]
493+ (nt (JSLiteral "["))
494+ (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
495+ (nt (JSLiteral "]")))
497+ (nt (JSLiteral "."))
498+ (nt (JSIdentifier "main")))
499+ , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))
501+ , nt (JSLiteral ";")
504+ nt :: Node -> JSNode
505+ nt n = NT n tokenPosnEmpty []
508+ lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
510+ sp :: Node -> JSNode
511+ sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]
513+ nl :: Node -> JSNode
514+ nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
516+-- | The main application function.
517+-- This function parses the input files, performs dead code elimination, filters empty modules
518+-- and generates and prints the final Javascript bundle.
519+app :: forall m. (Applicative m, MonadError ErrorMessage m, MonadIO m) => Options -> m String
520+app opts@Options{..} = do
521+ input <- for optionsInputFiles $ \filename -> do
522+ js <- liftIO (readFile filename)
523+ ast <- fromRight (parse js filename)
524+ mid <- guessModuleIdentifier filename
527+ let mids = S.fromList (map (moduleName . fst) input)
529+ modules <- mapM (fmap withDeps . uncurry (toModule mids)) input
531+ let compiled = compile modules (map (`ModuleIdentifier` Regular) optionsEntryPoints)
532+ sorted = sortModules (filter (not . isModuleEmpty) compiled)
534+ return (codeGen opts sorted)
537+ fromRight :: Either a b -> m b
538+ fromRight (Right b) = pure b
539+ fromRight (Left _) = throwError UnableToParseModule
541+-- | Command line options parser.
542+options :: Parser Options
543+options = Options <$> some inputFile
545+ <*> optional mainModule
548+ inputFile :: Parser FilePath
549+ inputFile = strArgument $
551+ <> help "The input .js file(s)"
553+ entryPoint :: Parser String
554+ entryPoint = strOption $
557+ <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
559+ mainModule :: Parser String
560+ mainModule = strOption $
562+ <> help "Generate code to run the main method in the specified module."
564+ namespace :: Parser String
565+ namespace = strOption $
570+ <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
575+ opts <- execParser (info (version <*> helper <*> options) infoModList)
576+ output <- runExceptT (app opts)
579+ hPutStrLn stderr (unlines (printErrorMessage err))
584+ infoModList = fullDesc <> headerInfo <> footerInfo
585+ headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"
586+ footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version
588+ version :: Parser (a -> a)
589+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden