{-# LINE 1 "Z/Data/YAML/FFI.hsc" #-}
{-# OPTIONS_GHC -Wno-missing-fields #-}
{-|
Module      : Z.Data.YAML.FFI
Description : LibYAML bindings
Copyright   : (c) Dong Han, 2020
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

LibYAML bindings, which provide streaming YAML read & write.

-}

module Z.Data.YAML.FFI
    ( -- * The event stream
      MarkedEvent(..)
    , Mark (..)
    , Event (..)
    , Tag(..)
    , Anchor
      -- * Decoding
    , initParser
    , initFileParser
      -- * Encoding
    , YAMLFormatOpts(..)
    , initEmitter
    , initFileEmitter
    , getEmitterResult
    , defaultYAMLFormatOpts
    , renderScalarTags
    , renderAllTags
    , renderNoTags
    , renderUriTags
    -- * Constants
    , ScalarStyle
    , pattern Any          
    , pattern Plain        
    , pattern SingleQuoted 
    , pattern DoubleQuoted 
    , pattern Literal      
    , pattern Folded       
    , pattern PlainNoTag   
    , SequenceStyle
    , pattern AnySequence  
    , pattern BlockSequence
    , pattern FlowSequence 
    , MappingStyle
    , pattern AnyMapping
    , pattern BlockMapping
    , pattern FlowMapping 
    -- * Exception type
    , LibYAMLException (..)
    ) where

import Control.Applicative
import Control.Exception (mask_, throwIO, Exception, finally)
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.IO.Class
import Data.Bits ((.|.))
import Data.Word
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable
import GHC.Generics
import Prelude hiding (pi)
import qualified Z.Data.CBytes      as CB
import Z.Foreign
import Z.IO
import qualified Z.IO.FileSystem    as FS
import qualified Z.Data.Vector      as V
import qualified Z.Data.Text.Base   as T
import           Z.Data.Text.ShowT  (ShowT)
import           Z.Data.JSON        (EncodeJSON, FromValue, ToValue)



type Anchor = T.Text

data Event =
      EventStreamStart   
    | EventStreamEnd     
    | EventDocumentStart 
    | EventDocumentEnd   
    | EventAlias          !Anchor
    | EventScalar         !Anchor !T.Text !Tag !ScalarStyle 
    | EventSequenceStart  !Anchor !Tag !SequenceStyle 
    | EventSequenceEnd   
    | EventMappingStart   !Anchor !Tag !MappingStyle 
    | EventMappingEnd    
    deriving (Show, Ord, Eq, Generic)
    deriving anyclass (ShowT, EncodeJSON, FromValue, ToValue)

data MarkedEvent = MarkedEvent 
    { markedEvent :: !Event
    , startMark :: !Mark
    , endMark :: !Mark
    }
    deriving (Show, Ord, Eq, Generic)
    deriving anyclass (ShowT, EncodeJSON, FromValue, ToValue)

-- | The pointer position
data Mark = Mark 
    { yamlIndex  :: {-# UNPACK #-} !Int
    , yamlLine   :: {-# UNPACK #-} !Int
    , yamlColumn :: {-# UNPACK #-} !Int 
    }
    deriving (Show, Ord, Eq, Generic)
    deriving anyclass (ShowT, EncodeJSON, FromValue, ToValue)

-- | Style for scalars - e.g. quoted / folded
-- 
type ScalarStyle = CInt
pattern Any, Plain, SingleQuoted, DoubleQuoted, Literal, Folded, PlainNoTag :: ScalarStyle
pattern Any           = 0
pattern Plain         = 1 
pattern SingleQuoted  = 2 
pattern DoubleQuoted  = 3 
pattern Literal       = 4 
pattern Folded        = 5 
pattern PlainNoTag    = 6 

-- | Style for sequences - e.g. block or flow
-- 
type SequenceStyle = CInt
pattern AnySequence, BlockSequence, FlowSequence :: SequenceStyle
pattern AnySequence   = 0
pattern BlockSequence = 1 
pattern FlowSequence  = 2

-- | Style for mappings - e.g. block or flow
-- 
type MappingStyle = CInt 
pattern AnyMapping, BlockMapping, FlowMapping :: MappingStyle
pattern AnyMapping   = 0 
pattern BlockMapping = 1
pattern FlowMapping  = 2

data Tag = StrTag
         | FloatTag
         | NullTag
         | BoolTag
         | SetTag
         | IntTag
         | SeqTag
         | MapTag
         | UriTag T.Text
         | NoTag
    deriving (Show, Ord, Eq, Generic)
    deriving anyclass (ShowT, EncodeJSON, FromValue, ToValue)

tagToCBytes :: Tag -> CB.CBytes
tagToCBytes StrTag = "tag:yaml.org,2002:str"
tagToCBytes FloatTag = "tag:yaml.org,2002:float"
tagToCBytes NullTag = "tag:yaml.org,2002:null"
tagToCBytes BoolTag = "tag:yaml.org,2002:bool"
tagToCBytes SetTag = "tag:yaml.org,2002:set"
tagToCBytes IntTag = "tag:yaml.org,2002:int"
tagToCBytes SeqTag = "tag:yaml.org,2002:seq"
tagToCBytes MapTag = "tag:yaml.org,2002:map"
tagToCBytes (UriTag s) = CB.fromText s
tagToCBytes NoTag = ""

bytesToTag :: V.Bytes -> Tag
bytesToTag "tag:yaml.org,2002:str" = StrTag
bytesToTag "tag:yaml.org,2002:float" = FloatTag
bytesToTag "tag:yaml.org,2002:null" = NullTag
bytesToTag "tag:yaml.org,2002:bool" = BoolTag
bytesToTag "tag:yaml.org,2002:set" = SetTag
bytesToTag "tag:yaml.org,2002:int" = IntTag
bytesToTag "tag:yaml.org,2002:seq" = SeqTag
bytesToTag "tag:yaml.org,2002:map" = MapTag
bytesToTag "" = NoTag
bytesToTag s = UriTag (T.validate s)

data LibYAMLException
    = ParseEventException CB.CBytes CB.CBytes Mark CallStack  -- ^ problem, context, mark
    | ParseAliasEventWithEmptyAnchor Mark Mark CallStack
    | EmitEventException Event CInt CallStack
    | EmitAliasEventWithEmptyAnchor CallStack
    deriving Show

instance Exception LibYAMLException

data ParserStruct
foreign import ccall unsafe "hs_yaml.c hs_init_yaml_parser" hs_init_yaml_parser :: IO (Ptr ParserStruct)
foreign import ccall unsafe "hs_yaml.c hs_free_yaml_parser" hs_free_yaml_parser :: Ptr ParserStruct -> IO ()

data EventStruct
foreign import ccall unsafe yaml_parser_set_input_string :: Ptr ParserStruct -> Ptr Word8 -> CSize -> IO ()
foreign import ccall unsafe yaml_parser_set_input_file :: Ptr ParserStruct -> Ptr File -> IO ()
foreign import ccall unsafe yaml_parser_parse :: Ptr ParserStruct -> MBA# EventStruct -> IO CInt
foreign import ccall unsafe yaml_event_delete :: MBA# EventStruct -> IO ()

-- | Create a source that yields marked events from a piece of YAML bytes.
--
initParser :: HasCallStack => V.Bytes -> Resource (Source MarkedEvent)
initParser bs 
    | V.null bs = return BIO{ pull = return Nothing }
    | otherwise = do
        (pparser, bs', bio) <- initResource 
            (do pparser <- throwOOMIfNull hs_init_yaml_parser
                bs' <- pinPrimVector bs
                withPrimVectorSafe bs' $ \ bptr blen -> do
                    yaml_parser_set_input_string pparser bptr (fromIntegral blen)
                return (pparser, bs', BIO{ pull = peekParserEvent pparser }))
            (\ (pparser, bs', _) -> do
                hs_free_yaml_parser pparser
                touch bs')
        return bio

-- | Create a source that yields marked events from a piece of YAML bytes.
--
initFileParser :: HasCallStack => CB.CBytes -> Resource (Source MarkedEvent)
initFileParser p = do
    (pparser, file, bio) <- initResource 
        (do pparser <- throwOOMIfNull hs_init_yaml_parser
            (f, _) <- acquire $ FS.initFile p FS.O_RDONLY FS.DEFAULT_MODE
            fd <- FS.getFileFD f
            file <-   CB.withCBytesUnsafe "r" (fdopen fd)
            yaml_parser_set_input_file pparser file
            return (pparser, file, BIO{ pull = peekParserEvent pparser }))
        (\ (pparser, file, _) -> do
            hs_free_yaml_parser pparser
            fclose file)
    return bio


-- | Parse a single event from YAML parser.
peekParserEvent :: HasCallStack => Ptr ParserStruct -> IO (Maybe MarkedEvent)
peekParserEvent parser = do
    (_, me) <- allocBytesUnsafe ((104)) $ \ pe -> do
{-# LINE 234 "Z/Data/YAML/FFI.hsc" #-}
        res <- yaml_parser_parse parser pe
        flip finally (yaml_event_delete pe) $
            if res == 0
            then do
                problem <- CB.fromCString =<< ((\hsc_ptr -> peekByteOff hsc_ptr 8)) parser
{-# LINE 239 "Z/Data/YAML/FFI.hsc" #-}
                context <- CB.fromCString =<< ((\hsc_ptr -> peekByteOff hsc_ptr 56)) parser
{-# LINE 240 "Z/Data/YAML/FFI.hsc" #-}
                i :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) parser
{-# LINE 241 "Z/Data/YAML/FFI.hsc" #-}
                l :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) parser
{-# LINE 242 "Z/Data/YAML/FFI.hsc" #-}
                c :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) parser
{-# LINE 243 "Z/Data/YAML/FFI.hsc" #-}
                let problemMark = Mark (fromIntegral i) (fromIntegral l) (fromIntegral c)
                throwIO (ParseEventException problem context problemMark callStack)
            else peekEvent pe
    return me
  where
    readAnchor :: Int -> MBA# EventStruct -> IO Anchor
    readAnchor off pe = do
        p <- peekMBA pe off 
        if p == nullPtr 
        then return T.empty
        else T.Text <$> fromNullTerminated p

    readStyle :: Int -> MBA# EventStruct -> IO CInt
    readStyle off pe = peekMBA pe off

    readTag :: Int -> MBA# EventStruct -> IO Tag
    readTag off pe = do
        p <- peekMBA pe off 
        if p == nullPtr 
        then return NoTag
        else bytesToTag <$!> fromNullTerminated p

    peekEvent :: HasCallStack => MBA# EventStruct -> IO (Maybe MarkedEvent)
    peekEvent pe = do
        et <- peekMBA pe ((0))
{-# LINE 268 "Z/Data/YAML/FFI.hsc" #-}

        si :: CUInt <- peekMBA pe ((56)) 
{-# LINE 270 "Z/Data/YAML/FFI.hsc" #-}
        sl :: CUInt <- peekMBA pe ((64)) 
{-# LINE 271 "Z/Data/YAML/FFI.hsc" #-}
        sc :: CUInt <- peekMBA pe ((72)) 
{-# LINE 272 "Z/Data/YAML/FFI.hsc" #-}
        ei :: CUInt <- peekMBA pe ((80)) 
{-# LINE 273 "Z/Data/YAML/FFI.hsc" #-}
        el :: CUInt <- peekMBA pe ((88)) 
{-# LINE 274 "Z/Data/YAML/FFI.hsc" #-}
        ec :: CUInt <- peekMBA pe ((96)) 
{-# LINE 275 "Z/Data/YAML/FFI.hsc" #-}
        let startMark = Mark (fromIntegral si) (fromIntegral sl) (fromIntegral sc)
            endMark = Mark (fromIntegral ei) (fromIntegral el) (fromIntegral ec)
            returnMarked e = return (Just (MarkedEvent e startMark endMark))
        case (et :: CInt) of
            (0)              -> return Nothing
{-# LINE 280 "Z/Data/YAML/FFI.hsc" #-}
            (1)    -> returnMarked EventStreamStart
{-# LINE 281 "Z/Data/YAML/FFI.hsc" #-}
            (2)      -> returnMarked EventStreamEnd
{-# LINE 282 "Z/Data/YAML/FFI.hsc" #-}
            (3)  -> returnMarked EventDocumentStart
{-# LINE 283 "Z/Data/YAML/FFI.hsc" #-}
            (4)    -> returnMarked EventDocumentEnd
{-# LINE 284 "Z/Data/YAML/FFI.hsc" #-}
            (5) -> do
{-# LINE 285 "Z/Data/YAML/FFI.hsc" #-}
                yanchor <- peekMBA pe ((8))
{-# LINE 286 "Z/Data/YAML/FFI.hsc" #-}
                anchor <- if yanchor == nullPtr
                          then throwIO (ParseAliasEventWithEmptyAnchor startMark endMark callStack)
                          else fromNullTerminated yanchor
                returnMarked (EventAlias (T.Text anchor))
            (6) -> do
{-# LINE 291 "Z/Data/YAML/FFI.hsc" #-}
                anchor <- readAnchor ((8)) pe
{-# LINE 292 "Z/Data/YAML/FFI.hsc" #-}
                yvalue <- peekMBA pe ((24))
{-# LINE 293 "Z/Data/YAML/FFI.hsc" #-}
                ylen   <- peekMBA pe ((32))
{-# LINE 294 "Z/Data/YAML/FFI.hsc" #-}
                bs <- fromPtr yvalue (fromIntegral (ylen :: CULong))
                tag <- readTag ((16)) pe
{-# LINE 296 "Z/Data/YAML/FFI.hsc" #-}
                style <- readStyle ((48)) pe
{-# LINE 297 "Z/Data/YAML/FFI.hsc" #-}
                returnMarked (EventScalar anchor (T.Text bs) tag style)
            (7) -> do
{-# LINE 299 "Z/Data/YAML/FFI.hsc" #-}
                anchor <- readAnchor ((8)) pe
{-# LINE 300 "Z/Data/YAML/FFI.hsc" #-}
                tag <- readTag ((16)) pe
{-# LINE 301 "Z/Data/YAML/FFI.hsc" #-}
                style <- readStyle ((28)) pe
{-# LINE 302 "Z/Data/YAML/FFI.hsc" #-}
                returnMarked (EventSequenceStart anchor tag style)
            (8)    -> returnMarked EventSequenceEnd
{-# LINE 304 "Z/Data/YAML/FFI.hsc" #-}
            (9) -> do
{-# LINE 305 "Z/Data/YAML/FFI.hsc" #-}
                anchor <- readAnchor ((8)) pe
{-# LINE 306 "Z/Data/YAML/FFI.hsc" #-}
                tag <- readTag ((16)) pe
{-# LINE 307 "Z/Data/YAML/FFI.hsc" #-}
                style <- readStyle ((28)) pe
{-# LINE 308 "Z/Data/YAML/FFI.hsc" #-}
                returnMarked (EventMappingStart anchor tag style)
            (10) -> returnMarked EventMappingEnd
{-# LINE 310 "Z/Data/YAML/FFI.hsc" #-}


--------------------------------------------------------------------------------
-- Emitter

data EmitterStruct

foreign import ccall unsafe "hs_yaml.c hs_init_yaml_emitter"
    hs_init_yaml_emitter :: CInt -> CInt -> CInt -> IO (Ptr EmitterStruct)

foreign import ccall unsafe "hs_yaml.c hs_free_yaml_emitter"
    hs_free_yaml_emitter :: Ptr EmitterStruct -> IO ()

foreign import ccall unsafe "hs_yaml.c hs_init_yaml_emitter_file"
    hs_init_yaml_emitter_file :: Ptr File -> CInt -> CInt -> CInt -> IO (Ptr EmitterStruct)

foreign import ccall unsafe "hs_yaml.c hs_free_yaml_emitter_file"
    hs_free_yaml_emitter_file :: Ptr EmitterStruct -> IO ()

foreign import ccall unsafe "hs_yaml.c hs_get_yaml_emitter_length"
    hs_get_yaml_emitter_length :: Ptr EmitterStruct -> IO CSize

foreign import ccall unsafe "hs_yaml.c hs_copy_yaml_emitter_result"
    hs_copy_yaml_emitter_result :: Ptr EmitterStruct -> MBA# Word8 -> CSize -> IO ()

foreign import ccall unsafe yaml_emitter_emit :: Ptr EmitterStruct -> MBA# EventStruct -> IO CInt

foreign import ccall unsafe yaml_stream_start_event_initialize :: MBA# EventStruct -> CInt -> IO CInt

foreign import ccall unsafe yaml_stream_end_event_initialize :: MBA# EventStruct -> IO CInt

foreign import ccall unsafe "hs_yaml.c hs_yaml_scalar_event_initialize"
    hs_yaml_scalar_event_initialize
        :: MBA# EventStruct
        -> BA# Word8 -- anchor
        -> BA# Word8 -- tag
        -> BA# Word8 -- value
        -> CInt       -- offset
        -> CInt       -- length
        -> CInt       -- plain_implicit
        -> CInt       -- quoted_implicit
        -> CInt       -- style
        -> IO CInt

foreign import ccall unsafe "hs_yaml.c hs_yaml_document_start"
    hs_yaml_document_start :: MBA# EventStruct -> IO CInt

foreign import ccall unsafe yaml_document_end_event_initialize :: MBA# EventStruct -> CInt -> IO CInt

foreign import ccall unsafe "hs_yaml.c hs_yaml_sequence_start_event_initialize"
    hs_yaml_sequence_start_event_initialize
        :: MBA# EventStruct
        -> BA# Word8  -- anchor
        -> BA# Word8  -- tag
        -> CInt
        -> CInt
        -> IO CInt

foreign import ccall unsafe yaml_sequence_end_event_initialize :: MBA# EventStruct -> IO CInt

foreign import ccall unsafe "hs_yaml.c hs_yaml_mapping_start_event_initialize"
    hs_yaml_mapping_start_event_initialize
        :: MBA# EventStruct
        -> BA# Word8
        -> BA# Word8
        -> CInt
        -> CInt
        -> IO CInt

foreign import ccall unsafe yaml_mapping_end_event_initialize :: MBA# EventStruct -> IO CInt

foreign import ccall unsafe yaml_alias_event_initialize :: MBA# EventStruct -> BA# Word8 -> IO CInt

-- | Make a new YAML event sink, whose result can be fetched via 'getEmitterResult'.
--
initEmitter :: HasCallStack => YAMLFormatOpts -> Resource (Ptr EmitterStruct, Sink Event) 
initEmitter fopts@YAMLFormatOpts{..} = do
    p <- initResource 
        (do let canonical = if yamlFormatCanonical then 1 else 0
            throwOOMIfNull (hs_init_yaml_emitter canonical
                (fromIntegral yamlFormatIndent) (fromIntegral yamlFormatWidth)))
        hs_free_yaml_emitter
    return (p, BIO {
        push = \ e -> emitEvent p fopts e >> return Nothing
    ,   pull = return Nothing
    })

-- | Make a new YAML event sink, whose result are written to a file.
--
-- Note the file will be opened in @'FS.O_APPEND' .|. 'FS.O_CREAT' .|. 'FS.O_WRONLY'@ mode,
-- bytes will be written after the end of the original file if there'are old bytes.
initFileEmitter :: HasCallStack => YAMLFormatOpts -> CB.CBytes -> Resource (Sink Event) 
initFileEmitter fopts@YAMLFormatOpts{..} p = do
    (pemitter, file) <- initResource
        (do (f, _) <- acquire $ FS.initFile p (FS.O_APPEND .|. FS.O_CREAT .|. FS.O_WRONLY) FS.DEFAULT_MODE
            fd <- FS.getFileFD f
            file <- CB.withCBytesUnsafe "w" (fdopen fd)
            let canonical = if yamlFormatCanonical then 1 else 0
            pemitter <- throwOOMIfNull (hs_init_yaml_emitter_file file canonical
                (fromIntegral yamlFormatIndent) (fromIntegral yamlFormatWidth))
            return (pemitter, file))
            (\ (pemitter, file) -> do
            hs_free_yaml_emitter_file pemitter
            fclose file)
    return BIO {
        push = \ e -> emitEvent pemitter fopts e >> return Nothing
    ,   pull = return Nothing
    }

-- | Fetch YAML emitter's building buffer.
--
getEmitterResult :: Ptr EmitterStruct -> IO T.Text 
getEmitterResult pemitter = do
    l <- hs_get_yaml_emitter_length pemitter
    (bs,_) <- allocBytesUnsafe (fromIntegral l) $ \ p -> hs_copy_yaml_emitter_result pemitter p l
    return (T.Text bs)

-- | Push a single YAML event to emitter.
--
emitEvent :: HasCallStack => Ptr EmitterStruct -> YAMLFormatOpts -> Event -> IO ()
emitEvent pemitter fopts e = void . allocBytesUnsafe ((104)) $ \ pe -> do
{-# LINE 431 "Z/Data/YAML/FFI.hsc" #-}
    ret <- case e of
        EventStreamStart   -> yaml_stream_start_event_initialize pe (0)
{-# LINE 433 "Z/Data/YAML/FFI.hsc" #-}
        EventStreamEnd     -> yaml_stream_end_event_initialize pe
        EventDocumentStart -> hs_yaml_document_start pe
        EventDocumentEnd   -> yaml_document_end_event_initialize pe 1
        EventScalar anchor t tag style0 -> 
            withPrimVectorUnsafe (T.getUTF8Bytes t) $ \ pvalue off len -> 
                withAnchor anchor $ \ panchor -> 
                    withTag tag $ \ ptag -> do
                        let pi0 = tagsImplicit e
                            (pi, style) = case style0 of
                                PlainNoTag -> (1,   Plain)
                                x          -> (pi0, x)
                        hs_yaml_scalar_event_initialize
                            pe
                            panchor -- anchor
                            ptag    -- tag
                            pvalue  -- value
                            (fromIntegral off)   -- offset
                            (fromIntegral len)   -- length
                            (if T.null anchor then pi else 0)   -- plain_implicit
                            pi      -- quoted_implicit
                            style   -- style

        EventSequenceStart anchor tag style ->
            withAnchor anchor $ \ panchor -> 
                withTag tag $ \ ptag ->
                    hs_yaml_sequence_start_event_initialize
                        pe
                        panchor
                        ptag
                        (tagsImplicit e)
                        style

        EventSequenceEnd -> yaml_sequence_end_event_initialize pe

        EventMappingStart anchor tag style ->
            withAnchor anchor $ \ panchor ->
                withTag tag $ \ ptag -> 
                    hs_yaml_mapping_start_event_initialize pe panchor ptag (tagsImplicit e) style

        EventMappingEnd -> yaml_mapping_end_event_initialize pe

        EventAlias anchor ->
            if T.null anchor
            then throwIO (EmitAliasEventWithEmptyAnchor callStack)
            else withAnchor anchor (yaml_alias_event_initialize pe)

    if (ret /= 1) 
    then throwIO (EmitEventException e ret callStack)
    else do
        ret' <- yaml_emitter_emit pemitter pe
        when (ret /= 1) (throwIO (EmitEventException e ret callStack))
  where
    tagsImplicit (EventScalar _ _ t _) | tagSuppressed t = 1
    tagsImplicit (EventMappingStart _ t _) | tagSuppressed t = 1
    tagsImplicit (EventSequenceStart _ t _) | tagSuppressed t = 1
    tagsImplicit evt = yamlFormatRenderTags fopts evt

    tagSuppressed (NoTag) = True
    tagSuppressed (UriTag "") = True
    tagSuppressed _ = False

    withTag tag = CB.withCBytesUnsafe (tagToCBytes tag)
    withAnchor anchor = CB.withCBytesUnsafe (CB.fromText anchor) 


-- | Whether a tag should be rendered explicitly in the output or left
-- implicit.
--
type TagRender = CInt
pattern Explicit, Implicit :: TagRender
pattern Explicit = 0
pattern Implicit = 1

-- | A value for 'formatOptionsRenderTags' that renders no
-- collection tags but all scalar tags (unless suppressed with styles
-- 'NoTag or 'PlainNoTag').
--
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).
--
renderAllTags :: Event -> TagRender
renderAllTags _ = Explicit

-- | A value for 'formatOptionsRenderTags' that renders no
-- tags.
--
renderNoTags :: Event -> TagRender
renderNoTags _ = Implicit

-- which are instances of 'UriTag'
--
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.
--
data YAMLFormatOpts = YAMLFormatOpts
    { yamlFormatCanonical  :: Bool     -- ^ use canonical style, default 'False'
    , yamlFormatIndent     :: Int      -- ^ default 4
    , yamlFormatWidth      :: Int      -- ^ default 80
    , yamlFormatRenderTags :: Event -> TagRender
    }

defaultYAMLFormatOpts :: YAMLFormatOpts
defaultYAMLFormatOpts = YAMLFormatOpts False 4 80 renderScalarTags

--------------------------------------------------------------------------------

data File

{-# LINE 554 "Z/Data/YAML/FFI.hsc" #-}
foreign import ccall unsafe "fdopen"

{-# LINE 556 "Z/Data/YAML/FFI.hsc" #-}
    fdopen :: CInt -> BA# Word8 -> IO (Ptr File)

foreign import ccall unsafe "fclose" fclose :: Ptr File -> IO ()