@@ -1,10 +1,16 @@
1+{-# OPTIONS_GHC -Wall #-}
12{-# LANGUAGE OverloadedStrings #-}
23module Reporting.Error where
34
5+import Data.Aeson ((.=))
6+import qualified Data.Aeson as Json
7+import qualified Data.Aeson.Types as Json
8+
49import qualified Reporting.Annotation as A
510import qualified Reporting.Error.Canonicalize as Canonicalize
611import qualified Reporting.Error.Syntax as Syntax
712import qualified Reporting.Error.Type as Type
13+import qualified Reporting.Region as Region
814import qualified Reporting.Report as Report
915
1016
@@ -33,3 +39,48 @@ toString location source (A.A region err) =
3339 Type.toReport typeError
3440 in
3541 Report.toString location region report source
42+
43+
44+-- TO JSON
45+
46+toJson :: String -> A.Located Error -> Json.Value
47+toJson location (A.A region err) =
48+ let
49+ (maybeRegion, additionalFields) =
50+ case err of
51+ Syntax syntaxError ->
52+ reportToJson [] (Syntax.toReport syntaxError)
53+
54+ Canonicalize canonicalizeError ->
55+ let
56+ suggestions =
57+ maybe []
58+ (\s -> ["suggestions" .= s])
59+ (Canonicalize.extractSuggestions canonicalizeError)
60+ in
61+ reportToJson suggestions (Canonicalize.toReport canonicalizeError)
62+
63+ Type typeError ->
64+ reportToJson [] (Type.toReport typeError)
65+ in
66+ Json.object $
67+ [ "file" .= location
68+ , "region" .= maybe region id maybeRegion
69+ , "type" .= ("error" :: String)
70+ ]
71+ ++ additionalFields
72+
73+
74+reportToJson
75+ :: [Json.Pair]
76+ -> Report.Report
77+ -> (Maybe Region.Region, [Json.Pair])
78+reportToJson extraFields (Report.Report title subregion pre post) =
79+ let
80+ fields =
81+ [ "tag" .= title
82+ , "overview" .= pre
83+ , "details" .= post
84+ ]
85+ in
86+ (subregion, fields ++ extraFields)