fe08234 · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

more detailed error reporting

fe08234Boris Lykah14 years ago

Data/Yaml.hs+5−2

compare with master

unifiedsplit

@@ -12,6 +12,7 @@ module Data.Yaml

12 , Parser

13 , Object

14 , Array

15+ , ParseException(..)

15 -- * Constructors and accessors

16 -- * Constructors and accessors

16 , object

17 , object

17 , array

18 , array

@@ -33,6 +34,8 @@ module Data.Yaml

33 , decodeFile

34 , decodeFile

34 -- ** Better error information

35 -- ** Better error information

35 , decodeEither

36 , decodeEither

37+ -- ** More control over decoding

38+ , decodeHelper

36 ) where

39 ) where

38import qualified Text.Libyaml as Y

41import qualified Text.Libyaml as Y

@@ -114,7 +117,7 @@ data ParseException = NonScalarKey

114 | UnexpectedEvent { _received :: Maybe Event

117 | UnexpectedEvent { _received :: Maybe Event

115 , _expected :: Maybe Event

118 , _expected :: Maybe Event

116 }

119 }

117− | InvalidYaml (Maybe String)

120+ | InvalidYaml (Maybe YamlException)

118 deriving (Show, Typeable)

121 deriving (Show, Typeable)

119instance Exception ParseException

122instance Exception ParseException

120

123

@@ -264,7 +267,7 @@ decodeHelper src = do

264 case x of

267 case x of

265 Left e

268 Left e

266 | Just pe <- fromException e -> return $ Left pe

269 | Just pe <- fromException e -> return $ Left pe

267− | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just $ show (ye :: YamlException)

270+ | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just (ye :: YamlException)

268 | otherwise -> throwIO e

271 | otherwise -> throwIO e

269 Right y -> return $ Right $ parseEither parseJSON y

272 Right y -> return $ Right $ parseEither parseJSON y

270

273

Setup.lhsmode 100755 → 100644

Only the mode changed.

Text/Libyaml.hs+17−15

@@ -164,8 +164,14 @@ foreign import ccall "get_parser_error_problem"

164foreign import ccall "get_parser_error_context"

165 c_get_parser_error_context :: Parser -> IO (Ptr CUChar)

166

167−foreign import ccall unsafe "get_parser_error_offset"

167+foreign import ccall unsafe "get_parser_error_index"

168− c_get_parser_error_offset :: Parser -> IO CULong

168+ c_get_parser_error_index :: Parser -> IO CULong

169+

170+foreign import ccall unsafe "get_parser_error_line"

171+ c_get_parser_error_line :: Parser -> IO CULong

172+

173+foreign import ccall unsafe "get_parser_error_column"

174+ c_get_parser_error_column :: Parser -> IO CULong

169

175

170makeString :: MonadIO m => (a -> m (Ptr CUChar)) -> a -> m String

176makeString :: MonadIO m => (a -> m (Ptr CUChar)) -> a -> m String

171makeString f a = do

177makeString f a = do

@@ -511,12 +517,12 @@ runParser :: MonadResource m => Parser -> GSource m Event

511runParser parser = do

517runParser parser = do

512 e <- liftIO $ parserParseOne' parser

518 e <- liftIO $ parserParseOne' parser

513 case e of

519 case e of

514− Left err -> liftIO $ throwIO $ YamlException err

520+ Left err -> liftIO $ throwIO err

515 Right Nothing -> return ()

521 Right Nothing -> return ()

516 Right (Just ev) -> yield ev >> runParser parser

522 Right (Just ev) -> yield ev >> runParser parser

517

523

518parserParseOne' :: Parser

524parserParseOne' :: Parser

519− -> IO (Either String (Maybe Event))

525+ -> IO (Either YamlException (Maybe Event))

520parserParseOne' parser = allocaBytes eventSize $ \er -> do

526parserParseOne' parser = allocaBytes eventSize $ \er -> do

521 res <- liftIO $ c_yaml_parser_parse parser er

527 res <- liftIO $ c_yaml_parser_parse parser er

522 flip finally (c_yaml_event_delete er) $

528 flip finally (c_yaml_event_delete er) $

@@ -524,16 +530,10 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do

524 then do

530 then do

525 problem <- makeString c_get_parser_error_problem parser

531 problem <- makeString c_get_parser_error_problem parser

526 context <- makeString c_get_parser_error_context parser

532 context <- makeString c_get_parser_error_context parser

527− offset <- c_get_parser_error_offset parser

533+ index <- c_get_parser_error_index parser

528− return $ Left $ concat

534+ line <- c_get_parser_error_line parser

529− [ "YAML parse error: "

535+ column <- c_get_parser_error_column parser

530− , problem

536+ return $ Left $ YamlParseException problem context (fromIntegral index, fromIntegral line, fromIntegral column)

531− , "\nContext: "

532− , context

533− , "\nOffset: "

534− , show offset

535− , "\n"

536− ]

537 else Right <$> getEvent er

538

539encode :: MonadResource m => GSink Event m ByteString

@@ -594,5 +594,7 @@ runEmitter allocI closeI =

594 close u = liftIO $ closeI u a

595

596data YamlException = YamlException String

597+ -- | problem, context, index, position line, position column

598+ | YamlParseException String String (Int, Int, Int)

597 deriving (Show, Typeable)

599 deriving (Show, Typeable)

598−instance Exception YamlException

600+instance Exception YamlException

c/helper.c+12−2

@@ -56,9 +56,19 @@ unsigned char const * get_parser_error_context(yaml_parser_t *p)

56 return p->context;

57}

59−unsigned int get_parser_error_offset(yaml_parser_t *p)

59+unsigned int get_parser_error_index(yaml_parser_t *p)

60{

61− return p->offset;

61+ return p->problem_mark.index;

62+}

63+

64+unsigned int get_parser_error_line(yaml_parser_t *p)

65+{

66+ return p->problem_mark.line;

67+}

68+

69+unsigned int get_parser_error_column(yaml_parser_t *p)

70+{

71+ return p->problem_mark.column;

62}

72}

64unsigned char const * get_emitter_error(yaml_emitter_t *e)

74unsigned char const * get_emitter_error(yaml_emitter_t *e)