d206726 · typeable/yaml

git.iko.soy/typeable/yaml

Better error reporting

commitd206726371dcadc47bf4e1c19e3928c799b20d0d authorMichael Snoyman <michael@snoyman.com> dateTue 17 Nov 2009, 01:59 (17 years ago) parent9c58ace

5 files changed+73−51

compare with master

unifiedsplit

Text/Libyaml.hs+38−11 Text/Yaml.hs−26 c/helper.c+14−7 c/helper.h+6−2 test/test.hs+15−5

Text/Libyaml.hs+38−11

@@ -27,6 +27,10 @@ import Control.Monad.Failure

2727import Data.Typeable (Typeable)

2828import Control.Exception (Exception)

2929

30+import Data.Convertible

31+import Data.Text.Lazy (Text)

32+import Data.Object.Text ()

33+

3034data ParserStruct

3135type Parser = Ptr ParserStruct

3236parserSize :: Int

@@ -73,15 +77,32 @@ foreign import ccall unsafe "yaml_parser_parse"

7377foreign import ccall unsafe "yaml_event_delete"

7478 c_yaml_event_delete :: EventRaw -> IO ()

7579

76−foreign import ccall "print_parser_error"

77− c_print_parser_error :: Parser -> IO ()

80+foreign import ccall "get_parser_error_problem"

81+ c_get_parser_error_problem :: Parser -> IO (Ptr CUChar)

82+

83+foreign import ccall "get_parser_error_context"

84+ c_get_parser_error_context :: Parser -> IO (Ptr CUChar)

85+

86+foreign import ccall unsafe "get_parser_error_offset"

87+ c_get_parser_error_offset :: Parser -> IO CULong

7888

7989data YamlException =

80− YamlParserException String

81− | YamlEmitterException String

90+ YamlParserException

91+ { parserProblem :: String

92+ , parserContext :: String

93+ , parserOffset :: Int

94+ }

95+ | YamlEmitterException { emitterProblem :: String }

8296 deriving (Show, Typeable)

8397instance Exception YamlException

8498

99+makeString :: (a -> IO (Ptr CUChar)) -> a -> IO String

100+makeString f a = do

101+ cchar <- castPtr `fmap` f a

102+ len <- fromIntegral `fmap` B.c_strlen cchar

103+ bs <- B.create len $ \dest -> B.memcpy dest (castPtr cchar) (fromIntegral len)

104+ return $ (convertSuccess :: Text -> String) $ convertSuccess bs

105+

85106parserParseOne :: MonadFailure YamlException m

86107 => Parser

87108 -> IO (m Event)

@@ -89,8 +110,13 @@ parserParseOne parser = withEventRaw $ \er -> do

89110 res <- c_yaml_parser_parse parser er

90111 event <-

91112 if res == 0

92− then c_print_parser_error parser

93− >> return (failure $ YamlParserException "FIXME")

113+ then do

114+ problem <- makeString c_get_parser_error_problem parser

115+ context <- makeString c_get_parser_error_context parser

116+ offset <- fromIntegral `fmap`

117+ c_get_parser_error_offset parser

118+ return $ failure $

119+ YamlParserException problem context offset

94120 else return `fmap` getEvent er

95121 c_yaml_event_delete er

96122 return event

@@ -154,7 +180,7 @@ getEvent er = do

154180 YamlMappingStartEvent -> return EventMappingStart

155181 YamlMappingEndEvent -> return EventMappingEnd

156182

157−data YAttempt v = YSuccess v | YFailure YamlException -- FIXME use c-m-e?

183+data YAttempt v = YSuccess v | YFailure YamlException

158184instance Monad YAttempt where

159185 return = YSuccess

160186 YSuccess v >>= f = f v

@@ -237,8 +263,8 @@ withEmitter f = allocaBytes emitterSize $ \e -> do

237263foreign import ccall unsafe "yaml_emitter_emit"

238264 c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt

239265

240−foreign import ccall unsafe "print_emitter_error"

241− c_print_emitter_error :: Emitter -> IO ()

266+foreign import ccall unsafe "get_emitter_error"

267+ c_get_emitter_error :: Emitter -> IO (Ptr CUChar)

242268

243269emitEvents :: MonadFailure YamlException m

244270 => Emitter

@@ -248,8 +274,9 @@ emitEvents _ [] = return $ return ()

248274emitEvents emitter (e:rest) = do

249275 res <- toEventRaw e $ c_yaml_emitter_emit emitter

250276 if res == 0

251− then c_print_emitter_error emitter

252− >> return (failure $ YamlEmitterException "FIXME")

277+ then do

278+ problem <- makeString c_get_emitter_error emitter

279+ return $ failure $ YamlEmitterException problem

253280 else emitEvents emitter rest

254281

255282foreign import ccall unsafe "yaml_stream_start_event_initialize"

Text/Yaml.hs−26

@@ -196,11 +196,6 @@ myEquals :: Eq v => Attempt v -> Attempt v -> Bool

196196myEquals (Success v1) (Success v2) = v1 == v2

197197myEquals _ _ = False

198198

199−instance ConvertSuccess B.ByteString B.ByteString where -- FIXME belongs elsewhere

200− convertSuccess = id

