on f9de430 help sign in
136 lines 2.7 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Reporting.Exit.Help
3 ( Report
4 , report
5 , docReport
6 , jsonReport
7 , compilerReport
8 , reportToDoc
9 , reportToJson
10 , toString
11 , toStdout
12 , toStderr
13 )
14 where
17import GHC.IO.Handle (hIsTerminalDevice)
18import System.IO (Handle, hPutStr, stderr, stdout)
20import qualified Json.Encode as E
21import Json.Encode ((==>))
22import Reporting.Doc ((<+>))
23import qualified Reporting.Doc as D
24import qualified Reporting.Error as Error
28-- REPORT
31data Report
32 = CompilerReport FilePath Error.Module [Error.Module]
33 | Report
34 { _title :: String
35 , _path :: Maybe FilePath
36 , _message :: D.Doc
37 }
40report :: String -> Maybe FilePath -> String -> [D.Doc] -> Report
41report title path startString others =
42 Report title path $ D.stack (D.reflow startString:others)
45docReport :: String -> Maybe FilePath -> D.Doc -> [D.Doc] -> Report
46docReport title path startDoc others =
47 Report title path $ D.stack (startDoc:others)
50jsonReport :: String -> Maybe FilePath -> D.Doc -> Report
51jsonReport =
52 Report
55compilerReport :: FilePath -> Error.Module -> [Error.Module] -> Report
56compilerReport =
57 CompilerReport
61-- TO DOC
64reportToDoc :: Report -> D.Doc
65reportToDoc report_ =
66 case report_ of
67 CompilerReport root e es ->
68 Error.toDoc root e es
70 Report title maybePath message ->
71 let
72 makeDashes n =
73 replicate (max 1 (80 - n)) '-'
75 errorBarEnd =
76 case maybePath of
77 Nothing ->
78 makeDashes (4 + length title)
80 Just path ->
81 makeDashes (5 + length title + length path) ++ " " ++ path
83 errorBar =
84 D.dullcyan $
85 "--" <+> D.fromChars title <+> D.fromChars errorBarEnd
86 in
87 D.stack [errorBar, message, ""]
91-- TO JSON
94reportToJson :: Report -> E.Value
95reportToJson report_ =
96 case report_ of
97 CompilerReport _ e es ->
98 E.object
99 [ "type" ==> E.chars "compile-errors"
100 , "errors" ==> E.list Error.toJson (e:es)
101 ]
103 Report title maybePath message ->
104 E.object
105 [ "type" ==> E.chars "error"
106 , "path" ==> maybe E.null E.chars maybePath
107 , "title" ==> E.chars title
108 , "message" ==> D.encode message
109 ]
113-- OUTPUT
116toString :: D.Doc -> String
117toString =
118 D.toString
121toStdout :: D.Doc -> IO ()
122toStdout doc =
123 toHandle stdout doc
126toStderr :: D.Doc -> IO ()
127toStderr doc =
128 toHandle stderr doc
131toHandle :: Handle -> D.Doc -> IO ()
132toHandle handle doc =
133 do isTerminal <- hIsTerminalDevice handle
134 if isTerminal
135 then D.toAnsi handle doc
136 else hPutStr handle (toString doc)