0 | module Idrall.Error

  2 | import Data.String

  4 | import public Text.PrettyPrint.Prettyprinter

  5 | import public Idrall.FC

  7 | public export

  8 | data Error

  9 |   = MissingVar FC String

 10 |   | AlphaEquivError FC String

 11 |   | EvalIntegerNegateErr FC String

 12 |   | EvalNaturalIsZeroErr FC String

 13 |   | EvalBoolAndErr FC

 14 |   | EvalApplyErr FC

 15 |   | Unexpected FC String

 16 |   | ErrorMessage FC String

 17 |   | ReadBackError FC String

 18 |   | SortError FC

 19 |   | AssertError FC String

 20 |   | ListAppendError FC String

 21 |   | ListHeadError FC String

 22 |   | FieldNotFoundError FC String

 23 |   | FieldArgMismatchError FC String

 24 |   | InvalidFieldType FC String

 25 |   | CombineError FC String

 26 |   | RecordFieldCollision FC String

 27 |   | ReadFileError FC String

 28 |   | MergeUnusedHandler FC String

 29 |   | MergeUnhandledCase FC String

 30 |   | ToMapError FC String

 31 |   | ToMapEmpty FC String

 32 |   | EmptyMerge FC String

 33 |   | InvalidRecordCompletion FC String

 34 |   | CyclicImportError FC String

 35 |   | EnvVarError FC String

 36 |   | FromDhallError FC String

 37 |   | ParseError FC String

 38 |   | LexError FC String

 39 |   | NestedError FC Error Error

 42 | HasFC Error where

 43 |   getFC (MissingVar fc x) = fc

 44 |   getFC (AlphaEquivError fc x) = fc

 45 |   getFC (EvalIntegerNegateErr fc x) = fc

 46 |   getFC (EvalNaturalIsZeroErr fc x) = fc

 47 |   getFC (EvalBoolAndErr fc) = fc

 48 |   getFC (EvalApplyErr fc) = fc

 49 |   getFC (Unexpected fc x) = fc

 50 |   getFC (ErrorMessage fc x) = fc

 51 |   getFC (ReadBackError fc x) = fc

 52 |   getFC (SortError fc) = fc

 53 |   getFC (AssertError fc x) = fc

 54 |   getFC (ListAppendError fc x) = fc

 55 |   getFC (ListHeadError fc x) = fc

 56 |   getFC (FieldNotFoundError fc x) = fc

 57 |   getFC (FieldArgMismatchError fc x) = fc

 58 |   getFC (InvalidFieldType fc x) = fc

 59 |   getFC (CombineError fc x) = fc

 60 |   getFC (RecordFieldCollision fc x) = fc

 61 |   getFC (ReadFileError fc x) = fc

 62 |   getFC (MergeUnusedHandler fc x) = fc

 63 |   getFC (MergeUnhandledCase fc x) = fc

 64 |   getFC (ToMapError fc x) = fc

 65 |   getFC (ToMapEmpty fc x) = fc

 66 |   getFC (EmptyMerge fc x) = fc

 67 |   getFC (InvalidRecordCompletion fc x) = fc

 68 |   getFC (CyclicImportError fc x) = fc

 69 |   getFC (EnvVarError fc x) = fc

 70 |   getFC (FromDhallError fc x) = fc

 71 |   getFC (ParseError fc x) = fc

 72 |   getFC (LexError fc x) = fc

 73 |   getFC (NestedError fc x y) = fc

 75 | public export

 76 | Show Error where

 77 |   show (MissingVar fc x) = "\{show fc}MissingVar: \{show x}"

 78 |   show (AlphaEquivError fc x) = "\{show fc}AlphaEquivError: \{x}"

 79 |   show (EvalIntegerNegateErr fc x) = "\{show fc}EvalIntegerNegateErr: \{x}"

 80 |   show (EvalNaturalIsZeroErr fc x) = "\{show fc}EvalNaturalIsZeroErr: \{x}"

 81 |   show (EvalBoolAndErr fc) = "\{show fc}EvalBoolAndErr"

 82 |   show (EvalApplyErr fc) = "\{show fc}EvalApplyErr"

 83 |   show (Unexpected fc str) = "\{show fc}Unexpected: \{str}"

 84 |   show (ErrorMessage fc x) = "\{show fc}ErrorMessage: \{show x}"

 85 |   show (ReadBackError fc x) = "\{show fc}ReadBackError: \{x}"

 86 |   show (SortError fc) = "\{show fc}SortError"

 87 |   show (AssertError fc str) = "\{show fc}AssertError: \{str}"

 88 |   show (ListAppendError fc str) = "\{show fc}ListAppendError: \{str}"

 89 |   show (ListHeadError fc str) = "\{show fc}ListHeadError: \{str}"

 90 |   show (FieldNotFoundError fc str) = "\{show fc}FieldNotFoundError: \{str}"

 91 |   show (FieldArgMismatchError fc str) = "\{show fc}FieldArgMismatchError: \{str}"

 92 |   show (InvalidFieldType fc str) = "\{show fc}InvalidFieldType: \{str}"

 93 |   show (CombineError fc str) = "\{show fc}CombineError: \{str}"

 94 |   show (RecordFieldCollision fc str) = "\{show fc}RecordFieldCollision: \{str}"

 95 |   show (ReadFileError fc str) = "\{show fc}ReadFileError: \{str}"

 96 |   show (MergeUnusedHandler fc str) = "\{show fc}MergeUnusedHandler: \{str}"

 97 |   show (MergeUnhandledCase fc str) = "\{show fc}MergeUnhandledCase: \{str}"

 98 |   show (EmptyMerge fc str) = "\{show fc}EmptyMerge: \{str}"

 99 |   show (ToMapError fc str) = "\{show fc}ToMapError: \{str}"

