From 3176947c25ddfbe728fc4d700b74732a5e2f20b1 Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Thu, 31 Jan 2019 15:27:26 +0000 Subject: [PATCH 1/9] Add map/seq explicit tags setting to FormatOptions. --- libyaml/src/Text/Libyaml.hs | 189 ++++++++++++++++++------------------ 1 file changed, 96 insertions(+), 93 deletions(-) diff --git a/libyaml/src/Text/Libyaml.hs b/libyaml/src/Text/Libyaml.hs index 752dce0..671fcc6 100644 --- a/libyaml/src/Text/Libyaml.hs +++ b/libyaml/src/Text/Libyaml.hs @@ -446,107 +446,106 @@ foreign import ccall unsafe "yaml_alias_event_initialize" -> Ptr CUChar -> IO CInt -toEventRaw :: Event -> (EventRaw -> IO a) -> IO a -toEventRaw e f = allocaBytes eventSize $ \er -> do - ret <- case e of +toEventRaw :: FormatOptions -> Event -> (EventRaw -> IO a) -> IO a +toEventRaw opts e f = + allocaBytes eventSize $ \er -> do + ret <- + case e of EventStreamStart -> - c_yaml_stream_start_event_initialize - er - 0 -- YAML_ANY_ENCODING - EventStreamEnd -> - c_yaml_stream_end_event_initialize er - EventDocumentStart -> - c_simple_document_start er - EventDocumentEnd -> - c_yaml_document_end_event_initialize er 1 + c_yaml_stream_start_event_initialize er 0 -- YAML_ANY_ENCODING + EventStreamEnd -> c_yaml_stream_end_event_initialize er + EventDocumentStart -> c_simple_document_start er + EventDocumentEnd -> c_yaml_document_end_event_initialize er 1 EventScalar bs thetag style0 anchor -> do - BU.unsafeUseAsCStringLen bs $ \(value, len) -> do - let value' = castPtr value :: Ptr CUChar - len' = fromIntegral len :: CInt - let thetag' = tagToString thetag - withCString thetag' $ \tag' -> do - let (pi, style) = - case style0 of - PlainNoTag -> (1, Plain) - x -> (0, x) - style' = toEnum $ fromEnum style - tagP = castPtr tag' - qi = if null thetag' then 1 else 0 - case anchor of - Nothing -> - c_yaml_scalar_event_initialize - er - nullPtr -- anchor - tagP -- tag - value' -- value - len' -- length - pi -- plain_implicit - qi -- quoted_implicit - style' -- style - Just anchor' -> - withCString anchor' $ \anchorP' -> do - let anchorP = castPtr anchorP' - c_yaml_scalar_event_initialize - er - anchorP -- anchor - tagP -- tag - value' -- value - len' -- length - 0 -- plain_implicit - qi -- quoted_implicit - style' -- style + BU.unsafeUseAsCStringLen bs $ \(value, len) -> do + let value' = castPtr value :: Ptr CUChar + len' = fromIntegral len :: CInt + let thetag' = tagToString thetag + withCString thetag' $ \tag' -> do + let (pi, style) = + case style0 of + PlainNoTag -> (1, Plain) + x -> (0, x) + style' = toEnum $ fromEnum style + tagP = castPtr tag' + qi = + if null thetag' + then 1 + else 0 + case anchor of + Nothing -> + c_yaml_scalar_event_initialize + er + nullPtr -- anchor + tagP -- tag + value' -- value + len' -- length + pi -- plain_implicit + qi -- quoted_implicit + style' -- style + Just anchor' -> + withCString anchor' $ \anchorP' -> do + let anchorP = castPtr anchorP' + c_yaml_scalar_event_initialize + er + anchorP -- anchor + tagP -- tag + value' -- value + len' -- length + 0 -- plain_implicit + qi -- quoted_implicit + style' -- style EventSequenceStart tag style Nothing -> - withCString (tagToString tag) $ \tag' -> do - let tagP = castPtr tag' - c_yaml_sequence_start_event_initialize - er - nullPtr - tagP - 1 - (toEnum $ fromEnum style) + withCString (tagToString tag) $ \tag' -> do + let tagP = castPtr tag' + c_yaml_sequence_start_event_initialize + er + nullPtr + tagP + seqTagsImplicit + (toEnum $ fromEnum style) EventSequenceStart tag style (Just anchor) -> - withCString (tagToString tag) $ \tag' -> do - let tagP = castPtr tag' - withCString anchor $ \anchor' -> do - let anchorP = castPtr anchor' - c_yaml_sequence_start_event_initialize - er - anchorP - tagP - 1 - (toEnum $ fromEnum style) - EventSequenceEnd -> - c_yaml_sequence_end_event_initialize er + withCString (tagToString tag) $ \tag' -> do + let tagP = castPtr tag' + withCString anchor $ \anchor' -> do + let anchorP = castPtr anchor' + c_yaml_sequence_start_event_initialize + er + anchorP + tagP + seqTagsImplicit + (toEnum $ fromEnum style) + EventSequenceEnd -> c_yaml_sequence_end_event_initialize er EventMappingStart tag style Nothing -> - withCString (tagToString tag) $ \tag' -> do - let tagP = castPtr tag' - c_yaml_mapping_start_event_initialize - er - nullPtr - tagP - 1 - (toEnum $ fromEnum style) + withCString (tagToString tag) $ \tag' -> do + let tagP = castPtr tag' + c_yaml_mapping_start_event_initialize + er + nullPtr + tagP + mapTagsImplicit + (toEnum $ fromEnum style) EventMappingStart tag style (Just anchor) -> - withCString (tagToString tag) $ \tag' -> do - withCString anchor $ \anchor' -> do - let tagP = castPtr tag' - let anchorP = castPtr anchor' - c_yaml_mapping_start_event_initialize - er - anchorP - tagP - 1 - (toEnum $ fromEnum style) - EventMappingEnd -> - c_yaml_mapping_end_event_initialize er + withCString (tagToString tag) $ \tag' -> do + withCString anchor $ \anchor' -> do + let tagP = castPtr tag' + let anchorP = castPtr anchor' + c_yaml_mapping_start_event_initialize + er + anchorP + tagP + mapTagsImplicit + (toEnum $ fromEnum style) + EventMappingEnd -> c_yaml_mapping_end_event_initialize er EventAlias anchor -> - withCString anchor $ \anchorP' -> do - let anchorP = castPtr anchorP' - c_yaml_alias_event_initialize - er - anchorP + withCString anchor $ \anchorP' -> do + let anchorP = castPtr anchorP' + c_yaml_alias_event_initialize er anchorP unless (ret == 1) $ throwIO $ ToEventRawException ret f er + where + mapTagsImplicit = if formatOptionsExplicitMappingTags opts then 0 else 1 + seqTagsImplicit = if formatOptionsExplicitSequenceTags opts then 0 else 1 newtype ToEventRawException = ToEventRawException CInt deriving (Show, Typeable) @@ -668,6 +667,8 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do -- @since 0.10.2.0 data FormatOptions = FormatOptions { formatOptionsWidth :: Maybe Int + , formatOptionsExplicitMappingTags :: Bool + , formatOptionsExplicitSequenceTags :: Bool } -- | @@ -675,6 +676,8 @@ data FormatOptions = FormatOptions defaultFormatOptions :: FormatOptions defaultFormatOptions = FormatOptions { 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 + , formatOptionsExplicitMappingTags = False + , formatOptionsExplicitSequenceTags = False } -- | Set the maximum number of columns in the YAML output, or 'Nothing' for infinite. By default, the limit is 80 characters. @@ -756,7 +759,7 @@ runEmitter opts allocI closeI = loop = await >>= maybe (close ()) push push e = do - _ <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter + _ <- liftIO $ toEventRaw opts e $ c_yaml_emitter_emit emitter loop close u = liftIO $ closeI u a From 71839beecf1a6ee51b74713080901c2c938660c8 Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Thu, 31 Jan 2019 16:12:53 +0000 Subject: [PATCH 2/9] Handle NoTag && explicit + lots of tests --- libyaml/src/Text/Libyaml.hs | 204 ++++++++++++++++++++---------------- yaml/test/Data/YamlSpec.hs | 102 ++++++++++++++++++ 2 files changed, 217 insertions(+), 89 deletions(-) diff --git a/libyaml/src/Text/Libyaml.hs b/libyaml/src/Text/Libyaml.hs index 671fcc6..937f1a2 100644 --- a/libyaml/src/Text/Libyaml.hs +++ b/libyaml/src/Text/Libyaml.hs @@ -32,6 +32,8 @@ module Text.Libyaml , FormatOptions , defaultFormatOptions , setWidth + , setMappingTagsExplicit + , setSequenceTagsExplicit -- * Error handling , YamlException (..) , YamlMark (..) @@ -447,105 +449,111 @@ foreign import ccall unsafe "yaml_alias_event_initialize" -> IO CInt toEventRaw :: FormatOptions -> Event -> (EventRaw -> IO a) -> IO a -toEventRaw opts e f = - allocaBytes eventSize $ \er -> do - ret <- - case e of +toEventRaw opts e f = allocaBytes eventSize $ \er -> do + ret <- case e of EventStreamStart -> - c_yaml_stream_start_event_initialize er 0 -- YAML_ANY_ENCODING - EventStreamEnd -> c_yaml_stream_end_event_initialize er - EventDocumentStart -> c_simple_document_start er - EventDocumentEnd -> c_yaml_document_end_event_initialize er 1 + c_yaml_stream_start_event_initialize + er + 0 -- YAML_ANY_ENCODING + EventStreamEnd -> + c_yaml_stream_end_event_initialize er + EventDocumentStart -> + c_simple_document_start er + EventDocumentEnd -> + c_yaml_document_end_event_initialize er 1 EventScalar bs thetag style0 anchor -> do - BU.unsafeUseAsCStringLen bs $ \(value, len) -> do - let value' = castPtr value :: Ptr CUChar - len' = fromIntegral len :: CInt - let thetag' = tagToString thetag - withCString thetag' $ \tag' -> do - let (pi, style) = - case style0 of - PlainNoTag -> (1, Plain) - x -> (0, x) - style' = toEnum $ fromEnum style - tagP = castPtr tag' - qi = - if null thetag' - then 1 - else 0 - case anchor of - Nothing -> - c_yaml_scalar_event_initialize - er - nullPtr -- anchor - tagP -- tag - value' -- value - len' -- length - pi -- plain_implicit - qi -- quoted_implicit - style' -- style - Just anchor' -> - withCString anchor' $ \anchorP' -> do - let anchorP = castPtr anchorP' - c_yaml_scalar_event_initialize - er - anchorP -- anchor - tagP -- tag - value' -- value - len' -- length - 0 -- plain_implicit - qi -- quoted_implicit - style' -- style + BU.unsafeUseAsCStringLen bs $ \(value, len) -> do + let value' = castPtr value :: Ptr CUChar + len' = fromIntegral len :: CInt + let thetag' = tagToString thetag + withCString thetag' $ \tag' -> do + let (pi, style) = + case style0 of + PlainNoTag -> (1, Plain) + x -> (0, x) + style' = toEnum $ fromEnum style + tagP = castPtr tag' + qi = if null thetag' then 1 else 0 + case anchor of + Nothing -> + c_yaml_scalar_event_initialize + er + nullPtr -- anchor + tagP -- tag + value' -- value + len' -- length + pi -- plain_implicit + qi -- quoted_implicit + style' -- style + Just anchor' -> + withCString anchor' $ \anchorP' -> do + let anchorP = castPtr anchorP' + c_yaml_scalar_event_initialize + er + anchorP -- anchor + tagP -- tag + value' -- value + len' -- length + 0 -- plain_implicit + qi -- quoted_implicit + style' -- style EventSequenceStart tag style Nothing -> - withCString (tagToString tag) $ \tag' -> do - let tagP = castPtr tag' - c_yaml_sequence_start_event_initialize - er - nullPtr - tagP - seqTagsImplicit - (toEnum $ fromEnum style) + withCString (tagToString tag) $ \tag' -> do + let tagP = castPtr tag' + c_yaml_sequence_start_event_initialize + er + nullPtr + tagP + (seqTagImplicit tag) + (toEnum $ fromEnum style) EventSequenceStart tag style (Just anchor) -> - withCString (tagToString tag) $ \tag' -> do - let tagP = castPtr tag' - withCString anchor $ \anchor' -> do - let anchorP = castPtr anchor' - c_yaml_sequence_start_event_initialize - er - anchorP - tagP - seqTagsImplicit - (toEnum $ fromEnum style) - EventSequenceEnd -> c_yaml_sequence_end_event_initialize er + withCString (tagToString tag) $ \tag' -> do + let tagP = castPtr tag' + withCString anchor $ \anchor' -> do + let anchorP = castPtr anchor' + c_yaml_sequence_start_event_initialize + er + anchorP + tagP + (seqTagImplicit tag) + (toEnum $ fromEnum style) + EventSequenceEnd -> + c_yaml_sequence_end_event_initialize er EventMappingStart tag style Nothing -> - withCString (tagToString tag) $ \tag' -> do - let tagP = castPtr tag' - c_yaml_mapping_start_event_initialize - er - nullPtr - tagP - mapTagsImplicit - (toEnum $ fromEnum style) + withCString (tagToString tag) $ \tag' -> do + let tagP = castPtr tag' + c_yaml_mapping_start_event_initialize + er + nullPtr + tagP + (mapTagImplicit tag) + (toEnum $ fromEnum style) EventMappingStart tag style (Just anchor) -> - withCString (tagToString tag) $ \tag' -> do - withCString anchor $ \anchor' -> do - let tagP = castPtr tag' - let anchorP = castPtr anchor' - c_yaml_mapping_start_event_initialize - er - anchorP - tagP - mapTagsImplicit - (toEnum $ fromEnum style) - EventMappingEnd -> c_yaml_mapping_end_event_initialize er + withCString (tagToString tag) $ \tag' -> do + withCString anchor $ \anchor' -> do + let tagP = castPtr tag' + let anchorP = castPtr anchor' + c_yaml_mapping_start_event_initialize + er + anchorP + tagP + (mapTagImplicit tag) + (toEnum $ fromEnum style) + EventMappingEnd -> + c_yaml_mapping_end_event_initialize er EventAlias anchor -> - withCString anchor $ \anchorP' -> do - let anchorP = castPtr anchorP' - c_yaml_alias_event_initialize er anchorP + withCString anchor $ \anchorP' -> do + let anchorP = castPtr anchorP' + c_yaml_alias_event_initialize + er + anchorP unless (ret == 1) $ throwIO $ ToEventRawException ret f er where - mapTagsImplicit = if formatOptionsExplicitMappingTags opts then 0 else 1 - seqTagsImplicit = if formatOptionsExplicitSequenceTags opts then 0 else 1 + mapTagImplicit NoTag = 1 + mapTagImplicit _ = if formatOptionsExplicitMappingTags opts then 0 else 1 + seqTagImplicit NoTag = 1 + seqTagImplicit _ = if formatOptionsExplicitSequenceTags opts then 0 else 1 newtype ToEventRawException = ToEventRawException CInt deriving (Show, Typeable) @@ -686,6 +694,24 @@ defaultFormatOptions = FormatOptions setWidth :: Maybe Int -> FormatOptions -> FormatOptions setWidth w opts = opts { formatOptionsWidth = w } +-- | Set the control of mapping tags to "explicit" +-- +-- This means that tags on mappings (even the default 'mapTag') will +-- be rendered out. To inhibit, set the tag to `NoTag` instead. +-- +-- @since 0.11.0.0 +setMappingTagsExplicit :: Bool -> FormatOptions -> FormatOptions +setMappingTagsExplicit f opts = opts { formatOptionsExplicitMappingTags = f } + +-- | Set the control of mapping@ tags to "explicit" +-- +-- This means that tags on mappings (even the default 'seqTag') will +-- be rendered out. To inhibit, set the tag to `NoTag` instead. +-- +-- @since 0.11.0.0 +setSequenceTagsExplicit :: Bool -> FormatOptions -> FormatOptions +setSequenceTagsExplicit f opts = opts { formatOptionsExplicitSequenceTags = f } + encode :: MonadResource m => ConduitM Event o m ByteString encode = encodeWith defaultFormatOptions diff --git a/yaml/test/Data/YamlSpec.hs b/yaml/test/Data/YamlSpec.hs index f4a814b..88b055c 100644 --- a/yaml/test/Data/YamlSpec.hs +++ b/yaml/test/Data/YamlSpec.hs @@ -8,6 +8,7 @@ module Data.YamlSpec (main, spec) where import qualified Text.Libyaml as Y +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Data.Int (Int64) @@ -55,6 +56,27 @@ shouldDecode bs expected = do actual <- D.decodeThrow bs actual `shouldBe` expected +shouldEmit :: [Y.Event] -> BS.ByteString -> IO () +shouldEmit es expected = do + actual <- runConduitRes (CL.sourceList events .| Y.encode) + actual `shouldBe` expected + where + events = + [Y.EventStreamStart, Y.EventDocumentStart] ++ es ++ + [Y.EventDocumentEnd, Y.EventStreamEnd] + +shouldEmitWithTagsOn :: [Y.Event] -> BS.ByteString -> IO () +shouldEmitWithTagsOn es expected = do + actual <- runConduitRes (CL.sourceList events .| Y.encodeWith opts) + actual `shouldBe` expected + where + events = + [Y.EventStreamStart, Y.EventDocumentStart] ++ + es ++ [Y.EventDocumentEnd, Y.EventStreamEnd] + opts = + Y.setMappingTagsExplicit True $ + Y.setSequenceTagsExplicit True $ Y.defaultFormatOptions + main :: IO () main = hspec spec @@ -205,6 +227,86 @@ spec = do go "12.3015e+02" (1230.15 :: Scientific) go "1230.15" (1230.15 :: Scientific) + describe "Text.Libyaml with mapping and sequence tags off" $ do + it "elides custom sequence tags" $ + [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing + , Y.EventSequenceEnd + ] `shouldEmit` "[]\n" + it "elides custom mapping tags" $ + [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing + , Y.EventMappingEnd + ] `shouldEmit` "{}\n" + it "elides default sequence tags" $ + [ Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing + , Y.EventSequenceEnd + ] `shouldEmit` "[]\n" + it "elides default mapping tags" $ + [ Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing + , Y.EventMappingEnd + ] `shouldEmit` "{}\n" + it "handles NoTag on sequences" $ + [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing + , Y.EventSequenceEnd + ] `shouldEmit` "[]\n" + it "handles NoTag on mappings" $ + [ Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing + , Y.EventMappingEnd + ] `shouldEmit` "{}\n" + it "handles mixed tag usages but elides all mapping and sequence tags" $ + [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing + , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing + , Y.EventMappingEnd + , Y.EventSequenceEnd + ] `shouldEmit` "- {}\n" + it "in combination of tags, anchors and styles, outputs only the scalar tags" $ + [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a") + , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b") + , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c") + , Y.EventScalar "" Y.NullTag Y.Plain (Just "d") + , Y.EventSequenceEnd + , Y.EventMappingEnd + ] `shouldEmit` "&a\n&b ! foo: &c [&d !!null '']\n" + describe "Text.Libyaml with mapping and sequence tags on" $ do + it "will output custom sequence tags" $ + [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing + , Y.EventSequenceEnd + ] `shouldEmitWithTagsOn` "!foo []\n" + it "will output custom mapping tags" $ + [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing + , Y.EventMappingEnd + ] `shouldEmitWithTagsOn` "!foo {}\n" + it "will output default sequence tags" $ + [ Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing + , Y.EventSequenceEnd + ] `shouldEmitWithTagsOn` "!!seq []\n" + it "will output default mapping tags" $ + [ Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing + , Y.EventMappingEnd + ] `shouldEmitWithTagsOn` "!!map {}\n" + it "handles NoTag on sequences" $ + [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing + , Y.EventSequenceEnd + ] `shouldEmitWithTagsOn` "[]\n" + it "handles NoTag on mappings" $ + [ Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing + , Y.EventMappingEnd + ] `shouldEmitWithTagsOn` "{}\n" + it "handles mixed tag usages outputting all mapping and sequence tags" $ + [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing + , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing + , Y.EventMappingEnd + , Y.EventSequenceEnd + ] `shouldEmitWithTagsOn` "- !foo {}\n" + it "in combination of tags, anchors and styles, outputs all the tags" $ + [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a") + , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b") + , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c") + , Y.EventScalar "" Y.NullTag Y.Plain (Just "d") + , Y.EventSequenceEnd + , Y.EventMappingEnd + ] `shouldEmitWithTagsOn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" + + specialStrings :: [T.Text] specialStrings = [ "fo\"o" From 3ca60febda7fff4782dec68e27d377731a12956d Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Fri, 1 Feb 2019 08:47:11 +0000 Subject: [PATCH 3/9] Switch to option function for deciding render --- libyaml/src/Text/Libyaml.hs | 63 +++++++------- yaml/test/Data/YamlSpec.hs | 160 +++++++++++++++++++++--------------- 2 files changed, 127 insertions(+), 96 deletions(-) diff --git a/libyaml/src/Text/Libyaml.hs b/libyaml/src/Text/Libyaml.hs index 937f1a2..69fa35b 100644 --- a/libyaml/src/Text/Libyaml.hs +++ b/libyaml/src/Text/Libyaml.hs @@ -32,8 +32,10 @@ module Text.Libyaml , FormatOptions , defaultFormatOptions , setWidth - , setMappingTagsExplicit - , setSequenceTagsExplicit + , setCollectionTagRendering + , renderNone + , renderAll + , renderUriTags -- * Error handling , YamlException (..) , YamlMark (..) @@ -504,7 +506,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er nullPtr tagP - (seqTagImplicit tag) + (implicit e) (toEnum $ fromEnum style) EventSequenceStart tag style (Just anchor) -> withCString (tagToString tag) $ \tag' -> do @@ -515,7 +517,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er anchorP tagP - (seqTagImplicit tag) + (implicit e) (toEnum $ fromEnum style) EventSequenceEnd -> c_yaml_sequence_end_event_initialize er @@ -526,7 +528,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er nullPtr tagP - (mapTagImplicit tag) + (implicit e) (toEnum $ fromEnum style) EventMappingStart tag style (Just anchor) -> withCString (tagToString tag) $ \tag' -> do @@ -537,7 +539,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er anchorP tagP - (mapTagImplicit tag) + (implicit e) (toEnum $ fromEnum style) EventMappingEnd -> c_yaml_mapping_end_event_initialize er @@ -550,10 +552,9 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do unless (ret == 1) $ throwIO $ ToEventRawException ret f er where - mapTagImplicit NoTag = 1 - mapTagImplicit _ = if formatOptionsExplicitMappingTags opts then 0 else 1 - seqTagImplicit NoTag = 1 - seqTagImplicit _ = if formatOptionsExplicitSequenceTags opts then 0 else 1 + implicit (EventSequenceStart NoTag _ _) = 1 + implicit (EventMappingStart NoTag _ _) = 1 + implicit e = toEnum $ fromEnum $ formatOptionsRenderCollectionTags opts e newtype ToEventRawException = ToEventRawException CInt deriving (Show, Typeable) @@ -670,13 +671,28 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do return $ Left $ YamlParseException problem context problemMark else Right <$> getEvent er + +data TagRender = Explicit | Implicit + deriving (Enum) + +renderNone :: Event -> TagRender +renderNone _ = Implicit + +renderAll :: Event -> TagRender +renderAll _ = Explicit + +renderUriTags :: Event -> TagRender +renderUriTags (EventScalar _ UriTag{} _ _) = Explicit +renderUriTags (EventSequenceStart UriTag{} _ _) = Explicit +renderUriTags (EventMappingStart UriTag{} _ _) = Explicit +renderUriTags _ = Implicit + -- | Contains options relating to the formatting (indendation, width) of the YAML output. -- -- @since 0.10.2.0 data FormatOptions = FormatOptions { formatOptionsWidth :: Maybe Int - , formatOptionsExplicitMappingTags :: Bool - , formatOptionsExplicitSequenceTags :: Bool + , formatOptionsRenderCollectionTags :: Event -> TagRender } -- | @@ -684,8 +700,7 @@ data FormatOptions = FormatOptions defaultFormatOptions :: FormatOptions defaultFormatOptions = FormatOptions { 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 - , formatOptionsExplicitMappingTags = False - , formatOptionsExplicitSequenceTags = False + , formatOptionsRenderCollectionTags = renderNone } -- | 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 setWidth :: Maybe Int -> FormatOptions -> FormatOptions setWidth w opts = opts { formatOptionsWidth = w } --- | Set the control of mapping tags to "explicit" --- --- This means that tags on mappings (even the default 'mapTag') will --- be rendered out. To inhibit, set the tag to `NoTag` instead. --- --- @since 0.11.0.0 -setMappingTagsExplicit :: Bool -> FormatOptions -> FormatOptions -setMappingTagsExplicit f opts = opts { formatOptionsExplicitMappingTags = f } - --- | Set the control of mapping@ tags to "explicit" --- --- This means that tags on mappings (even the default 'seqTag') will --- be rendered out. To inhibit, set the tag to `NoTag` instead. +-- | Control when and whether collection tags are rendered to output. -- --- @since 0.11.0.0 -setSequenceTagsExplicit :: Bool -> FormatOptions -> FormatOptions -setSequenceTagsExplicit f opts = opts { formatOptionsExplicitSequenceTags = f } +-- @since 0.11.1.0 +setCollectionTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions +setCollectionTagRendering f opts = opts { formatOptionsRenderCollectionTags = f } encode :: MonadResource m => ConduitM Event o m ByteString encode = encodeWith defaultFormatOptions diff --git a/yaml/test/Data/YamlSpec.hs b/yaml/test/Data/YamlSpec.hs index 88b055c..d05d404 100644 --- a/yaml/test/Data/YamlSpec.hs +++ b/yaml/test/Data/YamlSpec.hs @@ -73,9 +73,18 @@ shouldEmitWithTagsOn es expected = do events = [Y.EventStreamStart, Y.EventDocumentStart] ++ es ++ [Y.EventDocumentEnd, Y.EventStreamEnd] - opts = - Y.setMappingTagsExplicit True $ - Y.setSequenceTagsExplicit True $ Y.defaultFormatOptions + opts = Y.setCollectionTagRendering Y.renderAll $ Y.defaultFormatOptions + +shouldEmitWithUriTagsOn :: [Y.Event] -> BS.ByteString -> IO () +shouldEmitWithUriTagsOn es expected = do + actual <- runConduitRes (CL.sourceList events .| Y.encodeWith opts) + actual `shouldBe` expected + where + events = + [Y.EventStreamStart, Y.EventDocumentStart] ++ + es ++ [Y.EventDocumentEnd, Y.EventStreamEnd] + opts = Y.setCollectionTagRendering Y.renderUriTags $ Y.defaultFormatOptions + main :: IO () main = hspec spec @@ -227,85 +236,57 @@ spec = do go "12.3015e+02" (1230.15 :: Scientific) go "1230.15" (1230.15 :: Scientific) - describe "Text.Libyaml with mapping and sequence tags off" $ do + describe "Text.Libyaml with collection tags off" $ do it "elides custom sequence tags" $ - [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing - , Y.EventSequenceEnd - ] `shouldEmit` "[]\n" + taggedSequence `shouldEmit` "[]\n" it "elides custom mapping tags" $ - [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing - , Y.EventMappingEnd - ] `shouldEmit` "{}\n" + taggedMapping `shouldEmit` "{}\n" it "elides default sequence tags" $ - [ Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing - , Y.EventSequenceEnd - ] `shouldEmit` "[]\n" + defaultTaggedSequence `shouldEmit` "[]\n" it "elides default mapping tags" $ - [ Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing - , Y.EventMappingEnd - ] `shouldEmit` "{}\n" + defaultTaggedMapping `shouldEmit` "{}\n" it "handles NoTag on sequences" $ - [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing - , Y.EventSequenceEnd - ] `shouldEmit` "[]\n" + untaggedSequence `shouldEmit` "[]\n" it "handles NoTag on mappings" $ - [ Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing - , Y.EventMappingEnd - ] `shouldEmit` "{}\n" + untaggedMapping `shouldEmit` "{}\n" it "handles mixed tag usages but elides all mapping and sequence tags" $ - [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing - , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing - , Y.EventMappingEnd - , Y.EventSequenceEnd - ] `shouldEmit` "- {}\n" + mixedTagSampleA `shouldEmit` "- {}\n" it "in combination of tags, anchors and styles, outputs only the scalar tags" $ - [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a") - , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b") - , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c") - , Y.EventScalar "" Y.NullTag Y.Plain (Just "d") - , Y.EventSequenceEnd - , Y.EventMappingEnd - ] `shouldEmit` "&a\n&b ! foo: &c [&d !!null '']\n" - describe "Text.Libyaml with mapping and sequence tags on" $ do + mixedTagSampleB `shouldEmit` "&a\n&b ! foo: &c [&d !!null '']\n" + describe "Text.Libyaml with collection tags on" $ do it "will output custom sequence tags" $ - [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing - , Y.EventSequenceEnd - ] `shouldEmitWithTagsOn` "!foo []\n" + taggedSequence `shouldEmitWithTagsOn` "!foo []\n" it "will output custom mapping tags" $ - [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing - , Y.EventMappingEnd - ] `shouldEmitWithTagsOn` "!foo {}\n" + taggedMapping `shouldEmitWithTagsOn` "!foo {}\n" it "will output default sequence tags" $ - [ Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing - , Y.EventSequenceEnd - ] `shouldEmitWithTagsOn` "!!seq []\n" + defaultTaggedSequence `shouldEmitWithTagsOn` "!!seq []\n" it "will output default mapping tags" $ - [ Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing - , Y.EventMappingEnd - ] `shouldEmitWithTagsOn` "!!map {}\n" + defaultTaggedMapping `shouldEmitWithTagsOn` "!!map {}\n" it "handles NoTag on sequences" $ - [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing - , Y.EventSequenceEnd - ] `shouldEmitWithTagsOn` "[]\n" + untaggedSequence `shouldEmitWithTagsOn` "[]\n" it "handles NoTag on mappings" $ - [ Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing - , Y.EventMappingEnd - ] `shouldEmitWithTagsOn` "{}\n" + untaggedMapping `shouldEmitWithTagsOn` "{}\n" it "handles mixed tag usages outputting all mapping and sequence tags" $ - [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing - , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing - , Y.EventMappingEnd - , Y.EventSequenceEnd - ] `shouldEmitWithTagsOn` "- !foo {}\n" + mixedTagSampleA `shouldEmitWithTagsOn` "- !foo {}\n" it "in combination of tags, anchors and styles, outputs all the tags" $ - [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a") - , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b") - , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c") - , Y.EventScalar "" Y.NullTag Y.Plain (Just "d") - , Y.EventSequenceEnd - , Y.EventMappingEnd - ] `shouldEmitWithTagsOn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" - + mixedTagSampleB `shouldEmitWithTagsOn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" + describe "Text.Libyaml with collection uri tags on" $ do + it "will output custom sequence tags" $ + taggedSequence `shouldEmitWithUriTagsOn` "!foo []\n" + it "will output custom mapping tags" $ + taggedMapping `shouldEmitWithUriTagsOn` "!foo {}\n" + it "will output default sequence tags" $ + defaultTaggedSequence `shouldEmitWithUriTagsOn` "[]\n" + it "will output default mapping tags" $ + defaultTaggedMapping `shouldEmitWithUriTagsOn` "{}\n" + it "handles NoTag on sequences" $ + untaggedSequence `shouldEmitWithUriTagsOn` "[]\n" + it "handles NoTag on mappings" $ + untaggedMapping `shouldEmitWithUriTagsOn` "{}\n" + it "handles mixed tag usages outputting all mapping and sequence tags" $ + mixedTagSampleA `shouldEmitWithUriTagsOn` "- !foo {}\n" + it "in combination of tags, anchors and styles, outputs all the tags" $ + mixedTagSampleB `shouldEmitWithUriTagsOn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" specialStrings :: [T.Text] specialStrings = @@ -724,3 +705,50 @@ caseTruncatesFiles = withSystemTempFile "truncate.yaml" $ \fp h -> do D.encodeFile fp val res <- D.decodeFileEither fp either (Left . show) Right res `shouldBe` Right val + + +taggedSequence :: [Y.Event] +taggedSequence = + [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing + , Y.EventSequenceEnd + ] + +taggedMapping :: [Y.Event] +taggedMapping = + [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing + , Y.EventMappingEnd + ] + +defaultTaggedSequence :: [Y.Event] +defaultTaggedSequence = + [Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing, Y.EventSequenceEnd] + +defaultTaggedMapping :: [Y.Event] +defaultTaggedMapping = + [Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing, Y.EventMappingEnd] + +untaggedSequence :: [Y.Event] +untaggedSequence = + [Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing, Y.EventSequenceEnd] + +untaggedMapping :: [Y.Event] +untaggedMapping = + [Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing, Y.EventMappingEnd] + +mixedTagSampleA :: [Y.Event] +mixedTagSampleA = + [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing + , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing + , Y.EventMappingEnd + , Y.EventSequenceEnd + ] + +mixedTagSampleB :: [Y.Event] +mixedTagSampleB = + [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a") + , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b") + , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c") + , Y.EventScalar "" Y.NullTag Y.Plain (Just "d") + , Y.EventSequenceEnd + , Y.EventMappingEnd + ] From 8e05045f6d9df419bd162e61c079ae01353240d8 Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Fri, 1 Feb 2019 09:21:35 +0000 Subject: [PATCH 4/9] Add speculative changelog info. --- libyaml/src/Text/Libyaml.hs | 17 ++++++++++++++++- yaml/ChangeLog.md | 4 ++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/libyaml/src/Text/Libyaml.hs b/libyaml/src/Text/Libyaml.hs index 69fa35b..3b72b6e 100644 --- a/libyaml/src/Text/Libyaml.hs +++ b/libyaml/src/Text/Libyaml.hs @@ -671,16 +671,31 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do return $ Left $ YamlParseException problem context problemMark else Right <$> getEvent er - +-- | Whether a tag should be rendered explicitly in the output or left +-- implicit. +-- +-- @since 0.11.1.0 data TagRender = Explicit | Implicit deriving (Enum) +-- | A value for 'formatOptionsRenderCollectionTags' that renders no +-- tags. +-- +-- @since 0.11.1.0 renderNone :: Event -> TagRender renderNone _ = Implicit +-- | A value for 'formatOptionsRenderCollectionTags' that renders all +-- tags. +-- +-- @since 0.11.1.0 renderAll :: Event -> TagRender renderAll _ = Explicit +-- | A value for 'formatOptionsRenderCollectionTags' that renders tags +-- which are instances of 'UriTag' +-- +-- @since 0.11.1.0 renderUriTags :: Event -> TagRender renderUriTags (EventScalar _ UriTag{} _ _) = Explicit renderUriTags (EventSequenceStart UriTag{} _ _) = Explicit diff --git a/yaml/ChangeLog.md b/yaml/ChangeLog.md index 0843476..9969d62 100644 --- a/yaml/ChangeLog.md +++ b/yaml/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yaml +## 0.11.1.0 + +* Add an option to `FormatOptions` to govern when tags on collections are rendered explicitly and when they are left implicit. [#165](https://github.com/snoyberg/yaml/issues/165) + ## 0.11.0.0 * Split out the `libyaml` and `Text.Libyaml` code into its own package. [#145](https://github.com/snoyberg/yaml/issues/145) From da70eaf3641d32c39e8c5d7021a5b40507d94ecd Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Fri, 1 Feb 2019 09:50:01 +0000 Subject: [PATCH 5/9] Extend approach to scalars --- libyaml/src/Text/Libyaml.hs | 55 +++++++++++++++++++++++++++---------- 1 file changed, 41 insertions(+), 14 deletions(-) diff --git a/libyaml/src/Text/Libyaml.hs b/libyaml/src/Text/Libyaml.hs index 3b72b6e..d3b80b4 100644 --- a/libyaml/src/Text/Libyaml.hs +++ b/libyaml/src/Text/Libyaml.hs @@ -33,6 +33,8 @@ module Text.Libyaml , defaultFormatOptions , setWidth , setCollectionTagRendering + , setPlainTagRendering + , setQuotedTagRendering , renderNone , renderAll , renderUriTags @@ -469,13 +471,14 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do len' = fromIntegral len :: CInt let thetag' = tagToString thetag withCString thetag' $ \tag' -> do - let (pi, style) = - case style0 of - PlainNoTag -> (1, Plain) - x -> (0, x) + let pi0 = implicitPlain e + qi = implicitQuoted e + (pi, style) = + case style0 of + PlainNoTag -> (1, Plain) + x -> (pi0, x) style' = toEnum $ fromEnum style tagP = castPtr tag' - qi = if null thetag' then 1 else 0 case anchor of Nothing -> c_yaml_scalar_event_initialize @@ -506,7 +509,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er nullPtr tagP - (implicit e) + (implicitColl e) (toEnum $ fromEnum style) EventSequenceStart tag style (Just anchor) -> withCString (tagToString tag) $ \tag' -> do @@ -517,7 +520,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er anchorP tagP - (implicit e) + (implicitColl e) (toEnum $ fromEnum style) EventSequenceEnd -> c_yaml_sequence_end_event_initialize er @@ -528,7 +531,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er nullPtr tagP - (implicit e) + (implicitColl e) (toEnum $ fromEnum style) EventMappingStart tag style (Just anchor) -> withCString (tagToString tag) $ \tag' -> do @@ -539,7 +542,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er anchorP tagP - (implicit e) + (implicitColl e) (toEnum $ fromEnum style) EventMappingEnd -> c_yaml_mapping_end_event_initialize er @@ -552,9 +555,17 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do unless (ret == 1) $ throwIO $ ToEventRawException ret f er where - implicit (EventSequenceStart NoTag _ _) = 1 - implicit (EventMappingStart NoTag _ _) = 1 - implicit e = toEnum $ fromEnum $ formatOptionsRenderCollectionTags opts e + implicitColl (EventMappingStart NoTag _ _) = 1 + implicitColl (EventSequenceStart NoTag _ _) = 1 + implicitColl (EventMappingStart (UriTag "") _ _) = 1 + implicitColl (EventSequenceStart (UriTag "") _ _) = 1 + implicitColl evt = toEnum $ fromEnum $ formatOptionsRenderCollectionTags opts evt + implicitPlain (EventScalar _ NoTag _ _) = 1 + implicitPlain (EventScalar _ (UriTag "") _ _) = 1 + implicitPlain evt = toEnum $ fromEnum $ formatOptionsRenderPlainScalarTags opts evt + implicitQuoted (EventScalar _ NoTag _ _) = 1 + implicitQuoted (EventScalar _ (UriTag "") _ _) = 1 + implicitQuoted evt = toEnum $ fromEnum $ formatOptionsRenderQuotedScalarTags opts evt newtype ToEventRawException = ToEventRawException CInt deriving (Show, Typeable) @@ -686,7 +697,7 @@ renderNone :: Event -> TagRender renderNone _ = Implicit -- | A value for 'formatOptionsRenderCollectionTags' that renders all --- tags. +-- tags (except 'NoTag' and 'PlainNoTag' for flow scalars). -- -- @since 0.11.1.0 renderAll :: Event -> TagRender @@ -708,6 +719,8 @@ renderUriTags _ = Implicit data FormatOptions = FormatOptions { formatOptionsWidth :: Maybe Int , formatOptionsRenderCollectionTags :: Event -> TagRender + , formatOptionsRenderPlainScalarTags :: Event -> TagRender + , formatOptionsRenderQuotedScalarTags :: Event -> TagRender } -- | @@ -716,6 +729,8 @@ defaultFormatOptions :: FormatOptions defaultFormatOptions = FormatOptions { 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 , formatOptionsRenderCollectionTags = renderNone + , formatOptionsRenderPlainScalarTags = renderAll + , formatOptionsRenderQuotedScalarTags = renderAll } -- | Set the maximum number of columns in the YAML output, or 'Nothing' for infinite. By default, the limit is 80 characters. @@ -724,12 +739,24 @@ defaultFormatOptions = FormatOptions setWidth :: Maybe Int -> FormatOptions -> FormatOptions setWidth w opts = opts { formatOptionsWidth = w } --- | Control when and whether collection tags are rendered to output. +-- | Control when and whether tags on collections are rendered to output. -- -- @since 0.11.1.0 setCollectionTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions setCollectionTagRendering f opts = opts { formatOptionsRenderCollectionTags = f } +-- | Control when and whether tags on plain scalars are rendered to output. +-- +-- @since 0.11.1.0 +setPlainTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions +setPlainTagRendering f opts = opts { formatOptionsRenderPlainScalarTags = f } + +-- | Control when and whether tags on quoted scalars are rendered to output. +-- +-- @since 0.11.1.0 +setQuotedTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions +setQuotedTagRendering f opts = opts { formatOptionsRenderQuotedScalarTags = f } + encode :: MonadResource m => ConduitM Event o m ByteString encode = encodeWith defaultFormatOptions From 3004598c33845984ccd992022c605574fbe301b9 Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Fri, 1 Feb 2019 10:16:21 +0000 Subject: [PATCH 6/9] Tests for the scalar tag rendering controls --- yaml/test/Data/YamlSpec.hs | 128 +++++++++++++++++++++++-------------- 1 file changed, 79 insertions(+), 49 deletions(-) diff --git a/yaml/test/Data/YamlSpec.hs b/yaml/test/Data/YamlSpec.hs index d05d404..feaba2d 100644 --- a/yaml/test/Data/YamlSpec.hs +++ b/yaml/test/Data/YamlSpec.hs @@ -56,36 +56,13 @@ shouldDecode bs expected = do actual <- D.decodeThrow bs actual `shouldBe` expected -shouldEmit :: [Y.Event] -> BS.ByteString -> IO () -shouldEmit es expected = do - actual <- runConduitRes (CL.sourceList events .| Y.encode) - actual `shouldBe` expected +testEncodeWith :: Y.FormatOptions -> [Y.Event] -> IO BS.ByteString +testEncodeWith opts es = runConduitRes (CL.sourceList events .| Y.encodeWith opts) where events = [Y.EventStreamStart, Y.EventDocumentStart] ++ es ++ [Y.EventDocumentEnd, Y.EventStreamEnd] -shouldEmitWithTagsOn :: [Y.Event] -> BS.ByteString -> IO () -shouldEmitWithTagsOn es expected = do - actual <- runConduitRes (CL.sourceList events .| Y.encodeWith opts) - actual `shouldBe` expected - where - events = - [Y.EventStreamStart, Y.EventDocumentStart] ++ - es ++ [Y.EventDocumentEnd, Y.EventStreamEnd] - opts = Y.setCollectionTagRendering Y.renderAll $ Y.defaultFormatOptions - -shouldEmitWithUriTagsOn :: [Y.Event] -> BS.ByteString -> IO () -shouldEmitWithUriTagsOn es expected = do - actual <- runConduitRes (CL.sourceList events .| Y.encodeWith opts) - actual `shouldBe` expected - where - events = - [Y.EventStreamStart, Y.EventDocumentStart] ++ - es ++ [Y.EventDocumentEnd, Y.EventStreamEnd] - opts = Y.setCollectionTagRendering Y.renderUriTags $ Y.defaultFormatOptions - - main :: IO () main = hspec spec @@ -237,56 +214,109 @@ spec = do go "1230.15" (1230.15 :: Scientific) describe "Text.Libyaml with collection tags off" $ do + let enc = testEncodeWith Y.defaultFormatOptions it "elides custom sequence tags" $ - taggedSequence `shouldEmit` "[]\n" + enc taggedSequence `shouldReturn` "[]\n" it "elides custom mapping tags" $ - taggedMapping `shouldEmit` "{}\n" + enc taggedMapping `shouldReturn` "{}\n" it "elides default sequence tags" $ - defaultTaggedSequence `shouldEmit` "[]\n" + enc defaultTaggedSequence `shouldReturn` "[]\n" it "elides default mapping tags" $ - defaultTaggedMapping `shouldEmit` "{}\n" + enc defaultTaggedMapping `shouldReturn` "{}\n" it "handles NoTag on sequences" $ - untaggedSequence `shouldEmit` "[]\n" + enc untaggedSequence `shouldReturn` "[]\n" it "handles NoTag on mappings" $ - untaggedMapping `shouldEmit` "{}\n" + enc untaggedMapping `shouldReturn` "{}\n" it "handles mixed tag usages but elides all mapping and sequence tags" $ - mixedTagSampleA `shouldEmit` "- {}\n" + enc mixedTagSampleA `shouldReturn` "- {}\n" it "in combination of tags, anchors and styles, outputs only the scalar tags" $ - mixedTagSampleB `shouldEmit` "&a\n&b ! foo: &c [&d !!null '']\n" + enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c [&d !!null '']\n" describe "Text.Libyaml with collection tags on" $ do + let enc = testEncodeWith $ Y.setCollectionTagRendering Y.renderAll Y.defaultFormatOptions it "will output custom sequence tags" $ - taggedSequence `shouldEmitWithTagsOn` "!foo []\n" + enc taggedSequence `shouldReturn` "!foo []\n" it "will output custom mapping tags" $ - taggedMapping `shouldEmitWithTagsOn` "!foo {}\n" + enc taggedMapping `shouldReturn` "!foo {}\n" it "will output default sequence tags" $ - defaultTaggedSequence `shouldEmitWithTagsOn` "!!seq []\n" + enc defaultTaggedSequence `shouldReturn` "!!seq []\n" it "will output default mapping tags" $ - defaultTaggedMapping `shouldEmitWithTagsOn` "!!map {}\n" + enc defaultTaggedMapping `shouldReturn` "!!map {}\n" it "handles NoTag on sequences" $ - untaggedSequence `shouldEmitWithTagsOn` "[]\n" + enc untaggedSequence `shouldReturn` "[]\n" it "handles NoTag on mappings" $ - untaggedMapping `shouldEmitWithTagsOn` "{}\n" + enc untaggedMapping `shouldReturn` "{}\n" it "handles mixed tag usages outputting all mapping and sequence tags" $ - mixedTagSampleA `shouldEmitWithTagsOn` "- !foo {}\n" + enc mixedTagSampleA `shouldReturn` "- !foo {}\n" it "in combination of tags, anchors and styles, outputs all the tags" $ - mixedTagSampleB `shouldEmitWithTagsOn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" + enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" describe "Text.Libyaml with collection uri tags on" $ do + let enc = testEncodeWith $ Y.setCollectionTagRendering Y.renderUriTags Y.defaultFormatOptions it "will output custom sequence tags" $ - taggedSequence `shouldEmitWithUriTagsOn` "!foo []\n" + enc taggedSequence `shouldReturn` "!foo []\n" it "will output custom mapping tags" $ - taggedMapping `shouldEmitWithUriTagsOn` "!foo {}\n" + enc taggedMapping `shouldReturn` "!foo {}\n" it "will output default sequence tags" $ - defaultTaggedSequence `shouldEmitWithUriTagsOn` "[]\n" + enc defaultTaggedSequence `shouldReturn` "[]\n" it "will output default mapping tags" $ - defaultTaggedMapping `shouldEmitWithUriTagsOn` "{}\n" + enc defaultTaggedMapping `shouldReturn` "{}\n" it "handles NoTag on sequences" $ - untaggedSequence `shouldEmitWithUriTagsOn` "[]\n" + enc untaggedSequence `shouldReturn` "[]\n" it "handles NoTag on mappings" $ - untaggedMapping `shouldEmitWithUriTagsOn` "{}\n" + enc untaggedMapping `shouldReturn` "{}\n" it "handles mixed tag usages outputting all mapping and sequence tags" $ - mixedTagSampleA `shouldEmitWithUriTagsOn` "- !foo {}\n" + enc mixedTagSampleA `shouldReturn` "- !foo {}\n" it "in combination of tags, anchors and styles, outputs all the tags" $ - mixedTagSampleB `shouldEmitWithUriTagsOn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" + enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" + describe "Text.Libyaml with plain scalar tags on" $ do + let enc = testEncodeWith $ Y.setPlainTagRendering Y.renderAll Y.defaultFormatOptions + it "outputs plain tags" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "!!str foo\n" + it "respects PlainNoTag tags" $ + enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n" + describe "Text.Libyaml with plain scalar tags off" $ do + let enc = testEncodeWith $ Y.setPlainTagRendering Y.renderNone Y.defaultFormatOptions + it "outputs plain tags" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "foo\n" + it "respects PlainNoTag tags" $ + enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n" + describe "Text.Libyaml with quoted scalar tags on" $ do + let enc = testEncodeWith $ Y.setQuotedTagRendering Y.renderAll Y.defaultFormatOptions + it "outputs tags when double quoted" $ + enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "!!str \"foo\"\n" + it "outputs tags when single quoted" $ + enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "!!str 'foo'\n" + it "outputs tags on literal text" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "!!str |-\n foo\n" + it "outputs tags on folded text" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` "!!str >-\n foo\n" + describe "Text.Libyaml with quoted scalar tags off" $ do + let enc = testEncodeWith $ Y.setQuotedTagRendering Y.renderNone Y.defaultFormatOptions + it "elides tags when double quoted" $ + enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "\"foo\"\n" + it "elides tags when single quoted" $ + enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "'foo'\n" + it "elides tags on literal text" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "|-\n foo\n" + it "elides tags on folded text" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` ">-\n foo\n" + describe "Text.Libyaml with only UriTags set to render " $ do + let enc = + testEncodeWith $ + Y.setCollectionTagRendering Y.renderUriTags $ + Y.setPlainTagRendering Y.renderUriTags $ + Y.setQuotedTagRendering Y.renderUriTags Y.defaultFormatOptions + it "outputs only UriTags" $ + enc + [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing + , Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing + , Y.EventScalar "99" Y.IntTag Y.Plain Nothing + , Y.EventScalar "99.99" Y.FloatTag Y.Plain Nothing + , Y.EventScalar "bar" Y.NoTag Y.Plain Nothing + , Y.EventScalar "foo" (Y.UriTag "!foo") Y.DoubleQuoted Nothing + , Y.EventScalar "foo" (Y.UriTag "!foo") Y.Plain Nothing + , Y.EventSequenceEnd + ] `shouldReturn` + "[\"foo\", 99, 99.99, bar, !foo \"foo\", !foo foo]\n" specialStrings :: [T.Text] specialStrings = From 4da1f0c2d3223126d117ef232b476df91e1153d2 Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Fri, 1 Feb 2019 10:25:15 +0000 Subject: [PATCH 7/9] Update changelog --- yaml/ChangeLog.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yaml/ChangeLog.md b/yaml/ChangeLog.md index 9969d62..8507037 100644 --- a/yaml/ChangeLog.md +++ b/yaml/ChangeLog.md @@ -2,7 +2,7 @@ ## 0.11.1.0 -* Add an option to `FormatOptions` to govern when tags on collections are rendered explicitly and when they are left implicit. [#165](https://github.com/snoyberg/yaml/issues/165) +* Add options to `FormatOptions` to govern when tags rendered explicitly and when they are left implicit. [#165](https://github.com/snoyberg/yaml/issues/165) ## 0.11.0.0 From 39042f3079b82fafa76f40c5f52f857834c655ac Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Tue, 5 Feb 2019 15:12:47 +0000 Subject: [PATCH 8/9] Made conversion to CInt param explicit --- libyaml/src/Text/Libyaml.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/libyaml/src/Text/Libyaml.hs b/libyaml/src/Text/Libyaml.hs index d3b80b4..fc3ebb9 100644 --- a/libyaml/src/Text/Libyaml.hs +++ b/libyaml/src/Text/Libyaml.hs @@ -559,13 +559,13 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do implicitColl (EventSequenceStart NoTag _ _) = 1 implicitColl (EventMappingStart (UriTag "") _ _) = 1 implicitColl (EventSequenceStart (UriTag "") _ _) = 1 - implicitColl evt = toEnum $ fromEnum $ formatOptionsRenderCollectionTags opts evt + implicitColl evt = toImplicitParam $ formatOptionsRenderCollectionTags opts evt implicitPlain (EventScalar _ NoTag _ _) = 1 implicitPlain (EventScalar _ (UriTag "") _ _) = 1 - implicitPlain evt = toEnum $ fromEnum $ formatOptionsRenderPlainScalarTags opts evt + implicitPlain evt = toImplicitParam $ formatOptionsRenderPlainScalarTags opts evt implicitQuoted (EventScalar _ NoTag _ _) = 1 implicitQuoted (EventScalar _ (UriTag "") _ _) = 1 - implicitQuoted evt = toEnum $ fromEnum $ formatOptionsRenderQuotedScalarTags opts evt + implicitQuoted evt = toImplicitParam $ formatOptionsRenderQuotedScalarTags opts evt newtype ToEventRawException = ToEventRawException CInt deriving (Show, Typeable) @@ -689,6 +689,10 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do data TagRender = Explicit | Implicit deriving (Enum) +toImplicitParam :: TagRender -> CInt +toImplicitParam Explicit = 0 +toImplicitParam _ = 1 + -- | A value for 'formatOptionsRenderCollectionTags' that renders no -- tags. -- From b8b5756d0d4c86e187c2a4903f3333f8cf0d1980 Mon Sep 17 00:00:00 2001 From: gmorpheme Date: Mon, 11 Feb 2019 21:05:43 +0000 Subject: [PATCH 9/9] Updated as per review comments --- libyaml/src/Text/Libyaml.hs | 99 +++++++++++++++++-------------------- yaml/test/Data/YamlSpec.hs | 50 ++++++++----------- 2 files changed, 66 insertions(+), 83 deletions(-) diff --git a/libyaml/src/Text/Libyaml.hs b/libyaml/src/Text/Libyaml.hs index fc3ebb9..4e19bcb 100644 --- a/libyaml/src/Text/Libyaml.hs +++ b/libyaml/src/Text/Libyaml.hs @@ -32,11 +32,10 @@ module Text.Libyaml , FormatOptions , defaultFormatOptions , setWidth - , setCollectionTagRendering - , setPlainTagRendering - , setQuotedTagRendering - , renderNone - , renderAll + , setTagRendering + , renderScalarTags + , renderAllTags + , renderNoTags , renderUriTags -- * Error handling , YamlException (..) @@ -127,6 +126,11 @@ data Tag = StrTag | NoTag deriving (Show, Eq, Read, Data, Typeable) +tagSuppressed :: Tag -> Bool +tagSuppressed (NoTag) = True +tagSuppressed (UriTag "") = True +tagSuppressed _ = False + type AnchorName = String type Anchor = Maybe AnchorName @@ -471,8 +475,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do len' = fromIntegral len :: CInt let thetag' = tagToString thetag withCString thetag' $ \tag' -> do - let pi0 = implicitPlain e - qi = implicitQuoted e + let pi0 = tagsImplicit e (pi, style) = case style0 of PlainNoTag -> (1, Plain) @@ -488,7 +491,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do value' -- value len' -- length pi -- plain_implicit - qi -- quoted_implicit + pi -- quoted_implicit style' -- style Just anchor' -> withCString anchor' $ \anchorP' -> do @@ -500,7 +503,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do value' -- value len' -- length 0 -- plain_implicit - qi -- quoted_implicit + pi -- quoted_implicit style' -- style EventSequenceStart tag style Nothing -> withCString (tagToString tag) $ \tag' -> do @@ -509,7 +512,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er nullPtr tagP - (implicitColl e) + (tagsImplicit e) (toEnum $ fromEnum style) EventSequenceStart tag style (Just anchor) -> withCString (tagToString tag) $ \tag' -> do @@ -520,7 +523,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er anchorP tagP - (implicitColl e) + (tagsImplicit e) (toEnum $ fromEnum style) EventSequenceEnd -> c_yaml_sequence_end_event_initialize er @@ -531,7 +534,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er nullPtr tagP - (implicitColl e) + (tagsImplicit e) (toEnum $ fromEnum style) EventMappingStart tag style (Just anchor) -> withCString (tagToString tag) $ \tag' -> do @@ -542,7 +545,7 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do er anchorP tagP - (implicitColl e) + (tagsImplicit e) (toEnum $ fromEnum style) EventMappingEnd -> c_yaml_mapping_end_event_initialize er @@ -555,17 +558,10 @@ toEventRaw opts e f = allocaBytes eventSize $ \er -> do unless (ret == 1) $ throwIO $ ToEventRawException ret f er where - implicitColl (EventMappingStart NoTag _ _) = 1 - implicitColl (EventSequenceStart NoTag _ _) = 1 - implicitColl (EventMappingStart (UriTag "") _ _) = 1 - implicitColl (EventSequenceStart (UriTag "") _ _) = 1 - implicitColl evt = toImplicitParam $ formatOptionsRenderCollectionTags opts evt - implicitPlain (EventScalar _ NoTag _ _) = 1 - implicitPlain (EventScalar _ (UriTag "") _ _) = 1 - implicitPlain evt = toImplicitParam $ formatOptionsRenderPlainScalarTags opts evt - implicitQuoted (EventScalar _ NoTag _ _) = 1 - implicitQuoted (EventScalar _ (UriTag "") _ _) = 1 - implicitQuoted evt = toImplicitParam $ formatOptionsRenderQuotedScalarTags opts evt + tagsImplicit (EventScalar _ t _ _) | tagSuppressed t = 1 + tagsImplicit (EventMappingStart t _ _) | tagSuppressed t = 1 + tagsImplicit (EventSequenceStart t _ _) | tagSuppressed t = 1 + tagsImplicit evt = toImplicitParam $ formatOptionsRenderTags opts evt newtype ToEventRawException = ToEventRawException CInt deriving (Show, Typeable) @@ -691,21 +687,32 @@ data TagRender = Explicit | Implicit toImplicitParam :: TagRender -> CInt toImplicitParam Explicit = 0 -toImplicitParam _ = 1 +toImplicitParam Implicit = 1 --- | A value for 'formatOptionsRenderCollectionTags' that renders no --- tags. +-- | A value for 'formatOptionsRenderTags' that renders no +-- collection tags but all scalar tags (unless suppressed with styles +-- 'NoTag or 'PlainNoTag'). +-- +-- @since 0.11.1.0 +renderScalarTags :: Event -> TagRender +renderScalarTags (EventScalar _ _ _ _) = Explicit +renderScalarTags (EventSequenceStart _ _ _) = Implicit +renderScalarTags (EventMappingStart _ _ _) = Implicit +renderScalarTags _ = Implicit + +-- | A value for 'formatOptionsRenderTags' that renders all +-- tags (except 'NoTag' tag and 'PlainNoTag' style). -- -- @since 0.11.1.0 -renderNone :: Event -> TagRender -renderNone _ = Implicit +renderAllTags :: Event -> TagRender +renderAllTags _ = Explicit --- | A value for 'formatOptionsRenderCollectionTags' that renders all --- tags (except 'NoTag' and 'PlainNoTag' for flow scalars). +-- | A value for 'formatOptionsRenderTags' that renders no +-- tags. -- -- @since 0.11.1.0 -renderAll :: Event -> TagRender -renderAll _ = Explicit +renderNoTags :: Event -> TagRender +renderNoTags _ = Implicit -- | A value for 'formatOptionsRenderCollectionTags' that renders tags -- which are instances of 'UriTag' @@ -722,9 +729,7 @@ renderUriTags _ = Implicit -- @since 0.10.2.0 data FormatOptions = FormatOptions { formatOptionsWidth :: Maybe Int - , formatOptionsRenderCollectionTags :: Event -> TagRender - , formatOptionsRenderPlainScalarTags :: Event -> TagRender - , formatOptionsRenderQuotedScalarTags :: Event -> TagRender + , formatOptionsRenderTags :: Event -> TagRender } -- | @@ -732,9 +737,7 @@ data FormatOptions = FormatOptions defaultFormatOptions :: FormatOptions defaultFormatOptions = FormatOptions { 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 - , formatOptionsRenderCollectionTags = renderNone - , formatOptionsRenderPlainScalarTags = renderAll - , formatOptionsRenderQuotedScalarTags = renderAll + , formatOptionsRenderTags = renderScalarTags } -- | Set the maximum number of columns in the YAML output, or 'Nothing' for infinite. By default, the limit is 80 characters. @@ -743,23 +746,11 @@ defaultFormatOptions = FormatOptions setWidth :: Maybe Int -> FormatOptions -> FormatOptions setWidth w opts = opts { formatOptionsWidth = w } --- | Control when and whether tags on collections are rendered to output. --- --- @since 0.11.1.0 -setCollectionTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions -setCollectionTagRendering f opts = opts { formatOptionsRenderCollectionTags = f } - --- | Control when and whether tags on plain scalars are rendered to output. --- --- @since 0.11.1.0 -setPlainTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions -setPlainTagRendering f opts = opts { formatOptionsRenderPlainScalarTags = f } - --- | Control when and whether tags on quoted scalars are rendered to output. +-- | Control when and whether tags are rendered to output. -- -- @since 0.11.1.0 -setQuotedTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions -setQuotedTagRendering f opts = opts { formatOptionsRenderQuotedScalarTags = f } +setTagRendering :: (Event -> TagRender) -> FormatOptions -> FormatOptions +setTagRendering f opts = opts { formatOptionsRenderTags = f } encode :: MonadResource m => ConduitM Event o m ByteString encode = encodeWith defaultFormatOptions diff --git a/yaml/test/Data/YamlSpec.hs b/yaml/test/Data/YamlSpec.hs index feaba2d..97ee3ae 100644 --- a/yaml/test/Data/YamlSpec.hs +++ b/yaml/test/Data/YamlSpec.hs @@ -213,7 +213,7 @@ spec = do go "12.3015e+02" (1230.15 :: Scientific) go "1230.15" (1230.15 :: Scientific) - describe "Text.Libyaml with collection tags off" $ do + describe "Text.Libyaml with default tag rendering" $ do let enc = testEncodeWith Y.defaultFormatOptions it "elides custom sequence tags" $ enc taggedSequence `shouldReturn` "[]\n" @@ -231,8 +231,16 @@ spec = do enc mixedTagSampleA `shouldReturn` "- {}\n" it "in combination of tags, anchors and styles, outputs only the scalar tags" $ enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c [&d !!null '']\n" - describe "Text.Libyaml with collection tags on" $ do - let enc = testEncodeWith $ Y.setCollectionTagRendering Y.renderAll Y.defaultFormatOptions + it "outputs tags when double quoted" $ + enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "!!str \"foo\"\n" + it "outputs tags when single quoted" $ + enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "!!str 'foo'\n" + it "outputs tags on literal text" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "!!str |-\n foo\n" + it "outputs tags on folded text" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` "!!str >-\n foo\n" + describe "Text.Libyaml with all tags on" $ do + let enc = testEncodeWith $ Y.setTagRendering Y.renderAllTags Y.defaultFormatOptions it "will output custom sequence tags" $ enc taggedSequence `shouldReturn` "!foo []\n" it "will output custom mapping tags" $ @@ -249,8 +257,12 @@ spec = do enc mixedTagSampleA `shouldReturn` "- !foo {}\n" it "in combination of tags, anchors and styles, outputs all the tags" $ enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" - describe "Text.Libyaml with collection uri tags on" $ do - let enc = testEncodeWith $ Y.setCollectionTagRendering Y.renderUriTags Y.defaultFormatOptions + it "outputs plain tags" $ + enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "!!str foo\n" + it "respects PlainNoTag tags" $ + enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n" + describe "Text.Libyaml with uri tags on" $ do + let enc = testEncodeWith $ Y.setTagRendering Y.renderUriTags Y.defaultFormatOptions it "will output custom sequence tags" $ enc taggedSequence `shouldReturn` "!foo []\n" it "will output custom mapping tags" $ @@ -266,31 +278,13 @@ spec = do it "handles mixed tag usages outputting all mapping and sequence tags" $ enc mixedTagSampleA `shouldReturn` "- !foo {}\n" it "in combination of tags, anchors and styles, outputs all the tags" $ - enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" - describe "Text.Libyaml with plain scalar tags on" $ do - let enc = testEncodeWith $ Y.setPlainTagRendering Y.renderAll Y.defaultFormatOptions - it "outputs plain tags" $ - enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "!!str foo\n" - it "respects PlainNoTag tags" $ - enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n" - describe "Text.Libyaml with plain scalar tags off" $ do - let enc = testEncodeWith $ Y.setPlainTagRendering Y.renderNone Y.defaultFormatOptions + enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c !baz [&d '']\n" + describe "Text.Libyaml with tags off" $ do + let enc = testEncodeWith $ Y.setTagRendering Y.renderNoTags Y.defaultFormatOptions it "outputs plain tags" $ enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "foo\n" it "respects PlainNoTag tags" $ enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n" - describe "Text.Libyaml with quoted scalar tags on" $ do - let enc = testEncodeWith $ Y.setQuotedTagRendering Y.renderAll Y.defaultFormatOptions - it "outputs tags when double quoted" $ - enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "!!str \"foo\"\n" - it "outputs tags when single quoted" $ - enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "!!str 'foo'\n" - it "outputs tags on literal text" $ - enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "!!str |-\n foo\n" - it "outputs tags on folded text" $ - enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` "!!str >-\n foo\n" - describe "Text.Libyaml with quoted scalar tags off" $ do - let enc = testEncodeWith $ Y.setQuotedTagRendering Y.renderNone Y.defaultFormatOptions it "elides tags when double quoted" $ enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "\"foo\"\n" it "elides tags when single quoted" $ @@ -302,9 +296,7 @@ spec = do describe "Text.Libyaml with only UriTags set to render " $ do let enc = testEncodeWith $ - Y.setCollectionTagRendering Y.renderUriTags $ - Y.setPlainTagRendering Y.renderUriTags $ - Y.setQuotedTagRendering Y.renderUriTags Y.defaultFormatOptions + Y.setTagRendering Y.renderUriTags $ Y.defaultFormatOptions it "outputs only UriTags" $ enc [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing