git.iko.soy/rowtype-yoga/purescript-native
on cd4c708 help sign in
rowtype-yoga/purescript-native/psc-bundle/Main.hs
127 lines 4.5 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE TupleSections #-}
4{-# LANGUAGE RecordWildCards #-}
6-- | Bundles compiled PureScript modules for the browser.
7module Main (main) where
9import Data.Traversable (for)
10import Data.Version (showVersion)
12import Control.Applicative
13import Control.Monad
14import Control.Monad.Error.Class
15import Control.Monad.Trans.Except
16import Control.Monad.IO.Class
18import System.FilePath (takeFileName, takeDirectory)
19import System.FilePath.Glob (glob)
20import System.Exit (exitFailure)
21import System.IO (stderr, stdout, hPutStrLn, hSetEncoding, utf8)
22import System.IO.UTF8 (readUTF8File)
23import System.Directory (createDirectoryIfMissing)
25import Language.PureScript.Bundle
27import Options.Applicative as Opts
29import qualified Paths_purescript as Paths
31-- | Command line options.
32data Options = Options
33 { optionsInputFiles :: [FilePath]
34 , optionsOutputFile :: Maybe FilePath
35 , optionsEntryPoints :: [String]
36 , optionsMainModule :: Maybe String
37 , optionsNamespace :: String
38 } deriving Show
40-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
41guessModuleIdentifier :: (MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier
42guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)
43 where
44 guessModuleType "index.js" = pure Regular
45 guessModuleType "foreign.js" = pure Foreign
46 guessModuleType name = throwError $ UnsupportedModulePath name
48-- | The main application function.
49-- This function parses the input files, performs dead code elimination, filters empty modules
50-- and generates and prints the final Javascript bundle.
51app :: (MonadError ErrorMessage m, MonadIO m) => Options -> m String
52app Options{..} = do
53 inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles
54 when (null inputFiles) . liftIO $ do
55 hPutStrLn stderr "psc-bundle: No input files."
56 exitFailure
57 input <- for inputFiles $ \filename -> do
58 js <- liftIO (readUTF8File filename)
59 mid <- guessModuleIdentifier filename
60 length js `seq` return (mid, js) -- evaluate readFile till EOF before returning, not to exhaust file handles
62 let entryIds = map (`ModuleIdentifier` Regular) optionsEntryPoints
64 bundle input entryIds optionsMainModule optionsNamespace
66-- | Command line options parser.
67options :: Parser Options
68options = Options <$> some inputFile
69 <*> optional outputFile
70 <*> many entryPoint
71 <*> optional mainModule
72 <*> namespace
73 where
74 inputFile :: Parser FilePath
75 inputFile = strArgument $
76 metavar "FILE"
77 <> help "The input .js file(s)"
79 outputFile :: Parser FilePath
80 outputFile = strOption $
81 short 'o'
82 <> long "output"
83 <> help "The output .js file"
85 entryPoint :: Parser String
86 entryPoint = strOption $
87 short 'm'
88 <> long "module"
89 <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
91 mainModule :: Parser String
92 mainModule = strOption $
93 long "main"
94 <> help "Generate code to run the main method in the specified module."
96 namespace :: Parser String
97 namespace = strOption $
98 short 'n'
99 <> long "namespace"
100 <> Opts.value "PS"
101 <> showDefault
102 <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
104-- | Make it go.
105main :: IO ()
106main = do
107 hSetEncoding stdout utf8
108 hSetEncoding stderr utf8
109 opts <- execParser (info (version <*> helper <*> options) infoModList)
110 output <- runExceptT (app opts)
111 case output of
112 Left err -> do
113 hPutStrLn stderr (unlines (printErrorMessage err))
114 exitFailure
115 Right js ->
116 case optionsOutputFile opts of
117 Just outputFile -> do
118 createDirectoryIfMissing True (takeDirectory outputFile)
119 writeFile outputFile js
120 Nothing -> putStrLn js
121 where
122 infoModList = fullDesc <> headerInfo <> footerInfo
123 headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"
124 footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version
126 version :: Parser (a -> a)
127 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden