on 1238607 help sign in
137 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 qualified Data.Utf8 as Utf8
18import GHC.IO.Handle (hIsTerminalDevice)
19import System.IO (Handle, hPutStr, stderr, stdout)
21import qualified Json.Encode as E
22import Json.Encode ((==>))
23import Reporting.Doc ((<+>))
24import qualified Reporting.Doc as D
25import qualified Reporting.Exit.Compile as Compile
29-- REPORT
32data Report
33 = CompilerReport Compile.Exit [Compile.Exit]
34 | Report
35 { _title :: String
36 , _path :: Maybe FilePath
37 , _message :: D.Doc
38 }
41report :: String -> Maybe FilePath -> String -> [D.Doc] -> Report
42report title path startString others =
43 Report title path $ D.stack (D.reflow startString:others)
46docReport :: String -> Maybe FilePath -> D.Doc -> [D.Doc] -> Report
47docReport title path startDoc others =
48 Report title path $ D.stack (startDoc:others)
51jsonReport :: String -> Maybe FilePath -> D.Doc -> Report
52jsonReport =
53 Report
56compilerReport :: Compile.Exit -> [Compile.Exit] -> Report
57compilerReport =
58 CompilerReport
62-- TO DOC
65reportToDoc :: Report -> D.Doc
66reportToDoc report_ =
67 case report_ of
68 CompilerReport e es ->
69 Compile.toDoc e es
71 Report title maybePath message ->
72 let
73 makeDashes n =
74 replicate (max 1 (80 - n)) '-'
76 errorBarEnd =
77 case maybePath of
78 Nothing ->
79 makeDashes (4 + length title)
81 Just path ->
82 makeDashes (5 + length title + length path) ++ " " ++ path
84 errorBar =
85 D.dullcyan $
86 "--" <+> D.fromChars title <+> D.fromChars errorBarEnd
87 in
88 D.stack [errorBar, message, ""]
92-- TO JSON
95reportToJson :: Report -> E.Value
96reportToJson report_ =
97 case report_ of
98 CompilerReport e es ->
99 E.object
100 [ "type" ==> E.string "compile-errors"
101 , "errors" ==> E.list Compile.toJson (e:es)
102 ]
104 Report title maybePath message ->
105 E.object
106 [ "type" ==> E.string "error"
107 , "path" ==> maybe E.null (E.string . Utf8.fromChars) maybePath
108 , "title" ==> E.string (Utf8.fromChars title)
109 , "message" ==> D.encode message
110 ]
114-- OUTPUT
117toString :: D.Doc -> String
118toString =
119 D.toString
122toStdout :: D.Doc -> IO ()
123toStdout doc =
124 toHandle stdout doc
127toStderr :: D.Doc -> IO ()
128toStderr doc =
129 toHandle stderr doc
132toHandle :: Handle -> D.Doc -> IO ()
133toHandle handle doc =
134 do isTerminal <- hIsTerminalDevice handle
135 if isTerminal
136 then D.toAnsi handle doc
137 else hPutStr handle (toString doc)