100 |   show (ToMapEmpty fc str) = "\{show fc}ToMapEmpty: \{str}"

101 |   show (InvalidRecordCompletion fc str) = "\{show fc}InvalidRecordCompletion: \{str}"

102 |   show (CyclicImportError fc str) = "\{show fc}CyclicImportError: \{str}"

103 |   show (EnvVarError fc str) = "\{show fc}EnvVarError \{show str}"

104 |   show (FromDhallError fc str) = "\{show fc}FromDhallError \{show str}"

105 |   show (ParseError fc str) = "\{show fc}ParseError \{show str}"

106 |   show (LexError fc str) = "\{show fc}LexError \{show str}"

107 |   show (NestedError fc e e') = "\{show fc}\{show e}\n\{show e'}"

110 | Pretty Error where

111 |   pretty (MissingVar fc x) = pretty fc <++> hardline <+> pretty "Missing Var" <++> colon <++> pretty (show x)

112 |   pretty (AlphaEquivError fc x) = pretty fc <++> hardline <+> pretty "AlphaEquivError" <++> colon <++> pretty (show x)

113 |   pretty (EvalIntegerNegateErr fc x) = pretty fc <++> hardline <+> pretty "EvalIntegerNegateErr" <++> colon <++> pretty (show x)

114 |   pretty (EvalNaturalIsZeroErr fc x) = pretty fc <++> hardline <+> pretty "EvalNaturalIsZeroErr" <++> colon <++> pretty (show x)

115 |   pretty (EvalBoolAndErr fc) = pretty fc <++> hardline <+> pretty "EvalBoolAndErr"

116 |   pretty (EvalApplyErr fc) = pretty fc <++> hardline <+> pretty "EvalApplyErr"

117 |   pretty (Unexpected fc x) = pretty fc <++> hardline <+> pretty "Unexpected" <++> colon <++> pretty (show x)

118 |   pretty (ErrorMessage fc x) = pretty fc <++> hardline <+> pretty "ErrorMessage" <++> colon <++> pretty (show x)

