git.iko.soy/typeable/yaml
on master help sign in
Test we distinguish flow / block styles.

And added separate sequence and mapping style enums.

commit12c24b6ad9547b727a7d489ddbb9c39afeeb049a authorgmorpheme <github@gmorpheme.net> dateMon 9 Jul 2018, 22:46 (8 years ago) parenta19ff82
4 files changed+51−7
compare with master
unifiedsplit
src/Data/Yaml.hs+2−2 src/Data/Yaml/Builder.hs+2−2 src/Text/Libyaml.hs+11−3 test/Data/YamlSpec.hs+36
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 Any Nothing
135+ EventSequenceStart NoTag AnySequence Nothing
136136 : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)
137137objToEvents' (Object pairs) rest =
138− EventMappingStart NoTag Any Nothing
138+ EventMappingStart NoTag AnyMapping 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 NoTag Any Nothing : foldr addPair (EventMappingEnd : rest) pairs
65+ EventMappingStart NoTag AnyMapping 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 Any Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)
73+ YamlBuilder $ (EventSequenceStart NoTag AnySequence Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)
7474 where
7575 go (YamlBuilder b) = b
7676
src/Text/Libyaml.hs+11−3
@@ -14,6 +14,8 @@ module Text.Libyaml
1414 ( -- * The event stream
1515 Event (..)
1616 , Style (..)
17+ , SequenceStyle (..)
18+ , MappingStyle (..)
1719 , Tag (..)
1820 , AnchorName
1921 , Anchor
@@ -62,9 +64,9 @@ data Event =
6264 | EventDocumentEnd
6365 | EventAlias !AnchorName
6466 | EventScalar !ByteString !Tag !Style !Anchor
65− | EventSequenceStart !Tag !Style !Anchor
67+ | EventSequenceStart !Tag !SequenceStyle !Anchor
6668 | EventSequenceEnd
67− | EventMappingStart !Tag !Style !Anchor
69+ | EventMappingStart !Tag !MappingStyle !Anchor
6870 | EventMappingEnd
6971 deriving (Show, Eq)
7072
@@ -77,6 +79,12 @@ data Style = Any
7779 | PlainNoTag
7880 deriving (Show, Read, Eq, Enum, Bounded, Ord, Data, Typeable)
7981
82+data SequenceStyle = AnySequence | BlockSequence | FlowSequence
83+ deriving (Show, Eq, Enum, Bounded, Ord, Data, Typeable)
84+
85+data MappingStyle = AnyMapping | BlockMapping | FlowMapping
86+ deriving (Show, Eq, Enum, Bounded, Ord, Data, Typeable)
87+
8088data Tag = StrTag
8189 | FloatTag
8290 | NullTag
@@ -260,7 +268,7 @@ readAnchor getAnchor er = do
260268 then return Nothing
261269 else Just <$> peekCString yanchor
262270
263−readStyle :: (EventRaw -> IO CInt) -> (EventRaw -> IO Style)
271+readStyle :: (Enum a) => (EventRaw -> IO CInt) -> (EventRaw -> IO a)
264272readStyle getStyle er = do
265273 ystyle <- getStyle er
266274 return $ toEnum $ fromEnum ystyle
test/Data/YamlSpec.hs+36
@@ -65,6 +65,10 @@ spec = do
6565 it "count mappings with anchor" caseCountMappingsWithAnchor
6666 it "count sequences with custom tag" caseCountSequenceTags
6767 it "count mappings with custom tag" caseCountMappingTags
68+ it "count block style sequences" caseCountBlockStyleSequences
69+ it "count flow style sequences" caseCountFlowStyleSequences
70+ it "count block style mappings" caseCountBlockStyleMappings
71+ it "count flow style mappings" caseCountFlowStyleMappings
6872 it "count aliases" caseCountAliases
6973 it "count scalars" caseCountScalars
7074 it "largest string" caseLargestString
@@ -267,6 +271,38 @@ caseCountSequenceTags =
267271 isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!bar") _ _) = True
268272 isCustomTaggedSequence _ = False
269273
274+caseCountFlowStyleSequences :: Assertion
275+caseCountFlowStyleSequences =
276+ caseHelper yamlString isFlowStyleSequence 1
277+ where
278+ yamlString = "foo: [x, y, z]"
279+ isFlowStyleSequence (Y.EventSequenceStart _ Y.FlowSequence _) = True
280+ isFlowStyleSequence _ = False
281+
282+caseCountBlockStyleSequences :: Assertion
283+caseCountBlockStyleSequences =
284+ caseHelper yamlString isBlockStyleSequence 1
285+ where
286+ yamlString = "foo:\n- x\n- y\n- z\n"
287+ isBlockStyleSequence (Y.EventSequenceStart _ Y.BlockSequence _) = True
288+ isBlockStyleSequence _ = False
289+
290+caseCountFlowStyleMappings :: Assertion
291+caseCountFlowStyleMappings =
292+ caseHelper yamlString isFlowStyleMapping 1
293+ where
294+ yamlString = "foo: { bar: 1, baz: 2 }"
295+ isFlowStyleMapping (Y.EventMappingStart _ Y.FlowMapping _) = True
296+ isFlowStyleMapping _ = False
297+
298+caseCountBlockStyleMappings :: Assertion
299+caseCountBlockStyleMappings =
300+ caseHelper yamlString isBlockStyleMapping 1
301+ where
302+ yamlString = "foo: bar\nbaz: quux"
303+ isBlockStyleMapping (Y.EventMappingStart _ Y.BlockMapping _) = True
304+ isBlockStyleMapping _ = False
305+
270306caseCountScalars :: Assertion
271307caseCountScalars = do
272308 res <- runConduitRes $ Y.decode yamlBS .| CL.fold adder accum