@@ -446,107 +446,106 @@ foreign import ccall unsafe "yaml_alias_event_initialize"
446446 -> Ptr CUChar
447447 -> IO CInt
448448
449−toEventRaw :: Event -> (EventRaw -> IO a) -> IO a
450−toEventRaw e f = allocaBytes eventSize $ \er -> do
451− ret <- case e of
449+toEventRaw :: FormatOptions -> Event -> (EventRaw -> IO a) -> IO a
450+toEventRaw opts e f =
451+ allocaBytes eventSize $ \er -> do
452+ ret <-
453+ case e of
452454 EventStreamStart ->
453− c_yaml_stream_start_event_initialize
454− er
455− 0 -- YAML_ANY_ENCODING
456− EventStreamEnd ->
457− c_yaml_stream_end_event_initialize er
458− EventDocumentStart ->
459− c_simple_document_start er
460− EventDocumentEnd ->
461− c_yaml_document_end_event_initialize er 1
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
462459 EventScalar bs thetag style0 anchor -> do
463− BU.unsafeUseAsCStringLen bs $ \(value, len) -> do
464− let value' = castPtr value :: Ptr CUChar
465− len' = fromIntegral len :: CInt
466− let thetag' = tagToString thetag
467− withCString thetag' $ \tag' -> do
468− let (pi, style) =
469− case style0 of
470− PlainNoTag -> (1, Plain)
471− x -> (0, x)
472− style' = toEnum $ fromEnum style
473− tagP = castPtr tag'
474− qi = if null thetag' then 1 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
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
498498 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− 1
506− (toEnum $ fromEnum style)
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)
507507 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− 1
517− (toEnum $ fromEnum style)
518− EventSequenceEnd ->
519− c_yaml_sequence_end_event_initialize er
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
520519 EventMappingStart tag style Nothing ->
521− withCString (tagToString tag) $ \tag' -> do
522− let tagP = castPtr tag'
523− c_yaml_mapping_start_event_initialize
524− er
525− nullPtr
526− tagP
527− 1
528− (toEnum $ fromEnum style)
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)
529528 EventMappingStart tag style (Just anchor) ->
530− withCString (tagToString tag) $ \tag' -> do
531− withCString anchor $ \anchor' -> do
532− let tagP = castPtr tag'
533− let anchorP = castPtr anchor'
534− c_yaml_mapping_start_event_initialize
535− er
536− anchorP
537− tagP
538− 1
539− (toEnum $ fromEnum style)
540− EventMappingEnd ->
541− c_yaml_mapping_end_event_initialize er
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
542540 EventAlias anchor ->
543− withCString anchor $ \anchorP' -> do
544− let anchorP = castPtr anchorP'
545− c_yaml_alias_event_initialize
546− er
547− anchorP
541+ withCString anchor $ \anchorP' -> do
542+ let anchorP = castPtr anchorP'
543+ c_yaml_alias_event_initialize er anchorP
548544 unless (ret == 1) $ throwIO $ ToEventRawException ret
549545 f er
546+ where
547+ mapTagsImplicit = if formatOptionsExplicitMappingTags opts then 0 else 1
548+ seqTagsImplicit = if formatOptionsExplicitSequenceTags opts then 0 else 1
550549
551550newtype ToEventRawException = ToEventRawException CInt
552551 deriving (Show, Typeable)
@@ -668,6 +667,8 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do
668667-- @since 0.10.2.0
669668data FormatOptions = FormatOptions
670669 { formatOptionsWidth :: Maybe Int
670+ , formatOptionsExplicitMappingTags :: Bool
671+ , formatOptionsExplicitSequenceTags :: Bool
671672 }
672673
673674-- |
@@ -675,6 +676,8 @@ data FormatOptions = FormatOptions
675676defaultFormatOptions :: FormatOptions
676677defaultFormatOptions = FormatOptions
677678 { 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
679+ , formatOptionsExplicitMappingTags = False
680+ , formatOptionsExplicitSequenceTags = False
678681 }
679682
680683-- | 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 =
756759 loop = await >>= maybe (close ()) push
757760
758761 push e = do
759− _ <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter
762+ _ <- liftIO $ toEventRaw opts e $ c_yaml_emitter_emit emitter
760763 loop
761764 close u = liftIO $ closeI u a
762765