@@ -27,6 +27,9 @@ import Control.Monad.Writer.Strict
2727import Data.List (isSuffixOf, partition)
2828import Data.Version (showVersion)
2929import qualified Data.Map as M
30+import qualified Data.Aeson as A
31+import qualified Data.ByteString.Lazy as B
32+import qualified Data.ByteString.UTF8 as BU8
3033
3134import Options.Applicative as Opts
3235
@@ -40,45 +43,54 @@ import qualified Paths_purescript as Paths
4043
4144import Language.PureScript.Make
4245
46+import JSON
47+
4348data PSCMakeOptions = PSCMakeOptions
4449 { pscmInput :: [FilePath]
4550 , pscmForeignInput :: [FilePath]
4651 , pscmOutputDir :: FilePath
4752 , pscmOpts :: P.Options
4853 , pscmUsePrefix :: Bool
54+ , pscmJSONErrors :: Bool
4955 }
5056
5157data InputOptions = InputOptions
5258 { ioInputFiles :: [FilePath]
5359 }
5460
61+-- | Argumnets: verbose, use JSON, warnings, errors
62+printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()
63+printWarningsAndErrors verbose False warnings errors = do
64+ when (P.nonEmpty warnings) $
65+ hPutStrLn stderr (P.prettyPrintMultipleWarnings verbose warnings)
66+ case errors of
67+ Left errs -> do
68+ hPutStrLn stderr (P.prettyPrintMultipleErrors verbose errs)
69+ exitFailure
70+ Right _ -> return ()
71+printWarningsAndErrors verbose True warnings errors = do
72+ hPutStrLn stderr . BU8.toString . B.toStrict . A.encode $
73+ JSONResult (toJSONErrors verbose P.Warning warnings)
74+ (either (toJSONErrors verbose P.Error) (const []) errors)
75+ either (const exitFailure) (const (return ())) errors
76+
5577compile :: PSCMakeOptions -> IO ()
56−compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
57− input <- globWarningOnMisses warnFileTypeNotFound inputGlob
78+compile PSCMakeOptions{..} = do
79+ input <- globWarningOnMisses warnFileTypeNotFound pscmInput
5880 when (null input) $ do
5981 hPutStrLn stderr "psc: No input files."
6082 exitFailure
6183 let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input
6284 moduleFiles <- readInput (InputOptions pursFiles)
63− inputForeign <- globWarningOnMisses warnFileTypeNotFound inputForeignGlob
85+ inputForeign <- globWarningOnMisses warnFileTypeNotFound pscmForeignInput
6486 foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readUTF8File inFile)
65− case runWriterT (parseInputs moduleFiles foreignFiles) of
66− Left errs -> do
67− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
68− exitFailure
69− Right ((ms, foreigns), warnings) -> do
70− when (P.nonEmpty warnings) $
71− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
72− let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
73− makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix
74− (e, warnings') <- runMake opts $ P.make makeActions (map snd ms)
75− when (P.nonEmpty warnings') $
76− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
77− case e of
78− Left errs -> do
79− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
80− exitFailure
81− Right _ -> exitSuccess
87+ (makeErrors, makeWarnings) <- runMake pscmOpts $ do
88+ (ms, foreigns) <- parseInputs moduleFiles foreignFiles
89+ let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
90+ makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix
91+ P.make makeActions (map snd ms)
92+ printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors makeWarnings makeErrors
93+ exitSuccess
8294
8395warnFileTypeNotFound :: String -> IO ()
8496warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)
@@ -161,6 +173,10 @@ noPrefix = switch $
161173 <> long "no-prefix"
162174 <> help "Do not include comment header"
163175
176+jsonErrors :: Parser Bool
177+jsonErrors = switch $
178+ long "json-errors"
179+ <> help "Print errors to stderr as JSON"
164180
165181options :: Parser P.Options
166182options = P.Options <$> noTco
@@ -177,7 +193,7 @@ pscMakeOptions = PSCMakeOptions <$> many inputFile
177193 <*> outputDirectory
178194 <*> options
179195 <*> (not <$> noPrefix)
180−
196+ <*> jsonErrors
181197
182198main :: IO ()
183199main = execParser opts >>= compile