91c6658 · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Close #157. Return start and end marks for all events.

91c6658Alex Franchuk8 years ago

c/helper.c+27−12

compare with master

unifiedsplit

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

56 return p->context;

57}

59−unsigned int get_parser_error_index(yaml_parser_t *p)

59+const yaml_mark_t * get_parser_error_mark(yaml_parser_t *p)

60{

61− return p->problem_mark.index;

61+ return &p->problem_mark;

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;

72}

62}

74char const * get_emitter_error(yaml_emitter_t *e)

64char const * get_emitter_error(yaml_emitter_t *e)

@@ -157,6 +147,31 @@ unsigned char * get_alias_anchor(yaml_event_t *e)

157 return e->data.alias.anchor;

147 return e->data.alias.anchor;

158}

148}

159

149

150+const yaml_mark_t * get_start_mark(yaml_event_t *e)

151+{

152+ return &e->start_mark;

153+}

154+

155+const yaml_mark_t * get_end_mark(yaml_event_t *e)

156+{

157+ return &e->end_mark;

158+}

159+

160+unsigned int get_mark_index(yaml_mark_t *m)

161+{

162+ return m->index;

163+}

164+

165+unsigned int get_mark_line(yaml_mark_t *m)

166+{

167+ return m->line;

168+}

169+

170+unsigned int get_mark_column(yaml_mark_t *m)

171+{

172+ return m->column;

173+}

174+

160int yaml_parser_set_input_filename(yaml_parser_t *parser, const char *filename)

175int yaml_parser_set_input_filename(yaml_parser_t *parser, const char *filename)

