@@ -1,231 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DataKinds #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE RecordWildCards #-}
18−{-# LANGUAGE ScopedTypeVariables #-}
19−{-# LANGUAGE TupleSections #-}
20−
21−module Main where
22−
23−import Control.Applicative
24−import Control.Monad
25−import Control.Monad.Error.Class (MonadError(..))
26−import Control.Monad.Reader
27−import Control.Monad.Writer
28−
29−import Data.Maybe (fromMaybe)
30−import Data.Version (showVersion)
31−
32−import Options.Applicative as Opts
33−
34−import System.Directory (createDirectoryIfMissing)
35−import System.Exit (exitSuccess, exitFailure)
36−import System.FilePath (takeDirectory)
37−import System.FilePath.Glob (glob)
38−import System.IO (hPutStrLn, stderr)
39−
40−import qualified Data.Map as M
41−import qualified Language.PureScript as P
42−import qualified Paths_purescript as Paths
43−
44−data PSCOptions = PSCOptions
45− { pscInput :: [FilePath]
46− , pscForeignInput :: [FilePath]
47− , pscOpts :: P.Options P.Compile
48− , pscStdIn :: Bool
49− , pscOutput :: Maybe FilePath
50− , pscExterns :: Maybe FilePath
51− , pscUsePrefix :: Bool
52− }
53−
54−data InputOptions = InputOptions
55− { ioUseStdIn :: Bool
56− , ioInputFiles :: [FilePath]
57− }
58−
59−readInput :: InputOptions -> IO [(Maybe FilePath, String)]
60−readInput InputOptions{..}
61− | ioUseStdIn = return . (Nothing ,) <$> getContents
62− | otherwise = forM ioInputFiles $ \inFile -> (Just inFile, ) <$> readFile inFile
63−
64−type PSC = ReaderT (P.Options P.Compile) (WriterT P.MultipleErrors (Either P.MultipleErrors))
65−
66−runPSC :: P.Options P.Compile -> PSC a -> Either P.MultipleErrors (a, P.MultipleErrors)
67−runPSC opts rwe = runWriterT (runReaderT rwe opts)
68−
69−compile :: PSCOptions -> IO ()
70−compile (PSCOptions inputGlob inputForeignGlob opts stdin output externs usePrefix) = do
71− let prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
72− input <- concat <$> mapM glob inputGlob
73− moduleFiles <- readInput (InputOptions stdin input)
74− inputForeign <- concat <$> mapM glob inputForeignGlob
75− foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
76− case runWriterT (parseInputs moduleFiles foreignFiles) of
77− Left errs -> do
78− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
79− exitFailure
80− Right ((ms, foreigns), warnings) -> do
81− when (P.nonEmpty warnings) $
82− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
83− case runPSC opts (P.compileJS ms foreigns prefix) of
84− Left errs -> do
85− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
86− exitFailure
87− Right ((js, exts, _), warnings') -> do
88− when (P.nonEmpty warnings') $
89− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
90− case output of
91− Just path -> mkdirp path >> writeFile path js
92− Nothing -> putStrLn js
93− case externs of
94− Just path -> mkdirp path >> writeFile path exts
95− Nothing -> return ()
96− exitSuccess
97−
98−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
99− => [(Maybe FilePath, String)] -> [(FilePath, P.ForeignJS)] -> m ([P.Module], M.Map P.ModuleName (FilePath, P.ForeignJS))
100−parseInputs modules foreigns =
101− (,) <$> (map snd <$> P.parseModulesFromFiles (fromMaybe "") modules)
102− <*> P.parseForeignModulesFromFiles foreigns
103−
104−mkdirp :: FilePath -> IO ()
105−mkdirp = createDirectoryIfMissing True . takeDirectory
106−
107−codeGenModule :: Parser String
108−codeGenModule = strOption $
109− long "codegen"
110− <> help "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times."
111−
112−dceModule :: Parser String
113−dceModule = strOption $
114− short 'm'
115− <> long "module"
116− <> help "Enables dead code elimination, all code which is not a transitive dependency of a specified module will be removed. This argument can be used multiple times."
117−
118−browserNamespace :: Parser String
119−browserNamespace = strOption $
120− long "browser-namespace"
121− <> Opts.value "PS"
122− <> showDefault
123− <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
124−
125−verboseErrors :: Parser Bool
126−verboseErrors = switch $
127− short 'v'
128− <> long "verbose-errors"
129− <> help "Display verbose error messages"
130−
131−noOpts :: Parser Bool
132−noOpts = switch $
133− long "no-opts"
134− <> help "Skip the optimization phase."
135−
136−runMain :: Parser (Maybe String)
137−runMain = optional $ noArgs <|> withArgs
138− where
139− defaultVal = "Main"
140− noArgs = flag' defaultVal (long "main")
141− withArgs = strOption $
142− long "main"
143− <> help (concat [
144− "Generate code to run the main method in the specified module. ",
145− "(no argument: \"", defaultVal, "\")"
146− ])
147−
148−noMagicDo :: Parser Bool
149−noMagicDo = switch $
150− long "no-magic-do"
151− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
152−
153−noTco :: Parser Bool
154−noTco = switch $
155− long "no-tco"
156− <> help "Disable tail call optimizations"
157−
158−comments :: Parser Bool
159−comments = switch $
160− short 'c'
161− <> long "comments"
162− <> help "Include comments in the generated code."
163−
164−useStdIn :: Parser Bool
165−useStdIn = switch $
166− short 's'
167− <> long "stdin"
168− <> help "Read from standard input"
169−
170−inputFile :: Parser FilePath
171−inputFile = strArgument $
172− metavar "FILE"
173− <> help "The input .purs file(s)"
174−
175−inputForeignFile :: Parser FilePath
176−inputForeignFile = strOption $
177− short 'f'
178− <> long "ffi"
179− <> help "The input .js file(s) providing foreign import implementations"
180−
181−outputFile :: Parser (Maybe FilePath)
182−outputFile = optional . strOption $
183− short 'o'
184− <> long "output"
185− <> help "The output .js file"
186−
187−externsFile :: Parser (Maybe FilePath)
188−externsFile = optional . strOption $
189− short 'e'
190− <> long "externs"
191− <> help "The output .e.purs file"
192−
193−noPrefix :: Parser Bool
194−noPrefix = switch $
195− short 'p'
196− <> long "no-prefix"
197− <> help "Do not include comment header"
198−
199−options :: Parser (P.Options P.Compile)
200−options = P.Options <$> noTco
201− <*> noMagicDo
202− <*> runMain
203− <*> noOpts
204− <*> verboseErrors
205− <*> (not <$> comments)
206− <*> additionalOptions
207− where
208− additionalOptions =
209− P.CompileOptions <$> browserNamespace
210− <*> many dceModule
211− <*> many codeGenModule
212−
213−pscOptions :: Parser PSCOptions
214−pscOptions = PSCOptions <$> many inputFile
215− <*> many inputForeignFile
216− <*> options
217− <*> useStdIn
218− <*> outputFile
219− <*> externsFile
220− <*> (not <$> noPrefix)
221−
222−main :: IO ()
223−main = execParser opts >>= compile
224− where
225− opts = info (version <*> helper <*> pscOptions) infoModList
226− infoModList = fullDesc <> headerInfo <> footerInfo
227− headerInfo = header "psc - Compiles PureScript to Javascript"
228− footerInfo = footer $ "psc " ++ showVersion Paths.version
229−
230− version :: Parser (a -> a)
231− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden