@@ -19,6 +19,7 @@ import Data.Aeson.Types hiding (parse)
19import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)
19import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)
20import Data.ByteString (ByteString)
20import Data.ByteString (ByteString)
21import qualified Data.Map as Map
21import qualified Data.Map as Map
22+import Data.Maybe (isNothing)
22import Control.Exception
23import Control.Exception
23import Control.Exception.Enclosed
24import Control.Exception.Enclosed
24import Control.Monad.Trans.State
25import Control.Monad.Trans.State
@@ -66,36 +67,44 @@ instance Exception ParseException where
66-- Instead of displaying the data constructors applied to their arguments,
67-- Instead of displaying the data constructors applied to their arguments,
67-- a more textual output is returned. For example, instead of printing:
68-- a more textual output is returned. For example, instead of printing:
69−-- > AesonException "The key \"foo\" was not found"
70+-- > InvalidYaml (Just (YamlParseException {yamlProblem = "did not find expected ',' or '}'", yamlContext = "while parsing a flow mapping", yamlProblemMark = YamlMark {yamlIndex = 42, yamlLine = 2, yamlColumn = 12}})))
71-- It looks more pleasant to print:
72-- It looks more pleasant to print:
73−-- > Aeson exception: The key "foo" was not found
74+-- > YAML parse exception at line 2, column 12,
75+-- > while parsing a flow mapping:
76+-- > did not find expected ',' or '}'
75-- Since 0.8.11
78-- Since 0.8.11
76prettyPrintParseException :: ParseException -> String
79prettyPrintParseException :: ParseException -> String
80+prettyPrintParseException pe = case pe of
77−prettyPrintParseException NonScalarKey = "Non scalar key"
81+ NonScalarKey -> "Non scalar key"
78−prettyPrintParseException (UnknownAlias n) =
79− "Unknown alias: " ++ n
82+ UnknownAlias anchor -> "Unknown alias `" ++ anchor ++ "`"
80−prettyPrintParseException (UnexpectedEvent r e) = unlines
83+ UnexpectedEvent mbExpected mbUnexpected -> unlines
81− [ "Unexpected event:"
84+ [ "Unexpected event: expected"
82− , " Received: " ++ maybe "None" show r
85+ , " " ++ show mbExpected
83− , " Expected: " ++ maybe "None" show e
86+ , "but received"
87+ , " " ++ show mbUnexpected
85−prettyPrintParseException (InvalidYaml mye) =
89+ InvalidYaml mbYamlError -> case mbYamlError of
86− case mye of
90+ Nothing -> "Unspecified YAML error"
87− Just ye -> "Invalid yaml: " ++ show ye
91+ Just yamlError -> case yamlError of
88− _ -> "Invalid yaml"
92+ YamlException s -> "YAML exception:\n" ++ s
89−prettyPrintParseException (AesonException e) =
93+ YamlParseException problem context mark -> unlines
94+ [ "YAML parse exception at line " ++ show (yamlLine mark) ++
95+ ", column " ++ show (yamlColumn mark) ++ ","
96+ -- The context seems to include a leading "while" or similar.
90− "Aeson exception: " ++ e
100+ AesonException s -> "Aeson exception:\n" ++ s
91−prettyPrintParseException (OtherParseException e) =
101+ OtherParseException exc -> "Generic parse exception:\n" ++ show exc
92− "Parse exception: " ++ show e
93−prettyPrintParseException (NonStringKeyAlias n v) = unlines
102+ NonStringKeyAlias anchor value -> unlines
94− [ "Non-string key alias:"
103+ [ "Non-string key alias:"
95− , " Anchor name: " ++ n
104+ , " Anchor name: " ++ anchor
96− , " Value: " ++ show v
105+ , " Value: " ++ show value
98−prettyPrintParseException CyclicIncludes = "Cyclic includes"
107+ CyclicIncludes -> "Cyclic includes"
100newtype PErrorT m a = PErrorT { runPErrorT :: m (Either ParseException a) }
109newtype PErrorT m a = PErrorT { runPErrorT :: m (Either ParseException a) }
101instance Monad m => Functor (PErrorT m) where
110instance Monad m => Functor (PErrorT m) where