git.iko.soy/rowtype-yoga/purescript-native
on 24fdff2 help sign in
rowtype-yoga/purescript-native/pcc/Main.hs
171 lines 5.3 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Main
4-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5-- License : MIT
6--
7-- Maintainer : Andy Arvanitis
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15{-# LANGUAGE DataKinds #-}
16{-# LANGUAGE FlexibleContexts #-}
17{-# LANGUAGE RecordWildCards #-}
18{-# LANGUAGE TupleSections #-}
20module Main where
22import Control.Applicative
23import Control.Monad
24import Control.Monad.Error.Class (MonadError(..))
25import Control.Monad.Writer.Strict
27import Data.Version (showVersion)
28import qualified Data.Map as M
30import Options.Applicative as Opts
32import System.Exit (exitSuccess, exitFailure)
33import System.IO (hPutStrLn, stderr)
34import System.IO.UTF8
36import qualified Language.PureScript as P
37import qualified Paths_purescript as Paths
39import Make
41data PCCOptions = PCCOptions
42 { pccmInput :: [FilePath]
43 , pccmForeignInput :: [FilePath]
44 , pccmOutputDir :: FilePath
45 , pccmOpts :: P.Options
46 , pccmUsePrefix :: Bool
47 }
49data InputOptions = InputOptions
50 { ioInputFiles :: [FilePath]
51 }
53compile :: PCCOptions -> IO ()
54compile (PCCOptions input _ outputDir opts usePrefix) = do
55 moduleFiles <- readInput (InputOptions input)
56 case runWriterT (parseInputs moduleFiles []) of
57 Left errs -> do
58 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
59 exitFailure
60 Right ((ms, _), warnings) -> do
61 when (P.nonEmpty warnings) $
62 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
63 let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
64 makeActions = buildMakeActions outputDir filePathMap usePrefix
65 (e, warnings') <- runMake opts $ P.make makeActions (map snd ms)
66 case e of
67 Left errs -> do
68 putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
69 exitFailure
70 Right _ -> exitSuccess
72readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
73readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
75parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
76 => [(Either P.RebuildPolicy FilePath, String)]
77 -> [(FilePath, P.ForeignJS)]
78 -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)
79parseInputs modules foreigns =
80 (,) <$> P.parseModulesFromFiles (either (const "") id) modules
81 <*> P.parseForeignModulesFromFiles foreigns
83inputFile :: Parser FilePath
84inputFile = strArgument $
85 metavar "FILE"
86 <> help "The input .purs file(s)"
88inputForeignFile :: Parser FilePath
89inputForeignFile = strOption $
90 short 'f'
91 <> long "ffi"
92 <> help "The input .js file(s) providing foreign import implementations"
94outputDirectory :: Parser FilePath
95outputDirectory = strOption $
96 short 'o'
97 <> long "output"
98 <> Opts.value "output"
99 <> showDefault
100 <> help "The output directory"
102requirePath :: Parser (Maybe FilePath)
103requirePath = optional $ strOption $
104 short 'r'
105 <> long "require-path"
106 <> help "The path prefix to use for require() calls in the generated code"
108noTco :: Parser Bool
109noTco = switch $
110 long "no-tco"
111 <> help "Disable tail call optimizations"
113noPrelude :: Parser Bool
114noPrelude = switch $
115 long "no-prelude"
116 <> help "Omit the automatic Prelude import"
118noMagicDo :: Parser Bool
119noMagicDo = switch $
120 long "no-magic-do"
121 <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
123noOpts :: Parser Bool
124noOpts = switch $
125 long "no-opts"
126 <> help "Skip the optimization phase."
128comments :: Parser Bool
129comments = switch $
130 short 'c'
131 <> long "comments"
132 <> help "Include comments in the generated code."
134verboseErrors :: Parser Bool
135verboseErrors = switch $
136 short 'v'
137 <> long "verbose-errors"
138 <> help "Display verbose error messages"
140noPrefix :: Parser Bool
141noPrefix = switch $
142 short 'p'
143 <> long "no-prefix"
144 <> help "Do not include comment header"
146options :: Parser P.Options
147options = P.Options <$> noTco
148 <*> noMagicDo
149 <*> pure Nothing
150 <*> noOpts
151 <*> verboseErrors
152 <*> (not <$> comments)
153 <*> requirePath
155pccOptions :: Parser PCCOptions
156pccOptions = PCCOptions <$> many inputFile
157 <*> many inputForeignFile
158 <*> outputDirectory
159 <*> options
160 <*> (not <$> noPrefix)
162main :: IO ()
163main = execParser opts >>= compile
164 where
165 opts = info (version <*> helper <*> pccOptions) infoModList
166 infoModList = fullDesc <> headerInfo <> footerInfo
167 headerInfo = header "pcc - Compiles PureScript to C++11"
168 footerInfo = footer $ "pcc " ++ showVersion Paths.version
170 version :: Parser (a -> a)
171 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden