git.iko.soy/elk
on fb1a6d2 help sign in
elk/src/Reporting/Error.hs
86 lines 2.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error where
5import Data.Aeson ((.=))
6import qualified Data.Aeson as Json
7import qualified Data.Aeson.Types as Json
9import qualified Reporting.Annotation as A
10import qualified Reporting.Error.Canonicalize as Canonicalize
11import qualified Reporting.Error.Syntax as Syntax
12import qualified Reporting.Error.Type as Type
13import qualified Reporting.Region as Region
14import qualified Reporting.Report as Report
17-- ALL POSSIBLE ERRORS
19data Error
20 = Syntax Syntax.Error
21 | Canonicalize Canonicalize.Error
22 | Type Type.Error
25-- TO STRING
27toString :: String -> String -> A.Located Error -> String
28toString location source (A.A region err) =
29 let
30 report =
31 case err of
32 Syntax syntaxError ->
33 Syntax.toReport syntaxError
35 Canonicalize canonicalizeError ->
36 Canonicalize.toReport canonicalizeError
38 Type typeError ->
39 Type.toReport typeError
40 in
41 Report.toString location region report source
44-- TO JSON
46toJson :: String -> A.Located Error -> Json.Value
47toJson location (A.A region err) =
48 let
49 (maybeRegion, additionalFields) =
50 case err of
51 Syntax syntaxError ->
52 reportToJson [] (Syntax.toReport syntaxError)
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)
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
74reportToJson
75 :: [Json.Pair]
76 -> Report.Report
77 -> (Maybe Region.Region, [Json.Pair])
78reportToJson 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)