@@ -20,15 +20,9 @@
2020
2121module Main (main) where
2222
23−import Data.List (nub)
24−import Data.Maybe (mapMaybe, catMaybes)
2523import Data.Traversable (for)
26−import Data.Generics (everything, everywhere, mkQ, mkT)
27−import Data.Graph
2824import Data.Version (showVersion)
2925
30−import qualified Data.Set as S
31−
3226import Control.Applicative
3327import Control.Monad
3428import Control.Monad.Error.Class
@@ -41,66 +35,12 @@ import System.Exit (exitFailure)
4135import System.IO (stderr, hPutStrLn)
4236import System.Directory (createDirectoryIfMissing)
4337
44−import Language.JavaScript.Parser
38+import Language.PureScript.Bundle
4539
4640import Options.Applicative as Opts
4741
4842import qualified Paths_purescript as Paths
4943
50−-- | The type of error messages. We separate generation and rendering of errors using a data
51−-- type, in case we need to match on error types later.
52−data ErrorMessage
53− = UnsupportedModulePath String
54− | InvalidTopLevel
55− | UnableToParseModule
56− | UnsupportedExport
57− | ErrorInFile FilePath ErrorMessage
58− deriving Show
59−
60−-- | Modules are either "regular modules" (i.e. those generated by psc-make) or foreign modules.
61−data ModuleType
62− = Regular
63− | Foreign
64− deriving (Show, Eq, Ord)
65−
66−-- | A module is identified by its module name and its type.
67−data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)
68−
69−moduleName :: ModuleIdentifier -> String
70−moduleName (ModuleIdentifier name _) = name
71−
72−-- | A piece of code is identified by its module and its name. These keys are used to label vertices
73−-- in the dependency graph.
74−type Key = (ModuleIdentifier, String)
75−
76−-- | An export is either a "regular export", which exports a name from the regular module we are in,
77−-- or a reexport of a declaration in the corresponding foreign module.
78−--
79−-- Regular exports are labelled, since they might re-export an operator with another name.
80−data ExportType
81− = RegularExport String
82− | ForeignReexport
83− deriving (Show, Eq, Ord)
84−
85−-- | There are four types of module element we are interested in:
86−--
87−-- 1) Require statements
88−-- 2) Member declarations
89−-- 3) Export lists
90−-- 4) Everything else
91−--
92−-- Each is labelled with the original AST node which generated it, so that we can dump it back
93−-- into the output during codegen.
94−data ModuleElement
95− = Require JSNode String ModuleIdentifier
96− | Member JSNode Bool String [JSNode] [Key]
97− | ExportsList [(ExportType, String, JSNode, [Key])]
98− | Other JSNode
99− deriving Show
100−
101−-- | A module is just a list of elements of the types listed above.
102−data Module = Module ModuleIdentifier [ModuleElement] deriving Show
103−
10444-- | Command line options.
10545data Options = Options
10646 { optionsInputFiles :: [FilePath]
@@ -110,33 +50,6 @@ data Options = Options
11050 , optionsNamespace :: String
11151 } deriving Show
11252
113−-- | Prepare an error message for consumption by humans.
114−printErrorMessage :: ErrorMessage -> [String]
115−printErrorMessage (UnsupportedModulePath s) =
116− [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."
117− , "The following file names are supported:"
118− , " 1) index.js (psc-make native modules)"
119− , " 2) foreign.js (psc-make foreign modules)"
120− ]
121−printErrorMessage InvalidTopLevel =
122− [ "Expected a list of source elements at the top level." ]
123−printErrorMessage UnableToParseModule =
124− [ "The module could not be parsed." ]
125−printErrorMessage UnsupportedExport =
126− [ "An export was unsupported. Exports can be defined in one of two ways: "
127− , " 1) exports.name = ..."
128− , " 2) exports = { ... }"
129− ]
130−printErrorMessage (ErrorInFile filename e) =
131− ("Error in file " ++ show filename ++ ":")
132− : ""
133− : map (" " ++) (printErrorMessage e)
134−
135−-- | Unpack the node inside a JSNode. This is useful when pattern matching.
136−node :: JSNode -> Node
137−node (NN n) = n
138−node (NT n _ _) = n
139−
14053-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
14154guessModuleIdentifier :: (Applicative m, MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier
14255guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> (guessModuleType (takeFileName filename))
@@ -145,419 +58,23 @@ guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory f
14558 guessModuleType "foreign.js" = pure Foreign
14659 guessModuleType name = throwError $ UnsupportedModulePath name
14760
148−-- | Calculate the ModuleIdentifier which a require(...) statement imports.
149−checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier
150−checkImportPath "./foreign" m _ =
151− Just (ModuleIdentifier (moduleName m) Foreign)
152−checkImportPath name _ names
153− | name `S.member` names = Just (ModuleIdentifier name Regular)
154−checkImportPath _ _ _ = Nothing
155−
156−-- | Compute the dependencies of all elements in a module, and add them to the tree.
157−--
158−-- Members and exports can have dependencies. A dependency is of one of the following forms:
159−--
160−-- 1) module.name or member["name"]
161−--
162−-- where module was imported using
163−--
164−-- var module = require("Module.Name");
165−--
166−-- 2) name
167−--
168−-- where name is the name of a member defined in the current module.
169−withDeps :: Module -> Module
170−withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
171− where
172− -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
173− imports :: [(String, ModuleIdentifier)]
174− imports = mapMaybe toImport es
175− where
176− toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)
177− toImport (Require _ nm mid) = Just (nm, mid)
178− toImport _ = Nothing
179−
180− -- | Collects all member names in scope, so that we can identify dependencies of the second type.
181− boundNames :: [String]
182− boundNames = mapMaybe toBoundName es
183− where
184− toBoundName :: ModuleElement -> Maybe String
185− toBoundName (Member _ _ nm _ _) = Just nm
186− toBoundName _ = Nothing
187−
188− -- | Calculate dependencies and add them to the current element.
189− expandDeps :: ModuleElement -> ModuleElement
190− expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))
191− expandDeps (ExportsList exps) = ExportsList (map expand exps)
192− where
193− expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))
194− expandDeps other = other
195−
196− dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]
197− dependencies m = everything (++) (mkQ [] toReference)
198− where
199− toReference :: Node -> [(ModuleIdentifier, String)]
200− toReference (JSMemberDot [ mn ] _ nm)
201− | JSIdentifier mn' <- node mn
202− , JSIdentifier nm' <- node nm
203− , Just mid <- lookup mn' imports
204− = [(mid, nm')]
205− toReference (JSMemberSquare [ mn ] _ nm _)
206− | JSIdentifier mn' <- node mn
207− , JSExpression [ s ] <- node nm
208− , JSStringLiteral _ nm' <- node s
209− , Just mid <- lookup mn' imports
210− = [(mid, nm')]
211− toReference (JSIdentifier nm)
212− | nm `elem` boundNames
213− = [(m, nm)]
214− toReference _ = []
215−
216−-- | Attempt to create a Module from a Javascript AST.
217−--
218−-- Each type of module element is matched using pattern guards, and everything else is bundled into the
219−-- Other constructor.
220−toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module
221−toModule mids mid top
222− | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns
223− | otherwise = throwError InvalidTopLevel
224− where
225− toModuleElement :: JSNode -> m ModuleElement
226− toModuleElement n
227− | JSVariables var [ varIntro ] _ <- node n
228− , JSLiteral "var" <- node var
229− , JSVarDecl impN [ eq, req, impP ] <- node varIntro
230− , JSIdentifier importName <- node impN
231− , JSLiteral "=" <- node eq
232− , JSIdentifier "require" <- node req
233− , JSArguments _ [ impS ] _ <- node impP
234− , JSStringLiteral _ importPath <- node impS
235− , Just importPath' <- checkImportPath importPath mid mids
236− = pure (Require n importName importPath')
237− toModuleElement n
238− | JSVariables var [ varIntro ] _ <- node n
239− , JSLiteral "var" <- node var
240− , JSVarDecl declN (eq : decl) <- node varIntro
241− , JSIdentifier name <- node declN
242− , JSLiteral "=" <- node eq
243− = pure (Member n False name decl [])
244− toModuleElement n
245− | JSExpression (e : op : decl) <- node n
246− , Just name <- accessor (node e)
247− , JSOperator eq <- node op
248− , JSLiteral "=" <- node eq
249− = pure (Member n True name decl [])
250− where
251− accessor :: Node -> Maybe String
252− accessor (JSMemberDot [ exports ] _ nm)
253− | JSIdentifier "exports" <- node exports
254− , JSIdentifier name <- node nm
255− = Just name
256− accessor (JSMemberSquare [ exports ] _ nm _)
257− | JSIdentifier "exports" <- node exports
258− , JSExpression [e] <- node nm
259− , JSStringLiteral _ name <- node e
260− = Just name
261− accessor _ = Nothing
262− toModuleElement n
263− | JSExpression (mnExp : op : obj: _) <- node n
264− , JSMemberDot [ mn ] _ e <- node mnExp
265− , JSIdentifier "module" <- node mn
266− , JSIdentifier "exports" <- node e
267− , JSOperator eq <- node op
268− , JSLiteral "=" <- node eq
269− , JSObjectLiteral _ props _ <- node obj
270− = ExportsList <$> mapM toExport (filter (not . isSeparator) (map node props))
271− where
272− toExport :: Node -> m (ExportType, String, JSNode, [Key])
273− toExport (JSPropertyNameandValue name _ [val] ) =
274− (,,val,[]) <$> exportType (node val)
275− <*> extractLabel (node name)
276− toExport _ = throwError UnsupportedExport
277−
278− exportType :: Node -> m ExportType
279− exportType (JSMemberDot [f] _ _)
280− | JSIdentifier "$foreign" <- node f
281− = pure ForeignReexport
282− exportType (JSMemberSquare [f] _ _ _)
283− | JSIdentifier "$foreign" <- node f
284− = pure ForeignReexport
285− exportType (JSIdentifier s) = pure (RegularExport s)
286− exportType _ = throwError UnsupportedExport
287−
288− extractLabel :: Node -> m String
289− extractLabel (JSStringLiteral _ nm) = pure nm
290− extractLabel (JSIdentifier nm) = pure nm
291− extractLabel _ = throwError UnsupportedExport
292−
293− isSeparator :: Node -> Bool
294− isSeparator (JSLiteral ",") = True
295− isSeparator _ = False
296− toModuleElement other = pure (Other other)
297−
298−-- | Eliminate unused code based on the specified entry point set.
299−compile :: [Module] -> [ModuleIdentifier] -> [Module]
300−compile modules [] = modules
301−compile modules entryPoints = filteredModules
302− where
303− (graph, _, vertexFor) = graphFromEdges verts
304−
305− -- | The vertex set
306− verts :: [(ModuleElement, Key, [Key])]
307− verts = do
308− Module mid els <- modules
309− concatMap (toVertices mid) els
310− where
311− -- | Create a set of vertices for a module element.
312− --
313− -- Some special cases worth commenting on:
314− --
315− -- 1) Regular exports which simply export their own name do not count as dependencies.
316− -- Regular exports which rename and reexport an operator do count, however.
317− --
318− -- 2) Require statements don't contribute towards dependencies, since they effectively get
319− -- inlined wherever they are used inside other module elements.
320− toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
321− toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]
322− toVertices p m@(ExportsList exps) = mapMaybe toVertex exps
323− where
324− toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)
325− toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)
326− toVertex _ = Nothing
327− toVertices _ _ = []
328−
329− -- | The set of vertices whose connected components we are interested in keeping.
330− entryPointVertices :: [Vertex]
331− entryPointVertices = catMaybes $ do
332− (_, k@(mid, _), _) <- verts
333− guard $ mid `elem` entryPoints
334− return (vertexFor k)
335−
336− -- | The set of vertices reachable from an entry point
337− reachableSet :: S.Set Vertex
338− reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)
339−
340− filteredModules :: [Module]
341− filteredModules = map filterUsed modules
342− where
343− filterUsed :: Module -> Module
344− filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
345− where
346− go :: [ModuleElement] -> [ModuleElement]
347− go [] = []
348− go (d : Other semi : rest)
349− | JSLiteral ";" <- node semi
350− , not (isDeclUsed d)
351− = go rest
352− go (d : rest)
353− | not (isDeclUsed d) = go rest
354− | otherwise = d : go rest
355−
356− -- | Filter out the exports for members which aren't used.
357− filterExports :: ModuleElement -> ModuleElement
358− filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
359− filterExports me = me
360−
361− isDeclUsed :: ModuleElement -> Bool
362− isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)
363− isDeclUsed _ = True
364−
365− isKeyUsed :: Key -> Bool
366− isKeyUsed k
367− | Just me <- vertexFor k = me `S.member` reachableSet
368− | otherwise = False
369−
370−-- | Topologically sort the module dependency graph, so that when we generate code, modules can be
371−-- defined in the right order.
372−sortModules :: [Module] -> [Module]
373−sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
374− where
375− (graph, nodeFor, _) = graphFromEdges $ do
376− m@(Module mid els) <- modules
377− return (m, mid, mapMaybe getKey els)
378−
379− getKey :: ModuleElement -> Maybe ModuleIdentifier
380− getKey (Require _ _ mi) = Just mi
381− getKey _ = Nothing
382−
383−-- | A module is empty if it contains no exported members (in other words,
384−-- if the only things left after dead code elimination are module imports and
385−-- "other" foreign code).
386−--
387−-- If a module is empty, we don't want to generate code for it.
388−isModuleEmpty :: Module -> Bool
389−isModuleEmpty (Module _ els) = all isElementEmpty els
390− where
391− isElementEmpty :: ModuleElement -> Bool
392− isElementEmpty (ExportsList exps) = null exps
393− isElementEmpty (Require _ _ _) = True
394− isElementEmpty (Other _) = True
395− isElementEmpty _ = False
396−
397−-- | Generate code for a set of modules, including a call to main().
398−--
399−-- Modules get defined on the global PS object, as follows:
400−--
401−-- var PS = { };
402−-- (function(exports) {
403−-- ...
404−-- })(PS["Module.Name"] = PS["Module.Name"] || {});
405−--
406−-- In particular, a module and its foreign imports share the same namespace inside PS.
407−-- This saves us from having to generate unique names for a module and its foreign imports,
408−-- and is safe since a module shares a namespace with its foreign imports in PureScript as well
409−-- (so there is no way to have overlaps in code generated by psc-make).
410−codeGen :: Options -> [Module] -> String
411−codeGen Options{..} ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))
412− where
413− moduleToJS :: Module -> [JSNode]
414− moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
415− where
416− declToJS :: ModuleElement -> [JSNode]
417− declToJS (Member n _ _ _ _) = [n]
418− declToJS (Other n) = [n]
419− declToJS (Require _ nm req) =
420− [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ])
421− [ NN (JSVarDecl (sp (JSIdentifier nm))
422− [ sp (JSLiteral "=")
423− , moduleReference sp (moduleName req)
424− ])
425− ]
426− (nt (JSLiteral ";"))) ]
427− declToJS (ExportsList exps) = map toExport exps
428−
429− where
430− toExport :: (ExportType, String, JSNode, [Key]) -> JSNode
431− toExport (_, nm, val, _) =
432− NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] ]
433− (nt (JSLiteral "["))
434− (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))
435− (nt (JSLiteral "]")))
436− , NN (JSOperator (sp (JSLiteral "=")))
437− , reindent val
438− , nt (JSLiteral ";")
439− ])
440−
441− reindent :: JSNode -> JSNode
442− reindent (NT n _ _) = sp n
443− reindent nn = nn
444−
445− indent :: [JSNode] -> [JSNode]
446− indent = everywhere (mkT squash)
447− where
448− squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)
449− squash nn = nn
450−
451− splat (CommentA pos s) = CommentA (keepCol pos) s
452− splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w
453− splat ann = ann
454−
455− keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)
456−
457− prelude :: [JSNode]
458− prelude =
459− [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)
460− , WhiteSpace tokenPosnEmpty "\n"
461− ])
462− [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))
463− [ sp (JSLiteral "=")
464− , NN (JSObjectLiteral (sp (JSLiteral "{"))
465− []
466− (sp (JSLiteral "}")))
467− ])
468− ]
469− (nt (JSLiteral ";")))
470− , lf
471− ]
472−
473− moduleReference :: (Node -> JSNode) -> String -> JSNode
474− moduleReference f mn =
475− NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]
476− (nt (JSLiteral "["))
477− (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
478− (nt (JSLiteral "]")))
479−
480− wrap :: String -> [JSNode] -> [JSNode]
481− wrap mn ds =
482− [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))
483− (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))
484− []
485− (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))
486− (NN (JSBlock [sp (JSLiteral "{")]
487− (lf : ds)
488− [nl (JSLiteral "}")])))]))
489− (nt (JSLiteral ")")))
490− , NN (JSArguments (nt (JSLiteral "("))
491− [ NN (JSExpression [ moduleReference nt mn
492− , NN (JSOperator (sp (JSLiteral "=")))
493− , NN (JSExpressionBinary "||"
494− [ moduleReference sp mn ]
495− (sp (JSLiteral "||"))
496− [ emptyObj ])
497− ])
498− ]
499− (nt (JSLiteral ")")))
500− ])
501− , nt (JSLiteral ";")
502− , lf
503− ]
504− where
505− emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))
506−
507− runMain :: String -> [JSNode]
508− runMain mn =
509− [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]
510− (nt (JSLiteral "["))
511− (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
512− (nt (JSLiteral "]")))
513− ]
514− (nt (JSLiteral "."))
515− (nt (JSIdentifier "main")))
516− , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))
517− ])
518− , nt (JSLiteral ";")
519− ]
520−
521− nt :: Node -> JSNode
522− nt n = NT n tokenPosnEmpty []
523−
524− lf :: JSNode
525− lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
526−
527− sp :: Node -> JSNode
528− sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]
529−
530− nl :: Node -> JSNode
531− nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
532−
53361-- | The main application function.
53462-- This function parses the input files, performs dead code elimination, filters empty modules
53563-- and generates and prints the final Javascript bundle.
53664app :: forall m. (Applicative m, MonadError ErrorMessage m, MonadIO m) => Options -> m String
537−app opts@Options{..} = do
65+app Options{..} = do
53866 inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles
53967 when (null inputFiles) . liftIO $ do
54068 hPutStrLn stderr "psc-bundle: No input files."
54169 exitFailure
54270 input <- for inputFiles $ \filename -> do
54371 js <- liftIO (readFile filename)
544− ast <- fromRight (parse js filename)
54572 mid <- guessModuleIdentifier filename
546− return (mid, ast)
547−
548− let mids = S.fromList (map (moduleName . fst) input)
73+ return (mid, js)
54974
550− modules <- mapM (fmap withDeps . uncurry (toModule mids)) input
551−
552− let compiled = compile modules (map (`ModuleIdentifier` Regular) optionsEntryPoints)
553− sorted = sortModules (filter (not . isModuleEmpty) compiled)
554−
555− return (codeGen opts sorted)
556−
557− where
558− fromRight :: Either a b -> m b
559− fromRight (Right b) = pure b
560− fromRight (Left _) = throwError UnableToParseModule
75+ let entryIds = (map (`ModuleIdentifier` Regular) optionsEntryPoints)
76+
77+ bundle input entryIds optionsMainModule optionsNamespace
56178
56279-- | Command line options parser.
56380options :: Parser Options
@@ -572,10 +89,10 @@ options = Options <$> some inputFile
57289 metavar "FILE"
57390 <> help "The input .js file(s)"
57491
575− outputFile :: Parser FilePath
576− outputFile = strOption $
577− short 'o'
578− <> long "output"
92+ outputFile :: Parser FilePath
93+ outputFile = strOption $
94+ short 'o'
95+ <> long "output"
57996 <> help "The output .js file"
58097
58198 entryPoint :: Parser String