f54356d · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Read tag in mapping start

f54356dgmorpheme8 years ago

src/Data/Yaml.hs+1−1

compare with master

unifiedsplit

@@ -135,7 +135,7 @@ objToEvents' (Array list) rest =

135 EventSequenceStart Nothing

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

137objToEvents' (Object pairs) rest =

138− EventMappingStart Nothing

138+ EventMappingStart MapTag 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

@@ -62,7 +62,7 @@ instance ToYaml Int where

63mapping :: [(Text, YamlBuilder)] -> YamlBuilder

64mapping pairs = YamlBuilder $ \rest ->

65− EventMappingStart Nothing : foldr addPair (EventMappingEnd : rest) pairs

65+ EventMappingStart MapTag Nothing : foldr addPair (EventMappingEnd : rest) pairs

66 where

67 addPair (key, YamlBuilder value) after

68 = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing

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

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

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

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

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

200 Just (EventAlias an) -> do

201 m <- lift get

202 case Map.lookup an m of

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

@@ -166,7 +166,7 @@ sinkValue =

166 vals <- goS id

167 let val = Sequence vals mname

168 tell' mname val

169− go (EventMappingStart mname) = do

169+ go (EventMappingStart _tag mname) = do

170 pairs <- goM id

171 let val = Mapping pairs mname

172 tell' mname val

src/Text/Libyaml.hs+34−13

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

64 | EventScalar !ByteString !Tag !Style !Anchor

65 | EventSequenceStart !Anchor

66 | EventSequenceEnd

67− | EventMappingStart !Anchor

67+ | EventMappingStart !Tag !Anchor

68 | EventMappingEnd

69 deriving (Show, Eq)

@@ -232,6 +232,12 @@ foreign import ccall unsafe "get_sequence_start_anchor"

232foreign import ccall unsafe "get_mapping_start_anchor"

233 c_get_mapping_start_anchor :: EventRaw -> IO CString

234

235+foreign import ccall unsafe "get_mapping_start_tag"

236+ c_get_mapping_start_tag :: EventRaw -> IO CString

237+

238+foreign import ccall unsafe "get_mapping_start_tag_len"

239+ c_get_mapping_start_tag_len :: EventRaw -> IO CULong

240+

235foreign import ccall unsafe "get_alias_anchor"

241foreign import ccall unsafe "get_alias_anchor"

236 c_get_alias_anchor :: EventRaw -> IO CString

242 c_get_alias_anchor :: EventRaw -> IO CString

237

243

@@ -280,10 +286,21 @@ getEvent er = do

280 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

286 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

281 YamlMappingStartEvent -> do

287 YamlMappingStartEvent -> do

282 yanchor <- c_get_mapping_start_anchor er

288 yanchor <- c_get_mapping_start_anchor er

289+ ytag <- c_get_mapping_start_tag er

290+ tag <- if ytag == nullPtr

291+ then return NoTag

292+ else do

293+ ytag_len <- c_get_mapping_start_tag_len er

294+ let ytag' = castPtr ytag

295+ let ytag_len' = fromEnum ytag_len

296+ bsToTag <$>

297+ if ytag_len' == 0

298+ then return Data.ByteString.empty

299+ else packCStringLen (ytag', ytag_len')

283 anchor <- if yanchor == nullPtr

300 anchor <- if yanchor == nullPtr

284 then return Nothing

301 then return Nothing

285 else Just <$> peekCString yanchor

302 else Just <$> peekCString yanchor

286− return $ Just $ EventMappingStart anchor

303+ return $ Just $ EventMappingStart tag anchor

287 YamlMappingEndEvent -> return $ Just EventMappingEnd

304 YamlMappingEndEvent -> return $ Just EventMappingEnd

288

305

289-- Emitter

306-- Emitter

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

448 0 -- YAML_ANY_SEQUENCE_STYLE

465 0 -- YAML_ANY_SEQUENCE_STYLE

449 EventSequenceEnd ->

466 EventSequenceEnd ->

450 c_yaml_sequence_end_event_initialize er

467 c_yaml_sequence_end_event_initialize er

451− EventMappingStart Nothing ->

468+ EventMappingStart tag Nothing ->

452− c_yaml_mapping_start_event_initialize

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

453− er

454− nullPtr

455− nullPtr

456− 1

457− 0 -- YAML_ANY_SEQUENCE_STYLE

458− EventMappingStart (Just anchor) ->

459− withCString anchor $ \anchor' -> do

460− let anchorP = castPtr anchor'

470+ let tagP = castPtr tag'

461 c_yaml_mapping_start_event_initialize

471 c_yaml_mapping_start_event_initialize

462 er

472 er

463− anchorP

464 nullPtr

473 nullPtr

474+ tagP

465 1

475 1

466 0 -- YAML_ANY_SEQUENCE_STYLE

476 0 -- YAML_ANY_SEQUENCE_STYLE

477+ EventMappingStart tag (Just anchor) ->

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

479+ withCString anchor $ \anchor' -> do

480+ let tagP = castPtr tag'

481+ let anchorP = castPtr anchor'

482+ c_yaml_mapping_start_event_initialize

483+ er

484+ anchorP

485+ tagP

486+ 1

487+ 0 -- YAML_ANY_SEQUENCE_STYLE

467 EventMappingEnd ->

488 EventMappingEnd ->

468 c_yaml_mapping_end_event_initialize er

489 c_yaml_mapping_end_event_initialize er

469 EventAlias anchor ->

490 EventAlias anchor ->

test/Data/YamlSpec.hs+1−1

@@ -238,7 +238,7 @@ caseCountMappingsWithAnchor =

238 caseHelper yamlString isMappingA 1

239 where

240 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"

241− isMappingA (Y.EventMappingStart (Just _)) = True

241+ isMappingA (Y.EventMappingStart _ (Just _)) = True

242 isMappingA _ = False

243

244caseCountAliases :: Assertion