1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

module Pretty.ToJson where

import List (intercalate)
import Char (isSpace)
import Float (i2f)

import Curry.Types
import Curry.Position
import Curry.Span
import Text.Pretty
import JSON.Data
import JSON.Pretty

import Types

-- takes a list of messages and transforms into a single Json-Object for output
renderMessagesToJson :: Config -> String -> [SrcLine] -> [Message] -> String
renderMessagesToJson conf name src ms = ppJSON $ JArray $ map (toJson conf name src) ms

-- renders a single message with fields:
-- [ ("file" : string),
--   ("span" :
--     ("from" :
--       [("line" : number), ("column" : number)])
--     ("to" :
--       [("line" : number), ("column" : number)])),
--   ("warning" : string),
--   ("hint" : string)
-- ]
toJson :: Config -> String -> [SrcLine] -> Message -> JValue
toJson conf name src (Message (Span (Position l1 c1) (Position l2 c2)) sW sH) =
  JObject [ ("file", JString name)
          , ("span", JObject [ ("from", JObject [ ("line" , JNumber (i2f l1))
                                                , ("column", JNumber (i2f c1))])
                             , ("to", JObject [ ("line" , JNumber (i2f l2))
                                              , ("column", JNumber (i2f c2))])
                             ])
          , ("warning", JString (pPrint (warningToDoc sW)))
          ,("hint", JString (pPrint (hintToDoc conf sH)))
          ]

--return Doc with formatted Warning
warningToDoc :: Doc -> Doc
warningToDoc sW = text "Warning" <> text ":"
                     <+> sW

--return Doc with formatted Hint
hintToDoc :: Config -> Doc -> Doc
hintToDoc conf sH = if (hints conf)
                         then text "Hint"
                              <> text ":"
                              <+> sH
                              else empty