git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #1523, add --json-errors flag.
11b2662Phil Freeman
psc/JSON.hsnew file+69
@@ -0,0 +1,69 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Main
4+-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5+-- License : MIT (http://opensource.org/licenses/MIT)
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE TemplateHaskell #-}
16+
17+module JSON where
18+
19+import Prelude ()
20+import Prelude.Compat
21+
22+import qualified Data.Aeson.TH as A
23+
24+import qualified Language.PureScript as P
25+
26+data ErrorPosition = ErrorPosition
27+ { startLine :: Int
28+ , startColumn :: Int
29+ , endLine :: Int
30+ , endColumn :: Int
31+ }
32+
33+data JSONError = JSONError
34+ { position :: Maybe ErrorPosition
35+ , message :: String
36+ , errorCode :: String
37+ , filename :: Maybe String
38+ , moduleName :: Maybe String
39+ }
40+
41+data JSONResult = JSONResult
42+ { warnings :: [JSONError]
43+ , errors :: [JSONError]
44+ }
45+
46+$(A.deriveJSON A.defaultOptions ''ErrorPosition)
47+$(A.deriveJSON A.defaultOptions ''JSONError)
48+$(A.deriveJSON A.defaultOptions ''JSONResult)
49+
50+toJSONErrors :: Bool -> P.Level -> P.MultipleErrors -> [JSONError]
51+toJSONErrors verbose level = map (toJSONError verbose level) . P.runMultipleErrors
52+
53+toJSONError :: Bool -> P.Level -> P.ErrorMessage -> JSONError
54+toJSONError verbose level e =
55+ JSONError (toErrorPosition <$> sspan)
56+ (P.renderBox (P.prettyPrintSingleError' verbose level (P.stripModuleAndSpan e)))
57+ (P.errorCode e)
58+ (P.spanName <$> sspan)
59+ (P.runModuleName <$> P.errorModule e)
60+ where
61+ sspan :: Maybe P.SourceSpan
62+ sspan = P.errorSpan e
63+
64+ toErrorPosition :: P.SourceSpan -> ErrorPosition
65+ toErrorPosition ss =
66+ ErrorPosition (P.sourcePosLine (P.spanStart ss))
67+ (P.sourcePosColumn (P.spanStart ss))
68+ (P.sourcePosLine (P.spanEnd ss))
69+ (P.sourcePosColumn (P.spanEnd ss))
psc/Main.hs+37−21
@@ -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
30
33
31import Options.Applicative as Opts
34import Options.Applicative as Opts
32
35
@@ -40,45 +43,54 @@ import qualified Paths_purescript as Paths
40
43
41import Language.PureScript.Make
44import Language.PureScript.Make
42
45
46+import JSON
47+
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
49 }
55 }
50
56
51data InputOptions = InputOptions
57data InputOptions = InputOptions
52 { ioInputFiles :: [FilePath]
58 { ioInputFiles :: [FilePath]
53 }
59 }
54
60
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+
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
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
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')
77− case e of
78− Left errs -> do
79− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
80− exitFailure
81− Right _ -> exitSuccess
93+ exitSuccess
82
94
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"
163
175
176+jsonErrors :: Parser Bool
177+jsonErrors = switch $
178+ long "json-errors"
179+ <> help "Print errors to stderr as JSON"
164
180
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)
180−
196+ <*> jsonErrors
181
197
182main :: IO ()
198main :: IO ()
183main = execParser opts >>= compile
199main = execParser opts >>= compile
purescript.cabal+5−2
@@ -185,12 +185,15 @@ library
185 ghc-options: -Wall -O2
185 ghc-options: -Wall -O2
186
186
187executable psc
187executable psc
188+ build-depends: base >=4 && <5, base-compat >=0.6.0,
188− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
189+ containers -any, directory -any, filepath -any,
189 mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
190 mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
190− time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8
191+ time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8,
192+ aeson >= 0.8 && < 0.11, bytestring -any, utf8-string >= 1 && < 2
191 main-is: Main.hs
193 main-is: Main.hs
192 buildable: True
194 buildable: True
193 hs-source-dirs: psc
195 hs-source-dirs: psc
196+ other-modules: JSON
194 ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts "-with-rtsopts=-N"
197 ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts "-with-rtsopts=-N"
195
198
196executable psci
199executable psci
src/Language/PureScript/Errors.hs+28−2
@@ -184,6 +184,31 @@ data HintCategory
184
184
185data ErrorMessage = ErrorMessage [ErrorMessageHint] SimpleErrorMessage deriving (Show)
185data ErrorMessage = ErrorMessage [ErrorMessageHint] SimpleErrorMessage deriving (Show)
186
186
187+-- | Get the source span for an error
188+errorSpan :: ErrorMessage -> Maybe SourceSpan
189+errorSpan = findHint matchSpan
190+ where
191+ matchSpan (PositionedError ss) = Just ss
192+ matchSpan _ = Nothing
193+
194+-- | Get the module name for an error
195+errorModule :: ErrorMessage -> Maybe ModuleName
196+errorModule = findHint matchModule
197+ where
198+ matchModule (ErrorInModule mn) = Just mn
199+ matchModule _ = Nothing
200+
201+findHint :: (ErrorMessageHint -> Maybe a) -> ErrorMessage -> Maybe a
202+findHint f (ErrorMessage hints _) = getLast . foldMap (Last . f) $ hints
203+
204+-- | Remove the module name and span hints from an error
205+stripModuleAndSpan :: ErrorMessage -> ErrorMessage
206+stripModuleAndSpan (ErrorMessage hints e) = ErrorMessage (filter (not . shouldStrip) hints) e
207+ where
208+ shouldStrip (ErrorInModule _) = True
209+ shouldStrip (PositionedError _) = True
210+ shouldStrip _ = False
211+
187-- |
212-- |
188-- Get the error code for a particular error type
213-- Get the error code for a particular error type
189--
214--
@@ -287,7 +312,6 @@ errorCode em = case unwrapErrorMessage em of
287 DuplicateImport{} -> "DuplicateImport"
312 DuplicateImport{} -> "DuplicateImport"
288 IntOutOfRange{} -> "IntOutOfRange"
313 IntOutOfRange{} -> "IntOutOfRange"
289
314
290−
291-- |
315-- |
292-- A stack trace for an error
316-- A stack trace for an error
293--
317--
@@ -304,7 +328,6 @@ nonEmpty = not . null . runMultipleErrors
304errorMessage :: SimpleErrorMessage -> MultipleErrors
328errorMessage :: SimpleErrorMessage -> MultipleErrors
305errorMessage err = MultipleErrors [ErrorMessage [] err]
329errorMessage err = MultipleErrors [ErrorMessage [] err]
306
330
307−
308-- |
331-- |
309-- Create an error set from a single error message
332-- Create an error set from a single error message
310--
333--
@@ -389,6 +412,9 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse
389 gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts
412 gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts
390 gHint other = pure other
413 gHint other = pure other
391
414
415+prettyPrintSingleError' :: Bool -> Level -> ErrorMessage ->Box.Box
416+prettyPrintSingleError' full level = flip evalState defaultUnknownMap . prettyPrintSingleError full level
417+
392-- |
418-- |
393-- Pretty print a single error, simplifying if necessary
419-- Pretty print a single error, simplifying if necessary
394--
420--