1-- | Bundles compiled PureScript modules for the browser.
2module Command.Bundle (command) where
3
4import Prelude
5
6import           Data.Traversable (for)
7import           Data.Aeson (encode)
8import           Data.Aeson.Encode.Pretty (confCompare, defConfig, encodePretty', keyOrder)
9import           Data.Maybe (isNothing)
10import           Data.Text (Text)
11import           Control.Applicative
12import           Control.Monad
13import           Control.Monad.Error.Class
14import           Control.Monad.Trans.Except
15import           Control.Monad.IO.Class
16import           System.FilePath (takeDirectory, (</>), (<.>), takeFileName)
17import           System.FilePath.Glob (glob)
18import           System.Exit (exitFailure)
19import           System.IO (stderr, hPutStr, hPutStrLn)
20import           System.IO.UTF8 (readUTF8File, writeUTF8File)
21import           System.Directory (createDirectoryIfMissing, getCurrentDirectory)
22import qualified Data.ByteString.Lazy.UTF8 as LBU8
23import           Language.PureScript.Bundle
24import           Options.Applicative (Parser)
25import qualified Options.Applicative as Opts
26import           SourceMap
27import           SourceMap.Types
28
29-- | Command line options.
30data Options = Options
31  { optionsInputFiles  :: [FilePath]
32  , optionsOutputFile  :: Maybe FilePath
33  , optionsEntryPoints :: [String]
34  , optionsMainModule  :: Maybe String
35  , optionsNamespace   :: String
36  , optionsSourceMaps  :: Bool
37  , optionsDebug       :: Bool
38  } deriving Show
39
40-- | The main application function.
41-- This function parses the input files, performs dead code elimination, filters empty modules
42-- and generates and prints the final Javascript bundle.
43app :: (MonadError ErrorMessage m, MonadIO m) => Options -> m (Maybe SourceMapping, String)
44app Options{..} = do
45  inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles
46  when (null inputFiles) . liftIO $ do
47    hPutStrLn stderr "purs bundle: No input files."
48    exitFailure
49  when (isNothing optionsOutputFile && optionsSourceMaps) . liftIO $ do
50    hPutStrLn stderr "purs bundle: Source maps only supported when output file specified."
51    exitFailure
52
53  input <- for inputFiles $ \filename -> do
54    js <- liftIO (readUTF8File filename)
55    mid <- guessModuleIdentifier filename
56    length js `seq` return (mid, Just filename, js)                                            -- evaluate readFile till EOF before returning, not to exhaust file handles
57
58  let entryIds = map (`ModuleIdentifier` Regular) optionsEntryPoints
59
60  currentDir <- liftIO getCurrentDirectory
61  let outFile = if optionsSourceMaps then fmap (currentDir </>) optionsOutputFile else Nothing
62  let withRawModules = if optionsDebug then Just bundleDebug else Nothing
63  bundleSM input entryIds optionsMainModule optionsNamespace outFile withRawModules
64
65-- | Print a JSON representation of a list of modules to stderr.
66bundleDebug :: (MonadIO m) => [Module] -> m ()
67bundleDebug = liftIO . hPutStrLn stderr . LBU8.toString . encodePretty' (defConfig { confCompare = keyComparer })
68  where
69  -- | Some key order hints for improved readability.
70  keyComparer :: Text -> Text -> Ordering
71  keyComparer =  keyOrder ["type", "name", "moduleId"]     -- keys to put first
72              <> flip (keyOrder ["dependsOn", "elements"]) -- keys to put last
73
74-- | Command line options parser.
75options :: Parser Options
76options = Options <$> some inputFile
77                  <*> optional outputFile
78                  <*> many entryPoint
79                  <*> optional mainModule
80                  <*> namespace
81                  <*> sourceMaps
82                  <*> debug
83  where
84  inputFile :: Parser FilePath
85  inputFile = Opts.strArgument $
86       Opts.metavar "FILE"
87    <> Opts.help "The input .js file(s)"
88
89  outputFile :: Parser FilePath
90  outputFile = Opts.strOption $
91       Opts.short 'o'
92    <> Opts.long "output"
93    <> Opts.help "The output .js file"
94
95  entryPoint :: Parser String
96  entryPoint = Opts.strOption $
97       Opts.short 'm'
98    <> Opts.long "module"
99    <> Opts.help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
100
101  mainModule :: Parser String
102  mainModule = Opts.strOption $
103       Opts.long "main"
104    <> Opts.help "Generate code to run the main method in the specified module."
105
106  namespace :: Parser String
107  namespace = Opts.strOption $
108       Opts.short 'n'
109    <> Opts.long "namespace"
110    <> Opts.value "PS"
111    <> Opts.showDefault
112    <> Opts.help "Specify the namespace that PureScript modules will be exported to when running in the browser."
113
114  sourceMaps :: Parser Bool
115  sourceMaps = Opts.switch $
116       Opts.long "source-maps"
117    <> Opts.help "Whether to generate source maps for the bundle (requires --output)."
118
119  debug :: Parser Bool
120  debug = Opts.switch $
121       Opts.long "debug"
122    <> Opts.help "Whether to emit a JSON representation of all parsed modules to stderr."
123
124-- | Make it go.
125command :: Opts.Parser (IO ())
126command = run <$> (Opts.helper <*> options) where
127  run :: Options -> IO ()
128  run opts = do
129    output <- runExceptT (app opts)
130    case output of
131      Left err -> do
132        hPutStr stderr (unlines (printErrorMessage err))
133        exitFailure
134      Right (sourcemap, js) ->
135        case optionsOutputFile opts of
136          Just outputFile -> do
137            createDirectoryIfMissing True (takeDirectory outputFile)
138            case sourcemap of
139              Just sm -> do
140                writeUTF8File outputFile $ js ++ "\n//# sourceMappingURL=" ++ (takeFileName outputFile <.> "map") ++ "\n"
141                writeUTF8File (outputFile <.> "map") $ LBU8.toString . encode $ generate sm
142              Nothing -> writeUTF8File outputFile js
143          Nothing -> putStrLn js
144