119 |   pretty (ReadBackError fc x) = pretty fc <++> hardline <+> pretty "ReadBackError" <++> colon <++> pretty (show x)

120 |   pretty (SortError fc) = pretty fc <++> hardline <+> pretty "SortError"

121 |   pretty (AssertError fc x) = pretty fc <++> hardline <+> pretty "AssertError" <++> colon <++> pretty (show x)

122 |   pretty (ListAppendError fc x) = pretty fc <++> hardline <+> pretty "ListAppendError" <++> colon <++> pretty (show x)

123 |   pretty (ListHeadError fc x) = pretty fc <++> hardline <+> pretty "ListHeadError" <++> colon <++> pretty (show x)

124 |   pretty (FieldNotFoundError fc x) = pretty fc <++> hardline <+> pretty "FieldNotFoundError" <++> colon <++> pretty (show x)

125 |   pretty (FieldArgMismatchError fc x) = pretty fc <++> hardline <+> pretty "FieldArgMismatchError" <++> colon <++> pretty (show x)

126 |   pretty (InvalidFieldType fc x) = pretty fc <++> hardline <+> pretty "InvalidFieldType" <++> colon <++> pretty (show x)

127 |   pretty (CombineError fc x) = pretty fc <++> hardline <+> pretty "CombineError" <++> colon <++> pretty (show x)

128 |   pretty (RecordFieldCollision fc x) = pretty fc <++> hardline <+> pretty "RecordFieldCollision" <++> colon <++> pretty (show x)

129 |   pretty (ReadFileError fc x) = pretty fc <++> hardline <+> pretty "ReadFileError" <++> colon <++> pretty (show x)

130 |   pretty (MergeUnusedHandler fc x) = pretty fc <++> hardline <+> pretty "MergeUnusedHandler" <++> colon <++> pretty (show x)

131 |   pretty (MergeUnhandledCase fc x) = pretty fc <++> hardline <+> pretty "MergeUnhandledCase" <++> colon <++> pretty (show x)

132 |   pretty (ToMapError fc x) = pretty fc <++> hardline <+> pretty "ToMapError" <++> colon <++> pretty (show x)

133 |   pretty (ToMapEmpty fc x) = pretty fc <++> hardline <+> pretty "ToMapEmpty" <++> colon <++> pretty (show x)

134 |   pretty (EmptyMerge fc x) = pretty fc <++> hardline <+> pretty "EmptyMerge" <++> colon <++> pretty (show x)

135 |   pretty (InvalidRecordCompletion fc x) = pretty fc <++> hardline <+> pretty "InvalidRecordCompletion" <++> colon <++> pretty (show x)

136 |   pretty (CyclicImportError fc x) = pretty fc <++> hardline <+> pretty "CyclicImportError" <++> colon <++> pretty (show x)

137 |   pretty (EnvVarError fc x) = pretty fc <++> hardline <+> pretty "EnvVarError" <++> colon <++> pretty (show x)

138 |   pretty (FromDhallError fc x) = pretty fc <++> hardline <+> pretty "FromDhallError" <++> colon <++> pretty (show x)

139 |   pretty (ParseError fc x) = pretty fc <++> hardline <+> pretty "ParseError" <++> colon <++> pretty (show x)

140 |   pretty (LexError fc x) = pretty fc <++> hardline <+> pretty "LexError" <++> colon <++> pretty (show x)

141 |   pretty (NestedError fc x y) = pretty fc <++> hardline <+> pretty "NestedError" <++> colon <++> pretty (show x)

144 | fancyError : Error -> IO String

145 | fancyError e =

146 |   let fc = getFC e

147 |       doc = the (Doc Error) $ pretty e

148 |   in do

149 |     str <- getSpanSnippet fc

150 |     case str of

151 |          Nothing => pure $ show e

152 |     -- putDoc doc

153 |     -- printLn ""

154 |          (Just span) => pure $ unlines [span, show e]