@@ -32,6 +32,8 @@ module Text.Libyaml
3232 , FormatOptions
3333 , defaultFormatOptions
3434 , setWidth
35+ , setMappingTagsExplicit
36+ , setSequenceTagsExplicit
3537 -- * Error handling
3638 , YamlException (..)
3739 , YamlMark (..)
@@ -447,105 +449,111 @@ foreign import ccall unsafe "yaml_alias_event_initialize"
447449 -> IO CInt
448450
449451toEventRaw :: FormatOptions -> Event -> (EventRaw -> IO a) -> IO a
450−toEventRaw opts e f =
451− allocaBytes eventSize $ \er -> do
452− ret <-
453− case e of
452+toEventRaw opts e f = allocaBytes eventSize $ \er -> do
453+ ret <- case e of
454454 EventStreamStart ->
455− c_yaml_stream_start_event_initialize er 0 -- YAML_ANY_ENCODING
456− EventStreamEnd -> c_yaml_stream_end_event_initialize er
457− EventDocumentStart -> c_simple_document_start er
458− EventDocumentEnd -> c_yaml_document_end_event_initialize er 1
455+ c_yaml_stream_start_event_initialize
456+ er
457+ 0 -- YAML_ANY_ENCODING
458+ EventStreamEnd ->
459+ c_yaml_stream_end_event_initialize er
460+ EventDocumentStart ->
461+ c_simple_document_start er
462+ EventDocumentEnd ->
463+ c_yaml_document_end_event_initialize er 1
459464 EventScalar bs thetag style0 anchor -> do
460− BU.unsafeUseAsCStringLen bs $ \(value, len) -> do
461− let value' = castPtr value :: Ptr CUChar
462− len' = fromIntegral len :: CInt
463− let thetag' = tagToString thetag
464− withCString thetag' $ \tag' -> do
465− let (pi, style) =
466− case style0 of
467− PlainNoTag -> (1, Plain)
468− x -> (0, x)
469− style' = toEnum $ fromEnum style
470− tagP = castPtr tag'
471− qi =
472− if null thetag'
473− then 1
474− else 0
475− case anchor of
476− Nothing ->
477− c_yaml_scalar_event_initialize
478− er
479− nullPtr -- anchor
480− tagP -- tag
481− value' -- value
482− len' -- length
483− pi -- plain_implicit
484− qi -- quoted_implicit
485− style' -- style
486− Just anchor' ->
487− withCString anchor' $ \anchorP' -> do
488− let anchorP = castPtr anchorP'
489− c_yaml_scalar_event_initialize
490− er
491− anchorP -- anchor
492− tagP -- tag
493− value' -- value
494− len' -- length
495− 0 -- plain_implicit
496− qi -- quoted_implicit
497− style' -- style
465+ BU.unsafeUseAsCStringLen bs $ \(value, len) -> do
466+ let value' = castPtr value :: Ptr CUChar
467+ len' = fromIntegral len :: CInt
468+ let thetag' = tagToString thetag
469+ withCString thetag' $ \tag' -> do
470+ let (pi, style) =
471+ case style0 of
472+ PlainNoTag -> (1, Plain)
473+ x -> (0, x)
474+ style' = toEnum $ fromEnum style
475+ tagP = castPtr tag'
476+ qi = if null thetag' then 1 else 0
477+ case anchor of
478+ Nothing ->
479+ c_yaml_scalar_event_initialize
480+ er
481+ nullPtr -- anchor
482+ tagP -- tag
483+ value' -- value
484+ len' -- length
485+ pi -- plain_implicit
486+ qi -- quoted_implicit
487+ style' -- style
488+ Just anchor' ->
489+ withCString anchor' $ \anchorP' -> do
490+ let anchorP = castPtr anchorP'
491+ c_yaml_scalar_event_initialize
492+ er
493+ anchorP -- anchor
494+ tagP -- tag
495+ value' -- value
496+ len' -- length
497+ 0 -- plain_implicit
498+ qi -- quoted_implicit
499+ style' -- style
498500 EventSequenceStart tag style Nothing ->
499− withCString (tagToString tag) $ \tag' -> do
500− let tagP = castPtr tag'
501− c_yaml_sequence_start_event_initialize
502− er
503− nullPtr
504− tagP
505− seqTagsImplicit
506− (toEnum $ fromEnum style)
501+ withCString (tagToString tag) $ \tag' -> do
502+ let tagP = castPtr tag'
503+ c_yaml_sequence_start_event_initialize
504+ er
505+ nullPtr
506+ tagP
507+ (seqTagImplicit tag)
508+ (toEnum $ fromEnum style)
507509 EventSequenceStart tag style (Just anchor) ->
508− withCString (tagToString tag) $ \tag' -> do
509− let tagP = castPtr tag'
510− withCString anchor $ \anchor' -> do
511− let anchorP = castPtr anchor'
512− c_yaml_sequence_start_event_initialize
513− er
514− anchorP
515− tagP
516− seqTagsImplicit
517− (toEnum $ fromEnum style)
518− EventSequenceEnd -> c_yaml_sequence_end_event_initialize er
510+ withCString (tagToString tag) $ \tag' -> do
511+ let tagP = castPtr tag'
512+ withCString anchor $ \anchor' -> do
513+ let anchorP = castPtr anchor'
514+ c_yaml_sequence_start_event_initialize
515+ er
516+ anchorP
517+ tagP
518+ (seqTagImplicit tag)
519+ (toEnum $ fromEnum style)
520+ EventSequenceEnd ->
521+ c_yaml_sequence_end_event_initialize er
519522 EventMappingStart tag style Nothing ->
520− withCString (tagToString tag) $ \tag' -> do
521− let tagP = castPtr tag'
522− c_yaml_mapping_start_event_initialize
523− er
524− nullPtr
525− tagP
526− mapTagsImplicit
527− (toEnum $ fromEnum style)
523+ withCString (tagToString tag) $ \tag' -> do
524+ let tagP = castPtr tag'
525+ c_yaml_mapping_start_event_initialize
526+ er
527+ nullPtr
528+ tagP
529+ (mapTagImplicit tag)
530+ (toEnum $ fromEnum style)
528531 EventMappingStart tag style (Just anchor) ->
529− withCString (tagToString tag) $ \tag' -> do
530− withCString anchor $ \anchor' -> do
531− let tagP = castPtr tag'
532− let anchorP = castPtr anchor'
533− c_yaml_mapping_start_event_initialize
534− er
535− anchorP
536− tagP
537− mapTagsImplicit
538− (toEnum $ fromEnum style)
539− EventMappingEnd -> c_yaml_mapping_end_event_initialize er
532+ withCString (tagToString tag) $ \tag' -> do
533+ withCString anchor $ \anchor' -> do
534+ let tagP = castPtr tag'
535+ let anchorP = castPtr anchor'
536+ c_yaml_mapping_start_event_initialize
537+ er
538+ anchorP
539+ tagP
540+ (mapTagImplicit tag)
541+ (toEnum $ fromEnum style)
542+ EventMappingEnd ->
543+ c_yaml_mapping_end_event_initialize er
540544 EventAlias anchor ->
541− withCString anchor $ \anchorP' -> do
542− let anchorP = castPtr anchorP'
543− c_yaml_alias_event_initialize er anchorP
545+ withCString anchor $ \anchorP' -> do
546+ let anchorP = castPtr anchorP'
547+ c_yaml_alias_event_initialize
548+ er
549+ anchorP
544550 unless (ret == 1) $ throwIO $ ToEventRawException ret
545551 f er
546552 where
547− mapTagsImplicit = if formatOptionsExplicitMappingTags opts then 0 else 1
548− seqTagsImplicit = if formatOptionsExplicitSequenceTags opts then 0 else 1
553+ mapTagImplicit NoTag = 1
554+ mapTagImplicit _ = if formatOptionsExplicitMappingTags opts then 0 else 1
555+ seqTagImplicit NoTag = 1
556+ seqTagImplicit _ = if formatOptionsExplicitSequenceTags opts then 0 else 1
549557
550558newtype ToEventRawException = ToEventRawException CInt
551559 deriving (Show, Typeable)
@@ -686,6 +694,24 @@ defaultFormatOptions = FormatOptions
686694setWidth :: Maybe Int -> FormatOptions -> FormatOptions
687695setWidth w opts = opts { formatOptionsWidth = w }
688696
697+-- | Set the control of mapping tags to "explicit"
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+--
711+-- @since 0.11.0.0
712+setSequenceTagsExplicit :: Bool -> FormatOptions -> FormatOptions
713+setSequenceTagsExplicit f opts = opts { formatOptionsExplicitSequenceTags = f }
714+
689715encode :: MonadResource m => ConduitM Event o m ByteString
690716encode = encodeWith defaultFormatOptions
691717