a19ff82 · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Add style too and tiny refactor

a19ff82gmorpheme8 years ago

c/helper.c+16−2

compare with master

unifiedsplit

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

128 return e->data.sequence_start.anchor;

129}

130

131+int get_sequence_start_style(yaml_event_t *e)

132+{

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

134+}

135+

131unsigned char * get_sequence_start_tag(yaml_event_t *e)

136unsigned char * get_sequence_start_tag(yaml_event_t *e)

132{

137{

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;

134}

141}

135

142

136unsigned long get_sequence_start_tag_len(yaml_event_t *e)

143unsigned long get_sequence_start_tag_len(yaml_event_t *e)

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

143 return e->data.mapping_start.anchor;

150 return e->data.mapping_start.anchor;

144}

151}

145

152

153+int get_mapping_start_style(yaml_event_t *e)

154+{

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

156+}

157+

146unsigned char * get_mapping_start_tag(yaml_event_t *e)

158unsigned char * get_mapping_start_tag(yaml_event_t *e)

147{

159{

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;

149}

163}

150

164

151unsigned long get_mapping_start_tag_len(yaml_event_t *e)

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

35unsigned long get_mapping_start_tag_len(yaml_event_t *e);

37int 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);

39unsigned char * get_scalar_anchor(yaml_event_t *e);

41unsigned char * get_scalar_anchor(yaml_event_t *e);

40unsigned char * get_sequence_start_anchor(yaml_event_t *e);

42unsigned 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

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

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

134objToEvents' (Array list) rest =

135− EventSequenceStart NoTag Nothing

135+ EventSequenceStart NoTag Any Nothing

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

137objToEvents' (Object pairs) rest =

138− EventMappingStart NoTag Nothing

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

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

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

64mapping pairs = YamlBuilder $ \rest ->

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

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

66 where

67 addPair (key, YamlBuilder value) after

68 = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing

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

71array :: [YamlBuilder] -> YamlBuilder

72array bs =

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

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

74 where

75 go (YamlBuilder b) = b

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

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

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

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

165+ go (EventSequenceStart _tag _style mname) = do

166 vals <- goS id

167 let val = Sequence vals mname

168 tell' mname val

169− go (EventMappingStart _tag mname) = do

169+ go (EventMappingStart _tag _style mname) = do

170 pairs <- goM id

171 let val = Mapping pairs mname

172 tell' mname val

src/Text/Libyaml.hs+54−59

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

62 | EventDocumentEnd

63 | EventAlias !AnchorName

64 | EventScalar !ByteString !Tag !Style !Anchor

65− | EventSequenceStart !Tag !Anchor

65+ | EventSequenceStart !Tag !Style !Anchor

66 | EventSequenceEnd

67− | EventMappingStart !Tag !Anchor

67+ | EventMappingStart !Tag !Style !Anchor

68 | EventMappingEnd

69 deriving (Show, Eq)

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

233+ c_get_sequence_start_style :: EventRaw -> IO CInt

234+

232foreign import ccall unsafe "get_sequence_start_tag"

235foreign 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)

234

237

235foreign import ccall unsafe "get_sequence_start_tag_len"

238foreign import ccall unsafe "get_sequence_start_tag_len"

236 c_get_sequence_start_tag_len :: EventRaw -> IO CULong

239 c_get_sequence_start_tag_len :: EventRaw -> IO CULong

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

238foreign import ccall unsafe "get_mapping_start_anchor"

241foreign import ccall unsafe "get_mapping_start_anchor"

239 c_get_mapping_start_anchor :: EventRaw -> IO CString

242 c_get_mapping_start_anchor :: EventRaw -> IO CString

240

243

244+foreign import ccall unsafe "get_mapping_start_style"

245+ c_get_mapping_start_style :: EventRaw -> IO CInt

246+

241foreign import ccall unsafe "get_mapping_start_tag"

247foreign 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)

243

249

244foreign import ccall unsafe "get_mapping_start_tag_len"

250foreign import ccall unsafe "get_mapping_start_tag_len"

245 c_get_mapping_start_tag_len :: EventRaw -> IO CULong

251 c_get_mapping_start_tag_len :: EventRaw -> IO CULong

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

247foreign import ccall unsafe "get_alias_anchor"

253foreign import ccall unsafe "get_alias_anchor"

248 c_get_alias_anchor :: EventRaw -> IO CString

254 c_get_alias_anchor :: EventRaw -> IO CString

249

255

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+

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

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

251getEvent er = do

281getEvent er = do

252 et <- c_get_event_type er

282 et <- c_get_event_type er

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

265 YamlScalarEvent -> do

295 YamlScalarEvent -> do

266 yvalue <- c_get_scalar_value er

296 yvalue <- c_get_scalar_value er

267 ylen <- c_get_scalar_length er

297 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

272 let yvalue' = castPtr yvalue

298 let yvalue' = castPtr yvalue

