git.iko.soy/rowtype-yoga/purescript-native
on 43aeba7 help sign in
rowtype-yoga/purescript-native/psc-bundle/Main.hs
138 lines 4.7 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 PatternGuards #-}
16{-# LANGUAGE FlexibleContexts #-}
17{-# LANGUAGE ScopedTypeVariables #-}
18{-# LANGUAGE TupleSections #-}
19{-# LANGUAGE RecordWildCards #-}
21module Main (main) where
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 } 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 :: forall m. (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 return (mid, js)
75 let entryIds = (map (`ModuleIdentifier` Regular) optionsEntryPoints)
77 bundle input entryIds optionsMainModule optionsNamespace
79-- | Command line options parser.
80options :: Parser Options
81options = Options <$> some inputFile
82 <*> optional outputFile
83 <*> many entryPoint
84 <*> optional mainModule
85 <*> namespace
86 where
87 inputFile :: Parser FilePath
88 inputFile = strArgument $
89 metavar "FILE"
90 <> help "The input .js file(s)"
92 outputFile :: Parser FilePath
93 outputFile = strOption $
94 short 'o'
95 <> long "output"
96 <> help "The output .js file"
98 entryPoint :: Parser String
99 entryPoint = strOption $
100 short 'm'
101 <> long "module"
102 <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
104 mainModule :: Parser String
105 mainModule = strOption $
106 long "main"
107 <> help "Generate code to run the main method in the specified module."
109 namespace :: Parser String
110 namespace = strOption $
111 short 'n'
112 <> long "namespace"
113 <> Opts.value "PS"
114 <> showDefault
115 <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
117-- | Make it go.
118main :: IO ()
119main = do
120 opts <- execParser (info (version <*> helper <*> options) infoModList)
121 output <- runExceptT (app opts)
122 case output of
123 Left err -> do
124 hPutStrLn stderr (unlines (printErrorMessage err))
125 exitFailure
126 Right js ->
127 case optionsOutputFile opts of
128 Just outputFile -> do
129 createDirectoryIfMissing True (takeDirectory outputFile)
130 writeFile outputFile js
131 Nothing -> putStrLn js
132 where
133 infoModList = fullDesc <> headerInfo <> footerInfo
134 headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"
135 footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version
137 version :: Parser (a -> a)
138 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden