{-# 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
    , TagRender
    , pattern Explicit
    , pattern Implicit
    -- * Exception type
    , YAMLError(..)
    , YAMLParseError(..)
    , throwYAMLError
    ) 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 qualified Z.Data.Text        as T
import           Z.Data.JSON        (JSON)



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 (T.Print, JSON)

data MarkedEvent = MarkedEvent
    { markedEvent :: !Event
    , startMark :: !Mark
    , endMark :: !Mark
    }
    deriving (Show, Ord, Eq, Generic)
    deriving anyclass (T.Print, JSON)

-- | The pointer position
data Mark = Mark
    { yamlIndex  :: {-# UNPACK #-} !Int
    , yamlLine   :: {-# UNPACK #-} !Int
    , yamlColumn :: {-# UNPACK #-} !Int
    }
    deriving (Show, Ord, Eq, Generic)
    deriving anyclass (T.Print, JSON)

-- | 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 (T.Print, JSON)

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 YAMLError
    = ParseEventException CB.CBytes CB.CBytes Mark     -- ^ problem, context, mark
    | ParseAliasEventWithEmptyAnchor Mark Mark
    | ParseYAMLError YAMLParseError                    -- ^ custom parse error
    | EmitEventException Event CInt
    | EmitAliasEventWithEmptyAnchor
    | OtherYAMLError T.Text
  deriving (Eq, Generic)
  deriving anyclass T.Print

instance Show YAMLError where show = T.toString

data YAMLParseError
    = UnknownAlias MarkedEvent
    | UnexpectedEvent MarkedEvent
    | NonStringKey MarkedEvent
    | NonStringKeyAlias MarkedEvent
    | UnexpectedEventEnd
  deriving (Eq, Generic)
  deriving anyclass T.Print

instance Show YAMLParseError where show = T.toString

instance Exception YAMLError
instance Exception YAMLParseError


-- | Throw custom YAML error.
throwYAMLError :: YAMLParseError -> IO a
throwYAMLError desc = throwIO (ParseYAMLError desc)

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 :: 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_FILE_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 :: Ptr ParserStruct -> IO (Maybe MarkedEvent)
peekParserEvent parser = do
    (_, me) <- allocBytesUnsafe ((104)) $ \ pe -> do
{-# LINE 260 "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 265 "Z/Data/YAML/FFI.hsc" #-}
                context <- CB.fromCString =<< ((\hsc_ptr -> peekByteOff hsc_ptr 56)) parser
{-# LINE 266 "Z/Data/YAML/FFI.hsc" #-}
                i :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) parser
{-# LINE 267 "Z/Data/YAML/FFI.hsc" #-}
                l :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) parser
{-# LINE 268 "Z/Data/YAML/FFI.hsc" #-}
                c :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) parser
{-# LINE 269 "Z/Data/YAML/FFI.hsc" #-}
                let problemMark = Mark (fromIntegral i) (fromIntegral l) (fromIntegral c)
                throwIO (ParseEventException problem context problemMark)
            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 :: MBA# EventStruct -> IO (Maybe MarkedEvent)
    peekEvent pe = do
        et <- peekMBA pe ((0))
{-# LINE 294 "Z/Data/YAML/FFI.hsc" #-}

        si :: CUInt <- peekMBA pe ((56))
{-# LINE 296 "Z/Data/YAML/FFI.hsc" #-}
        sl :: CUInt <- peekMBA pe ((64))
{-# LINE 297 "Z/Data/YAML/FFI.hsc" #-}
        sc :: CUInt <- peekMBA pe ((72))
{-# LINE 298 "Z/Data/YAML/FFI.hsc" #-}
        ei :: CUInt <- peekMBA pe ((80))
{-# LINE 299 "Z/Data/YAML/FFI.hsc" #-}
        el :: CUInt <- peekMBA pe ((88))
{-# LINE 300 "Z/Data/YAML/FFI.hsc" #-}
        ec :: CUInt <- peekMBA pe ((96))
{-# LINE 301 "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 306 "Z/Data/YAML/FFI.hsc" #-}
            (1)    -> returnMarked EventStreamStart
{-# LINE 307 "Z/Data/YAML/FFI.hsc" #-}
            (2)      -> returnMarked EventStreamEnd
{-# LINE 308 "Z/Data/YAML/FFI.hsc" #-}
            (3)  -> returnMarked EventDocumentStart
{-# LINE 309 "Z/Data/YAML/FFI.hsc" #-}
            (4)    -> returnMarked EventDocumentEnd
{-# LINE 310 "Z/Data/YAML/FFI.hsc" #-}
            (5) -> do
{-# LINE 311 "Z/Data/YAML/FFI.hsc" #-}
                yanchor <- peekMBA pe ((8))
{-# LINE 312 "Z/Data/YAML/FFI.hsc" #-}
                anchor <- if yanchor == nullPtr
                          then throwIO (ParseAliasEventWithEmptyAnchor startMark endMark)
                          else fromNullTerminated yanchor
                returnMarked (EventAlias (T.Text anchor))
            (6) -> do
{-# LINE 317 "Z/Data/YAML/FFI.hsc" #-}
                anchor <- readAnchor ((8)) pe
{-# LINE 318 "Z/Data/YAML/FFI.hsc" #-}
                yvalue <- peekMBA pe ((24))
{-# LINE 319 "Z/Data/YAML/FFI.hsc" #-}
                ylen   <- peekMBA pe ((32))
{-# LINE 320 "Z/Data/YAML/FFI.hsc" #-}
                bs <- fromPtr yvalue (fromIntegral (ylen :: CULong))
                tag <- readTag ((16)) pe
{-# LINE 322 "Z/Data/YAML/FFI.hsc" #-}
                style <- readStyle ((48)) pe
{-# LINE 323 "Z/Data/YAML/FFI.hsc" #-}
                returnMarked (EventScalar anchor (T.Text bs) tag style)
            (7) -> do
{-# LINE 325 "Z/Data/YAML/FFI.hsc" #-}
                anchor <- readAnchor ((8)) pe
{-# LINE 326 "Z/Data/YAML/FFI.hsc" #-}
                tag <- readTag ((16)) pe
{-# LINE 327 "Z/Data/YAML/FFI.hsc" #-}
                style <- readStyle ((28)) pe
{-# LINE 328 "Z/Data/YAML/FFI.hsc" #-}
                returnMarked (EventSequenceStart anchor tag style)
            (8)    -> returnMarked EventSequenceEnd
{-# LINE 330 "Z/Data/YAML/FFI.hsc" #-}
            (9) -> do
{-# LINE 331 "Z/Data/YAML/FFI.hsc" #-}
                anchor <- readAnchor ((8)) pe
{-# LINE 332 "Z/Data/YAML/FFI.hsc" #-}
                tag <- readTag ((16)) pe
{-# LINE 333 "Z/Data/YAML/FFI.hsc" #-}
                style <- readStyle ((28)) pe
{-# LINE 334 "Z/Data/YAML/FFI.hsc" #-}
                returnMarked (EventMappingStart anchor tag style)
            (10) -> returnMarked EventMappingEnd
{-# LINE 336 "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 :: 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_FILE_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 :: Ptr EmitterStruct -> YAMLFormatOpts -> Event -> IO ()
emitEvent pemitter fopts e = void . allocBytesUnsafe ((104)) $ \ pe -> do
{-# LINE 457 "Z/Data/YAML/FFI.hsc" #-}
    ret <- case e of
        EventStreamStart   -> yaml_stream_start_event_initialize pe (0)
{-# LINE 459 "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
            else withAnchor anchor (yaml_alias_event_initialize pe)

    if (ret /= 1)
    then throwIO (EmitEventException e ret)
    else do
        ret' <- yaml_emitter_emit pemitter pe
        when (ret /= 1) (throwIO (EmitEventException e ret))
  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 'yamlFormatRenderTags' 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 'yamlFormatRenderTags' that renders all
-- tags (except 'NoTag' tag and 'PlainNoTag' style).
--
renderAllTags :: Event -> TagRender
renderAllTags _ = Explicit

-- | A value for 'yamlFormatRenderTags' 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 579 "Z/Data/YAML/FFI.hsc" #-}
foreign import ccall unsafe "fdopen"

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

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