@@ -15,84 +15,94 @@
15{-# LANGUAGE DataKinds #-}
15{-# LANGUAGE DataKinds #-}
16{-# LANGUAGE FlexibleContexts #-}
16{-# LANGUAGE FlexibleContexts #-}
17{-# LANGUAGE RecordWildCards #-}
17{-# LANGUAGE RecordWildCards #-}
18+{-# LANGUAGE ScopedTypeVariables #-}
18{-# LANGUAGE TupleSections #-}
19{-# LANGUAGE TupleSections #-}
20module Main where
21module Main where
22−import Control.Applicative
23+import Control.Applicative
23−import Control.Monad
24+import Control.Monad
24−import Control.Monad.Error.Class (MonadError(..))
25−import Control.Monad.Writer.Strict
25+import Control.Monad.Writer.Strict
27−import Data.Version (showVersion)
27+import qualified Data.Aeson as A
28+import qualified Data.ByteString.Lazy as B
29+import qualified Data.ByteString.UTF8 as BU8
28import qualified Data.Map as M
30import qualified Data.Map as M
31+import Data.Version (showVersion)
30−import Options.Applicative as Opts
33+import qualified Language.PureScript as P
34+import Language.PureScript.Errors.JSON
35+import Language.PureScript.Make
32−import System.Exit (exitSuccess, exitFailure)
37+import Options.Applicative as Opts
33−import System.IO (hPutStrLn, stderr)
36−import qualified Language.PureScript as P
37import qualified Paths_purescript as Paths
39import qualified Paths_purescript as Paths
39−import Make
41+import System.Exit (exitSuccess, exitFailure)
40−import Makefile
42+import System.FilePath.Glob (glob)
43+import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)
42−data PCCOptions = PCCOptions
46+data PCCMakeOptions = PCCMakeOptions
43 { pccmInput :: [FilePath]
47 { pccmInput :: [FilePath]
44− , pccmForeignInput :: [FilePath]
45 , pccmOutputDir :: FilePath
48 , pccmOutputDir :: FilePath
46 , pccmOpts :: P.Options
49 , pccmOpts :: P.Options
47 , pccmUsePrefix :: Bool
50 , pccmUsePrefix :: Bool
51+ , pccmJSONErrors :: Bool
50−data InputOptions = InputOptions
54+-- | Argumnets: verbose, use JSON, warnings, errors
51− { ioInputFiles :: [FilePath]
55+printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()
52− }
56+printWarningsAndErrors verbose False warnings errors = do
53−
57+ when (P.nonEmpty warnings) $
54−compile :: PCCOptions -> IO ()
58+ hPutStrLn stderr (P.prettyPrintMultipleWarnings verbose warnings)
55−compile (PCCOptions input _ outputDir opts usePrefix) = do
59+ case errors of
56− when (null input) generateMakefile
57− moduleFiles <- readInput (InputOptions input)
58− case runWriterT (parseInputs moduleFiles []) of
59 Left errs -> do
60 Left errs -> do
60− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
61+ hPutStrLn stderr (P.prettyPrintMultipleErrors verbose errs)
61 exitFailure
62 exitFailure
62− Right ((ms, _), warnings) -> do
63+ Right _ -> return ()
63− when (P.nonEmpty warnings) $
64+printWarningsAndErrors verbose True warnings errors = do
64− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
65+ hPutStrLn stderr . BU8.toString . B.toStrict . A.encode $
66+ JSONResult (toJSONErrors verbose P.Warning warnings)
67+ (either (toJSONErrors verbose P.Error) (const []) errors)
68+ either (const exitFailure) (const (return ())) errors
70+compile :: PCCMakeOptions -> IO ()
71+compile PCCMakeOptions{..} = do
72+ input <- globWarningOnMisses (unless pccmJSONErrors . warnFileTypeNotFound) pccmInput
73+ when (null input && not pccmJSONErrors) $ do
74+ hPutStrLn stderr "pcc: No input files."
76+ moduleFiles <- readInput input
77+ (makeErrors, makeWarnings) <- runMake pccmOpts $ do
78+ ms <- P.parseModulesFromFiles id moduleFiles
65− let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
79+ let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, Right fp)) ms
80+ foreigns <- inferForeignModules filePathMap
66− makeActions = buildMakeActions outputDir filePathMap usePrefix
81+ let makeActions = buildMakeActions pccmOutputDir filePathMap foreigns pccmUsePrefix
67− (e, warnings') <- runMake opts $ P.make makeActions (map snd ms)
82+ P.make makeActions (map snd ms)
68− case e of
83+ printWarningsAndErrors (P.optionsVerboseErrors pccmOpts) pccmJSONErrors makeWarnings makeErrors
70− putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
72− Right _ -> exitSuccess
84+ exitSuccess
74−readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
86+warnFileTypeNotFound :: String -> IO ()
87+warnFileTypeNotFound = hPutStrLn stderr . ("pcc: No files found using pattern: " ++)
89+globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
90+globWarningOnMisses warn = concatMapM globWithWarning
92+ globWithWarning pattern = do
93+ paths <- glob pattern
94+ when (null paths) $ warn pattern
96+ concatMapM f = liftM concat . mapM f
98+readInput :: [FilePath] -> IO [(FilePath, String)]
75−readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
99+readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile
77−parseInputs :: (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)
81−parseInputs modules foreigns =
82− (,) <$> P.parseModulesFromFiles (either (const "") id) modules
83− <*> P.parseForeignModulesFromFiles foreigns
85inputFile :: Parser FilePath
101inputFile :: Parser FilePath
86inputFile = strArgument $
102inputFile = strArgument $
87 metavar "FILE"
103 metavar "FILE"
88 <> help "The input .purs file(s)"
104 <> help "The input .purs file(s)"
90−inputForeignFile :: Parser FilePath
91−inputForeignFile = strOption $
94− <> help "The input .js file(s) providing foreign import implementations"
96outputDirectory :: Parser FilePath
106outputDirectory :: Parser FilePath
97outputDirectory = strOption $
107outputDirectory = strOption $
98 short 'o'
108 short 'o'
@@ -106,26 +116,21 @@ noTco = switch $
106 long "no-tco"
116 long "no-tco"
107 <> help "Disable tail call optimizations"
117 <> help "Disable tail call optimizations"
109−noPrelude :: Parser Bool
112− <> help "Omit the automatic Prelude import"
114noMagicDo :: Parser Bool
119noMagicDo :: Parser Bool
115noMagicDo = switch $
120noMagicDo = switch $
116 long "no-magic-do"
121 long "no-magic-do"
117− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
122+ <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
119noOpts :: Parser Bool
124noOpts :: Parser Bool
120noOpts = switch $
125noOpts = switch $
121 long "no-opts"
126 long "no-opts"
122− <> help "Skip the optimization phase."
127+ <> help "Skip the optimization phase"
124comments :: Parser Bool
129comments :: Parser Bool
125comments = switch $
130comments = switch $
126 short 'c'
131 short 'c'
127 <> long "comments"
132 <> long "comments"
128− <> help "Include comments in the generated code."
133+ <> help "Include comments in the generated code"
130verboseErrors :: Parser Bool
135verboseErrors :: Parser Bool
131verboseErrors = switch $
136verboseErrors = switch $
@@ -139,11 +144,16 @@ noPrefix = switch $
139 <> long "no-prefix"
144 <> long "no-prefix"
140 <> help "Do not include comment header"
145 <> help "Do not include comment header"
147+jsonErrors :: Parser Bool
148+jsonErrors = switch $
150+ <> help "Print errors to stderr as JSON"
142sourceMaps :: Parser Bool
151sourceMaps :: Parser Bool
143sourceMaps = switch $
152sourceMaps = switch $
144 long "source-maps"
153 long "source-maps"
145 <> help "Generate source maps"
154 <> help "Generate source maps"
147options :: Parser P.Options
157options :: Parser P.Options
148options = P.Options <$> noTco
158options = P.Options <$> noTco
149 <*> noMagicDo
159 <*> noMagicDo
@@ -153,17 +163,20 @@ options = P.Options <$> noTco
153 <*> (not <$> comments)
163 <*> (not <$> comments)
154 <*> sourceMaps
164 <*> sourceMaps
156−pccOptions :: Parser PCCOptions
166+pccMakeOptions :: Parser PCCMakeOptions
157−pccOptions = PCCOptions <$> many inputFile
167+pccMakeOptions = PCCMakeOptions <$> many inputFile
158− <*> many inputForeignFile
159− <*> outputDirectory
168+ <*> outputDirectory
160− <*> options
169+ <*> options
161− <*> (not <$> noPrefix)
170+ <*> (not <$> noPrefix)
163main :: IO ()
173main :: IO ()
175+ hSetEncoding stdout utf8
176+ hSetEncoding stderr utf8
164−main = execParser opts >>= compile
177+ execParser opts >>= compile
166− opts = info (version <*> helper <*> pccOptions) infoModList
179+ opts = info (version <*> helper <*> pccMakeOptions) infoModList
167 infoModList = fullDesc <> headerInfo <> footerInfo
180 infoModList = fullDesc <> headerInfo <> footerInfo
168 headerInfo = header "pcc - Compiles PureScript to C++11"
181 headerInfo = header "pcc - Compiles PureScript to C++11"
169 footerInfo = footer $ "pcc " ++ showVersion Paths.version
182 footerInfo = footer $ "pcc " ++ showVersion Paths.version