a19ff82 · typeable/yaml

git.iko.soy/typeable/yaml

Add style too and tiny refactor

This brings sequence and mapping more into line with scalars

commita19ff822fb3ce0a3ce28edb362525d0aab04012a authorgmorpheme <github@gmorpheme.net> dateMon 9 Jul 2018, 22:09 (8 years ago) parentdd27fab

8 files changed+84−73

compare with master

unifiedsplit

c/helper.c+16−2 c/helper.h+2 src/Data/Yaml.hs+2−2 src/Data/Yaml/Builder.hs+2−2 src/Data/Yaml/Internal.hs+2−2 src/Data/Yaml/Parser.hs+2−2 src/Text/Libyaml.hs+54−59 test/Data/YamlSpec.hs+4−4

c/helper.c+16−2

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

128128 return e->data.sequence_start.anchor;

129129}

130130

131+int get_sequence_start_style(yaml_event_t *e)

132+{

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

134+}

135+

131136unsigned char * get_sequence_start_tag(yaml_event_t *e)

132137{

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

138+ unsigned char *s = e->data.sequence_start.tag;

139+ if (!s) s = (unsigned char *) "";

140+ return s;

134141}

135142

136143unsigned long get_sequence_start_tag_len(yaml_event_t *e)

@@ -143,9 +150,16 @@ unsigned char * get_mapping_start_anchor(yaml_event_t *e)

143150 return e->data.mapping_start.anchor;

144151}

145152

153+int get_mapping_start_style(yaml_event_t *e)

154+{

155+ return e->data.mapping_start.style;

156+}

157+

146158unsigned char * get_mapping_start_tag(yaml_event_t *e)

147159{

148− return e->data.mapping_start.tag;

160+ unsigned char *s = e->data.mapping_start.tag;

161+ if (!s) s = (unsigned char *) "";

162+ return s;

149163}

150164

151165unsigned long get_mapping_start_tag_len(yaml_event_t *e)

c/helper.h+2

@@ -35,6 +35,8 @@ unsigned char * get_mapping_start_tag(yaml_event_t *e);

3535unsigned long get_mapping_start_tag_len(yaml_event_t *e);

3636

3737int get_scalar_style(yaml_event_t *e);

38+int get_sequence_start_style(yaml_event_t *e);

39+int get_mapping_start_style(yaml_event_t *e);

3840

3941unsigned char * get_scalar_anchor(yaml_event_t *e);

4042unsigned char * get_sequence_start_anchor(yaml_event_t *e);

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 NoTag Nothing

135+ EventSequenceStart NoTag Any Nothing

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

137137objToEvents' (Object pairs) rest =

138− EventMappingStart NoTag Nothing

138+ EventMappingStart NoTag Any 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+2−2

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

6262

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

6464mapping pairs = YamlBuilder $ \rest ->

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

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

6666 where

6767 addPair (key, YamlBuilder value) after

6868 = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing

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

7070

7171array :: [YamlBuilder] -> YamlBuilder

7272array bs =

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

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

7474 where

7575 go (YamlBuilder b) = b

7676

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

@@ -195,8 +195,8 @@ 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

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

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

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+2−2

@@ -162,11 +162,11 @@ 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 _tag mname) = do

165+ go (EventSequenceStart _tag _style mname) = do

166166 vals <- goS id

167167 let val = Sequence vals mname

168168 tell' mname val

169− go (EventMappingStart _tag mname) = do

169+ go (EventMappingStart _tag _style mname) = do

170170 pairs <- goM id

171171 let val = Mapping pairs mname

172172 tell' mname val

src/Text/Libyaml.hs+54−59

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

6262 | EventDocumentEnd

6363 | EventAlias !AnchorName

6464 | EventScalar !ByteString !Tag !Style !Anchor

65− | EventSequenceStart !Tag !Anchor

65+ | EventSequenceStart !Tag !Style !Anchor

6666 | EventSequenceEnd

67− | EventMappingStart !Tag !Anchor

67+ | EventMappingStart !Tag !Style !Anchor

6868 | EventMappingEnd

6969 deriving (Show, Eq)

7070

@@ -229,8 +229,11 @@ 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_style"

233+ c_get_sequence_start_style :: EventRaw -> IO CInt

234+

232235foreign import ccall unsafe "get_sequence_start_tag"

233− c_get_sequence_start_tag :: EventRaw -> IO CString

236+ c_get_sequence_start_tag :: EventRaw -> IO (Ptr CUChar)

234237

235238foreign import ccall unsafe "get_sequence_start_tag_len"

236239 c_get_sequence_start_tag_len :: EventRaw -> IO CULong

@@ -238,8 +241,11 @@ foreign import ccall unsafe "get_sequence_start_tag_len"

238241foreign import ccall unsafe "get_mapping_start_anchor"

239242 c_get_mapping_start_anchor :: EventRaw -> IO CString

240243

244+foreign import ccall unsafe "get_mapping_start_style"

245+ c_get_mapping_start_style :: EventRaw -> IO CInt

246+

241247foreign import ccall unsafe "get_mapping_start_tag"

242− c_get_mapping_start_tag :: EventRaw -> IO CString

248+ c_get_mapping_start_tag :: EventRaw -> IO (Ptr CUChar)

243249

244250foreign import ccall unsafe "get_mapping_start_tag_len"

245251 c_get_mapping_start_tag_len :: EventRaw -> IO CULong

@@ -247,6 +253,30 @@ foreign import ccall unsafe "get_mapping_start_tag_len"

247253foreign import ccall unsafe "get_alias_anchor"

248254 c_get_alias_anchor :: EventRaw -> IO CString

249255

256+readAnchor :: (EventRaw -> IO CString) -> (EventRaw -> IO Anchor)

257+readAnchor getAnchor er = do

258+ yanchor <- getAnchor er

259+ if yanchor == nullPtr

260+ then return Nothing

261+ else Just <$> peekCString yanchor

262+

263+readStyle :: (EventRaw -> IO CInt) -> (EventRaw -> IO Style)

264+readStyle getStyle er = do

265+ ystyle <- getStyle er

266+ return $ toEnum $ fromEnum ystyle

267+

268+readTag ::

269+ (EventRaw -> IO (Ptr CUChar)) -> (EventRaw -> IO CULong) -> (EventRaw -> IO Tag)

270+readTag getTag getTagLen er = do

271+ ytag <- getTag er

272+ ytag_len <- getTagLen er

273+ let ytag' = castPtr ytag

274+ let ytag_len' = fromEnum ytag_len

275+ bsToTag <$>

276+ if ytag_len' == 0

277+ then return Data.ByteString.empty

278+ else packCStringLen (ytag', ytag_len')

279+

250280getEvent :: EventRaw -> IO (Maybe Event)

251281getEvent er = do

252282 et <- c_get_event_type er

@@ -265,59 +295,24 @@ getEvent er = do

265295 YamlScalarEvent -> do

266296 yvalue <- c_get_scalar_value er

267297 ylen <- c_get_scalar_length er

268− ytag <- c_get_scalar_tag er

269− ytag_len <- c_get_scalar_tag_len er

270− ystyle <- c_get_scalar_style er

271− let ytag_len' = fromEnum ytag_len

272298 let yvalue' = castPtr yvalue

273− let ytag' = castPtr ytag

274299 let ylen' = fromEnum ylen

275300 bs <- packCStringLen (yvalue', ylen')

276− tagbs <-

277− if ytag_len' == 0

278− then return Data.ByteString.empty

279− else packCStringLen (ytag', ytag_len')

280− let style = toEnum $ fromEnum ystyle

281− yanchor <- c_get_scalar_anchor er

282− anchor <- if yanchor == nullPtr

283− then return Nothing

284− else Just <$> peekCString yanchor

285− return $ Just $ EventScalar bs (bsToTag tagbs) style anchor

301+ tag <- readTag c_get_scalar_tag c_get_scalar_tag_len er

302+ style <- readStyle c_get_scalar_style er

303+ anchor <- readAnchor c_get_scalar_anchor er

304+ return $ Just $ EventScalar bs tag style anchor

286305 YamlSequenceStartEvent -> do

287− yanchor <- c_get_sequence_start_anchor er

288− anchor <- if yanchor == nullPtr

289− then return Nothing

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

302− return $ Just $ EventSequenceStart tag anchor

306+ tag <- readTag c_get_sequence_start_tag c_get_sequence_start_tag_len er

307+ style <- readStyle c_get_sequence_start_style er

308+ anchor <- readAnchor c_get_sequence_start_anchor er

309+ return $ Just $ EventSequenceStart tag style anchor

303310 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

304311 YamlMappingStartEvent -> do

305− yanchor <- c_get_mapping_start_anchor er

306− anchor <- if yanchor == nullPtr

307− then return Nothing

308− else Just <$> peekCString yanchor

309− ytag <- c_get_mapping_start_tag er

