{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gio.Objects.SimpleIOStream
    ( 

-- * Exported types
    SimpleIOStream(..)                      ,
    SimpleIOStreamK                         ,
    toSimpleIOStream                        ,
    noSimpleIOStream                        ,


 -- * Methods
-- ** simpleIOStreamNew
    simpleIOStreamNew                       ,




 -- * Properties
-- ** InputStream
    SimpleIOStreamInputStreamPropertyInfo   ,
    constructSimpleIOStreamInputStream      ,
    getSimpleIOStreamInputStream            ,


-- ** OutputStream
    SimpleIOStreamOutputStreamPropertyInfo  ,
    constructSimpleIOStreamOutputStream     ,
    getSimpleIOStreamOutputStream           ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gio.Types
import GI.Gio.Callbacks
import qualified GI.GObject as GObject

newtype SimpleIOStream = SimpleIOStream (ForeignPtr SimpleIOStream)
foreign import ccall "g_simple_io_stream_get_type"
    c_g_simple_io_stream_get_type :: IO GType

type instance ParentTypes SimpleIOStream = SimpleIOStreamParentTypes
type SimpleIOStreamParentTypes = '[IOStream, GObject.Object]

instance GObject SimpleIOStream where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_g_simple_io_stream_get_type
    

class GObject o => SimpleIOStreamK o
instance (GObject o, IsDescendantOf SimpleIOStream o) => SimpleIOStreamK o

toSimpleIOStream :: SimpleIOStreamK o => o -> IO SimpleIOStream
toSimpleIOStream = unsafeCastTo SimpleIOStream

noSimpleIOStream :: Maybe SimpleIOStream
noSimpleIOStream = Nothing

--- XXX Duplicated object with different types:
  --- Name {namespace = "Gio", name = "SimpleIOStream"} -> Property {propName = "input-stream", propType = TInterface "Gio" "InputStream", propFlags = [PropertyReadable,PropertyWritable,PropertyConstructOnly], propTransfer = TransferNothing, propDeprecated = Nothing}
  --- Name {namespace = "Gio", name = "IOStream"} -> Property {propName = "input-stream", propType = TInterface "Gio" "InputStream", propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing}
--- XXX Duplicated object with different types:
  --- Name {namespace = "Gio", name = "SimpleIOStream"} -> Property {propName = "output-stream", propType = TInterface "Gio" "OutputStream", propFlags = [PropertyReadable,PropertyWritable,PropertyConstructOnly], propTransfer = TransferNothing, propDeprecated = Nothing}
  --- Name {namespace = "Gio", name = "IOStream"} -> Property {propName = "output-stream", propType = TInterface "Gio" "OutputStream", propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing}
-- VVV Prop "input-stream"
   -- Type: TInterface "Gio" "InputStream"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getSimpleIOStreamInputStream :: (MonadIO m, SimpleIOStreamK o) => o -> m InputStream
getSimpleIOStreamInputStream obj = liftIO $ getObjectPropertyObject obj "input-stream" InputStream

constructSimpleIOStreamInputStream :: (InputStreamK a) => a -> IO ([Char], GValue)
constructSimpleIOStreamInputStream val = constructObjectPropertyObject "input-stream" val

data SimpleIOStreamInputStreamPropertyInfo
instance AttrInfo SimpleIOStreamInputStreamPropertyInfo where
    type AttrAllowedOps SimpleIOStreamInputStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SimpleIOStreamInputStreamPropertyInfo = InputStreamK
    type AttrBaseTypeConstraint SimpleIOStreamInputStreamPropertyInfo = SimpleIOStreamK
    type AttrGetType SimpleIOStreamInputStreamPropertyInfo = InputStream
    type AttrLabel SimpleIOStreamInputStreamPropertyInfo = "SimpleIOStream::input-stream"
    attrGet _ = getSimpleIOStreamInputStream
    attrSet _ = undefined
    attrConstruct _ = constructSimpleIOStreamInputStream

-- VVV Prop "output-stream"
   -- Type: TInterface "Gio" "OutputStream"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getSimpleIOStreamOutputStream :: (MonadIO m, SimpleIOStreamK o) => o -> m OutputStream
getSimpleIOStreamOutputStream obj = liftIO $ getObjectPropertyObject obj "output-stream" OutputStream

constructSimpleIOStreamOutputStream :: (OutputStreamK a) => a -> IO ([Char], GValue)
constructSimpleIOStreamOutputStream val = constructObjectPropertyObject "output-stream" val

data SimpleIOStreamOutputStreamPropertyInfo
instance AttrInfo SimpleIOStreamOutputStreamPropertyInfo where
    type AttrAllowedOps SimpleIOStreamOutputStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SimpleIOStreamOutputStreamPropertyInfo = OutputStreamK
    type AttrBaseTypeConstraint SimpleIOStreamOutputStreamPropertyInfo = SimpleIOStreamK
    type AttrGetType SimpleIOStreamOutputStreamPropertyInfo = OutputStream
    type AttrLabel SimpleIOStreamOutputStreamPropertyInfo = "SimpleIOStream::output-stream"
    attrGet _ = getSimpleIOStreamOutputStream
    attrSet _ = undefined
    attrConstruct _ = constructSimpleIOStreamOutputStream

type instance AttributeList SimpleIOStream = SimpleIOStreamAttributeList
type SimpleIOStreamAttributeList = ('[ '("closed", IOStreamClosedPropertyInfo)] :: [(Symbol, *)])

type instance SignalList SimpleIOStream = SimpleIOStreamSignalList
type SimpleIOStreamSignalList = ('[ '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method SimpleIOStream::new
-- method type : Constructor
-- Args : [Arg {argName = "input_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "output_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "input_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "output_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "SimpleIOStream"
-- throws : False
-- Skip return : False

foreign import ccall "g_simple_io_stream_new" g_simple_io_stream_new :: 
    Ptr InputStream ->                      -- input_stream : TInterface "Gio" "InputStream"
    Ptr OutputStream ->                     -- output_stream : TInterface "Gio" "OutputStream"
    IO (Ptr SimpleIOStream)


simpleIOStreamNew ::
    (MonadIO m, InputStreamK a, OutputStreamK b) =>
    a ->                                    -- input_stream
    b ->                                    -- output_stream
    m SimpleIOStream
simpleIOStreamNew input_stream output_stream = liftIO $ do
    let input_stream' = unsafeManagedPtrCastPtr input_stream
    let output_stream' = unsafeManagedPtrCastPtr output_stream
    result <- g_simple_io_stream_new input_stream' output_stream'
    checkUnexpectedReturnNULL "g_simple_io_stream_new" result
    result' <- (wrapObject SimpleIOStream) result
    touchManagedPtr input_stream
    touchManagedPtr output_stream
    return result'