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