273− let ytag' = castPtr ytag

274 let ylen' = fromEnum ylen

299 let ylen' = fromEnum ylen

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

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

276− tagbs <-

301+ tag <- readTag c_get_scalar_tag c_get_scalar_tag_len er

277− if ytag_len' == 0

302+ style <- readStyle c_get_scalar_style er

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

303+ anchor <- readAnchor 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

304+ return $ Just $ EventScalar bs tag style anchor

286 YamlSequenceStartEvent -> do

305 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

306+ tag <- readTag c_get_sequence_start_tag c_get_sequence_start_tag_len er

296− let ytag' = castPtr ytag

307+ style <- readStyle c_get_sequence_start_style er

297− let ytag_len' = fromEnum ytag_len

308+ anchor <- readAnchor c_get_sequence_start_anchor er

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

309+ return $ Just $ EventSequenceStart tag style anchor

303 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

310 YamlSequenceEndEvent -> return $ Just EventSequenceEnd

304 YamlMappingStartEvent -> do

311 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

312+ tag <- readTag c_get_mapping_start_tag c_get_mapping_start_tag_len er

314− let ytag' = castPtr ytag

313+ style <- readStyle c_get_mapping_start_style er

315− let ytag_len' = fromEnum ytag_len

314+ anchor <- readAnchor c_get_mapping_start_anchor er

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

315+ return $ Just $ EventMappingStart tag style anchor

321 YamlMappingEndEvent -> return $ Just EventMappingEnd

316 YamlMappingEndEvent -> return $ Just EventMappingEnd

322

317

323-- Emitter

318-- Emitter

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

464 0 -- plain_implicit

459 0 -- plain_implicit

465 qi -- quoted_implicit

460 qi -- quoted_implicit

466 style' -- style

461 style' -- style

467− EventSequenceStart tag Nothing ->

462+ EventSequenceStart tag style Nothing ->

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

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

469 let tagP = castPtr tag'

464 let tagP = castPtr tag'

470 c_yaml_sequence_start_event_initialize

465 c_yaml_sequence_start_event_initialize

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

472 nullPtr

467 nullPtr

473 tagP

468 tagP

474 1

469 1

475− 0 -- YAML_ANY_SEQUENCE_STYLE

470+ (toEnum $ fromEnum style)

476− EventSequenceStart tag (Just anchor) ->

471+ EventSequenceStart tag style (Just anchor) ->

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

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

478 let tagP = castPtr tag'

473 let tagP = castPtr tag'

479 withCString anchor $ \anchor' -> do

474 withCString anchor $ \anchor' -> do

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

483 anchorP

478 anchorP

484 tagP

479 tagP

485 1

480 1

486− 0 -- YAML_ANY_SEQUENCE_STYLE

481+ (toEnum $ fromEnum style)

487 EventSequenceEnd ->

482 EventSequenceEnd ->

488 c_yaml_sequence_end_event_initialize er

483 c_yaml_sequence_end_event_initialize er

489− EventMappingStart tag Nothing ->

484+ EventMappingStart tag style Nothing ->

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

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

491 let tagP = castPtr tag'

486 let tagP = castPtr tag'

492 c_yaml_mapping_start_event_initialize

487 c_yaml_mapping_start_event_initialize

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

494 nullPtr

489 nullPtr

495 tagP

490 tagP

496 1

491 1

497− 0 -- YAML_ANY_SEQUENCE_STYLE

492+ (toEnum $ fromEnum style)

498− EventMappingStart tag (Just anchor) ->

493+ EventMappingStart tag style (Just anchor) ->

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

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

500 withCString anchor $ \anchor' -> do

495 withCString anchor $ \anchor' -> do

501 let tagP = castPtr tag'

496 let tagP = castPtr tag'

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

505 anchorP

500 anchorP

506 tagP

501 tagP

507 1

502 1

508− 0 -- YAML_ANY_SEQUENCE_STYLE

503+ (toEnum $ fromEnum style)

509 EventMappingEnd ->

504 EventMappingEnd ->

510 c_yaml_mapping_end_event_initialize er

505 c_yaml_mapping_end_event_initialize er

511 EventAlias anchor ->

506 EventAlias anchor ->

test/Data/YamlSpec.hs+4−4

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

232 caseHelper yamlString isSequenceStartA 1

233 where

234 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

236 isSequenceStartA _ = False

237

238caseCountMappingsWithAnchor :: Assertion

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

240 caseHelper yamlString isMappingA 1

241 where

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

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

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

244 isMappingA _ = False

245

246caseCountAliases :: Assertion

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

256 caseHelper yamlString isCustomTaggedMapping 1

257 where

258 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

260 isCustomTaggedMapping _ = False

261

262caseCountSequenceTags :: Assertion

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

264 caseHelper yamlString isCustomTaggedSequence 1

265 where

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

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

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

268 isCustomTaggedSequence _ = False

269

270caseCountScalars :: Assertion