201−instance ConvertAttempt B.ByteString B.ByteString where -- FIXME belongs elsewhere

202− convertAttempt = return

203−

204199propEncodeDecode :: Object MyString MyString -> Bool

205200propEncodeDecode o =

206201 fmap h2 (decodeText (encodeText (h1 o) :: B.ByteString))

@@ -215,27 +210,6 @@ toSBS = convertSuccess

215210toLBS :: ConvertSuccess a BL.ByteString => a -> BL.ByteString

216211toLBS = convertSuccess

217212

218−instance ToObject (Object Text Text) Text Text where -- FIXME belongs elsewhere

219− toObject = id

220−

221−instance ConvertSuccess B.ByteString [Char] where -- FIXME belongs elsewhere

222− convertSuccess = convertSuccess . (convertSuccess :: B.ByteString -> Text)

223−instance ConvertAttempt B.ByteString [Char] where -- FIXME belongs elsewhere

224− convertAttempt = return . convertSuccess

225−instance ConvertSuccess [Char] B.ByteString where -- FIXME belongs elsewhere

226− convertSuccess = convertSuccess . (convertSuccess :: String -> Text)

227−instance ConvertAttempt [Char] B.ByteString where -- FIXME belongs elsewhere

228− convertAttempt = return . convertSuccess

229−

230−instance ConvertSuccess BL.ByteString [Char] where -- FIXME belongs elsewhere

231− convertSuccess = convertSuccess . (convertSuccess :: BL.ByteString -> Text)

232−instance ConvertAttempt BL.ByteString [Char] where -- FIXME belongs elsewhere

233− convertAttempt = return . convertSuccess

234−instance ConvertSuccess [Char] BL.ByteString where -- FIXME belongs elsewhere

235− convertSuccess = convertSuccess . (convertSuccess :: String -> Text)

236−instance ConvertAttempt [Char] BL.ByteString where -- FIXME belongs elsewhere

237− convertAttempt = return . convertSuccess

238−

239213caseEmptyStrings :: Assertion

240214caseEmptyStrings = do

241215 let m =

c/helper.c+14−7

@@ -46,17 +46,24 @@ void my_emitter_set_output(yaml_emitter_t *e, buffer_t *b)

4646 yaml_emitter_set_output(e, buffer_append, b);

4747}

4848

49−void print_parser_error(yaml_parser_t *p)

49+unsigned char const * get_parser_error_problem(yaml_parser_t *p)

5050{

51− fprintf(stderr, "Problem: %s\nContext: %s\nOffset: %u\n",

52− p->problem,

53− p->context,

54− (unsigned int) p->problem_offset);

51+ return p->problem;

5552}

5653

57−void print_emitter_error(yaml_emitter_t *e)

54+unsigned char const * get_parser_error_context(yaml_parser_t *p)

5855{

59− fprintf(stderr, "%s\n", e->problem);

56+ return p->context;

57+}

58+

59+unsigned int get_parser_error_offset(yaml_parser_t *p)

60+{

61+ return p->offset;

62+}

63+

64+unsigned char const * get_emitter_error(yaml_emitter_t *e)

65+{

66+ return e->problem;

6067}

6168

6269int simple_document_start(yaml_event_t *e)

c/helper.h+6−2

@@ -14,8 +14,12 @@ unsigned int get_buffer_used(buffer_t *b);

1414

1515void my_emitter_set_output(yaml_emitter_t *e, buffer_t *b);

1616

17−void print_parser_error(yaml_parser_t *p);

18−void print_emitter_error(yaml_emitter_t *e);

17+unsigned char const * get_parser_error_problem(yaml_parser_t *p);

18+unsigned char const * get_parser_error_context(yaml_parser_t *p);

19+unsigned int get_parser_error_offset(yaml_parser_t *p);

20+

21+unsigned char const * get_emitter_error(yaml_emitter_t *e);

22+

1923int simple_document_start(yaml_event_t *e);

2024

2125int get_event_type(yaml_event_t *e);

test/test.hs+15−5

@@ -1,19 +1,29 @@

1+{-# LANGUAGE MultiParamTypeClasses #-}

12import Text.Yaml

23import qualified Data.ByteString as B

34import Control.Monad

5+import Data.Convertible

7+-- FIXME

8+instance ConvertSuccess B.ByteString B.ByteString where

9+ convertSuccess = id

10+instance ConvertAttempt B.ByteString B.ByteString where

11+ convertAttempt = return

412

513main = do

614 contents <- B.readFile "input.yaml"

7− o <- decode contents

8− let contents2 = encode (o :: Object)

15+ o <- decodeText contents

16+ let contents2 = encodeText o

917 B.writeFile "output.yaml" contents2

10− o2 <- decode contents2

11− print (o2 :: Object)

18+ o2 <- decodeText contents2

19+ print o2

20+{-

1221 contents3 <- B.readFile "hebrew.yaml"

13− o3 <- decode contents3

22+ o3 <- decodeText contents3

1423 print (o3 :: B.ByteString)

1524 B.writeFile "hebrew.txt" o3

1625

1726 o4 <- join $ decodeFile "input.yaml"

1827 print (o4 :: Object)

1928 encodeFile "output2.yaml" o4

29+-}