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