@@ -6,6 +6,7 @@
66-- and generates the final Javascript bundle.
77module Language.PureScript.Bundle
88 ( bundle
9+ , bundleSM
910 , guessModuleIdentifier
1011 , ModuleIdentifier(..)
1112 , moduleName
@@ -19,6 +20,7 @@ import Prelude.Compat
1920
2021import Control.Monad
2122import Control.Monad.Error.Class
23+import Control.Arrow ((&&&))
2224
2325import Data.Char (chr, digitToInt)
2426import Data.Generics (everything, everywhere, mkQ, mkT)
@@ -33,7 +35,9 @@ import Language.JavaScript.Parser.AST
3335
3436import qualified Paths_purescript as Paths
3537
36−import System.FilePath (takeFileName, takeDirectory)
38+import System.FilePath (takeFileName, takeDirectory, takeDirectory, makeRelative)
39+
40+import SourceMap.Types
3741
3842-- | The type of error messages. We separate generation and rendering of errors using a data
3943-- type, in case we need to match on error types later.
@@ -98,10 +102,11 @@ data ModuleElement
98102 | Member JSStatement Bool String JSExpression [Key]
99103 | ExportsList [(ExportType, String, JSExpression, [Key])]
100104 | Other JSStatement
105+ | Skip JSStatement
101106 deriving (Show)
102107
103108-- | A module is just a list of elements of the types listed above.
104−data Module = Module ModuleIdentifier [ModuleElement] deriving (Show)
109+data Module = Module ModuleIdentifier (Maybe FilePath) [ModuleElement] deriving (Show)
105110
106111-- | Prepare an error message for consumption by humans.
107112printErrorMessage :: ErrorMessage -> [String]
@@ -159,7 +164,7 @@ checkImportPath name _ _ = Left name
159164--
160165-- where name is the name of a member defined in the current module.
161166withDeps :: Module -> Module
162−withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
167+withDeps (Module modulePath fn es) = Module modulePath fn (map expandDeps es)
163168 where
164169 -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
165170 imports :: [(String, ModuleIdentifier)]
@@ -248,9 +253,9 @@ trailingCommaList (JSCTLNone l) = commaList l
248253--
249254-- Each type of module element is matched using pattern guards, and everything else is bundled into the
250255-- Other constructor.
251−toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSAST -> m Module
252−toModule mids mid top
253− | JSAstProgram smts _ <- top = Module mid <$> traverse toModuleElement smts
256+toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> Maybe FilePath -> JSAST -> m Module
257+toModule mids mid filename top
258+ | JSAstProgram smts _ <- top = Module mid filename <$> traverse toModuleElement smts
254259 | otherwise = err InvalidTopLevel
255260 where
256261 err = throwError . ErrorInModule mid
@@ -389,7 +394,7 @@ compile modules entryPoints = filteredModules
389394 -- | The vertex set
390395 verts :: [(ModuleElement, Key, [Key])]
391396 verts = do
392− Module mid els <- modules
397+ Module mid _ els <- modules
393398 concatMap (toVertices mid) els
394399 where
395400 -- | Create a set of vertices for a module element.
@@ -425,14 +430,21 @@ compile modules entryPoints = filteredModules
425430 filteredModules = map filterUsed modules
426431 where
427432 filterUsed :: Module -> Module
428− filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
433+ filterUsed (Module mid fn ds) = Module mid fn (map filterExports (go ds))
429434 where
430435 go :: [ModuleElement] -> [ModuleElement]
431436 go [] = []
432437 go (d : rest)
433− | not (isDeclUsed d) = go rest
438+ | not (isDeclUsed d) = skipDecl d : go rest
434439 | otherwise = d : go rest
435440
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
447+
436448 -- | Filter out the exports for members which aren't used.
437449 filterExports :: ModuleElement -> ModuleElement
438450 filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
@@ -453,7 +465,7 @@ sortModules :: [Module] -> [Module]
453465sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
454466 where
455467 (graph, nodeFor, _) = graphFromEdges $ do
456− m@(Module mid els) <- modules
468+ m@(Module mid _ els) <- modules
457469 return (m, mid, mapMaybe getKey els)
458470
459471 getKey :: ModuleElement -> Maybe ModuleIdentifier
@@ -466,12 +478,13 @@ sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (top
466478--
467479-- If a module is empty, we don't want to generate code for it.
468480isModuleEmpty :: Module -> Bool
469−isModuleEmpty (Module _ els) = all isElementEmpty els
481+isModuleEmpty (Module _ _ els) = all isElementEmpty els
470482 where
471483 isElementEmpty :: ModuleElement -> Bool
472484 isElementEmpty (ExportsList exps) = null exps
473485 isElementEmpty Require{} = True
474486 isElementEmpty (Other _) = True
487+ isElementEmpty (Skip _) = True
475488 isElementEmpty _ = False
476489
477490-- | Generate code for a set of modules, including a call to main().
@@ -490,16 +503,62 @@ isModuleEmpty (Module _ els) = all isElementEmpty els
490503codeGen :: Maybe String -- ^ main module
491504 -> String -- ^ namespace
492505 -> [Module] -- ^ input modules
493− -> String
494−codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (prelude : concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule) JSNoAnnot)
506+ -> Maybe String -- ^ output filename
507+ -> (Maybe SourceMapping, String)
508+codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping outFileOpt, rendered)
495509 where
496− moduleToJS :: Module -> [JSStatement]
497− moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
510+ rendered = renderToString (JSAstProgram (prelude : concatMap fst modulesJS ++ maybe [] runMain optionsMainModule) JSNoAnnot)
511+
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+ }
498529 where
499− declToJS :: ModuleElement -> [JSStatement]
500− declToJS (Member n _ _ _ _) = [n]
501− declToJS (Other n) = [n]
502− declToJS (Require _ nm req) =
530+ pathToFile = makeRelative (takeDirectory outFile)
531+
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 _ _ = []
535+
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
542+
543+ moduleLengths :: [Int]
544+ moduleLengths = map (sum . map (either (const 0) id) . snd) modulesJS
545+ moduleFns = map (\(Module _ fn _) -> fn) ms
546+
547+ modulesJS = map moduleToJS ms
548+
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
553+
554+ withLength :: [JSStatement] -> ([JSStatement], Either Int Int)
555+ withLength n = (n, Right $ moduleLength n)
556+
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
503562 [
504563 JSVariable lfsp
505564 (cList [
@@ -507,9 +566,10 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p
507566 (JSVarInit sp $ either require (moduleReference sp . moduleName) req )
508567 ]) (JSSemi JSNoAnnot)
509568 ]
510− declToJS (ExportsList exps) = map toExport exps
569+ declToJS (ExportsList exps) = withLength $ map toExport exps
511570
512571 where
572+
513573 toExport :: (ExportType, String, JSExpression, [Key]) -> JSStatement
514574 toExport (_, nm, val, _) =
515575 JSAssignStatement
@@ -612,26 +672,39 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p
612672-- | The bundling function.
613673-- This function performs dead code elimination, filters empty modules
614674-- and generates and prints the final Javascript bundle.
615−bundle :: (MonadError ErrorMessage m)
616− => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
675+bundleSM :: (MonadError ErrorMessage m)
676+ => [(ModuleIdentifier, Maybe FilePath, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
617677 -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination
618678 -> Maybe String -- ^ An optional main module.
619679 -> String -- ^ The namespace (e.g. PS).
620− -> m String
621−bundle inputStrs entryPoints mainModule namespace = do
680+ -> Maybe FilePath -- ^ The output file name (if there is one - in which case generate source map)
681+ -> m (Maybe SourceMapping, String)
682+bundleSM inputStrs entryPoints mainModule namespace outFilename = do
683+ let mid (a,_,_) = a
622684 forM_ mainModule $ \mname ->
623− when (mname `notElem` map (moduleName . fst) inputStrs) (throwError (MissingMainModule mname))
685+ when (mname `notElem` map (moduleName . mid) inputStrs) (throwError (MissingMainModule mname))
624686 forM_ entryPoints $ \mIdent ->
625− when (mIdent `notElem` map fst inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))
626− input <- forM inputStrs $ \(ident, js) -> do
687+ when (mIdent `notElem` map mid inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))
688+ input <- forM inputStrs $ \(ident, filename, js) -> do
627689 ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)
628− return (ident, ast)
690+ return (ident, filename, ast)
629691
630− let mids = S.fromList (map (moduleName . fst) input)
692+ let mids = S.fromList (map (moduleName . mid) input)
631693
632− modules <- traverse (fmap withDeps . uncurry (toModule mids)) input
694+ modules <- traverse (fmap withDeps . (\(a,fn,c) -> toModule mids a fn c)) input
633695
634696 let compiled = compile modules entryPoints
635697 sorted = sortModules (filter (not . isModuleEmpty) compiled)
636698
637− return (codeGen mainModule namespace sorted)
699+ return (codeGen mainModule namespace sorted outFilename)
700+
701+-- | The bundling function.
702+-- This function performs dead code elimination, filters empty modules
703+-- and generates and prints the final Javascript bundle.
704+bundle :: (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
710+bundle inputStrs entryPoints mainModule namespace = snd <$> bundleSM (map (\(a,b) -> (a,Nothing,b)) inputStrs) entryPoints mainModule namespace Nothing