git.iko.soy/typeable/yaml
on master help sign in
Switch to option function for deciding render
3ca60fegmorpheme
libyaml/src/Text/Libyaml.hs+33−30
compare with master
unifiedsplit
@@ -32,8 +32,10 @@ module Text.Libyaml
32 , FormatOptions
32 , FormatOptions
33 , defaultFormatOptions
33 , defaultFormatOptions
34 , setWidth
34 , setWidth
35− , setMappingTagsExplicit
35+ , setCollectionTagRendering
36− , setSequenceTagsExplicit
36+ , renderNone
37+ , renderAll
38+ , renderUriTags
37 -- * Error handling
39 -- * Error handling
38 , YamlException (..)
40 , YamlException (..)
39 , YamlMark (..)
41 , YamlMark (..)
@@ -504,7 +506,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do
504 er
506 er
505 nullPtr
507 nullPtr
506 tagP
508 tagP
507− (seqTagImplicit tag)
509+ (implicit e)
508 (toEnum $ fromEnum style)
510 (toEnum $ fromEnum style)
509 EventSequenceStart tag style (Just anchor) ->
511 EventSequenceStart tag style (Just anchor) ->
510 withCString (tagToString tag) $ \tag' -> do
512 withCString (tagToString tag) $ \tag' -> do
@@ -515,7 +517,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do
515 er
517 er
516 anchorP
518 anchorP
517 tagP
519 tagP
518− (seqTagImplicit tag)
520+ (implicit e)
519 (toEnum $ fromEnum style)
521 (toEnum $ fromEnum style)
520 EventSequenceEnd ->
522 EventSequenceEnd ->
521 c_yaml_sequence_end_event_initialize er
523 c_yaml_sequence_end_event_initialize er
@@ -526,7 +528,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do
526 er
528 er
527 nullPtr
529 nullPtr
528 tagP
530 tagP
529− (mapTagImplicit tag)
531+ (implicit e)
530 (toEnum $ fromEnum style)
532 (toEnum $ fromEnum style)
531 EventMappingStart tag style (Just anchor) ->
533 EventMappingStart tag style (Just anchor) ->
532 withCString (tagToString tag) $ \tag' -> do
534 withCString (tagToString tag) $ \tag' -> do
@@ -537,7 +539,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do
537 er
539 er
538 anchorP
540 anchorP
539 tagP
541 tagP
540− (mapTagImplicit tag)
542+ (implicit e)
541 (toEnum $ fromEnum style)
543 (toEnum $ fromEnum style)
542 EventMappingEnd ->
544 EventMappingEnd ->
543 c_yaml_mapping_end_event_initialize er
545 c_yaml_mapping_end_event_initialize er
@@ -550,10 +552,9 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do
550 unless (ret == 1) $ throwIO $ ToEventRawException ret
552 unless (ret == 1) $ throwIO $ ToEventRawException ret
551 f er
553 f er
552 where
554 where
553− mapTagImplicit NoTag = 1
555+ implicit (EventSequenceStart NoTag _ _) = 1
554− mapTagImplicit _ = if formatOptionsExplicitMappingTags opts then 0 else 1
556+ implicit (EventMappingStart NoTag _ _) = 1
555− seqTagImplicit NoTag = 1
557+ implicit e = toEnum $ fromEnum $ formatOptionsRenderCollectionTags opts e
556− seqTagImplicit _ = if formatOptionsExplicitSequenceTags opts then 0 else 1
557
558
558newtype ToEventRawException = ToEventRawException CInt
559newtype ToEventRawException = ToEventRawException CInt
559 deriving (Show, Typeable)
560 deriving (Show, Typeable)
@@ -670,13 +671,28 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do
670 return $ Left $ YamlParseException problem context problemMark
671 return $ Left $ YamlParseException problem context problemMark
671 else Right <$> getEvent er
672 else Right <$> getEvent er
672
673
674+
675+data TagRender = Explicit | Implicit
676+ deriving (Enum)
677+
678+renderNone :: Event -> TagRender
679+renderNone _ = Implicit
680+
681+renderAll :: Event -> TagRender
682+renderAll _ = Explicit
683+
684+renderUriTags :: Event -> TagRender
685+renderUriTags (EventScalar _ UriTag{} _ _) = Explicit
686+renderUriTags (EventSequenceStart UriTag{} _ _) = Explicit
687+renderUriTags (EventMappingStart UriTag{} _ _) = Explicit
688+renderUriTags _ = Implicit
689+
673-- | Contains options relating to the formatting (indendation, width) of the YAML output.
690-- | Contains options relating to the formatting (indendation, width) of the YAML output.
674--
691--
675-- @since 0.10.2.0
692-- @since 0.10.2.0
676data FormatOptions = FormatOptions
693data FormatOptions = FormatOptions
677 { formatOptionsWidth :: Maybe Int
694 { formatOptionsWidth :: Maybe Int
678− , formatOptionsExplicitMappingTags :: Bool
695+ , formatOptionsRenderCollectionTags :: Event -> TagRender
679− , formatOptionsExplicitSequenceTags :: Bool
680 }
696 }
681
697
682-- |
698-- |
@@ -684,8 +700,7 @@ data FormatOptions = FormatOptions
684defaultFormatOptions :: FormatOptions
700defaultFormatOptions :: FormatOptions
685defaultFormatOptions = FormatOptions
701defaultFormatOptions = FormatOptions
686 { formatOptionsWidth = Just 80 -- by default the width is set to 0 in the C code, which gets turned into 80 in yaml_emitter_emit_stream_start
702 { formatOptionsWidth = Just 80 -- by default the width is set to 0 in the C code, which gets turned into 80 in yaml_emitter_emit_stream_start
687− , formatOptionsExplicitMappingTags = False
703+ , formatOptionsRenderCollectionTags = renderNone
688− , formatOptionsExplicitSequenceTags = False
689 }
704 }
690
705
691-- | Set the maximum number of columns in the YAML output, or 'Nothing' for infinite. By default, the limit is 80 characters.
706-- | Set the maximum number of columns in the YAML output, or 'Nothing' for infinite. By default, the limit is 80 characters.
@@ -694,23 +709,11 @@ defaultFormatOptions = FormatOptions
694setWidth :: Maybe Int -> FormatOptions -> FormatOptions
709setWidth :: Maybe Int -> FormatOptions -> FormatOptions
695setWidth w opts = opts { formatOptionsWidth = w }
710setWidth w opts = opts { formatOptionsWidth = w }
696
711
697−-- | Set the control of mapping tags to "explicit"
712+-- | Control when and whether collection tags are rendered to output.
698−--
699−-- This means that tags on mappings (even the default 'mapTag') will
700−-- be rendered out. To inhibit, set the tag to `NoTag` instead.
701−--
702−-- @since 0.11.0.0
703−setMappingTagsExplicit :: Bool -> FormatOptions -> FormatOptions
704−setMappingTagsExplicit f opts = opts { formatOptionsExplicitMappingTags = f }
705−
706−-- | Set the control of mapping@ tags to "explicit"
707−--
708−-- This means that tags on mappings (even the default 'seqTag') will
709−-- be rendered out. To inhibit, set the tag to `NoTag` instead.
710--
713--
711−-- @since 0.11.0.0
714+-- @since 0.11.1.0
712−setSequenceTagsExplicit :: Bool -> FormatOptions -> FormatOptions
715+setCollectionTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions
713−setSequenceTagsExplicit f opts = opts { formatOptionsExplicitSequenceTags = f }
716+setCollectionTagRendering f opts = opts { formatOptionsRenderCollectionTags = f }
714
717
715encode :: MonadResource m => ConduitM Event o m ByteString
718encode :: MonadResource m => ConduitM Event o m ByteString
716encode = encodeWith defaultFormatOptions
719encode = encodeWith defaultFormatOptions
yaml/test/Data/YamlSpec.hs+94−66
@@ -73,9 +73,18 @@ shouldEmitWithTagsOn es expected = do
73 events =
73 events =
74 [Y.EventStreamStart, Y.EventDocumentStart] ++
74 [Y.EventStreamStart, Y.EventDocumentStart] ++
75 es ++ [Y.EventDocumentEnd, Y.EventStreamEnd]
75 es ++ [Y.EventDocumentEnd, Y.EventStreamEnd]
76− opts =
76+ opts = Y.setCollectionTagRendering Y.renderAll $ Y.defaultFormatOptions
77− Y.setMappingTagsExplicit True $
77+
78− Y.setSequenceTagsExplicit True $ Y.defaultFormatOptions
78+shouldEmitWithUriTagsOn :: [Y.Event] -> BS.ByteString -> IO ()
79+shouldEmitWithUriTagsOn es expected = do
80+ actual <- runConduitRes (CL.sourceList events .| Y.encodeWith opts)
81+ actual `shouldBe` expected
82+ where
83+ events =
84+ [Y.EventStreamStart, Y.EventDocumentStart] ++
85+ es ++ [Y.EventDocumentEnd, Y.EventStreamEnd]
86+ opts = Y.setCollectionTagRendering Y.renderUriTags $ Y.defaultFormatOptions
87+
79
88
80main :: IO ()
89main :: IO ()
81main = hspec spec
90main = hspec spec
@@ -227,85 +236,57 @@ spec = do
227 go "12.3015e+02" (1230.15 :: Scientific)
236 go "12.3015e+02" (1230.15 :: Scientific)
228 go "1230.15" (1230.15 :: Scientific)
237 go "1230.15" (1230.15 :: Scientific)
229
238
230− describe "Text.Libyaml with mapping and sequence tags off" $ do
239+ describe "Text.Libyaml with collection tags off" $ do
231 it "elides custom sequence tags" $
240 it "elides custom sequence tags" $
232− [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing
233− , Y.EventSequenceEnd
234− ] `shouldEmit` "[]\n"
241+ taggedSequence `shouldEmit` "[]\n"
235 it "elides custom mapping tags" $
242 it "elides custom mapping tags" $
236− [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
237− , Y.EventMappingEnd
238− ] `shouldEmit` "{}\n"
243+ taggedMapping `shouldEmit` "{}\n"
239 it "elides default sequence tags" $
244 it "elides default sequence tags" $
240− [ Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing
241− , Y.EventSequenceEnd
242− ] `shouldEmit` "[]\n"
245+ defaultTaggedSequence `shouldEmit` "[]\n"
243 it "elides default mapping tags" $
246 it "elides default mapping tags" $
244− [ Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing
245− , Y.EventMappingEnd
246− ] `shouldEmit` "{}\n"
247+ defaultTaggedMapping `shouldEmit` "{}\n"
247 it "handles NoTag on sequences" $
248 it "handles NoTag on sequences" $
248− [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing
249− , Y.EventSequenceEnd
250− ] `shouldEmit` "[]\n"
249+ untaggedSequence `shouldEmit` "[]\n"
251 it "handles NoTag on mappings" $
250 it "handles NoTag on mappings" $
252− [ Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing
253− , Y.EventMappingEnd
254− ] `shouldEmit` "{}\n"
251+ untaggedMapping `shouldEmit` "{}\n"
255 it "handles mixed tag usages but elides all mapping and sequence tags" $
252 it "handles mixed tag usages but elides all mapping and sequence tags" $
256− [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing
257− , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
258− , Y.EventMappingEnd
259− , Y.EventSequenceEnd
260− ] `shouldEmit` "- {}\n"
253+ mixedTagSampleA `shouldEmit` "- {}\n"
261 it "in combination of tags, anchors and styles, outputs only the scalar tags" $
254 it "in combination of tags, anchors and styles, outputs only the scalar tags" $
262− [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a")
263− , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b")
264− , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c")
265− , Y.EventScalar "" Y.NullTag Y.Plain (Just "d")
266− , Y.EventSequenceEnd
267− , Y.EventMappingEnd
268− ] `shouldEmit` "&a\n&b !<bar> foo: &c [&d !!null '']\n"
255+ mixedTagSampleB `shouldEmit` "&a\n&b !<bar> foo: &c [&d !!null '']\n"
269− describe "Text.Libyaml with mapping and sequence tags on" $ do
256+ describe "Text.Libyaml with collection tags on" $ do
270 it "will output custom sequence tags" $
257 it "will output custom sequence tags" $
271− [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing
272− , Y.EventSequenceEnd
273− ] `shouldEmitWithTagsOn` "!foo []\n"
258+ taggedSequence `shouldEmitWithTagsOn` "!foo []\n"
274 it "will output custom mapping tags" $
259 it "will output custom mapping tags" $
275− [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
276− , Y.EventMappingEnd
277− ] `shouldEmitWithTagsOn` "!foo {}\n"
260+ taggedMapping `shouldEmitWithTagsOn` "!foo {}\n"
278 it "will output default sequence tags" $
261 it "will output default sequence tags" $
279− [ Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing
280− , Y.EventSequenceEnd
281− ] `shouldEmitWithTagsOn` "!!seq []\n"
262+ defaultTaggedSequence `shouldEmitWithTagsOn` "!!seq []\n"
282 it "will output default mapping tags" $
263 it "will output default mapping tags" $
283− [ Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing
284− , Y.EventMappingEnd
285− ] `shouldEmitWithTagsOn` "!!map {}\n"
264+ defaultTaggedMapping `shouldEmitWithTagsOn` "!!map {}\n"
286 it "handles NoTag on sequences" $
265 it "handles NoTag on sequences" $
287− [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing
288− , Y.EventSequenceEnd
289− ] `shouldEmitWithTagsOn` "[]\n"
266+ untaggedSequence `shouldEmitWithTagsOn` "[]\n"
290 it "handles NoTag on mappings" $
267 it "handles NoTag on mappings" $
291− [ Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing
292− , Y.EventMappingEnd
293− ] `shouldEmitWithTagsOn` "{}\n"
268+ untaggedMapping `shouldEmitWithTagsOn` "{}\n"
294 it "handles mixed tag usages outputting all mapping and sequence tags" $
269 it "handles mixed tag usages outputting all mapping and sequence tags" $
295− [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing
296− , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
297− , Y.EventMappingEnd
298− , Y.EventSequenceEnd
299− ] `shouldEmitWithTagsOn` "- !foo {}\n"
270+ mixedTagSampleA `shouldEmitWithTagsOn` "- !foo {}\n"
300 it "in combination of tags, anchors and styles, outputs all the tags" $
271 it "in combination of tags, anchors and styles, outputs all the tags" $
301− [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a")
302− , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b")
303− , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c")
304− , Y.EventScalar "" Y.NullTag Y.Plain (Just "d")
305− , Y.EventSequenceEnd
306− , Y.EventMappingEnd
307− ] `shouldEmitWithTagsOn` "&a\n&b !<bar> foo: &c !baz [&d !!null '']\n"
272+ mixedTagSampleB `shouldEmitWithTagsOn` "&a\n&b !<bar> foo: &c !baz [&d !!null '']\n"
308−
273+ describe "Text.Libyaml with collection uri tags on" $ do
274+ it "will output custom sequence tags" $
275+ taggedSequence `shouldEmitWithUriTagsOn` "!foo []\n"
276+ it "will output custom mapping tags" $
277+ taggedMapping `shouldEmitWithUriTagsOn` "!foo {}\n"
278+ it "will output default sequence tags" $
279+ defaultTaggedSequence `shouldEmitWithUriTagsOn` "[]\n"
280+ it "will output default mapping tags" $
281+ defaultTaggedMapping `shouldEmitWithUriTagsOn` "{}\n"
282+ it "handles NoTag on sequences" $
283+ untaggedSequence `shouldEmitWithUriTagsOn` "[]\n"
284+ it "handles NoTag on mappings" $
285+ untaggedMapping `shouldEmitWithUriTagsOn` "{}\n"
286+ it "handles mixed tag usages outputting all mapping and sequence tags" $
287+ mixedTagSampleA `shouldEmitWithUriTagsOn` "- !foo {}\n"
288+ it "in combination of tags, anchors and styles, outputs all the tags" $
289+ mixedTagSampleB `shouldEmitWithUriTagsOn` "&a\n&b !<bar> foo: &c !baz [&d !!null '']\n"
309
290
310specialStrings :: [T.Text]
291specialStrings :: [T.Text]
311specialStrings =
292specialStrings =
@@ -724,3 +705,50 @@ caseTruncatesFiles = withSystemTempFile "truncate.yaml" $ \fp h -> do
724 D.encodeFile fp val
705 D.encodeFile fp val
725 res <- D.decodeFileEither fp
706 res <- D.decodeFileEither fp
726 either (Left . show) Right res `shouldBe` Right val
707 either (Left . show) Right res `shouldBe` Right val
708+
709+
710+taggedSequence :: [Y.Event]
711+taggedSequence =
712+ [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing
713+ , Y.EventSequenceEnd
714+ ]
715+
716+taggedMapping :: [Y.Event]
717+taggedMapping =
718+ [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
719+ , Y.EventMappingEnd
720+ ]
721+
722+defaultTaggedSequence :: [Y.Event]
723+defaultTaggedSequence =
724+ [Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing, Y.EventSequenceEnd]
725+
726+defaultTaggedMapping :: [Y.Event]
727+defaultTaggedMapping =
728+ [Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing, Y.EventMappingEnd]
729+
730+untaggedSequence :: [Y.Event]
731+untaggedSequence =
732+ [Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing, Y.EventSequenceEnd]
733+
734+untaggedMapping :: [Y.Event]
735+untaggedMapping =
736+ [Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing, Y.EventMappingEnd]
737+
738+mixedTagSampleA :: [Y.Event]
739+mixedTagSampleA =
740+ [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing
741+ , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
742+ , Y.EventMappingEnd
743+ , Y.EventSequenceEnd
744+ ]
745+
746+mixedTagSampleB :: [Y.Event]
747+mixedTagSampleB =
748+ [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a")
749+ , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b")
750+ , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c")
751+ , Y.EventScalar "" Y.NullTag Y.Plain (Just "d")
752+ , Y.EventSequenceEnd
753+ , Y.EventMappingEnd
754+ ]