f54356d · typeable/yaml

git.iko.soy/typeable/yaml

Read tag in mapping start

commitf54356d512a9e8ca650772e771b658b224aa1449 authorgmorpheme <github@gmorpheme.net> dateMon 9 Jul 2018, 20:56 (8 years ago) parent7d6e398

6 files changed+39−18

compare with master

unifiedsplit

src/Data/Yaml.hs+1−1 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+34−13 test/Data/YamlSpec.hs+1−1

src/Data/Yaml.hs+1−1

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

135135 EventSequenceStart Nothing

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

137137objToEvents' (Object pairs) rest =

138− EventMappingStart Nothing

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

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

6262

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

6464mapping pairs = YamlBuilder $ \rest ->

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

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

6666 where

6767 addPair (key, YamlBuilder value) after

6868 = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing

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

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

196196 case me of

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

198198 Just (EventSequenceStart a) -> parseS a id

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

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

200200 Just (EventAlias an) -> do

201201 m <- lift get

202202 case Map.lookup an m of

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

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

166166 vals <- goS id

167167 let val = Sequence vals mname

168168 tell' mname val

169− go (EventMappingStart mname) = do

169+ go (EventMappingStart _tag mname) = do

170170 pairs <- goM id

171171 let val = Mapping pairs mname

172172 tell' mname val

src/Text/Libyaml.hs+34−13

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

6464 | EventScalar !ByteString !Tag !Style !Anchor

6565 | EventSequenceStart !Anchor

6666 | EventSequenceEnd

67− | EventMappingStart !Anchor

67+ | EventMappingStart !Tag !Anchor

6868 | EventMappingEnd

6969 deriving (Show, Eq)

7070

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

232232foreign import ccall unsafe "get_mapping_start_anchor"

233233 c_get_mapping_start_anchor :: EventRaw -> IO CString

234234

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+

235241foreign import ccall unsafe "get_alias_anchor"

236242 c_get_alias_anchor :: EventRaw -> IO CString

237243

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

280286 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

281287 YamlMappingStartEvent -> do

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

283300 anchor <- if yanchor == nullPtr

284301 then return Nothing

285302 else Just <$> peekCString yanchor

286− return $ Just $ EventMappingStart anchor

303+ return $ Just $ EventMappingStart tag anchor

287304 YamlMappingEndEvent -> return $ Just EventMappingEnd

288305

289306-- Emitter

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

448465 0 -- YAML_ANY_SEQUENCE_STYLE

449466 EventSequenceEnd ->

450467 c_yaml_sequence_end_event_initialize er

451− EventMappingStart Nothing ->

452− c_yaml_mapping_start_event_initialize

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'

468+ EventMappingStart tag Nothing ->

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

470+ let tagP = castPtr tag'

461471 c_yaml_mapping_start_event_initialize

462472 er

463− anchorP

464473 nullPtr

474+ tagP

465475 1

466476 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

467488 EventMappingEnd ->

468489 c_yaml_mapping_end_event_initialize er

469490 EventAlias anchor ->

test/Data/YamlSpec.hs+1−1

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

238238 caseHelper yamlString isMappingA 1

239239 where

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

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

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

242242 isMappingA _ = False

243243

244244caseCountAliases :: Assertion