@@ -66,36 +66,56 @@ instance Exception ParseException where
6666-- Instead of displaying the data constructors applied to their arguments,
6767-- a more textual output is returned. For example, instead of printing:
6868--
69−-- > AesonException "The key \"foo\" was not found"
69+-- > InvalidYaml (Just (YamlParseException {yamlProblem = "did not find expected ',' or '}'", yamlContext = "while parsing a flow mapping", yamlProblemMark = YamlMark {yamlIndex = 42, yamlLine = 2, yamlColumn = 12}})))
7070--
7171-- It looks more pleasant to print:
7272--
73−-- > Aeson exception: The key "foo" was not found
73+-- > YAML parse exception at line 2, column 12,
74+-- > while parsing a flow mapping:
75+-- > did not find expected ',' or '}'
7476--
7577-- Since 0.8.11
7678prettyPrintParseException :: ParseException -> String
77−prettyPrintParseException NonScalarKey = "Non scalar key"
78−prettyPrintParseException (UnknownAlias n) =
79− "Unknown alias: " ++ n
80−prettyPrintParseException (UnexpectedEvent r e) = unlines
81− [ "Unexpected event:"
82− , " Received: " ++ maybe "None" show r
83− , " Expected: " ++ maybe "None" show e
79+prettyPrintParseException pe = case pe of
80+ NonScalarKey -> "Non scalar key"
81+ UnknownAlias anchor -> "Unknown alias `" ++ anchor ++ "`"
82+ UnexpectedEvent mbExpected mbUnexpected -> case (mbExpected, mbUnexpected) of
83+ (Nothing, Nothing) ->
84+ error $ "prettyPrintYamlParseException: Got UnexpectedEvent with two `Nothing`s"
85+ (Just expected, Just received) -> unlines
86+ [ "Unexpected event: expected"
87+ , " " ++ show expected
88+ , "but received"
89+ , " " ++ show received
90+ ]
91+ (Just expected, Nothing) -> unlines
92+ [ "Expected event"
93+ , " " ++ show expected
94+ , "but got none"
95+ ]
96+ (Nothing, Just received) -> unlines
97+ [ "Expected no events, but received"
98+ , " " ++ show received
99+ ]
100+ InvalidYaml mbYamlError -> case mbYamlError of
101+ Nothing -> "Unspecified YAML error"
102+ Just yamlError -> case yamlError of
103+ YamlException s -> "YAML exception:\n" ++ s
104+ YamlParseException problem context mark -> unlines
105+ [ "YAML parse exception at line " ++ show (yamlLine mark) ++
106+ ", column " ++ show (yamlColumn mark) ++ ","
107+ -- The context seems to include a leading "while" or similar.
108+ , context ++ ":"
109+ , problem
110+ ]
111+ AesonException s -> "Aeson exception:\n" ++ s
112+ OtherParseException exc -> "Generic parse exception:\n" ++ show exc
113+ NonStringKeyAlias anchor value -> unlines
114+ [ "Non-string key alias:"
115+ , " Anchor name: " ++ anchor
116+ , " Value: " ++ show value
84117 ]
85−prettyPrintParseException (InvalidYaml mye) =
86− case mye of
87− Just ye -> "Invalid yaml: " ++ show ye
88− _ -> "Invalid yaml"
89−prettyPrintParseException (AesonException e) =
90− "Aeson exception: " ++ e
91−prettyPrintParseException (OtherParseException e) =
92− "Parse exception: " ++ show e
93−prettyPrintParseException (NonStringKeyAlias n v) = unlines
94− [ "Non-string key alias:"
95− , " Anchor name: " ++ n
96− , " Value: " ++ show v
97− ]
98−prettyPrintParseException CyclicIncludes = "Cyclic includes"
118+ CyclicIncludes -> "Cyclic includes"
99119
100120newtype PErrorT m a = PErrorT { runPErrorT :: m (Either ParseException a) }
101121instance Monad m => Functor (PErrorT m) where