summaryrefslogtreecommitdiff
path: root/psc/Main.hs
blob: 45653a742f9ce1aa08f5634a10f9e31144dd7193 (plain)
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