git.iko.soy/elk
on 267f708 help sign in
elk/src/Reporting/Report.hs
106 lines 2.2 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
17 , hardline, plain, renderPretty, text
18 )
20import qualified Reporting.Region as R
21import qualified Reporting.Render.Code as Code
25-- BUILD REPORTS
28data Report = Report
29 { _title :: String
30 , _highlight :: Maybe R.Region
31 , _preHint :: Doc
32 , _postHint :: Doc
33 }
36report :: String -> Maybe R.Region -> String -> Doc -> Report
37report title highlight pre post =
38 Report title highlight (fillSep (map text (words pre))) post
42-- REPORT TO JSON
45toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
46toJson extraFields (Report title subregion pre post) =
47 let
48 fields =
49 [ "tag" .= title
50 , "overview" .= nonAnsiRender pre
51 , "details" .= nonAnsiRender post
52 ]
53 in
54 (subregion, fields ++ extraFields)
58-- REPORT TO DOC
61toDoc :: String -> R.Region -> Report -> String -> Doc
62toDoc location region (Report title highlight preHint postHint) source =
63 messageBar title location
64 <> hardline <> hardline <>
65 preHint
66 <> hardline <> hardline <>
67 Code.render highlight region source
68 <> hardline <>
69 postHint
70 <> hardline <> hardline
73messageBar :: String -> String -> Doc
74messageBar tag location =
75 let
76 usedSpace =
77 4 + length tag + 1 + length location
78 in
79 dullcyan $ text $
80 "-- " ++ tag ++ " " ++ replicate (max 1 (80 - usedSpace)) '-' ++ " " ++ location
84-- RENDER DOCS
87toHandle :: Handle -> String -> R.Region -> Report -> String -> IO ()
88toHandle handle location region rprt source =
89 displayIO
90 handle
91 (renderPretty 1 80 (toDoc location region rprt source))
94toString :: String -> R.Region -> Report -> String -> String
95toString location region rprt source =
96 nonAnsiRender (toDoc location region rprt source)
100-- DOC TO STRING WITH NO ANSI CODES
103nonAnsiRender :: Doc -> String
104nonAnsiRender doc =
105 displayS (renderPretty 1 80 (plain doc)) ""