on 769faec help sign in
elk/src/Reporting/Report.hs
97 lines 2.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Report
4 ( Report
5 , report
6 , toString
7 , toJson
8 , toHandle
9 )
10 where
12import Data.Aeson ((.=))
13import qualified Data.Aeson.Types as Json
14import System.IO (Handle)
15import Text.PrettyPrint.ANSI.Leijen
16 ( Doc, (<>), displayS, displayIO, dullcyan, fillSep, hardline, renderPretty, text
17 )
19import qualified Reporting.Region as R
20import qualified Reporting.Render.Code as Code
24-- BUILD REPORTS
27data Report = Report
28 { _title :: String
29 , _highlight :: Maybe R.Region
30 , _preHint :: Doc
31 , _postHint :: Doc
32 }
35report :: String -> Maybe R.Region -> String -> Doc -> Report
36report title highlight pre post =
37 Report title highlight (fillSep (map text (words pre))) post
41-- REPORT TO JSON
44toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
45toJson extraFields (Report title subregion pre post) =
46 let
47 fields =
48 [ "tag" .= title
49 , "overview" .= displayS (renderPretty 1 80 pre) ""
50 , "details" .= displayS (renderPretty 1 80 post) ""
51 ]
52 in
53 (subregion, fields ++ extraFields)
57-- REPORT TO DOC
60toDoc :: String -> R.Region -> Report -> String -> Doc
61toDoc location region (Report title highlight preHint postHint) source =
62 messageBar title location
63 <> hardline <> hardline <>
64 preHint
65 <> hardline <> hardline <>
66 Code.render highlight region source
67 <> hardline <>
68 postHint
69 <> hardline <> hardline
72messageBar :: String -> String -> Doc
73messageBar tag location =
74 let
75 usedSpace =
76 4 + length tag + 1 + length location
77 in
78 dullcyan $ text $
79 "-- " ++ tag ++ " " ++ replicate (max 1 (80 - usedSpace)) '-' ++ " " ++ location
83-- RENDER DOCS
86toString :: String -> R.Region -> Report -> String -> String
87toString location region rprt source =
88 displayS
89 (renderPretty 1 80 (toDoc location region rprt source))
90 ""
93toHandle :: Handle -> String -> R.Region -> Report -> String -> IO ()
94toHandle handle location region rprt source =
95 displayIO
96 handle
97 (renderPretty 1 80 (toDoc location region rprt source))