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