git.iko.soy/elk
on ea77dcf help sign in
elk/src/Reporting/Report.hs
92 lines 2.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Report
4 ( Report
5 , report
6 , reportDoc
7 , toDoc
8 , toJson
9 )
10 where
12import Data.Aeson ((.=))
13import qualified Data.Aeson.Types as Json
14import qualified Data.Text as Text
15import Data.Text (Text)
16import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), displayS, dullcyan, hardline, plain, renderPretty, text)
18import qualified Reporting.Helpers as Help
19import qualified Reporting.Region as R
20import qualified Reporting.Render.Code as Code
24-- BUILD REPORTS
27data Report =
28 Report
29 { _title :: Text
30 , _highlight :: Maybe R.Region
31 , _preHint :: Doc
32 , _postHint :: Doc
33 }
36report :: Text -> Maybe R.Region -> Text -> Doc -> Report
37report title highlight pre post =
38 Report title highlight (Help.reflowParagraph pre) post
41reportDoc :: Text -> Maybe R.Region -> [Doc] -> Doc -> Report
42reportDoc title highlight pre post =
43 Report title highlight (Help.hsep pre) post
47-- REPORT TO JSON
50toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
51toJson extraFields (Report title subregion pre post) =
52 let
53 fields =
54 [ "tag" .= title
55 , "overview" .= nonAnsiRender pre
56 , "details" .= nonAnsiRender post
57 ]
58 in
59 (subregion, fields ++ extraFields)
62nonAnsiRender :: Doc -> String
63nonAnsiRender doc =
64 displayS (renderPretty 1 80 (plain doc)) ""
68-- REPORT TO DOC
71toDoc :: String -> R.Region -> Report -> Text -> Doc
72toDoc location region (Report title highlight preHint postHint) source =
73 messageBar title location
74 <> hardline <> hardline <>
75 preHint
76 <> hardline <> hardline <>
77 Code.render highlight region source
78 <> hardline <>
79 postHint
80 <> hardline <> hardline
83messageBar :: Text -> String -> Doc
84messageBar tag location =
85 let
86 usedSpace =
87 4 + Text.length tag + 1 + length location
88 in
89 dullcyan $ text $
90 "-- " ++ Text.unpack tag
91 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
92 ++ " " ++ location