d206726 · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Better error reporting

d206726Michael Snoyman17 years ago

Text/Libyaml.hs+38−11

compare with master

unifiedsplit

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

27import Data.Typeable (Typeable)

28import Control.Exception (Exception)

30+import Data.Convertible

31+import Data.Text.Lazy (Text)

32+import Data.Object.Text ()

33+

30data ParserStruct

34data ParserStruct

31type Parser = Ptr ParserStruct

35type Parser = Ptr ParserStruct

32parserSize :: Int

36parserSize :: Int

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

73foreign import ccall unsafe "yaml_event_delete"

77foreign import ccall unsafe "yaml_event_delete"

74 c_yaml_event_delete :: EventRaw -> IO ()

78 c_yaml_event_delete :: EventRaw -> IO ()

76−foreign import ccall "print_parser_error"

80+foreign import ccall "get_parser_error_problem"

77− c_print_parser_error :: Parser -> IO ()

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

79data YamlException =

89data YamlException =

80− YamlParserException String

90+ YamlParserException

91+ { parserProblem :: String

92+ , parserContext :: String

93+ , parserOffset :: Int

94+ }

81− | YamlEmitterException String

95+ | YamlEmitterException { emitterProblem :: String }

82 deriving (Show, Typeable)

96 deriving (Show, Typeable)

83instance Exception YamlException

97instance Exception YamlException

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+

85parserParseOne :: MonadFailure YamlException m

106parserParseOne :: MonadFailure YamlException m

86 => Parser

107 => Parser

87 -> IO (m Event)

108 -> IO (m Event)

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

89 res <- c_yaml_parser_parse parser er

110 res <- c_yaml_parser_parse parser er

90 event <-

111 event <-

91 if res == 0

112 if res == 0

92− then c_print_parser_error parser

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

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

118+ return $ failure $

119+ YamlParserException problem context offset

94 else return `fmap` getEvent er

120 else return `fmap` getEvent er

95 c_yaml_event_delete er

121 c_yaml_event_delete er

96 return event

122 return event

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

154 YamlMappingStartEvent -> return EventMappingStart

180 YamlMappingStartEvent -> return EventMappingStart

155 YamlMappingEndEvent -> return EventMappingEnd

181 YamlMappingEndEvent -> return EventMappingEnd

156

182

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

183+data YAttempt v = YSuccess v | YFailure YamlException

158instance Monad YAttempt where

184instance Monad YAttempt where

159 return = YSuccess

185 return = YSuccess

160 YSuccess v >>= f = f v

186 YSuccess v >>= f = f v

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

237foreign import ccall unsafe "yaml_emitter_emit"

263foreign import ccall unsafe "yaml_emitter_emit"

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

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

239

265

240−foreign import ccall unsafe "print_emitter_error"

266+foreign import ccall unsafe "get_emitter_error"

241− c_print_emitter_error :: Emitter -> IO ()

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

242

268

243emitEvents :: MonadFailure YamlException m

269emitEvents :: MonadFailure YamlException m

244 => Emitter

270 => Emitter

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

248emitEvents emitter (e:rest) = do

274emitEvents emitter (e:rest) = do

249 res <- toEventRaw e $ c_yaml_emitter_emit emitter

275 res <- toEventRaw e $ c_yaml_emitter_emit emitter

250 if res == 0

276 if res == 0

251− then c_print_emitter_error emitter

277+ then do

278+ problem <- makeString c_get_emitter_error emitter

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

279+ return $ failure $ YamlEmitterException problem

253 else emitEvents emitter rest

280 else emitEvents emitter rest

254

281

255foreign import ccall unsafe "yaml_stream_start_event_initialize"

282foreign import ccall unsafe "yaml_stream_start_event_initialize"

Text/Yaml.hs−26

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

196myEquals (Success v1) (Success v2) = v1 == v2

197myEquals _ _ = False

198

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−

204propEncodeDecode :: Object MyString MyString -> Bool

199propEncodeDecode :: Object MyString MyString -> Bool

205propEncodeDecode o =

200propEncodeDecode o =

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

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

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

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

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

216toLBS = convertSuccess

211toLBS = convertSuccess

217

212

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−

239caseEmptyStrings :: Assertion

213caseEmptyStrings :: Assertion

240caseEmptyStrings = do

214caseEmptyStrings = do

241 let m =

215 let m =

c/helper.c+14−7

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

46 yaml_emitter_set_output(e, buffer_append, b);

47}

49−void print_parser_error(yaml_parser_t *p)

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

50{

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

52− p->problem,

51+ return p->problem;

53− p->context,

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

55}

52}

57−void print_emitter_error(yaml_emitter_t *e)

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

58{

55{

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+{

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

66+ return e->problem;

60}

67}

62int simple_document_start(yaml_event_t *e)

69int simple_document_start(yaml_event_t *e)

c/helper.h+6−2

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

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

17−void print_parser_error(yaml_parser_t *p);

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

18−void print_emitter_error(yaml_emitter_t *e);

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+

19int simple_document_start(yaml_event_t *e);

23int simple_document_start(yaml_event_t *e);

21int get_event_type(yaml_event_t *e);

25int get_event_type(yaml_event_t *e);

test/test.hs+15−5

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

1+{-# LANGUAGE MultiParamTypeClasses #-}

1import Text.Yaml

2import Text.Yaml

2import qualified Data.ByteString as B

3import qualified Data.ByteString as B

3import Control.Monad

4import 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

5main = do

13main = do

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

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

7− o <- decode contents

15+ o <- decodeText contents

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

16+ let contents2 = encodeText o

9 B.writeFile "output.yaml" contents2

17 B.writeFile "output.yaml" contents2

10− o2 <- decode contents2

18+ o2 <- decodeText contents2

11− print (o2 :: Object)

19+ print o2

20+{-

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

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

13− o3 <- decode contents3

22+ o3 <- decodeText contents3

14 print (o3 :: B.ByteString)

23 print (o3 :: B.ByteString)

15 B.writeFile "hebrew.txt" o3

24 B.writeFile "hebrew.txt" o3

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

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

18 print (o4 :: Object)

27 print (o4 :: Object)

19 encodeFile "output2.yaml" o4

28 encodeFile "output2.yaml" o4

29+-}