161{

176{

162 FILE *in = fopen(filename, "r");

177 FILE *in = fopen(filename, "r");

src/Text/Libyaml.hs+60−20

@@ -12,7 +12,8 @@

12-- "Data.Yaml".

13module Text.Libyaml

14 ( -- * The event stream

15+ MarkedEvent(..)

15− Event (..)

16+ , Event (..)

16 , Style (..)

17 , Style (..)

17 , SequenceStyle (..)

18 , SequenceStyle (..)

18 , MappingStyle (..)

19 , MappingStyle (..)

@@ -23,8 +24,10 @@ module Text.Libyaml

23 , encode

24 , encode

24 , encodeWith

25 , encodeWith

25 , decode

26 , decode

27+ , decodeMarked

26 , encodeFile

28 , encodeFile

27 , decodeFile

29 , decodeFile

30+ , decodeFileMarked

28 , encodeFileWith

31 , encodeFileWith

29 , FormatOptions

32 , FormatOptions

30 , defaultFormatOptions

33 , defaultFormatOptions

@@ -74,6 +77,15 @@ data Event =

74 | EventMappingEnd

77 | EventMappingEnd

75 deriving (Show, Eq)

78 deriving (Show, Eq)

80+-- | Event with start and end marks.

81+--

82+-- @since [INSERTVERSION]

83+data MarkedEvent = MarkedEvent

84+ { yamlEvent :: Event

85+ , yamlStartMark :: YamlMark

86+ , yamlEndMark :: YamlMark

87+ }

88+

77-- | Style for scalars - e.g. quoted / folded

89-- | Style for scalars - e.g. quoted / folded

78--

90--

79data Style = Any

91data Style = Any

@@ -166,6 +178,24 @@ foreign import ccall unsafe "yaml_parser_set_input_file"

166 -> File

178 -> File

167 -> IO ()

179 -> IO ()

168

180

181+data MarkRawStruct

182+type MarkRaw = Ptr MarkRawStruct

183+

184+foreign import ccall unsafe "get_mark_index"

185+ c_get_mark_index :: MarkRaw -> IO CULong

186+

187+foreign import ccall unsafe "get_mark_line"

188+ c_get_mark_line :: MarkRaw -> IO CULong

189+

190+foreign import ccall unsafe "get_mark_column"

191+ c_get_mark_column :: MarkRaw -> IO CULong

192+

193+getMark :: MarkRaw -> IO YamlMark

194+getMark m = YamlMark

195+ <$> (fromIntegral <$> c_get_mark_index m)

196+ <*> (fromIntegral <$> c_get_mark_line m)

197+ <*> (fromIntegral <$> c_get_mark_column m)

198+

169data FileStruct

199data FileStruct

170type File = Ptr FileStruct

200type File = Ptr FileStruct

171

201

@@ -196,14 +226,8 @@ foreign import ccall "get_parser_error_problem"

196foreign import ccall "get_parser_error_context"

226foreign import ccall "get_parser_error_context"

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

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

198

228

199−foreign import ccall unsafe "get_parser_error_index"

229+foreign import ccall unsafe "get_parser_error_mark"

200− c_get_parser_error_index :: Parser -> IO CULong

230+ c_get_parser_error_mark :: Parser -> IO MarkRaw

201−

202−foreign import ccall unsafe "get_parser_error_line"

203− c_get_parser_error_line :: Parser -> IO CULong

204−

205−foreign import ccall unsafe "get_parser_error_column"

206− c_get_parser_error_column :: Parser -> IO CULong

207

231

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

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

209makeString f a = do

233makeString f a = do

@@ -228,6 +252,12 @@ data EventType = YamlNoEvent

228foreign import ccall unsafe "get_event_type"

252foreign import ccall unsafe "get_event_type"

229 c_get_event_type :: EventRaw -> IO CInt

253 c_get_event_type :: EventRaw -> IO CInt

230

254

255+foreign import ccall unsafe "get_start_mark"

256+ c_get_start_mark :: EventRaw -> IO MarkRaw

257+

258+foreign import ccall unsafe "get_end_mark"

259+ c_get_end_mark :: EventRaw -> IO MarkRaw

260+

231foreign import ccall unsafe "get_scalar_value"

261foreign import ccall unsafe "get_scalar_value"

232 c_get_scalar_value :: EventRaw -> IO (Ptr CUChar)

262 c_get_scalar_value :: EventRaw -> IO (Ptr CUChar)

233

263

@@ -277,10 +307,12 @@ readStyle getStyle er = toEnum . fromEnum <$> getStyle er

277readTag :: (EventRaw -> IO (Ptr CUChar)) -> EventRaw -> IO Tag

307readTag :: (EventRaw -> IO (Ptr CUChar)) -> EventRaw -> IO Tag

278readTag getTag er = bsToTag <$> (getTag er >>= packCString . castPtr)

308readTag getTag er = bsToTag <$> (getTag er >>= packCString . castPtr)

279

309

280−getEvent :: EventRaw -> IO (Maybe Event)

310+getEvent :: EventRaw -> IO (Maybe MarkedEvent)

281getEvent er = do

311getEvent er = do

282 et <- c_get_event_type er

312 et <- c_get_event_type er

313+ startMark <- c_get_start_mark er >>= getMark

314+ endMark <- c_get_end_mark er >>= getMark

283− case toEnum $ fromEnum et of

315+ event <- case toEnum $ fromEnum et of

284 YamlNoEvent -> return Nothing

316 YamlNoEvent -> return Nothing

285 YamlStreamStartEvent -> return $ Just EventStreamStart

317 YamlStreamStartEvent -> return $ Just EventStreamStart

286 YamlStreamEndEvent -> return $ Just EventStreamEnd

318 YamlStreamEndEvent -> return $ Just EventStreamEnd

@@ -314,6 +346,7 @@ getEvent er = do

314 anchor <- readAnchor c_get_mapping_start_anchor er

346 anchor <- readAnchor c_get_mapping_start_anchor er

315 return $ Just $ EventMappingStart tag style anchor

347 return $ Just $ EventMappingStart tag style anchor

316 YamlMappingEndEvent -> return $ Just EventMappingEnd

348 YamlMappingEndEvent -> return $ Just EventMappingEnd

349+ return $ (\e -> MarkedEvent e startMark endMark) <$> event

317

350

318-- Emitter

351-- Emitter

319

352

@@ -520,8 +553,13 @@ newtype ToEventRawException = ToEventRawException CInt

520instance Exception ToEventRawException

553instance Exception ToEventRawException

521

554

522decode :: MonadResource m => B.ByteString -> ConduitM i Event m ()

555decode :: MonadResource m => B.ByteString -> ConduitM i Event m ()

556+decode = mapOutput yamlEvent . decodeMarked

557+

558+-- |

559+-- @since [INSERTVERSION]

560+decodeMarked :: MonadResource m => B.ByteString -> ConduitM i MarkedEvent m ()

523−decode bs | B8.null bs = return ()

561+decodeMarked bs | B8.null bs = return ()

524−decode bs =

562+decodeMarked bs =

525 bracketP alloc cleanup (runParser . fst)

563 bracketP alloc cleanup (runParser . fst)

526 where

564 where

527 alloc = mask_ $ do

565 alloc = mask_ $ do

@@ -562,7 +600,12 @@ openFile file rawOpenFlags openMode = do

562 else return nullPtr

600 else return nullPtr

563

601

564decodeFile :: MonadResource m => FilePath -> ConduitM i Event m ()

602decodeFile :: MonadResource m => FilePath -> ConduitM i Event m ()

565−decodeFile file =

603+decodeFile = mapOutput yamlEvent . decodeFileMarked

604+

605+-- |

606+-- @since [INSERTVERSION]

607+decodeFileMarked :: MonadResource m => FilePath -> ConduitM i MarkedEvent m ()

608+decodeFileMarked file =

566 bracketP alloc cleanup (runParser . fst)

609 bracketP alloc cleanup (runParser . fst)

567 where

610 where

568 alloc = mask_ $ do

611 alloc = mask_ $ do

@@ -589,7 +632,7 @@ decodeFile file =

589 c_yaml_parser_delete ptr

632 c_yaml_parser_delete ptr

590 free ptr

633 free ptr

591

634

592−runParser :: MonadResource m => Parser -> ConduitM i Event m ()

635+runParser :: MonadResource m => Parser -> ConduitM i MarkedEvent m ()

593runParser parser = do

636runParser parser = do

594 e <- liftIO $ parserParseOne' parser

637 e <- liftIO $ parserParseOne' parser

595 case e of

638 case e of

@@ -598,7 +641,7 @@ runParser parser = do

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

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

599

642

600parserParseOne' :: Parser

643parserParseOne' :: Parser

601− -> IO (Either YamlException (Maybe Event))

644+ -> IO (Either YamlException (Maybe MarkedEvent))

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

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

603 res <- liftIO $ c_yaml_parser_parse parser er

646 res <- liftIO $ c_yaml_parser_parse parser er

604 flip finally (c_yaml_event_delete er) $

647 flip finally (c_yaml_event_delete er) $

@@ -606,10 +649,7 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do

606 then do

649 then do

607 problem <- makeString c_get_parser_error_problem parser

650 problem <- makeString c_get_parser_error_problem parser

608 context <- makeString c_get_parser_error_context parser

651 context <- makeString c_get_parser_error_context parser

609− index <- c_get_parser_error_index parser

652+ problemMark <- c_get_parser_error_mark parser >>= getMark

610− line <- c_get_parser_error_line parser

611− column <- c_get_parser_error_column parser

612− let problemMark = YamlMark (fromIntegral index) (fromIntegral line) (fromIntegral column)

613 return $ Left $ YamlParseException problem context problemMark

653 return $ Left $ YamlParseException problem context problemMark

614 else Right <$> getEvent er

654 else Right <$> getEvent er

615

655