on e00a3f3 help sign in
elk/src/Reporting/Report.hs
85 lines 1.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Report
4 ( Report
5 , report
6 , toDoc
7 , toJson
8 )
9 where
11import Data.Aeson ((.=))
12import qualified Data.Aeson.Types as Json
13import qualified Data.Text as Text
14import Data.Text (Text)
15import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), displayS, dullcyan, hardline, plain, renderPretty, text)
17import qualified Reporting.Helpers as Help
18import qualified Reporting.Region as R
19import qualified Reporting.Render.Code as Code
23-- BUILD REPORTS
26data Report = Report
27 { _title :: Text
28 , _highlight :: Maybe R.Region
29 , _preHint :: Doc
30 , _postHint :: Doc
31 }
34report :: Text -> Maybe R.Region -> Text -> Doc -> Report
35report title highlight pre post =
36 Report title highlight (Help.reflowParagraph pre) post
40-- REPORT TO JSON
43toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
44toJson extraFields (Report title subregion pre post) =
45 let
46 fields =
47 [ "tag" .= title
48 , "overview" .= nonAnsiRender pre
49 , "details" .= nonAnsiRender post
50 ]
51 in
52 (subregion, fields ++ extraFields)
55nonAnsiRender :: Doc -> String
56nonAnsiRender doc =
57 displayS (renderPretty 1 80 (plain doc)) ""
61-- REPORT TO DOC
64toDoc :: String -> R.Region -> Report -> Text -> Doc
65toDoc location region (Report title highlight preHint postHint) source =
66 messageBar title location
67 <> hardline <> hardline <>
68 preHint
69 <> hardline <> hardline <>
70 Code.render highlight region source
71 <> hardline <>
72 postHint
73 <> hardline <> hardline
76messageBar :: Text -> String -> Doc
77messageBar tag location =
78 let
79 usedSpace =
80 4 + Text.length tag + 1 + length location
81 in
82 dullcyan $ text $
83 "-- " ++ Text.unpack tag
84 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
85 ++ " " ++ location