310− tag <- if ytag == nullPtr

311− then return NoTag

312− else do

313− ytag_len <- c_get_mapping_start_tag_len er

314− let ytag' = castPtr ytag

315− let ytag_len' = fromEnum ytag_len

316− bsToTag <$>

317− if ytag_len' == 0

318− then return Data.ByteString.empty

319− else packCStringLen (ytag', ytag_len')

320− return $ Just $ EventMappingStart tag anchor

312+ tag <- readTag c_get_mapping_start_tag c_get_mapping_start_tag_len er

313+ style <- readStyle c_get_mapping_start_style er

314+ anchor <- readAnchor c_get_mapping_start_anchor er

315+ return $ Just $ EventMappingStart tag style anchor

321316 YamlMappingEndEvent -> return $ Just EventMappingEnd

322317

323318-- Emitter

@@ -464,7 +459,7 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do

464459 0 -- plain_implicit

465460 qi -- quoted_implicit

466461 style' -- style

467− EventSequenceStart tag Nothing ->

462+ EventSequenceStart tag style Nothing ->

468463 withCString (tagToString tag) $ \tag' -> do

469464 let tagP = castPtr tag'

470465 c_yaml_sequence_start_event_initialize

@@ -472,8 +467,8 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do

472467 nullPtr

473468 tagP

474469 1

475− 0 -- YAML_ANY_SEQUENCE_STYLE

476− EventSequenceStart tag (Just anchor) ->

470+ (toEnum $ fromEnum style)

471+ EventSequenceStart tag style (Just anchor) ->

477472 withCString (tagToString tag) $ \tag' -> do

478473 let tagP = castPtr tag'

479474 withCString anchor $ \anchor' -> do

@@ -483,10 +478,10 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do

483478 anchorP

484479 tagP

485480 1

486− 0 -- YAML_ANY_SEQUENCE_STYLE

481+ (toEnum $ fromEnum style)

487482 EventSequenceEnd ->

488483 c_yaml_sequence_end_event_initialize er

489− EventMappingStart tag Nothing ->

484+ EventMappingStart tag style Nothing ->

490485 withCString (tagToString tag) $ \tag' -> do

491486 let tagP = castPtr tag'

492487 c_yaml_mapping_start_event_initialize

@@ -494,8 +489,8 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do

494489 nullPtr

495490 tagP

496491 1

497− 0 -- YAML_ANY_SEQUENCE_STYLE

498− EventMappingStart tag (Just anchor) ->

492+ (toEnum $ fromEnum style)

493+ EventMappingStart tag style (Just anchor) ->

499494 withCString (tagToString tag) $ \tag' -> do

500495 withCString anchor $ \anchor' -> do

501496 let tagP = castPtr tag'

@@ -505,7 +500,7 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do

505500 anchorP

506501 tagP

507502 1

508− 0 -- YAML_ANY_SEQUENCE_STYLE

503+ (toEnum $ fromEnum style)

509504 EventMappingEnd ->

510505 c_yaml_mapping_end_event_initialize er

511506 EventAlias anchor ->

test/Data/YamlSpec.hs+4−4

@@ -232,7 +232,7 @@ caseCountSequencesWithAnchor =

232232 caseHelper yamlString isSequenceStartA 1

233233 where

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

235− isSequenceStartA (Y.EventSequenceStart Y.NoTag (Just _)) = True

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

236236 isSequenceStartA _ = False

237237

238238caseCountMappingsWithAnchor :: Assertion

@@ -240,7 +240,7 @@ caseCountMappingsWithAnchor =

240240 caseHelper yamlString isMappingA 1

241241 where

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

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

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

244244 isMappingA _ = False

245245

246246caseCountAliases :: Assertion

@@ -256,7 +256,7 @@ caseCountMappingTags =

256256 caseHelper yamlString isCustomTaggedMapping 1

257257 where

258258 yamlString = "foo: !bar\n k: v\n k2: v2"

259− isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!bar") _) = True

259+ isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!bar") _ _) = True

260260 isCustomTaggedMapping _ = False

261261

262262caseCountSequenceTags :: Assertion

@@ -264,7 +264,7 @@ caseCountSequenceTags =

264264 caseHelper yamlString isCustomTaggedSequence 1

265265 where

266266 yamlString = "foo: !bar [x, y, z]"

267− isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!bar") _) = True

267+ isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!bar") _ _) = True

268268 isCustomTaggedSequence _ = False

269269

270270caseCountScalars :: Assertion