git.iko.soy/rowtype-yoga/purescript-native
on eaaef21 help sign in
rowtype-yoga/purescript-native/psc/Main.hs
181 lines 6.0 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE TupleSections #-}
7module Main where
9import Control.Applicative
10import Control.Monad
11import Control.Monad.Writer.Strict
13import qualified Data.Aeson as A
14import Data.Bool (bool)
15import qualified Data.ByteString.Lazy as B
16import qualified Data.ByteString.UTF8 as BU8
17import qualified Data.Map as M
18import Data.Version (showVersion)
20import qualified Language.PureScript as P
21import Language.PureScript.Errors.JSON
22import Language.PureScript.Make
24import Options.Applicative as Opts
26import qualified Paths_purescript as Paths
28import qualified System.Console.ANSI as ANSI
29import System.Exit (exitSuccess, exitFailure)
30import System.FilePath.Glob (glob)
31import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)
32import System.IO.UTF8
34data PSCMakeOptions = PSCMakeOptions
35 { pscmInput :: [FilePath]
36 , pscmOutputDir :: FilePath
37 , pscmOpts :: P.Options
38 , pscmUsePrefix :: Bool
39 , pscmJSONErrors :: Bool
40 }
42-- | Argumnets: verbose, use JSON, warnings, errors
43printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()
44printWarningsAndErrors verbose False warnings errors = do
45 cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stderr
46 let ppeOpts = P.defaultPPEOptions { P.ppeCodeColor = cc, P.ppeFull = verbose }
47 when (P.nonEmpty warnings) $
48 hPutStrLn stderr (P.prettyPrintMultipleWarnings ppeOpts warnings)
49 case errors of
50 Left errs -> do
51 hPutStrLn stderr (P.prettyPrintMultipleErrors ppeOpts errs)
52 exitFailure
53 Right _ -> return ()
54printWarningsAndErrors verbose True warnings errors = do
55 hPutStrLn stderr . BU8.toString . B.toStrict . A.encode $
56 JSONResult (toJSONErrors verbose P.Warning warnings)
57 (either (toJSONErrors verbose P.Error) (const []) errors)
58 either (const exitFailure) (const (return ())) errors
60compile :: PSCMakeOptions -> IO ()
61compile PSCMakeOptions{..} = do
62 input <- globWarningOnMisses (unless pscmJSONErrors . warnFileTypeNotFound) pscmInput
63 when (null input && not pscmJSONErrors) $ do
64 hPutStrLn stderr "psc: No input files."
65 exitFailure
66 moduleFiles <- readInput input
67 (makeErrors, makeWarnings) <- runMake pscmOpts $ do
68 ms <- P.parseModulesFromFiles id moduleFiles
69 let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, Right fp)) ms
70 foreigns <- inferForeignModules filePathMap
71 let makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix
72 P.make makeActions (map snd ms)
73 printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors makeWarnings makeErrors
74 exitSuccess
76warnFileTypeNotFound :: String -> IO ()
77warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)
79globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
80globWarningOnMisses warn = concatMapM globWithWarning
81 where
82 globWithWarning pattern' = do
83 paths <- glob pattern'
84 when (null paths) $ warn pattern'
85 return paths
86 concatMapM f = fmap concat . mapM f
88readInput :: [FilePath] -> IO [(FilePath, String)]
89readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile
91inputFile :: Parser FilePath
92inputFile = strArgument $
93 metavar "FILE"
94 <> help "The input .purs file(s)"
96outputDirectory :: Parser FilePath
97outputDirectory = strOption $
98 short 'o'
99 <> long "output"
100 <> Opts.value "output"
101 <> showDefault
102 <> help "The output directory"
104noTco :: Parser Bool
105noTco = switch $
106 long "no-tco"
107 <> help "Disable tail call optimizations"
109noMagicDo :: Parser Bool
110noMagicDo = switch $
111 long "no-magic-do"
112 <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
114noOpts :: Parser Bool
115noOpts = switch $
116 long "no-opts"
117 <> help "Skip the optimization phase"
119comments :: Parser Bool
120comments = switch $
121 short 'c'
122 <> long "comments"
123 <> help "Include comments in the generated code"
125verboseErrors :: Parser Bool
126verboseErrors = switch $
127 short 'v'
128 <> long "verbose-errors"
129 <> help "Display verbose error messages"
131noPrefix :: Parser Bool
132noPrefix = switch $
133 short 'p'
134 <> long "no-prefix"
135 <> help "Do not include comment header"
137jsonErrors :: Parser Bool
138jsonErrors = switch $
139 long "json-errors"
140 <> help "Print errors to stderr as JSON"
141sourceMaps :: Parser Bool
142sourceMaps = switch $
143 long "source-maps"
144 <> help "Generate source maps"
146dumpCoreFn :: Parser Bool
147dumpCoreFn = switch $
148 long "dump-corefn"
149 <> help "Dump the (functional) core representation of the compiled code at output/*/corefn.json"
152options :: Parser P.Options
153options = P.Options <$> noTco
154 <*> noMagicDo
155 <*> pure Nothing
156 <*> noOpts
157 <*> verboseErrors
158 <*> (not <$> comments)
159 <*> sourceMaps
160 <*> dumpCoreFn
162pscMakeOptions :: Parser PSCMakeOptions
163pscMakeOptions = PSCMakeOptions <$> many inputFile
164 <*> outputDirectory
165 <*> options
166 <*> (not <$> noPrefix)
167 <*> jsonErrors
169main :: IO ()
170main = do
171 hSetEncoding stdout utf8
172 hSetEncoding stderr utf8
173 execParser opts >>= compile
174 where
175 opts = info (version <*> helper <*> pscMakeOptions) infoModList
176 infoModList = fullDesc <> headerInfo <> footerInfo
177 headerInfo = header "psc - Compiles PureScript to Javascript"
178 footerInfo = footer $ "psc " ++ showVersion Paths.version
180 version :: Parser (a -> a)
181 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden