git.iko.soy/rowtype-yoga/purescript-native
on ebbc4e4 help sign in
rowtype-yoga/purescript-native/pcc/Main.hs
179 lines 5.5 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
40import Makefile
42data PCCOptions = PCCOptions
43 { pccmInput :: [FilePath]
44 , pccmForeignInput :: [FilePath]
45 , pccmOutputDir :: FilePath
46 , pccmOpts :: P.Options
47 , pccmUsePrefix :: Bool
48 }
50data InputOptions = InputOptions
51 { ioInputFiles :: [FilePath]
52 }
54compile :: PCCOptions -> IO ()
55compile (PCCOptions input _ outputDir opts usePrefix) = do
56 when (null input) generateMakefile
57 moduleFiles <- readInput (InputOptions input)
58 case runWriterT (parseInputs moduleFiles []) of
59 Left errs -> do
60 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
61 exitFailure
62 Right ((ms, _), warnings) -> do
63 when (P.nonEmpty warnings) $
64 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
65 let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
66 makeActions = buildMakeActions outputDir filePathMap usePrefix
67 (e, warnings') <- runMake opts $ P.make makeActions (map snd ms)
68 case e of
69 Left errs -> do
70 putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
71 exitFailure
72 Right _ -> exitSuccess
74readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
75readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
77parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
78 => [(Either P.RebuildPolicy FilePath, String)]
79 -> [(FilePath, P.ForeignJS)]
80 -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)
81parseInputs modules foreigns =
82 (,) <$> P.parseModulesFromFiles (either (const "") id) modules
83 <*> P.parseForeignModulesFromFiles foreigns
85inputFile :: Parser FilePath
86inputFile = strArgument $
87 metavar "FILE"
88 <> help "The input .purs file(s)"
90inputForeignFile :: Parser FilePath
91inputForeignFile = strOption $
92 short 'f'
93 <> long "ffi"
94 <> help "The input .js file(s) providing foreign import implementations"
96outputDirectory :: Parser FilePath
97outputDirectory = strOption $
98 short 'o'
99 <> long "output"
100 <> Opts.value "output"
101 <> showDefault
102 <> help "The output directory"
104requirePath :: Parser (Maybe FilePath)
105requirePath = optional $ strOption $
106 short 'r'
107 <> long "require-path"
108 <> help "The path prefix to use for require() calls in the generated code"
110noTco :: Parser Bool
111noTco = switch $
112 long "no-tco"
113 <> help "Disable tail call optimizations"
115noPrelude :: Parser Bool
116noPrelude = switch $
117 long "no-prelude"
118 <> help "Omit the automatic Prelude import"
120noMagicDo :: Parser Bool
121noMagicDo = switch $
122 long "no-magic-do"
123 <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
125noOpts :: Parser Bool
126noOpts = switch $
127 long "no-opts"
128 <> help "Skip the optimization phase."
130comments :: Parser Bool
131comments = switch $
132 short 'c'
133 <> long "comments"
134 <> help "Include comments in the generated code."
136verboseErrors :: Parser Bool
137verboseErrors = switch $
138 short 'v'
139 <> long "verbose-errors"
140 <> help "Display verbose error messages"
142noPrefix :: Parser Bool
143noPrefix = switch $
144 short 'p'
145 <> long "no-prefix"
146 <> help "Do not include comment header"
148sourceMaps :: Parser Bool
149sourceMaps = switch $
150 long "source-maps"
151 <> help "Generate source maps"
153options :: Parser P.Options
154options = P.Options <$> noTco
155 <*> noMagicDo
156 <*> pure Nothing
157 <*> noOpts
158 <*> verboseErrors
159 <*> (not <$> comments)
160 <*> requirePath
161 <*> sourceMaps
163pccOptions :: Parser PCCOptions
164pccOptions = PCCOptions <$> many inputFile
165 <*> many inputForeignFile
166 <*> outputDirectory
167 <*> options
168 <*> (not <$> noPrefix)
170main :: IO ()
171main = execParser opts >>= compile
172 where
173 opts = info (version <*> helper <*> pccOptions) infoModList
174 infoModList = fullDesc <> headerInfo <> footerInfo
175 headerInfo = header "pcc - Compiles PureScript to C++11"
176 footerInfo = footer $ "pcc " ++ showVersion Paths.version
178 version :: Parser (a -> a)
179 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden