e5d2f3e · typeable/yaml

git.iko.soy/typeable/yaml

Expose tags for sequences too.

commite5d2f3e8488023f9e27940593848a38e0ebdfd01 authorgmorpheme <github@gmorpheme.net> dateMon 9 Jul 2018, 21:16 (8 years ago) parentf54356d

8 files changed+59−26

compare with master

unifiedsplit

c/helper.c+10 c/helper.h+2 src/Data/Yaml.hs+2−2 src/Data/Yaml/Builder.hs+1−1 src/Data/Yaml/Internal.hs+1−1 src/Data/Yaml/Parser.hs+1−1 src/Text/Libyaml.hs+41−20 test/Data/YamlSpec.hs+1−1

c/helper.c+10

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

128128 return e->data.sequence_start.anchor;

129129}

130130

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+

131141unsigned char * get_mapping_start_anchor(yaml_event_t *e)

132142{

133143 return e->data.mapping_start.anchor;

c/helper.h+2

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

2929

3030unsigned char * get_scalar_tag(yaml_event_t *e);

3131unsigned 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);

3234unsigned char * get_mapping_start_tag(yaml_event_t *e);

3335unsigned long get_mapping_start_tag_len(yaml_event_t *e);

3436

src/Data/Yaml.hs+2−2

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

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

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

134134objToEvents' (Array list) rest =

135− EventSequenceStart Nothing

135+ EventSequenceStart NoTag Nothing

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

137137objToEvents' (Object pairs) rest =

138− EventMappingStart MapTag Nothing

138+ EventMappingStart NoTag Nothing

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

140140

141141-- 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 ->

7070

7171array :: [YamlBuilder] -> YamlBuilder

7272array bs =

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

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

7474 where

7575 go (YamlBuilder b) = b

7676

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

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

195195 me <- CL.head

196196 case me of

197197 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

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

200200 Just (EventAlias an) -> do

201201 m <- lift get

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

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

162162 go EventDocumentStart = start

163163 go (EventAlias a) = return $ Alias a

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

165− go (EventSequenceStart mname) = do

165+ go (EventSequenceStart _tag mname) = do

166166 vals <- goS id

167167 let val = Sequence vals mname

168168 tell' mname val

src/Text/Libyaml.hs+41−20

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

6262 | EventDocumentEnd

6363 | EventAlias !AnchorName

6464 | EventScalar !ByteString !Tag !Style !Anchor

65− | EventSequenceStart !Anchor

65+ | EventSequenceStart !Tag !Anchor

6666 | EventSequenceEnd

6767 | EventMappingStart !Tag !Anchor

6868 | EventMappingEnd

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

229229foreign import ccall unsafe "get_sequence_start_anchor"

230230 c_get_sequence_start_anchor :: EventRaw -> IO CString

231231

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+

232238foreign import ccall unsafe "get_mapping_start_anchor"

233239 c_get_mapping_start_anchor :: EventRaw -> IO CString

234240

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

282288 anchor <- if yanchor == nullPtr

283289 then return Nothing

284290 else Just <$> peekCString yanchor

285− return $ Just $ EventSequenceStart anchor

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')

302+ return $ Just $ EventSequenceStart tag anchor

286303 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

287304 YamlMappingStartEvent -> do

288305 yanchor <- c_get_mapping_start_anchor er

306+ anchor <- if yanchor == nullPtr

307+ then return Nothing

308+ else Just <$> peekCString yanchor

289309 ytag <- c_get_mapping_start_tag er

290310 tag <- if ytag == nullPtr

291311 then return NoTag

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

297317 if ytag_len' == 0

298318 then return Data.ByteString.empty

299319 else packCStringLen (ytag', ytag_len')

300− anchor <- if yanchor == nullPtr

301− then return Nothing

302− else Just <$> peekCString yanchor

303320 return $ Just $ EventMappingStart tag anchor

304321 YamlMappingEndEvent -> return $ Just EventMappingEnd

305322

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

447464 0 -- plain_implicit

448465 qi -- quoted_implicit

449466 style' -- style

450− EventSequenceStart Nothing ->

451− c_yaml_sequence_start_event_initialize

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'

467+ EventSequenceStart tag Nothing ->

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

469+ let tagP = castPtr tag'

460470 c_yaml_sequence_start_event_initialize

461− er

462− anchorP

463− nullPtr

464− 1

465− 0 -- YAML_ANY_SEQUENCE_STYLE

471+ er

472+ nullPtr

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

486+ 0 -- YAML_ANY_SEQUENCE_STYLE

466487 EventSequenceEnd ->

467488 c_yaml_sequence_end_event_initialize er

468489 EventMappingStart tag Nothing ->

test/Data/YamlSpec.hs+1−1

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

230230 caseHelper yamlString isSequenceStartA 1

231231 where

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

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

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

234234 isSequenceStartA _ = False

235235

236236caseCountMappingsWithAnchor :: Assertion