git.iko.soy/elk
on c299dfe help sign in
elk/builder/src/Reporting/Error/Help.hs
149 lines 2.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error.Help
4 ( Report
5 , report
6 , docReport
7 , compilerReport
8 , reportToDoc
9 , hintLink
10 , stack
11 , reflow
12 , note
13 , toString
14 , toStdout
15 , toStderr
16 )
17 where
19import qualified Data.List as List
20import GHC.IO.Handle (hIsTerminalDevice)
21import System.IO (Handle, hPutStr, stderr, stdout)
22import qualified Text.PrettyPrint.ANSI.Leijen as P
23import Text.PrettyPrint.ANSI.Leijen ((<>),(<+>))
25import qualified Elm.Compiler as Compiler
26import qualified Elm.Package as Pkg
30-- REPORT
33data Report
34 = FromCompiler P.Doc
35 | Report
36 { _title :: String
37 , _path :: Maybe FilePath
38 , _start :: P.Doc
39 , _others :: [P.Doc]
40 }
43report :: String -> Maybe FilePath -> String -> [P.Doc] -> Report
44report title maybePath startString others =
45 Report title maybePath (P.text startString) others
48docReport :: String -> Maybe FilePath -> P.Doc -> [P.Doc] -> Report
49docReport =
50 Report
53compilerReport :: P.Doc -> Report
54compilerReport =
55 FromCompiler
58reportToDoc :: Report -> P.Doc
59reportToDoc report_ =
60 case report_ of
61 FromCompiler doc ->
62 doc
64 Report title maybePath start others ->
65 let
66 makeDashes n =
67 replicate (max 1 (80 - n)) '-'
69 errorBarEnd =
70 case maybePath of
71 Nothing ->
72 makeDashes (4 + length title)
74 Just path ->
75 makeDashes (5 + length title + length path) ++ " " ++ path
77 errorBar =
78 P.dullcyan $
79 "--" <+> P.text title <+> P.text errorBarEnd
80 in
81 stack (errorBar : start : others ++ [""])
85-- HINT LINKS
88hintLink :: String -> String
89hintLink hintName =
90 "<https://github.com/elm-lang/elm-compiler/blob/"
91 ++ Pkg.versionToString Compiler.version
92 ++ "/hints/" ++ hintName ++ ".md>"
96-- HELPERS
99stack :: [P.Doc] -> P.Doc
100stack allDocs =
101 case allDocs of
102 [] ->
103 error "Do not use `stack` on empty lists."
105 doc : docs ->
106 List.foldl' verticalAppend doc docs
109verticalAppend :: P.Doc -> P.Doc -> P.Doc
110verticalAppend a b =
111 a <> P.hardline <> P.hardline <> b
114reflow :: String -> P.Doc
115reflow paragraph =
116 P.fillSep (map P.text (words paragraph))
119note :: String -> P.Doc
120note details =
121 P.fillSep $
122 (P.underline "Note" <> ":") : map P.text (words details)
126-- OUTPUT
129toString :: P.Doc -> String
130toString doc =
131 P.displayS (P.renderPretty 1 80 (P.plain doc)) ""
134toStdout :: P.Doc -> IO ()
135toStdout doc =
136 toHandle stdout doc
139toStderr :: P.Doc -> IO ()
140toStderr doc =
141 toHandle stderr doc
144toHandle :: Handle -> P.Doc -> IO ()
145toHandle handle doc =
146 do isTerminal <- hIsTerminalDevice handle
147 if isTerminal
148 then P.displayIO handle (P.renderPretty 1 80 doc)
149 else hPutStr handle (toString doc)