e5d2f3e · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Expose tags for sequences too.

e5d2f3egmorpheme8 years ago

c/helper.c+10

compare with master

unifiedsplit

@@ -128,6 +128,16 @@ unsigned char * get_sequence_start_anchor(yaml_event_t *e)

128 return e->data.sequence_start.anchor;

129}

130

131+unsigned char * get_sequence_start_tag(yaml_event_t *e)

132+{

133+ return e->data.sequence_start.tag;

134+}

135+

136+unsigned long get_sequence_start_tag_len(yaml_event_t *e)

137+{

138+ return strlen((char *) get_sequence_start_tag(e));

139+}

140+

131unsigned char * get_mapping_start_anchor(yaml_event_t *e)

141unsigned char * get_mapping_start_anchor(yaml_event_t *e)

132{

142{

133 return e->data.mapping_start.anchor;

143 return e->data.mapping_start.anchor;

c/helper.h+2

@@ -29,6 +29,8 @@ unsigned long get_scalar_length(yaml_event_t *e);

30unsigned char * get_scalar_tag(yaml_event_t *e);

31unsigned long get_scalar_tag_len(yaml_event_t *e);

32+unsigned char * get_sequence_start_tag(yaml_event_t *e);

33+unsigned long get_sequence_start_tag_len(yaml_event_t *e);

32unsigned char * get_mapping_start_tag(yaml_event_t *e);

34unsigned char * get_mapping_start_tag(yaml_event_t *e);

33unsigned long get_mapping_start_tag_len(yaml_event_t *e);

35unsigned long get_mapping_start_tag_len(yaml_event_t *e);

src/Data/Yaml.hs+2−2

@@ -132,10 +132,10 @@ scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing

132objToEvents' :: Value -> [Y.Event] -> [Y.Event]

133--objToEvents' (Scalar s) rest = scalarToEvent s : rest

134objToEvents' (Array list) rest =

135− EventSequenceStart Nothing

135+ EventSequenceStart NoTag Nothing

136 : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)

137objToEvents' (Object pairs) rest =

138− EventMappingStart MapTag Nothing

138+ EventMappingStart NoTag Nothing

139 : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)

140

141-- Empty strings need special handling to ensure they get quoted. This avoids:

src/Data/Yaml/Builder.hs+1−1

@@ -70,7 +70,7 @@ mapping pairs = YamlBuilder $ \rest ->

71array :: [YamlBuilder] -> YamlBuilder

72array bs =

73− YamlBuilder $ (EventSequenceStart Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)

73+ YamlBuilder $ (EventSequenceStart NoTag Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)

74 where

75 go (YamlBuilder b) = b

src/Data/Yaml/Internal.hs+1−1

@@ -195,7 +195,7 @@ parseO = do

195 me <- CL.head

196 case me of

197 Just (EventScalar v tag style a) -> textToValue style tag <$> parseScalar v a style tag

198− Just (EventSequenceStart a) -> parseS a id

198+ Just (EventSequenceStart _ a) -> parseS a id

199 Just (EventMappingStart _ a) -> parseM a M.empty

200 Just (EventAlias an) -> do

201 m <- lift get

src/Data/Yaml/Parser.hs+1−1

@@ -162,7 +162,7 @@ sinkValue =

162 go EventDocumentStart = start

163 go (EventAlias a) = return $ Alias a

164 go (EventScalar a b c d) = tell' d $ Scalar a b c d

165− go (EventSequenceStart mname) = do

165+ go (EventSequenceStart _tag mname) = do

166 vals <- goS id

167 let val = Sequence vals mname

168 tell' mname val

src/Text/Libyaml.hs+41−20

@@ -62,7 +62,7 @@ data Event =

62 | EventDocumentEnd

63 | EventAlias !AnchorName

64 | EventScalar !ByteString !Tag !Style !Anchor

65− | EventSequenceStart !Anchor

65+ | EventSequenceStart !Tag !Anchor

66 | EventSequenceEnd

67 | EventMappingStart !Tag !Anchor

68 | EventMappingEnd

@@ -229,6 +229,12 @@ foreign import ccall unsafe "get_scalar_anchor"

229foreign import ccall unsafe "get_sequence_start_anchor"

230 c_get_sequence_start_anchor :: EventRaw -> IO CString

231

232+foreign import ccall unsafe "get_sequence_start_tag"

233+ c_get_sequence_start_tag :: EventRaw -> IO CString

234+

235+foreign import ccall unsafe "get_sequence_start_tag_len"

236+ c_get_sequence_start_tag_len :: EventRaw -> IO CULong

237+

232foreign import ccall unsafe "get_mapping_start_anchor"

