@@ -27,6 +27,9 @@ import Control.Monad.Writer.Strict
27import Data.List (isSuffixOf, partition)
27import Data.List (isSuffixOf, partition)
28import Data.Version (showVersion)
28import Data.Version (showVersion)
29import qualified Data.Map as M
29import 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
31import Options.Applicative as Opts
34import Options.Applicative as Opts
@@ -40,45 +43,54 @@ import qualified Paths_purescript as Paths
41import Language.PureScript.Make
44import Language.PureScript.Make
43data PSCMakeOptions = PSCMakeOptions
48data PSCMakeOptions = PSCMakeOptions
44 { pscmInput :: [FilePath]
49 { pscmInput :: [FilePath]
45 , pscmForeignInput :: [FilePath]
50 , pscmForeignInput :: [FilePath]
46 , pscmOutputDir :: FilePath
51 , pscmOutputDir :: FilePath
47 , pscmOpts :: P.Options
52 , pscmOpts :: P.Options
48 , pscmUsePrefix :: Bool
53 , pscmUsePrefix :: Bool
54+ , pscmJSONErrors :: Bool
51data InputOptions = InputOptions
57data InputOptions = InputOptions
52 { ioInputFiles :: [FilePath]
58 { ioInputFiles :: [FilePath]
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)
68+ hPutStrLn stderr (P.prettyPrintMultipleErrors verbose errs)
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
55compile :: PSCMakeOptions -> IO ()
77compile :: PSCMakeOptions -> IO ()
56−compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
78+compile PSCMakeOptions{..} = do
57− input <- globWarningOnMisses warnFileTypeNotFound inputGlob
79+ input <- globWarningOnMisses warnFileTypeNotFound pscmInput
58 when (null input) $ do
80 when (null input) $ do
59 hPutStrLn stderr "psc: No input files."
81 hPutStrLn stderr "psc: No input files."
60 exitFailure
82 exitFailure
61 let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input
83 let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input
62 moduleFiles <- readInput (InputOptions pursFiles)
84 moduleFiles <- readInput (InputOptions pursFiles)
63− inputForeign <- globWarningOnMisses warnFileTypeNotFound inputForeignGlob
85+ inputForeign <- globWarningOnMisses warnFileTypeNotFound pscmForeignInput
64 foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readUTF8File inFile)
86 foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readUTF8File inFile)
87+ (makeErrors, makeWarnings) <- runMake pscmOpts $ do
65− case runWriterT (parseInputs moduleFiles foreignFiles) of
88+ (ms, foreigns) <- parseInputs moduleFiles foreignFiles
67− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
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
89+ let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
73− makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix
90+ makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix
74− (e, warnings') <- runMake opts $ P.make makeActions (map snd ms)
91+ P.make makeActions (map snd ms)
75− when (P.nonEmpty warnings') $
92+ printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors makeWarnings makeErrors
76− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
79− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
81− Right _ -> exitSuccess
93+ exitSuccess
83warnFileTypeNotFound :: String -> IO ()
95warnFileTypeNotFound :: String -> IO ()
84warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)
96warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)
@@ -161,6 +173,10 @@ noPrefix = switch $
161 <> long "no-prefix"
173 <> long "no-prefix"
162 <> help "Do not include comment header"
174 <> help "Do not include comment header"
176+jsonErrors :: Parser Bool
177+jsonErrors = switch $
179+ <> help "Print errors to stderr as JSON"
165options :: Parser P.Options
181options :: Parser P.Options
166options = P.Options <$> noTco
182options = P.Options <$> noTco
@@ -177,7 +193,7 @@ pscMakeOptions = PSCMakeOptions <$> many inputFile
177 <*> outputDirectory
193 <*> outputDirectory
178 <*> options
194 <*> options
179 <*> (not <$> noPrefix)
195 <*> (not <$> noPrefix)
182main :: IO ()
198main :: IO ()
183main = execParser opts >>= compile
199main = execParser opts >>= compile