@@ -0,0 +1,605 @@
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
34+import Control.Monad.Error.Class
35+import Control.Monad.Trans.Except
36+import Control.Monad.IO.Class
38+import System.FilePath (takeFileName, takeDirectory)
39+import System.Exit (exitFailure)
40+import System.IO (stderr, hPutStrLn)
41+import System.Directory (createDirectoryIfMissing)
43+import Language.JavaScript.Parser
45+import Options.Applicative as Opts
47+import qualified Paths_purescript as Paths
49+-- | The type of error messages. We separate generation and rendering of errors using a data
50+-- type, in case we need to match on error types later.
52+ = UnsupportedModulePath String
54+ | UnableToParseModule
56+ | ErrorInFile FilePath ErrorMessage
59+-- | Modules are either "regular modules" (i.e. those generated by psc-make) or foreign modules.
63+ deriving (Show, Eq, Ord)
65+-- | A module is identified by its module name and its type.
66+data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)
68+moduleName :: ModuleIdentifier -> String
69+moduleName (ModuleIdentifier name _) = name
71+-- | A piece of code is identified by its module and its name. These keys are used to label vertices
72+-- in the dependency graph.
73+type Key = (ModuleIdentifier, String)
75+-- | An export is either a "regular export", which exports a name from the regular module we are in,
76+-- or a reexport of a declaration in the corresponding foreign module.
78+-- Regular exports are labelled, since they might re-export an operator with another name.
80+ = RegularExport String
82+ deriving (Show, Eq, Ord)
84+-- | There are four types of module element we are interested in:
86+-- 1) Require statements
87+-- 2) Member declarations
91+-- Each is labelled with the original AST node which generated it, so that we can dump it back
92+-- into the output during codegen.
94+ = Require JSNode String ModuleIdentifier
95+ | Member JSNode Bool String [JSNode] [Key]
96+ | ExportsList [(ExportType, String, JSNode, [Key])]
100+-- | A module is just a list of elements of the types listed above.
101+data Module = Module ModuleIdentifier [ModuleElement] deriving Show
103+-- | Command line options.
104+data Options = Options
105+ { optionsInputFiles :: [FilePath]
106+ , optionsOutputFile :: Maybe FilePath
107+ , optionsEntryPoints :: [String]
108+ , optionsMainModule :: Maybe String
109+ , optionsNamespace :: String
112+-- | Prepare an error message for consumption by humans.
113+printErrorMessage :: ErrorMessage -> [String]
114+printErrorMessage (UnsupportedModulePath s) =
115+ [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."
116+ , "The following file names are supported:"
117+ , " 1) index.js (psc-make native modules)"
118+ , " 2) foreign.js (psc-make foreign modules)"
120+printErrorMessage InvalidTopLevel =
121+ [ "Expected a list of source elements at the top level." ]
122+printErrorMessage UnableToParseModule =
123+ [ "The module could not be parsed." ]
124+printErrorMessage UnsupportedExport =
125+ [ "An export was unsupported. Exports can be defined in one of two ways: "
126+ , " 1) exports.name = ..."
127+ , " 2) exports = { ... }"
129+printErrorMessage (ErrorInFile filename e) =
130+ ("Error in file " ++ show filename ++ ":")
132+ : map (" " ++) (printErrorMessage e)
134+-- | Unpack the node inside a JSNode. This is useful when pattern matching.
135+node :: JSNode -> Node
139+-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
140+guessModuleIdentifier :: (Applicative m, MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier
141+guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> (guessModuleType (takeFileName filename))
143+ guessModuleType "index.js" = pure Regular
144+ guessModuleType "foreign.js" = pure Foreign
145+ guessModuleType name = throwError $ UnsupportedModulePath name
147+-- | Calculate the ModuleIdentifier which a require(...) statement imports.
148+checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier
149+checkImportPath "./foreign" m _ =
150+ Just (ModuleIdentifier (moduleName m) Foreign)
151+checkImportPath name _ names
152+ | name `S.member` names = Just (ModuleIdentifier name Regular)
153+checkImportPath _ _ _ = Nothing
155+-- | Compute the dependencies of all elements in a module, and add them to the tree.
157+-- Members and exports can have dependencies. A dependency is of one of the following forms:
159+-- 1) module.name or member["name"]
161+-- where module was imported using
163+-- var module = require("Module.Name");
167+-- where name is the name of a member defined in the current module.
168+withDeps :: Module -> Module
169+withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
171+ -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
172+ imports :: [(String, ModuleIdentifier)]
173+ imports = mapMaybe toImport es
175+ toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)
176+ toImport (Require _ nm mid) = Just (nm, mid)
177+ toImport _ = Nothing
179+ -- | Collects all member names in scope, so that we can identify dependencies of the second type.
180+ boundNames :: [String]
181+ boundNames = mapMaybe toBoundName es
183+ toBoundName :: ModuleElement -> Maybe String
184+ toBoundName (Member _ _ nm _ _) = Just nm
185+ toBoundName _ = Nothing
187+ -- | Calculate dependencies and add them to the current element.
188+ expandDeps :: ModuleElement -> ModuleElement
189+ expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))
190+ expandDeps (ExportsList exps) = ExportsList (map expand exps)
192+ expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))
193+ expandDeps other = other
195+ dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]
196+ dependencies m = everything (++) (mkQ [] toReference)
198+ toReference :: Node -> [(ModuleIdentifier, String)]
199+ toReference (JSMemberDot [ mn ] _ nm)
200+ | JSIdentifier mn' <- node mn
201+ , JSIdentifier nm' <- node nm
202+ , Just mid <- lookup mn' imports
204+ toReference (JSMemberSquare [ mn ] _ nm _)
205+ | JSIdentifier mn' <- node mn
206+ , JSExpression [ s ] <- node nm
207+ , JSStringLiteral _ nm' <- node s
208+ , Just mid <- lookup mn' imports
210+ toReference (JSIdentifier nm)
211+ | nm `elem` boundNames
215+-- | Attempt to create a Module from a Javascript AST.
217+-- Each type of module element is matched using pattern guards, and everything else is bundled into the
218+-- Other constructor.
219+toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module
220+toModule mids mid top
221+ | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns
222+ | otherwise = throwError InvalidTopLevel
224+ toModuleElement :: JSNode -> m ModuleElement
226+ | JSVariables var [ varIntro ] _ <- node n
227+ , JSLiteral "var" <- node var
228+ , JSVarDecl impN [ eq, req, impP ] <- node varIntro
229+ , JSIdentifier importName <- node impN
230+ , JSLiteral "=" <- node eq
231+ , JSIdentifier "require" <- node req
232+ , JSArguments _ [ impS ] _ <- node impP
233+ , JSStringLiteral _ importPath <- node impS
234+ , Just importPath' <- checkImportPath importPath mid mids
235+ = pure (Require n importName importPath')
237+ | JSVariables var [ varIntro ] _ <- node n
238+ , JSLiteral "var" <- node var
239+ , JSVarDecl declN (eq : decl) <- node varIntro
240+ , JSIdentifier name <- node declN
241+ , JSLiteral "=" <- node eq
242+ = pure (Member n False name decl [])
244+ | JSExpression (e : op : decl) <- node n
245+ , JSMemberDot [ exports ] _ nm <- node e
246+ , JSIdentifier "exports" <- node exports
247+ , JSOperator eq <- node op
248+ , JSLiteral "=" <- node eq
249+ , JSIdentifier name <- node nm
250+ = pure (Member n True name decl [])
252+ | JSExpression (mnExp : op : obj: _) <- node n
253+ , JSMemberDot [ mn ] _ e <- node mnExp
254+ , JSIdentifier "module" <- node mn
255+ , JSIdentifier "exports" <- node e
256+ , JSOperator eq <- node op
257+ , JSLiteral "=" <- node eq
258+ , JSObjectLiteral _ props _ <- node obj
259+ = ExportsList <$> mapM toExport (filter (not . isSeparator) (map node props))
261+ toExport :: Node -> m (ExportType, String, JSNode, [Key])
262+ toExport (JSPropertyNameandValue name _ [val] ) =
263+ (,,val,[]) <$> exportType (node val)
264+ <*> extractLabel (node name)
265+ toExport _ = throwError UnsupportedExport
267+ exportType :: Node -> m ExportType
268+ exportType (JSMemberDot [f] _ _)
269+ | JSIdentifier "$foreign" <- node f
270+ = pure ForeignReexport
271+ exportType (JSMemberSquare [f] _ _ _)
272+ | JSIdentifier "$foreign" <- node f
273+ = pure ForeignReexport
274+ exportType (JSIdentifier s) = pure (RegularExport s)
275+ exportType _ = throwError UnsupportedExport
277+ extractLabel :: Node -> m String
278+ extractLabel (JSStringLiteral _ nm) = pure nm
279+ extractLabel (JSIdentifier nm) = pure nm
280+ extractLabel _ = throwError UnsupportedExport
282+ isSeparator :: Node -> Bool
283+ isSeparator (JSLiteral ",") = True
284+ isSeparator _ = False
285+ toModuleElement other = pure (Other other)
287+-- | Eliminate unused code based on the specified entry point set.
288+compile :: [Module] -> [ModuleIdentifier] -> [Module]
289+compile modules entryPoints = filteredModules
291+ (graph, _, vertexFor) = graphFromEdges verts
294+ verts :: [(ModuleElement, Key, [Key])]
296+ Module mid els <- modules
297+ concatMap (toVertices mid) els
299+ -- | Create a set of vertices for a module element.
301+ -- Some special cases worth commenting on:
303+ -- 1) Regular exports which simply export their own name do not count as dependencies.
304+ -- Regular exports which rename and reexport an operator do count, however.
306+ -- 2) Require statements don't contribute towards dependencies, since they effectively get
307+ -- inlined wherever they are used inside other module elements.
308+ toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
309+ toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]
310+ toVertices p m@(ExportsList exps) = mapMaybe toVertex exps
312+ toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)
313+ toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)
314+ toVertex _ = Nothing
317+ -- | The set of vertices whose connected components we are interested in keeping.
318+ entryPointVertices :: [Vertex]
319+ entryPointVertices = catMaybes $ do
320+ (_, k@(mid, _), _) <- verts
321+ guard $ mid `elem` entryPoints
322+ return (vertexFor k)
324+ -- | The set of vertices reachable from an entry point
325+ reachableSet :: S.Set Vertex
326+ reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)
328+ filteredModules :: [Module]
329+ filteredModules = map filterUsed modules
331+ filterUsed :: Module -> Module
332+ filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
334+ go :: [ModuleElement] -> [ModuleElement]
336+ go (d : Other semi : rest)
337+ | JSLiteral ";" <- node semi
338+ , not (isDeclUsed d)
341+ | not (isDeclUsed d) = go rest
342+ | otherwise = d : go rest
344+ -- | Filter out the exports for members which aren't used.
345+ filterExports :: ModuleElement -> ModuleElement
346+ filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
347+ filterExports me = me
349+ isDeclUsed :: ModuleElement -> Bool
350+ isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)
353+ isKeyUsed :: Key -> Bool
355+ | Just me <- vertexFor k = me `S.member` reachableSet
358+-- | Topologically sort the module dependency graph, so that when we generate code, modules can be
359+-- defined in the right order.
360+sortModules :: [Module] -> [Module]
361+sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
363+ (graph, nodeFor, _) = graphFromEdges $ do
364+ m@(Module mid els) <- modules
365+ return (m, mid, mapMaybe getKey els)
367+ getKey :: ModuleElement -> Maybe ModuleIdentifier
368+ getKey (Require _ _ mi) = Just mi
371+-- | A module is empty if it contains no exported members (in other words,
372+-- if the only things left after dead code elimination are module imports and
373+-- "other" foreign code).
375+-- If a module is empty, we don't want to generate code for it.
376+isModuleEmpty :: Module -> Bool
377+isModuleEmpty (Module _ els) = all isElementEmpty els
379+ isElementEmpty :: ModuleElement -> Bool
380+ isElementEmpty (ExportsList exps) = null exps
381+ isElementEmpty (Require _ _ _) = True
382+ isElementEmpty (Other _) = True
383+ isElementEmpty _ = False
385+-- | Generate code for a set of modules, including a call to main().
387+-- Modules get defined on the global PS object, as follows:
390+-- (function(exports) {
392+-- })(PS["Module.Name"] = PS["Module.Name"] || {});
394+-- In particular, a module and its foreign imports share the same namespace inside PS.
395+-- This saves us from having to generate unique names for a module and its foreign imports,
396+-- and is safe since a module shares a namespace with its foreign imports in PureScript as well
397+-- (so there is no way to have overlaps in code generated by psc-make).
398+codeGen :: Options -> [Module] -> String
399+codeGen Options{..} ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))
401+ moduleToJS :: Module -> [JSNode]
402+ moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
404+ declToJS :: ModuleElement -> [JSNode]
405+ declToJS (Member n _ _ _ _) = [n]
406+ declToJS (Other n) = [n]
407+ declToJS (Require _ nm req) =
408+ [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ])
409+ [ NN (JSVarDecl (sp (JSIdentifier nm))
410+ [ sp (JSLiteral "=")
411+ , moduleReference sp (moduleName req)
414+ (nt (JSLiteral ";"))) ]
415+ declToJS (ExportsList exps) = map toExport exps
418+ toExport :: (ExportType, String, JSNode, [Key]) -> JSNode
419+ toExport (_, nm, val, _) =
420+ NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] ]
421+ (nt (JSLiteral "["))
422+ (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))
423+ (nt (JSLiteral "]")))
424+ , NN (JSOperator (sp (JSLiteral "=")))
426+ , nt (JSLiteral ";")
429+ reindent :: JSNode -> JSNode
430+ reindent (NT n _ _) = sp n
433+ indent :: [JSNode] -> [JSNode]
434+ indent = everywhere (mkT squash)
436+ squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)
439+ splat (CommentA pos s) = CommentA (keepCol pos) s
440+ splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w
443+ keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)
447+ [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)
448+ , WhiteSpace tokenPosnEmpty "\n"
450+ [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))
451+ [ sp (JSLiteral "=")
452+ , NN (JSObjectLiteral (sp (JSLiteral "{"))
454+ (sp (JSLiteral "}")))
457+ (nt (JSLiteral ";")))
461+ moduleReference :: (Node -> JSNode) -> String -> JSNode
462+ moduleReference f mn =
463+ NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]
464+ (nt (JSLiteral "["))
465+ (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
466+ (nt (JSLiteral "]")))
468+ wrap :: String -> [JSNode] -> [JSNode]
470+ [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))
471+ (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))
473+ (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))
474+ (NN (JSBlock [sp (JSLiteral "{")]
476+ [nl (JSLiteral "}")])))]))
477+ (nt (JSLiteral ")")))
478+ , NN (JSArguments (nt (JSLiteral "("))
479+ [ NN (JSExpression [ moduleReference nt mn
480+ , NN (JSOperator (sp (JSLiteral "=")))
481+ , NN (JSExpressionBinary "||"
482+ [ moduleReference sp mn ]
483+ (sp (JSLiteral "||"))
487+ (nt (JSLiteral ")")))
489+ , nt (JSLiteral ";")
493+ emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))
495+ runMain :: String -> [JSNode]
497+ [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]
498+ (nt (JSLiteral "["))
499+ (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
500+ (nt (JSLiteral "]")))
502+ (nt (JSLiteral "."))
503+ (nt (JSIdentifier "main")))
504+ , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))
506+ , nt (JSLiteral ";")
509+ nt :: Node -> JSNode
510+ nt n = NT n tokenPosnEmpty []
513+ lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
515+ sp :: Node -> JSNode
516+ sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]
518+ nl :: Node -> JSNode
519+ nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
521+-- | The main application function.
522+-- This function parses the input files, performs dead code elimination, filters empty modules
523+-- and generates and prints the final Javascript bundle.
524+app :: forall m. (Applicative m, MonadError ErrorMessage m, MonadIO m) => Options -> m String
525+app opts@Options{..} = do
526+ input <- for optionsInputFiles $ \filename -> do
527+ js <- liftIO (readFile filename)
528+ ast <- fromRight (parse js filename)
529+ mid <- guessModuleIdentifier filename
532+ let mids = S.fromList (map (moduleName . fst) input)
534+ modules <- mapM (fmap withDeps . uncurry (toModule mids)) input
536+ let compiled = compile modules (map (`ModuleIdentifier` Regular) optionsEntryPoints)
537+ sorted = sortModules (filter (not . isModuleEmpty) compiled)
539+ return (codeGen opts sorted)
542+ fromRight :: Either a b -> m b
543+ fromRight (Right b) = pure b
544+ fromRight (Left _) = throwError UnableToParseModule
546+-- | Command line options parser.
547+options :: Parser Options
548+options = Options <$> some inputFile
549+ <*> optional outputFile
551+ <*> optional mainModule
554+ inputFile :: Parser FilePath
555+ inputFile = strArgument $
557+ <> help "The input .js file(s)"
559+ outputFile :: Parser FilePath
560+ outputFile = strOption $
563+ <> help "The output .js file"
565+ entryPoint :: Parser String
566+ entryPoint = strOption $
569+ <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
571+ mainModule :: Parser String
572+ mainModule = strOption $
574+ <> help "Generate code to run the main method in the specified module."
576+ namespace :: Parser String
577+ namespace = strOption $
582+ <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
587+ opts <- execParser (info (version <*> helper <*> options) infoModList)
588+ output <- runExceptT (app opts)
591+ hPutStrLn stderr (unlines (printErrorMessage err))
594+ case optionsOutputFile opts of
595+ Just outputFile -> do
596+ createDirectoryIfMissing True (takeDirectory outputFile)
597+ writeFile outputFile js
598+ Nothing -> putStrLn js
600+ infoModList = fullDesc <> headerInfo <> footerInfo
601+ headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"
602+ footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version
604+ version :: Parser (a -> a)
605+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden