{-# 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 (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Eq Event
Eq Event
-> (Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Ord, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic)
    deriving anyclass (Int -> Event -> Builder ()
(Int -> Event -> Builder ()) -> ShowT Event
forall a. (Int -> a -> Builder ()) -> ShowT a
toUTF8BuilderP :: Int -> Event -> Builder ()
$ctoUTF8BuilderP :: Int -> Event -> Builder ()
ShowT, Event -> Builder ()
(Event -> Builder ()) -> EncodeJSON Event
forall a. (a -> Builder ()) -> EncodeJSON a
encodeJSON :: Event -> Builder ()
$cencodeJSON :: Event -> Builder ()
EncodeJSON, Value -> Converter Event
(Value -> Converter Event) -> FromValue Event
forall a. (Value -> Converter a) -> FromValue a
fromValue :: Value -> Converter Event
$cfromValue :: Value -> Converter Event
FromValue, Event -> Value
(Event -> Value) -> ToValue Event
forall a. (a -> Value) -> ToValue a
toValue :: Event -> Value
$ctoValue :: Event -> Value
ToValue)

data MarkedEvent = MarkedEvent 
    { MarkedEvent -> Event
markedEvent :: !Event
    , MarkedEvent -> Mark
startMark :: !Mark
    , MarkedEvent -> Mark
endMark :: !Mark
    }
    deriving (Int -> MarkedEvent -> ShowS
[MarkedEvent] -> ShowS
MarkedEvent -> String
(Int -> MarkedEvent -> ShowS)
-> (MarkedEvent -> String)
-> ([MarkedEvent] -> ShowS)
-> Show MarkedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkedEvent] -> ShowS
$cshowList :: [MarkedEvent] -> ShowS
show :: MarkedEvent -> String
$cshow :: MarkedEvent -> String
showsPrec :: Int -> MarkedEvent -> ShowS
$cshowsPrec :: Int -> MarkedEvent -> ShowS
Show, Eq MarkedEvent
Eq MarkedEvent
-> (MarkedEvent -> MarkedEvent -> Ordering)
-> (MarkedEvent -> MarkedEvent -> Bool)
-> (MarkedEvent -> MarkedEvent -> Bool)
-> (MarkedEvent -> MarkedEvent -> Bool)
-> (MarkedEvent -> MarkedEvent -> Bool)
-> (MarkedEvent -> MarkedEvent -> MarkedEvent)
-> (MarkedEvent -> MarkedEvent -> MarkedEvent)
-> Ord MarkedEvent
MarkedEvent -> MarkedEvent -> Bool
MarkedEvent -> MarkedEvent -> Ordering
MarkedEvent -> MarkedEvent -> MarkedEvent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MarkedEvent -> MarkedEvent -> MarkedEvent
$cmin :: MarkedEvent -> MarkedEvent -> MarkedEvent
max :: MarkedEvent -> MarkedEvent -> MarkedEvent
$cmax :: MarkedEvent -> MarkedEvent -> MarkedEvent
>= :: MarkedEvent -> MarkedEvent -> Bool
$c>= :: MarkedEvent -> MarkedEvent -> Bool
> :: MarkedEvent -> MarkedEvent -> Bool
$c> :: MarkedEvent -> MarkedEvent -> Bool
<= :: MarkedEvent -> MarkedEvent -> Bool
$c<= :: MarkedEvent -> MarkedEvent -> Bool
< :: MarkedEvent -> MarkedEvent -> Bool
$c< :: MarkedEvent -> MarkedEvent -> Bool
compare :: MarkedEvent -> MarkedEvent -> Ordering
$ccompare :: MarkedEvent -> MarkedEvent -> Ordering
$cp1Ord :: Eq MarkedEvent
Ord, MarkedEvent -> MarkedEvent -> Bool
(MarkedEvent -> MarkedEvent -> Bool)
-> (MarkedEvent -> MarkedEvent -> Bool) -> Eq MarkedEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkedEvent -> MarkedEvent -> Bool
$c/= :: MarkedEvent -> MarkedEvent -> Bool
== :: MarkedEvent -> MarkedEvent -> Bool
$c== :: MarkedEvent -> MarkedEvent -> Bool
Eq, (forall x. MarkedEvent -> Rep MarkedEvent x)
-> (forall x. Rep MarkedEvent x -> MarkedEvent)
-> Generic MarkedEvent
forall x. Rep MarkedEvent x -> MarkedEvent
forall x. MarkedEvent -> Rep MarkedEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MarkedEvent x -> MarkedEvent
$cfrom :: forall x. MarkedEvent -> Rep MarkedEvent x
Generic)
    deriving anyclass (Int -> MarkedEvent -> Builder ()
(Int -> MarkedEvent -> Builder ()) -> ShowT MarkedEvent
forall a. (Int -> a -> Builder ()) -> ShowT a
toUTF8BuilderP :: Int -> MarkedEvent -> Builder ()
$ctoUTF8BuilderP :: Int -> MarkedEvent -> Builder ()
ShowT, MarkedEvent -> Builder ()
(MarkedEvent -> Builder ()) -> EncodeJSON MarkedEvent
forall a. (a -> Builder ()) -> EncodeJSON a
encodeJSON :: MarkedEvent -> Builder ()
$cencodeJSON :: MarkedEvent -> Builder ()
EncodeJSON, Value -> Converter MarkedEvent
(Value -> Converter MarkedEvent) -> FromValue MarkedEvent
forall a. (Value -> Converter a) -> FromValue a
fromValue :: Value -> Converter MarkedEvent
$cfromValue :: Value -> Converter MarkedEvent
FromValue, MarkedEvent -> Value
(MarkedEvent -> Value) -> ToValue MarkedEvent
forall a. (a -> Value) -> ToValue a
toValue :: MarkedEvent -> Value
$ctoValue :: MarkedEvent -> Value
ToValue)

-- | The pointer position
data Mark = Mark 
    { Mark -> Int
yamlIndex  :: {-# UNPACK #-} !Int
    , Mark -> Int
yamlLine   :: {-# UNPACK #-} !Int
    , Mark -> Int
yamlColumn :: {-# UNPACK #-} !Int 
    }
    deriving (Int -> Mark -> ShowS
[Mark] -> ShowS
Mark -> String
(Int -> Mark -> ShowS)
-> (Mark -> String) -> ([Mark] -> ShowS) -> Show Mark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mark] -> ShowS
$cshowList :: [Mark] -> ShowS
show :: Mark -> String
$cshow :: Mark -> String
showsPrec :: Int -> Mark -> ShowS
$cshowsPrec :: Int -> Mark -> ShowS
Show, Eq Mark
Eq Mark
-> (Mark -> Mark -> Ordering)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Mark)
-> (Mark -> Mark -> Mark)
-> Ord Mark
Mark -> Mark -> Bool
Mark -> Mark -> Ordering
Mark -> Mark -> Mark
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mark -> Mark -> Mark
$cmin :: Mark -> Mark -> Mark
max :: Mark -> Mark -> Mark
$cmax :: Mark -> Mark -> Mark
>= :: Mark -> Mark -> Bool
$c>= :: Mark -> Mark -> Bool
> :: Mark -> Mark -> Bool
$c> :: Mark -> Mark -> Bool
<= :: Mark -> Mark -> Bool
$c<= :: Mark -> Mark -> Bool
< :: Mark -> Mark -> Bool
$c< :: Mark -> Mark -> Bool
compare :: Mark -> Mark -> Ordering
$ccompare :: Mark -> Mark -> Ordering
$cp1Ord :: Eq Mark
Ord, Mark -> Mark -> Bool
(Mark -> Mark -> Bool) -> (Mark -> Mark -> Bool) -> Eq Mark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mark -> Mark -> Bool
$c/= :: Mark -> Mark -> Bool
== :: Mark -> Mark -> Bool
$c== :: Mark -> Mark -> Bool
Eq, (forall x. Mark -> Rep Mark x)
-> (forall x. Rep Mark x -> Mark) -> Generic Mark
forall x. Rep Mark x -> Mark
forall x. Mark -> Rep Mark x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mark x -> Mark
$cfrom :: forall x. Mark -> Rep Mark x
Generic)
    deriving anyclass (Int -> Mark -> Builder ()
(Int -> Mark -> Builder ()) -> ShowT Mark
forall a. (Int -> a -> Builder ()) -> ShowT a
toUTF8BuilderP :: Int -> Mark -> Builder ()
$ctoUTF8BuilderP :: Int -> Mark -> Builder ()
ShowT, Mark -> Builder ()
(Mark -> Builder ()) -> EncodeJSON Mark
forall a. (a -> Builder ()) -> EncodeJSON a
encodeJSON :: Mark -> Builder ()
$cencodeJSON :: Mark -> Builder ()
EncodeJSON, Value -> Converter Mark
(Value -> Converter Mark) -> FromValue Mark
forall a. (Value -> Converter a) -> FromValue a
fromValue :: Value -> Converter Mark
$cfromValue :: Value -> Converter Mark
FromValue, Mark -> Value
(Mark -> Value) -> ToValue Mark
forall a. (a -> Value) -> ToValue a
toValue :: Mark -> Value
$ctoValue :: Mark -> Value
ToValue)

-- | Style for scalars - e.g. quoted / folded
-- 
type ScalarStyle = CInt
pattern Any, Plain, SingleQuoted, DoubleQuoted, Literal, Folded, PlainNoTag :: ScalarStyle
pattern $bAny :: ScalarStyle
$mAny :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
Any           = 0
pattern $bPlain :: ScalarStyle
$mPlain :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
Plain         = 1 
pattern $bSingleQuoted :: ScalarStyle
$mSingleQuoted :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
SingleQuoted  = 2 
pattern $bDoubleQuoted :: ScalarStyle
$mDoubleQuoted :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
DoubleQuoted  = 3 
pattern $bLiteral :: ScalarStyle
$mLiteral :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
Literal       = 4 
pattern $bFolded :: ScalarStyle
$mFolded :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
Folded        = 5 
pattern $bPlainNoTag :: ScalarStyle
$mPlainNoTag :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
PlainNoTag    = 6 

-- | Style for sequences - e.g. block or flow
-- 
type SequenceStyle = CInt
pattern AnySequence, BlockSequence, FlowSequence :: SequenceStyle
pattern $bAnySequence :: ScalarStyle
$mAnySequence :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
AnySequence   = 0
pattern $bBlockSequence :: ScalarStyle
$mBlockSequence :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
BlockSequence = 1 
pattern $bFlowSequence :: ScalarStyle
$mFlowSequence :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
FlowSequence  = 2

-- | Style for mappings - e.g. block or flow
-- 
type MappingStyle = CInt 
pattern AnyMapping, BlockMapping, FlowMapping :: MappingStyle
pattern $bAnyMapping :: ScalarStyle
$mAnyMapping :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
AnyMapping   = 0 
pattern $bBlockMapping :: ScalarStyle
$mBlockMapping :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
BlockMapping = 1
pattern $bFlowMapping :: ScalarStyle
$mFlowMapping :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
FlowMapping  = 2

data Tag = StrTag
         | FloatTag
         | NullTag
         | BoolTag
         | SetTag
         | IntTag
         | SeqTag
         | MapTag
         | UriTag T.Text
         | NoTag
    deriving (Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, Eq Tag
Eq Tag
-> (Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
$cp1Ord :: Eq Tag
Ord, Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, (forall x. Tag -> Rep Tag x)
-> (forall x. Rep Tag x -> Tag) -> Generic Tag
forall x. Rep Tag x -> Tag
forall x. Tag -> Rep Tag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tag x -> Tag
$cfrom :: forall x. Tag -> Rep Tag x
Generic)
    deriving anyclass (Int -> Tag -> Builder ()
(Int -> Tag -> Builder ()) -> ShowT Tag
forall a. (Int -> a -> Builder ()) -> ShowT a
toUTF8BuilderP :: Int -> Tag -> Builder ()
$ctoUTF8BuilderP :: Int -> Tag -> Builder ()
ShowT, Tag -> Builder ()
(Tag -> Builder ()) -> EncodeJSON Tag
forall a. (a -> Builder ()) -> EncodeJSON a
encodeJSON :: Tag -> Builder ()
$cencodeJSON :: Tag -> Builder ()
EncodeJSON, Value -> Converter Tag
(Value -> Converter Tag) -> FromValue Tag
forall a. (Value -> Converter a) -> FromValue a
fromValue :: Value -> Converter Tag
$cfromValue :: Value -> Converter Tag
FromValue, Tag -> Value
(Tag -> Value) -> ToValue Tag
forall a. (a -> Value) -> ToValue a
toValue :: Tag -> Value
$ctoValue :: Tag -> Value
ToValue)

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

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

data LibYAMLException
    = ParseEventException CB.CBytes CB.CBytes Mark CallStack  -- ^ problem, context, mark
    | ParseAliasEventWithEmptyAnchor Mark Mark CallStack
    | EmitEventException Event CInt CallStack
    | EmitAliasEventWithEmptyAnchor CallStack
    deriving Int -> LibYAMLException -> ShowS
[LibYAMLException] -> ShowS
LibYAMLException -> String
(Int -> LibYAMLException -> ShowS)
-> (LibYAMLException -> String)
-> ([LibYAMLException] -> ShowS)
-> Show LibYAMLException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LibYAMLException] -> ShowS
$cshowList :: [LibYAMLException] -> ShowS
show :: LibYAMLException -> String
$cshow :: LibYAMLException -> String
showsPrec :: Int -> LibYAMLException -> ShowS
$cshowsPrec :: Int -> LibYAMLException -> ShowS
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 :: Bytes -> Resource (Source MarkedEvent)
initParser Bytes
bs 
    | Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
bs = Source MarkedEvent -> Resource (Source MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return BIO :: forall inp out.
(HasCallStack => inp -> IO (Maybe out))
-> (HasCallStack => IO (Maybe out)) -> BIO inp out
BIO{ pull :: HasCallStack => IO (Maybe MarkedEvent)
pull = Maybe MarkedEvent -> IO (Maybe MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MarkedEvent
forall a. Maybe a
Nothing }
    | Bool
otherwise = do
        (Ptr ParserStruct
pparser, Bytes
bs', Source MarkedEvent
bio) <- IO (Ptr ParserStruct, Bytes, Source MarkedEvent)
-> ((Ptr ParserStruct, Bytes, Source MarkedEvent) -> IO ())
-> Resource (Ptr ParserStruct, Bytes, Source MarkedEvent)
forall a. IO a -> (a -> IO ()) -> Resource a
initResource 
            (do Ptr ParserStruct
pparser <- IO (Ptr ParserStruct) -> IO (Ptr ParserStruct)
forall a. HasCallStack => IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull IO (Ptr ParserStruct)
hs_init_yaml_parser
                Bytes
bs' <- Bytes -> IO Bytes
forall a. Prim a => PrimVector a -> IO (PrimVector a)
pinPrimVector Bytes
bs
                Bytes -> (Ptr Word8 -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
bs' ((Ptr Word8 -> Int -> IO ()) -> IO ())
-> (Ptr Word8 -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bptr Int
blen -> do
                    Ptr ParserStruct -> Ptr Word8 -> CSize -> IO ()
yaml_parser_set_input_string Ptr ParserStruct
pparser Ptr Word8
bptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blen)
                (Ptr ParserStruct, Bytes, Source MarkedEvent)
-> IO (Ptr ParserStruct, Bytes, Source MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ParserStruct
pparser, Bytes
bs', BIO :: forall inp out.
(HasCallStack => inp -> IO (Maybe out))
-> (HasCallStack => IO (Maybe out)) -> BIO inp out
BIO{ pull :: HasCallStack => IO (Maybe MarkedEvent)
pull = HasCallStack => Ptr ParserStruct -> IO (Maybe MarkedEvent)
Ptr ParserStruct -> IO (Maybe MarkedEvent)
peekParserEvent Ptr ParserStruct
pparser }))
            (\ (Ptr ParserStruct
pparser, Bytes
bs', Source MarkedEvent
_) -> do
                Ptr ParserStruct -> IO ()
hs_free_yaml_parser Ptr ParserStruct
pparser
                Bytes -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch Bytes
bs')
        Source MarkedEvent -> Resource (Source MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return Source MarkedEvent
bio

-- | Create a source that yields marked events from a piece of YAML bytes.
--
initFileParser :: HasCallStack => CB.CBytes -> Resource (Source MarkedEvent)
initFileParser :: CBytes -> Resource (Source MarkedEvent)
initFileParser CBytes
p = do
    (Ptr ParserStruct
pparser, Ptr File
file, Source MarkedEvent
bio) <- IO (Ptr ParserStruct, Ptr File, Source MarkedEvent)
-> ((Ptr ParserStruct, Ptr File, Source MarkedEvent) -> IO ())
-> Resource (Ptr ParserStruct, Ptr File, Source MarkedEvent)
forall a. IO a -> (a -> IO ()) -> Resource a
initResource 
        (do Ptr ParserStruct
pparser <- IO (Ptr ParserStruct) -> IO (Ptr ParserStruct)
forall a. HasCallStack => IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull IO (Ptr ParserStruct)
hs_init_yaml_parser
            (File
f, IO ()
_) <- Resource File -> HasCallStack => IO (File, IO ())
forall a. Resource a -> HasCallStack => IO (a, IO ())
acquire (Resource File -> HasCallStack => IO (File, IO ()))
-> Resource File -> HasCallStack => IO (File, IO ())
forall a b. (a -> b) -> a -> b
$ CBytes -> ScalarStyle -> ScalarStyle -> Resource File
FS.initFile CBytes
p ScalarStyle
FS.O_RDONLY ScalarStyle
FS.DEFAULT_MODE
            ScalarStyle
fd <- File -> IO ScalarStyle
FS.getFileFD File
f
            Ptr File
file <-   CBytes -> (BA# Word8 -> IO (Ptr File)) -> IO (Ptr File)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
"r" (ScalarStyle -> BA# Word8 -> IO (Ptr File)
fdopen ScalarStyle
fd)
            Ptr ParserStruct -> Ptr File -> IO ()
yaml_parser_set_input_file Ptr ParserStruct
pparser Ptr File
file
            (Ptr ParserStruct, Ptr File, Source MarkedEvent)
-> IO (Ptr ParserStruct, Ptr File, Source MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ParserStruct
pparser, Ptr File
file, BIO :: forall inp out.
(HasCallStack => inp -> IO (Maybe out))
-> (HasCallStack => IO (Maybe out)) -> BIO inp out
BIO{ pull :: HasCallStack => IO (Maybe MarkedEvent)
pull = HasCallStack => Ptr ParserStruct -> IO (Maybe MarkedEvent)
Ptr ParserStruct -> IO (Maybe MarkedEvent)
peekParserEvent Ptr ParserStruct
pparser }))
        (\ (Ptr ParserStruct
pparser, Ptr File
file, Source MarkedEvent
_) -> do
            Ptr ParserStruct -> IO ()
hs_free_yaml_parser Ptr ParserStruct
pparser
            Ptr File -> IO ()
fclose Ptr File
file)
    Source MarkedEvent -> Resource (Source MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return Source MarkedEvent
bio


-- | Parse a single event from YAML parser.
peekParserEvent :: HasCallStack => Ptr ParserStruct -> IO (Maybe MarkedEvent)
peekParserEvent :: Ptr ParserStruct -> IO (Maybe MarkedEvent)
peekParserEvent Ptr ParserStruct
parser = do
    (Bytes
_, Maybe MarkedEvent
me) <- Int
-> (MBA# Any -> IO (Maybe MarkedEvent))
-> IO (Bytes, Maybe MarkedEvent)
forall k (a :: k) b. Int -> (MBA# Any -> IO b) -> IO (Bytes, b)
allocBytesUnsafe ((Int
104)) ((MBA# Any -> IO (Maybe MarkedEvent))
 -> IO (Bytes, Maybe MarkedEvent))
-> (MBA# Any -> IO (Maybe MarkedEvent))
-> IO (Bytes, Maybe MarkedEvent)
forall a b. (a -> b) -> a -> b
$ \ MBA# Any
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
    Maybe MarkedEvent -> IO (Maybe MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MarkedEvent
me
  where
    readAnchor :: Int -> MBA# EventStruct -> IO Anchor
    readAnchor :: Int -> MBA# Any -> IO Text
readAnchor Int
off MBA# Any
pe = do
        Ptr Any
p <- MBA# Any -> Int -> IO (Ptr Any)
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe Int
off 
        if Ptr Any
p Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall a. Ptr a
nullPtr 
        then Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
T.empty
        else Bytes -> Text
T.Text (Bytes -> Text) -> IO Bytes -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> IO Bytes
forall a. Ptr a -> IO Bytes
fromNullTerminated Ptr Any
p

    readStyle :: Int -> MBA# EventStruct -> IO CInt
    readStyle :: Int -> MBA# Any -> IO ScalarStyle
readStyle Int
off MBA# Any
pe = MBA# Any -> Int -> IO ScalarStyle
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe Int
off

    readTag :: Int -> MBA# EventStruct -> IO Tag
    readTag :: Int -> MBA# Any -> IO Tag
readTag Int
off MBA# Any
pe = do
        Ptr Any
p <- MBA# Any -> Int -> IO (Ptr Any)
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe Int
off 
        if Ptr Any
p Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall a. Ptr a
nullPtr 
        then Tag -> IO Tag
forall (m :: * -> *) a. Monad m => a -> m a
return Tag
NoTag
        else Bytes -> Tag
bytesToTag (Bytes -> Tag) -> IO Bytes -> IO Tag
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Ptr Any -> IO Bytes
forall a. Ptr a -> IO Bytes
fromNullTerminated Ptr Any
p

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

        CUInt
si :: CUInt <- MBA# Any -> Int -> IO CUInt
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
56)) 
{-# LINE 270 "Z/Data/YAML/FFI.hsc" #-}
        CUInt
sl :: CUInt <- MBA# Any -> Int -> IO CUInt
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
64)) 
{-# LINE 271 "Z/Data/YAML/FFI.hsc" #-}
        CUInt
sc :: CUInt <- MBA# Any -> Int -> IO CUInt
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
72)) 
{-# LINE 272 "Z/Data/YAML/FFI.hsc" #-}
        CUInt
ei :: CUInt <- MBA# Any -> Int -> IO CUInt
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
80)) 
{-# LINE 273 "Z/Data/YAML/FFI.hsc" #-}
        CUInt
el :: CUInt <- MBA# Any -> Int -> IO CUInt
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
88)) 
{-# LINE 274 "Z/Data/YAML/FFI.hsc" #-}
        CUInt
ec :: CUInt <- MBA# Any -> Int -> IO CUInt
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
96)) 
{-# LINE 275 "Z/Data/YAML/FFI.hsc" #-}
        let startMark :: Mark
startMark = Int -> Int -> Int -> Mark
Mark (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
si) (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sl) (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sc)
            endMark :: Mark
endMark = Int -> Int -> Int -> Mark
Mark (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
ei) (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
el) (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
ec)
            returnMarked :: Event -> IO (Maybe MarkedEvent)
returnMarked Event
e = Maybe MarkedEvent -> IO (Maybe MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkedEvent -> Maybe MarkedEvent
forall a. a -> Maybe a
Just (Event -> Mark -> Mark -> MarkedEvent
MarkedEvent Event
e Mark
startMark Mark
endMark))
        case (ScalarStyle
et :: CInt) of
            (ScalarStyle
0)              -> Maybe MarkedEvent -> IO (Maybe MarkedEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MarkedEvent
forall a. Maybe a
Nothing
{-# LINE 280 "Z/Data/YAML/FFI.hsc" #-}
            (ScalarStyle
1)    -> Event -> IO (Maybe MarkedEvent)
returnMarked Event
EventStreamStart
{-# LINE 281 "Z/Data/YAML/FFI.hsc" #-}
            (ScalarStyle
2)      -> Event -> IO (Maybe MarkedEvent)
returnMarked Event
EventStreamEnd
{-# LINE 282 "Z/Data/YAML/FFI.hsc" #-}
            (ScalarStyle
3)  -> Event -> IO (Maybe MarkedEvent)
returnMarked Event
EventDocumentStart
{-# LINE 283 "Z/Data/YAML/FFI.hsc" #-}
            (ScalarStyle
4)    -> Event -> IO (Maybe MarkedEvent)
returnMarked Event
EventDocumentEnd
{-# LINE 284 "Z/Data/YAML/FFI.hsc" #-}
            (ScalarStyle
5) -> do
{-# LINE 285 "Z/Data/YAML/FFI.hsc" #-}
                Ptr Any
yanchor <- MBA# Any -> Int -> IO (Ptr Any)
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
8))
{-# LINE 286 "Z/Data/YAML/FFI.hsc" #-}
                Bytes
anchor <- if Ptr Any
yanchor Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall a. Ptr a
nullPtr
                          then LibYAMLException -> IO Bytes
forall e a. Exception e => e -> IO a
throwIO (Mark -> Mark -> CallStack -> LibYAMLException
ParseAliasEventWithEmptyAnchor Mark
startMark Mark
endMark CallStack
HasCallStack => CallStack
callStack)
                          else Ptr Any -> IO Bytes
forall a. Ptr a -> IO Bytes
fromNullTerminated Ptr Any
yanchor
                Event -> IO (Maybe MarkedEvent)
returnMarked (Text -> Event
EventAlias (Bytes -> Text
T.Text Bytes
anchor))
            (ScalarStyle
6) -> do
{-# LINE 291 "Z/Data/YAML/FFI.hsc" #-}
                Text
anchor <- Int -> MBA# Any -> IO Text
readAnchor ((Int
8)) MBA# Any
pe
{-# LINE 292 "Z/Data/YAML/FFI.hsc" #-}
                Ptr Any
yvalue <- MBA# Any -> Int -> IO (Ptr Any)
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
24))
{-# LINE 293 "Z/Data/YAML/FFI.hsc" #-}
                CULong
ylen   <- MBA# Any -> Int -> IO CULong
forall a. Unaligned a => MBA# Any -> Int -> IO a
peekMBA MBA# Any
pe ((Int
32))
{-# LINE 294 "Z/Data/YAML/FFI.hsc" #-}
                Bytes
bs <- Ptr Any -> Int -> IO Bytes
forall a. Ptr a -> Int -> IO Bytes
fromPtr Ptr Any
yvalue (CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULong
ylen :: CULong))
                Tag
tag <- Int -> MBA# Any -> IO Tag
readTag ((Int
16)) MBA# Any
pe
{-# LINE 296 "Z/Data/YAML/FFI.hsc" #-}
                ScalarStyle
style <- Int -> MBA# Any -> IO ScalarStyle
readStyle ((Int
48)) MBA# Any
pe
{-# LINE 297 "Z/Data/YAML/FFI.hsc" #-}
                Event -> IO (Maybe MarkedEvent)
returnMarked (Text -> Text -> Tag -> ScalarStyle -> Event
EventScalar Text
anchor (Bytes -> Text
T.Text Bytes
bs) Tag
tag ScalarStyle
style)
            (ScalarStyle
7) -> do
{-# LINE 299 "Z/Data/YAML/FFI.hsc" #-}
                Text
anchor <- Int -> MBA# Any -> IO Text
readAnchor ((Int
8)) MBA# Any
pe
{-# LINE 300 "Z/Data/YAML/FFI.hsc" #-}
                Tag
tag <- Int -> MBA# Any -> IO Tag
readTag ((Int
16)) MBA# Any
pe
{-# LINE 301 "Z/Data/YAML/FFI.hsc" #-}
                ScalarStyle
style <- Int -> MBA# Any -> IO ScalarStyle
readStyle ((Int
28)) MBA# Any
pe
{-# LINE 302 "Z/Data/YAML/FFI.hsc" #-}
                Event -> IO (Maybe MarkedEvent)
returnMarked (Text -> Tag -> ScalarStyle -> Event
EventSequenceStart Text
anchor Tag
tag ScalarStyle
style)
            (ScalarStyle
8)    -> Event -> IO (Maybe MarkedEvent)
returnMarked Event
EventSequenceEnd
{-# LINE 304 "Z/Data/YAML/FFI.hsc" #-}
            (ScalarStyle
9) -> do
{-# LINE 305 "Z/Data/YAML/FFI.hsc" #-}
                Text
anchor <- Int -> MBA# Any -> IO Text
readAnchor ((Int
8)) MBA# Any
pe
{-# LINE 306 "Z/Data/YAML/FFI.hsc" #-}
                Tag
tag <- Int -> MBA# Any -> IO Tag
readTag ((Int
16)) MBA# Any
pe
{-# LINE 307 "Z/Data/YAML/FFI.hsc" #-}
                ScalarStyle
style <- Int -> MBA# Any -> IO ScalarStyle
readStyle ((Int
28)) MBA# Any
pe
{-# LINE 308 "Z/Data/YAML/FFI.hsc" #-}
                Event -> IO (Maybe MarkedEvent)
returnMarked (Text -> Tag -> ScalarStyle -> Event
EventMappingStart Text
anchor Tag
tag ScalarStyle
style)
            (ScalarStyle
10) -> Event -> IO (Maybe MarkedEvent)
returnMarked Event
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 :: YAMLFormatOpts -> Resource (Ptr EmitterStruct, Sink Event)
initEmitter fopts :: YAMLFormatOpts
fopts@YAMLFormatOpts{Bool
Int
Event -> ScalarStyle
yamlFormatRenderTags :: YAMLFormatOpts -> Event -> ScalarStyle
yamlFormatWidth :: YAMLFormatOpts -> Int
yamlFormatIndent :: YAMLFormatOpts -> Int
yamlFormatCanonical :: YAMLFormatOpts -> Bool
yamlFormatRenderTags :: Event -> ScalarStyle
yamlFormatWidth :: Int
yamlFormatIndent :: Int
yamlFormatCanonical :: Bool
..} = do
    Ptr EmitterStruct
p <- IO (Ptr EmitterStruct)
-> (Ptr EmitterStruct -> IO ()) -> Resource (Ptr EmitterStruct)
forall a. IO a -> (a -> IO ()) -> Resource a
initResource 
        (do let canonical :: ScalarStyle
canonical = if Bool
yamlFormatCanonical then ScalarStyle
1 else ScalarStyle
0
            IO (Ptr EmitterStruct) -> IO (Ptr EmitterStruct)
forall a. HasCallStack => IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull (ScalarStyle -> ScalarStyle -> ScalarStyle -> IO (Ptr EmitterStruct)
hs_init_yaml_emitter ScalarStyle
canonical
                (Int -> ScalarStyle
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yamlFormatIndent) (Int -> ScalarStyle
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yamlFormatWidth)))
        Ptr EmitterStruct -> IO ()
hs_free_yaml_emitter
    (Ptr EmitterStruct, Sink Event)
-> Resource (Ptr EmitterStruct, Sink Event)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr EmitterStruct
p, BIO :: forall inp out.
(HasCallStack => inp -> IO (Maybe out))
-> (HasCallStack => IO (Maybe out)) -> BIO inp out
BIO {
        push :: HasCallStack => Event -> IO (Maybe Void)
push = \ Event
e -> HasCallStack =>
Ptr EmitterStruct -> YAMLFormatOpts -> Event -> IO ()
Ptr EmitterStruct -> YAMLFormatOpts -> Event -> IO ()
emitEvent Ptr EmitterStruct
p YAMLFormatOpts
fopts Event
e IO () -> IO (Maybe Void) -> IO (Maybe Void)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Void -> IO (Maybe Void)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Void
forall a. Maybe a
Nothing
    ,   pull :: HasCallStack => IO (Maybe Void)
pull = Maybe Void -> IO (Maybe Void)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Void
forall a. Maybe a
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 :: YAMLFormatOpts -> CBytes -> Resource (Sink Event)
initFileEmitter fopts :: YAMLFormatOpts
fopts@YAMLFormatOpts{Bool
Int
Event -> ScalarStyle
yamlFormatRenderTags :: Event -> ScalarStyle
yamlFormatWidth :: Int
yamlFormatIndent :: Int
yamlFormatCanonical :: Bool
yamlFormatRenderTags :: YAMLFormatOpts -> Event -> ScalarStyle
yamlFormatWidth :: YAMLFormatOpts -> Int
yamlFormatIndent :: YAMLFormatOpts -> Int
yamlFormatCanonical :: YAMLFormatOpts -> Bool
..} CBytes
p = do
    (Ptr EmitterStruct
pemitter, Ptr File
file) <- IO (Ptr EmitterStruct, Ptr File)
-> ((Ptr EmitterStruct, Ptr File) -> IO ())
-> Resource (Ptr EmitterStruct, Ptr File)
forall a. IO a -> (a -> IO ()) -> Resource a
initResource
        (do (File
f, IO ()
_) <- Resource File -> HasCallStack => IO (File, IO ())
forall a. Resource a -> HasCallStack => IO (a, IO ())
acquire (Resource File -> HasCallStack => IO (File, IO ()))
-> Resource File -> HasCallStack => IO (File, IO ())
forall a b. (a -> b) -> a -> b
$ CBytes -> ScalarStyle -> ScalarStyle -> Resource File
FS.initFile CBytes
p (ScalarStyle
FS.O_APPEND ScalarStyle -> ScalarStyle -> ScalarStyle
forall a. Bits a => a -> a -> a
.|. ScalarStyle
FS.O_CREAT ScalarStyle -> ScalarStyle -> ScalarStyle
forall a. Bits a => a -> a -> a
.|. ScalarStyle
FS.O_WRONLY) ScalarStyle
FS.DEFAULT_MODE
            ScalarStyle
fd <- File -> IO ScalarStyle
FS.getFileFD File
f
            Ptr File
file <- CBytes -> (BA# Word8 -> IO (Ptr File)) -> IO (Ptr File)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
"w" (ScalarStyle -> BA# Word8 -> IO (Ptr File)
fdopen ScalarStyle
fd)
            let canonical :: ScalarStyle
canonical = if Bool
yamlFormatCanonical then ScalarStyle
1 else ScalarStyle
0
            Ptr EmitterStruct
pemitter <- IO (Ptr EmitterStruct) -> IO (Ptr EmitterStruct)
forall a. HasCallStack => IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull (Ptr File
-> ScalarStyle
-> ScalarStyle
-> ScalarStyle
-> IO (Ptr EmitterStruct)
hs_init_yaml_emitter_file Ptr File
file ScalarStyle
canonical
                (Int -> ScalarStyle
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yamlFormatIndent) (Int -> ScalarStyle
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yamlFormatWidth))
            (Ptr EmitterStruct, Ptr File) -> IO (Ptr EmitterStruct, Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr EmitterStruct
pemitter, Ptr File
file))
            (\ (Ptr EmitterStruct
pemitter, Ptr File
file) -> do
            Ptr EmitterStruct -> IO ()
hs_free_yaml_emitter_file Ptr EmitterStruct
pemitter
            Ptr File -> IO ()
fclose Ptr File
file)
    Sink Event -> Resource (Sink Event)
forall (m :: * -> *) a. Monad m => a -> m a
return BIO :: forall inp out.
(HasCallStack => inp -> IO (Maybe out))
-> (HasCallStack => IO (Maybe out)) -> BIO inp out
BIO {
        push :: HasCallStack => Event -> IO (Maybe Void)
push = \ Event
e -> HasCallStack =>
Ptr EmitterStruct -> YAMLFormatOpts -> Event -> IO ()
Ptr EmitterStruct -> YAMLFormatOpts -> Event -> IO ()
emitEvent Ptr EmitterStruct
pemitter YAMLFormatOpts
fopts Event
e IO () -> IO (Maybe Void) -> IO (Maybe Void)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Void -> IO (Maybe Void)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Void
forall a. Maybe a
Nothing
    ,   pull :: HasCallStack => IO (Maybe Void)
pull = Maybe Void -> IO (Maybe Void)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Void
forall a. Maybe a
Nothing
    }

-- | Fetch YAML emitter's building buffer.
--
getEmitterResult :: Ptr EmitterStruct -> IO T.Text 
getEmitterResult :: Ptr EmitterStruct -> IO Text
getEmitterResult Ptr EmitterStruct
pemitter = do
    CSize
l <- Ptr EmitterStruct -> IO CSize
hs_get_yaml_emitter_length Ptr EmitterStruct
pemitter
    (Bytes
bs,()
_) <- Int -> (MBA# Any -> IO ()) -> IO (Bytes, ())
forall k (a :: k) b. Int -> (MBA# Any -> IO b) -> IO (Bytes, b)
allocBytesUnsafe (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
l) ((MBA# Any -> IO ()) -> IO (Bytes, ()))
-> (MBA# Any -> IO ()) -> IO (Bytes, ())
forall a b. (a -> b) -> a -> b
$ \ MBA# Any
p -> Ptr EmitterStruct -> MBA# Any -> CSize -> IO ()
hs_copy_yaml_emitter_result Ptr EmitterStruct
pemitter MBA# Any
p CSize
l
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes -> Text
T.Text Bytes
bs)

-- | Push a single YAML event to emitter.
--
emitEvent :: HasCallStack => Ptr EmitterStruct -> YAMLFormatOpts -> Event -> IO ()
emitEvent :: Ptr EmitterStruct -> YAMLFormatOpts -> Event -> IO ()
emitEvent Ptr EmitterStruct
pemitter YAMLFormatOpts
fopts Event
e = IO (Bytes, ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Bytes, ()) -> IO ())
-> ((MBA# Any -> IO ()) -> IO (Bytes, ()))
-> (MBA# Any -> IO ())
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (MBA# Any -> IO ()) -> IO (Bytes, ())
forall k (a :: k) b. Int -> (MBA# Any -> IO b) -> IO (Bytes, b)
allocBytesUnsafe ((Int
104)) ((MBA# Any -> IO ()) -> IO ()) -> (MBA# Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ MBA# Any
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 :: Event -> ScalarStyle
tagsImplicit (EventScalar Text
_ Text
_ Tag
t ScalarStyle
_) | Tag -> Bool
tagSuppressed Tag
t = ScalarStyle
1
    tagsImplicit (EventMappingStart Text
_ Tag
t ScalarStyle
_) | Tag -> Bool
tagSuppressed Tag
t = ScalarStyle
1
    tagsImplicit (EventSequenceStart Text
_ Tag
t ScalarStyle
_) | Tag -> Bool
tagSuppressed Tag
t = ScalarStyle
1
    tagsImplicit Event
evt = YAMLFormatOpts -> Event -> ScalarStyle
yamlFormatRenderTags YAMLFormatOpts
fopts Event
evt

    tagSuppressed :: Tag -> Bool
tagSuppressed (Tag
NoTag) = Bool
True
    tagSuppressed (UriTag Text
"") = Bool
True
    tagSuppressed Tag
_ = Bool
False

    withTag :: Tag -> (BA# Word8 -> IO a) -> IO a
withTag Tag
tag = CBytes -> (BA# Word8 -> IO a) -> IO a
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe (Tag -> CBytes
tagToCBytes Tag
tag)
    withAnchor :: Text -> (BA# Word8 -> IO a) -> IO a
withAnchor Text
anchor = CBytes -> (BA# Word8 -> IO a) -> IO a
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe (Text -> CBytes
CB.fromText Text
anchor) 


-- | Whether a tag should be rendered explicitly in the output or left
-- implicit.
--
type TagRender = CInt
pattern Explicit, Implicit :: TagRender
pattern $bExplicit :: ScalarStyle
$mExplicit :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
Explicit = 0
pattern $bImplicit :: ScalarStyle
$mImplicit :: forall r. ScalarStyle -> (Void# -> r) -> (Void# -> r) -> r
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 :: Event -> ScalarStyle
renderScalarTags (EventScalar Text
_ Text
_ Tag
_ ScalarStyle
_) = ScalarStyle
Explicit
renderScalarTags (EventSequenceStart Text
_ Tag
_ ScalarStyle
_) = ScalarStyle
Implicit
renderScalarTags (EventMappingStart Text
_ Tag
_ ScalarStyle
_) = ScalarStyle
Implicit
renderScalarTags Event
_ = ScalarStyle
Implicit

-- | A value for 'formatOptionsRenderTags' that renders all
-- tags (except 'NoTag' tag and 'PlainNoTag' style).
--
renderAllTags :: Event -> TagRender
renderAllTags :: Event -> ScalarStyle
renderAllTags Event
_ = ScalarStyle
Explicit

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

-- which are instances of 'UriTag'
--
renderUriTags :: Event -> TagRender
renderUriTags :: Event -> ScalarStyle
renderUriTags (EventScalar Text
_ Text
_ UriTag{} ScalarStyle
_) = ScalarStyle
Explicit
renderUriTags (EventSequenceStart Text
_ UriTag{} ScalarStyle
_) = ScalarStyle
Explicit
renderUriTags (EventMappingStart Text
_ UriTag{} ScalarStyle
_) = ScalarStyle
Explicit
renderUriTags Event
_ = ScalarStyle
Implicit

-- | Contains options relating to the formatting (indendation, width) of the YAML output.
--
data YAMLFormatOpts = YAMLFormatOpts
    { YAMLFormatOpts -> Bool
yamlFormatCanonical  :: Bool     -- ^ use canonical style, default 'False'
    , YAMLFormatOpts -> Int
yamlFormatIndent     :: Int      -- ^ default 4
    , YAMLFormatOpts -> Int
yamlFormatWidth      :: Int      -- ^ default 80
    , YAMLFormatOpts -> Event -> ScalarStyle
yamlFormatRenderTags :: Event -> TagRender
    }

defaultYAMLFormatOpts :: YAMLFormatOpts
defaultYAMLFormatOpts :: YAMLFormatOpts
defaultYAMLFormatOpts = Bool -> Int -> Int -> (Event -> ScalarStyle) -> YAMLFormatOpts
YAMLFormatOpts Bool
False Int
4 Int
80 Event -> ScalarStyle
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 ()