@@ -1,21 +1,17 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Reporting.Report
4− ( Report
5− , report
6− , reportDoc
4+ ( Report(..)
75 , toDoc
8− , toJson
6+ , toCodeSnippet
7+ , toCodePair
98 )
109 where
1110
12−import Data.Aeson ((.=))
13−import qualified Data.Aeson.Types as Json
1411import qualified Data.Text as Text
15−import Data.Text (Text)
16−import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), displayS, dullcyan, hardline, plain, renderPretty, text)
12+import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), hardline, dullcyan)
1713
18−import qualified Reporting.Helpers as Help
14+import qualified Reporting.Helpers as H
1915import qualified Reporting.Region as R
2016import qualified Reporting.Render.Code as Code
2117
@@ -26,67 +22,63 @@ import qualified Reporting.Render.Code as Code
2622
2723data Report =
2824 Report
29− { _title :: Text
30− , _highlight :: Maybe R.Region
31− , _preHint :: Doc
32− , _postHint :: Doc
25+ { _title :: String
26+ , _region :: R.Region
27+ , _sgstns :: [Text.Text]
28+ , _message :: Doc
3329 }
3430
3531
36−report :: Text -> Maybe R.Region -> Text -> Doc -> Report
37−report title highlight pre post =
38− Report title highlight (Help.reflowParagraph pre) post
32+toDoc :: FilePath -> Report -> Doc
33+toDoc filePath (Report title _ _ message) =
34+ messageBar title filePath
35+ <> hardline <> hardline <>
36+ message
3937
4038
41−reportDoc :: Text -> Maybe R.Region -> [Doc] -> Doc -> Report
42−reportDoc title highlight pre post =
43− Report title highlight (Help.hsep pre) post
44−
45−
46−
47−-- REPORT TO JSON
48−
49−
50−toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
51−toJson 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)
60−
61−
62−nonAnsiRender :: Doc -> String
63−nonAnsiRender doc =
64− displayS (renderPretty 1 80 (plain doc)) ""
65−
66−
67−
68−-- REPORT TO DOC
69−
70−
71−toDoc :: String -> R.Region -> Report -> Text -> Doc
72−toDoc 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
81−
82−
83−messageBar :: Text -> String -> Doc
84−messageBar tag location =
39+messageBar :: String -> FilePath -> Doc
40+messageBar title filePath =
8541 let
8642 usedSpace =
87− 4 + Text.length tag + 1 + length location
43+ 4 + length title + 1 + length filePath
8844 in
89− dullcyan $ text $
90− "-- " ++ Text.unpack tag
45+ dullcyan $ H.text $
46+ "-- " ++ title
9147 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
92− ++ " " ++ location
48+ ++ " " ++ filePath
49+
50+
51+
52+-- CODE FORMATTING
53+
54+
55+toCodeSnippet :: Code.Source -> R.Region -> Maybe R.Region -> (Doc, Doc) -> Doc
56+toCodeSnippet source region highlight (preHint, postHint) =
57+ preHint
58+ <> hardline <> hardline <>
59+ Code.render source region highlight
60+ <> hardline <>
61+ postHint
62+ <> hardline <> hardline
63+
64+
65+toCodePair :: Code.Source -> R.Region -> R.Region -> (Doc, Doc) -> (Doc, Doc, Doc) -> Doc
66+toCodePair source r1 r2 (oneStart, oneEnd) (twoStart, twoMiddle, twoEnd) =
67+ case Code.renderPair source r1 r2 of
68+ Code.OneLine codeDocs ->
69+ oneStart
70+ <> hardline <> hardline <>
71+ codeDocs
72+ <> hardline <>
73+ oneEnd
74+
75+ Code.TwoChunks code1 code2 ->
76+ twoStart
77+ <> hardline <> hardline <>
78+ code1
79+ <> hardline <>
80+ twoMiddle
81+ <> hardline <> hardline <>
82+ code2
83+ <> hardline <>
84+ twoEnd