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