238foreign import ccall unsafe "get_mapping_start_anchor"

233 c_get_mapping_start_anchor :: EventRaw -> IO CString

239 c_get_mapping_start_anchor :: EventRaw -> IO CString

234

240

@@ -282,10 +288,24 @@ getEvent er = do

282 anchor <- if yanchor == nullPtr

288 anchor <- if yanchor == nullPtr

283 then return Nothing

289 then return Nothing

284 else Just <$> peekCString yanchor

290 else Just <$> peekCString yanchor

291+ ytag <- c_get_sequence_start_tag er

292+ tag <- if ytag == nullPtr

293+ then return NoTag

294+ else do

295+ ytag_len <- c_get_sequence_start_tag_len er

296+ let ytag' = castPtr ytag

297+ let ytag_len' = fromEnum ytag_len

298+ bsToTag <$>

299+ if ytag_len' == 0

300+ then return Data.ByteString.empty

301+ else packCStringLen (ytag', ytag_len')

285− return $ Just $ EventSequenceStart anchor

302+ return $ Just $ EventSequenceStart tag anchor

286 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

303 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

287 YamlMappingStartEvent -> do

304 YamlMappingStartEvent -> do

288 yanchor <- c_get_mapping_start_anchor er

305 yanchor <- c_get_mapping_start_anchor er

306+ anchor <- if yanchor == nullPtr

307+ then return Nothing

308+ else Just <$> peekCString yanchor

289 ytag <- c_get_mapping_start_tag er

309 ytag <- c_get_mapping_start_tag er

290 tag <- if ytag == nullPtr

310 tag <- if ytag == nullPtr

291 then return NoTag

311 then return NoTag

@@ -297,9 +317,6 @@ getEvent er = do

297 if ytag_len' == 0

317 if ytag_len' == 0

298 then return Data.ByteString.empty

318 then return Data.ByteString.empty

299 else packCStringLen (ytag', ytag_len')

319 else packCStringLen (ytag', ytag_len')

300− anchor <- if yanchor == nullPtr

301− then return Nothing

302− else Just <$> peekCString yanchor

303 return $ Just $ EventMappingStart tag anchor

320 return $ Just $ EventMappingStart tag anchor

304 YamlMappingEndEvent -> return $ Just EventMappingEnd

321 YamlMappingEndEvent -> return $ Just EventMappingEnd

305

322

@@ -447,22 +464,26 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do

447 0 -- plain_implicit

464 0 -- plain_implicit

448 qi -- quoted_implicit

465 qi -- quoted_implicit

449 style' -- style

466 style' -- style

450− EventSequenceStart Nothing ->

467+ EventSequenceStart tag Nothing ->

451− c_yaml_sequence_start_event_initialize

468+ withCString (tagToString tag) $ \tag' -> do

452− er

453− nullPtr

454− nullPtr

455− 1

456− 0 -- YAML_ANY_SEQUENCE_STYLE

457− EventSequenceStart (Just anchor) ->

458− withCString anchor $ \anchor' -> do

459− let anchorP = castPtr anchor'

469+ let tagP = castPtr tag'

460 c_yaml_sequence_start_event_initialize

470 c_yaml_sequence_start_event_initialize

461− er

471+ er

462− anchorP

463− nullPtr

472+ nullPtr

464− 1

473+ tagP

474+ 1

475+ 0 -- YAML_ANY_SEQUENCE_STYLE

476+ EventSequenceStart tag (Just anchor) ->

477+ withCString (tagToString tag) $ \tag' -> do

478+ let tagP = castPtr tag'

479+ withCString anchor $ \anchor' -> do

480+ let anchorP = castPtr anchor'

481+ c_yaml_sequence_start_event_initialize

482+ er

483+ anchorP

484+ tagP

485+ 1

465− 0 -- YAML_ANY_SEQUENCE_STYLE

486+ 0 -- YAML_ANY_SEQUENCE_STYLE

466 EventSequenceEnd ->

487 EventSequenceEnd ->

467 c_yaml_sequence_end_event_initialize er

488 c_yaml_sequence_end_event_initialize er

468 EventMappingStart tag Nothing ->

489 EventMappingStart tag Nothing ->

test/Data/YamlSpec.hs+1−1

@@ -230,7 +230,7 @@ caseCountSequencesWithAnchor =

230 caseHelper yamlString isSequenceStartA 1

231 where

232 yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"

233− isSequenceStartA (Y.EventSequenceStart (Just _)) = True

233+ isSequenceStartA (Y.EventSequenceStart Y.NoTag (Just _)) = True

234 isSequenceStartA _ = False

235

236caseCountMappingsWithAnchor :: Assertion