{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GFileInputStream provides input streams that take their
-- content from a file.
-- 
-- GFileInputStream implements t'GI.Gio.Interfaces.Seekable.Seekable', which allows the input
-- stream to jump to arbitrary positions in the file, provided the
-- filesystem of the file allows it. To find the position of a file
-- input stream, use 'GI.Gio.Interfaces.Seekable.seekableTell'. To find out if a file input
-- stream supports seeking, use 'GI.Gio.Interfaces.Seekable.seekableCanSeek'.
-- To position a file input stream, use 'GI.Gio.Interfaces.Seekable.seekableSeek'.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gio.Objects.FileInputStream
    ( 

-- * Exported types
    FileInputStream(..)                     ,
    IsFileInputStream                       ,
    toFileInputStream                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [canSeek]("GI.Gio.Interfaces.Seekable#g:method:canSeek"), [canTruncate]("GI.Gio.Interfaces.Seekable#g:method:canTruncate"), [clearPending]("GI.Gio.Objects.InputStream#g:method:clearPending"), [close]("GI.Gio.Objects.InputStream#g:method:close"), [closeAsync]("GI.Gio.Objects.InputStream#g:method:closeAsync"), [closeFinish]("GI.Gio.Objects.InputStream#g:method:closeFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasPending]("GI.Gio.Objects.InputStream#g:method:hasPending"), [isClosed]("GI.Gio.Objects.InputStream#g:method:isClosed"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [queryInfo]("GI.Gio.Objects.FileInputStream#g:method:queryInfo"), [queryInfoAsync]("GI.Gio.Objects.FileInputStream#g:method:queryInfoAsync"), [queryInfoFinish]("GI.Gio.Objects.FileInputStream#g:method:queryInfoFinish"), [read]("GI.Gio.Objects.InputStream#g:method:read"), [readAll]("GI.Gio.Objects.InputStream#g:method:readAll"), [readAllAsync]("GI.Gio.Objects.InputStream#g:method:readAllAsync"), [readAllFinish]("GI.Gio.Objects.InputStream#g:method:readAllFinish"), [readAsync]("GI.Gio.Objects.InputStream#g:method:readAsync"), [readBytes]("GI.Gio.Objects.InputStream#g:method:readBytes"), [readBytesAsync]("GI.Gio.Objects.InputStream#g:method:readBytesAsync"), [readBytesFinish]("GI.Gio.Objects.InputStream#g:method:readBytesFinish"), [readFinish]("GI.Gio.Objects.InputStream#g:method:readFinish"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [seek]("GI.Gio.Interfaces.Seekable#g:method:seek"), [skip]("GI.Gio.Objects.InputStream#g:method:skip"), [skipAsync]("GI.Gio.Objects.InputStream#g:method:skipAsync"), [skipFinish]("GI.Gio.Objects.InputStream#g:method:skipFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [tell]("GI.Gio.Interfaces.Seekable#g:method:tell"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [truncate]("GI.Gio.Interfaces.Seekable#g:method:truncate"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setPending]("GI.Gio.Objects.InputStream#g:method:setPending"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFileInputStreamMethod            ,
#endif

-- ** queryInfo #method:queryInfo#

#if defined(ENABLE_OVERLOADING)
    FileInputStreamQueryInfoMethodInfo      ,
#endif
    fileInputStreamQueryInfo                ,


-- ** queryInfoAsync #method:queryInfoAsync#

#if defined(ENABLE_OVERLOADING)
    FileInputStreamQueryInfoAsyncMethodInfo ,
#endif
    fileInputStreamQueryInfoAsync           ,


-- ** queryInfoFinish #method:queryInfoFinish#

#if defined(ENABLE_OVERLOADING)
    FileInputStreamQueryInfoFinishMethodInfo,
#endif
    fileInputStreamQueryInfoFinish          ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Seekable as Gio.Seekable
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.FileInfo as Gio.FileInfo
import {-# SOURCE #-} qualified GI.Gio.Objects.InputStream as Gio.InputStream

-- | Memory-managed wrapper type.
newtype FileInputStream = FileInputStream (SP.ManagedPtr FileInputStream)
    deriving (FileInputStream -> FileInputStream -> Bool
(FileInputStream -> FileInputStream -> Bool)
-> (FileInputStream -> FileInputStream -> Bool)
-> Eq FileInputStream
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileInputStream -> FileInputStream -> Bool
== :: FileInputStream -> FileInputStream -> Bool
$c/= :: FileInputStream -> FileInputStream -> Bool
/= :: FileInputStream -> FileInputStream -> Bool
Eq)

instance SP.ManagedPtrNewtype FileInputStream where
    toManagedPtr :: FileInputStream -> ManagedPtr FileInputStream
toManagedPtr (FileInputStream ManagedPtr FileInputStream
p) = ManagedPtr FileInputStream
p

foreign import ccall "g_file_input_stream_get_type"
    c_g_file_input_stream_get_type :: IO B.Types.GType

instance B.Types.TypedObject FileInputStream where
    glibType :: IO GType
glibType = IO GType
c_g_file_input_stream_get_type

instance B.Types.GObject FileInputStream

-- | Type class for types which can be safely cast to `FileInputStream`, for instance with `toFileInputStream`.
class (SP.GObject o, O.IsDescendantOf FileInputStream o) => IsFileInputStream o
instance (SP.GObject o, O.IsDescendantOf FileInputStream o) => IsFileInputStream o

instance O.HasParentTypes FileInputStream
type instance O.ParentTypes FileInputStream = '[Gio.InputStream.InputStream, GObject.Object.Object, Gio.Seekable.Seekable]

-- | Cast to `FileInputStream`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toFileInputStream :: (MIO.MonadIO m, IsFileInputStream o) => o -> m FileInputStream
toFileInputStream :: forall (m :: * -> *) o.
(MonadIO m, IsFileInputStream o) =>
o -> m FileInputStream
toFileInputStream = IO FileInputStream -> m FileInputStream
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO FileInputStream -> m FileInputStream)
-> (o -> IO FileInputStream) -> o -> m FileInputStream
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr FileInputStream -> FileInputStream)
-> o -> IO FileInputStream
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr FileInputStream -> FileInputStream
FileInputStream

-- | Convert 'FileInputStream' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe FileInputStream) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_file_input_stream_get_type
    gvalueSet_ :: Ptr GValue -> Maybe FileInputStream -> IO ()
gvalueSet_ Ptr GValue
gv Maybe FileInputStream
P.Nothing = Ptr GValue -> Ptr FileInputStream -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr FileInputStream
forall a. Ptr a
FP.nullPtr :: FP.Ptr FileInputStream)
    gvalueSet_ Ptr GValue
gv (P.Just FileInputStream
obj) = FileInputStream -> (Ptr FileInputStream -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FileInputStream
obj (Ptr GValue -> Ptr FileInputStream -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe FileInputStream)
gvalueGet_ Ptr GValue
gv = do
        Ptr FileInputStream
ptr <- Ptr GValue -> IO (Ptr FileInputStream)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr FileInputStream)
        if Ptr FileInputStream
ptr Ptr FileInputStream -> Ptr FileInputStream -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr FileInputStream
forall a. Ptr a
FP.nullPtr
        then FileInputStream -> Maybe FileInputStream
forall a. a -> Maybe a
P.Just (FileInputStream -> Maybe FileInputStream)
-> IO FileInputStream -> IO (Maybe FileInputStream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr FileInputStream -> FileInputStream)
-> Ptr FileInputStream -> IO FileInputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr FileInputStream -> FileInputStream
FileInputStream Ptr FileInputStream
ptr
        else Maybe FileInputStream -> IO (Maybe FileInputStream)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileInputStream
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveFileInputStreamMethod (t :: Symbol) (o :: *) :: * where
    ResolveFileInputStreamMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFileInputStreamMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFileInputStreamMethod "canSeek" o = Gio.Seekable.SeekableCanSeekMethodInfo
    ResolveFileInputStreamMethod "canTruncate" o = Gio.Seekable.SeekableCanTruncateMethodInfo
    ResolveFileInputStreamMethod "clearPending" o = Gio.InputStream.InputStreamClearPendingMethodInfo
    ResolveFileInputStreamMethod "close" o = Gio.InputStream.InputStreamCloseMethodInfo
    ResolveFileInputStreamMethod "closeAsync" o = Gio.InputStream.InputStreamCloseAsyncMethodInfo
    ResolveFileInputStreamMethod "closeFinish" o = Gio.InputStream.InputStreamCloseFinishMethodInfo
    ResolveFileInputStreamMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFileInputStreamMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFileInputStreamMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFileInputStreamMethod "hasPending" o = Gio.InputStream.InputStreamHasPendingMethodInfo
    ResolveFileInputStreamMethod "isClosed" o = Gio.InputStream.InputStreamIsClosedMethodInfo
    ResolveFileInputStreamMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFileInputStreamMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFileInputStreamMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFileInputStreamMethod "queryInfo" o = FileInputStreamQueryInfoMethodInfo
    ResolveFileInputStreamMethod "queryInfoAsync" o = FileInputStreamQueryInfoAsyncMethodInfo
    ResolveFileInputStreamMethod "queryInfoFinish" o = FileInputStreamQueryInfoFinishMethodInfo
    ResolveFileInputStreamMethod "read" o = Gio.InputStream.InputStreamReadMethodInfo
    ResolveFileInputStreamMethod "readAll" o = Gio.InputStream.InputStreamReadAllMethodInfo
    ResolveFileInputStreamMethod "readAllAsync" o = Gio.InputStream.InputStreamReadAllAsyncMethodInfo
    ResolveFileInputStreamMethod "readAllFinish" o = Gio.InputStream.InputStreamReadAllFinishMethodInfo
    ResolveFileInputStreamMethod "readAsync" o = Gio.InputStream.InputStreamReadAsyncMethodInfo
    ResolveFileInputStreamMethod "readBytes" o = Gio.InputStream.InputStreamReadBytesMethodInfo
    ResolveFileInputStreamMethod "readBytesAsync" o = Gio.InputStream.InputStreamReadBytesAsyncMethodInfo
    ResolveFileInputStreamMethod "readBytesFinish" o = Gio.InputStream.InputStreamReadBytesFinishMethodInfo
    ResolveFileInputStreamMethod "readFinish" o = Gio.InputStream.InputStreamReadFinishMethodInfo
    ResolveFileInputStreamMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFileInputStreamMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFileInputStreamMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFileInputStreamMethod "seek" o = Gio.Seekable.SeekableSeekMethodInfo
    ResolveFileInputStreamMethod "skip" o = Gio.InputStream.InputStreamSkipMethodInfo
    ResolveFileInputStreamMethod "skipAsync" o = Gio.InputStream.InputStreamSkipAsyncMethodInfo
    ResolveFileInputStreamMethod "skipFinish" o = Gio.InputStream.InputStreamSkipFinishMethodInfo
    ResolveFileInputStreamMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFileInputStreamMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFileInputStreamMethod "tell" o = Gio.Seekable.SeekableTellMethodInfo
    ResolveFileInputStreamMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFileInputStreamMethod "truncate" o = Gio.Seekable.SeekableTruncateMethodInfo
    ResolveFileInputStreamMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFileInputStreamMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFileInputStreamMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFileInputStreamMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFileInputStreamMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFileInputStreamMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFileInputStreamMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFileInputStreamMethod "setPending" o = Gio.InputStream.InputStreamSetPendingMethodInfo
    ResolveFileInputStreamMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFileInputStreamMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveFileInputStreamMethod t FileInputStream, O.OverloadedMethod info FileInputStream p) => OL.IsLabel t (FileInputStream -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveFileInputStreamMethod t FileInputStream, O.OverloadedMethod info FileInputStream p, R.HasField t FileInputStream p) => R.HasField t FileInputStream p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveFileInputStreamMethod t FileInputStream, O.OverloadedMethodInfo info FileInputStream) => OL.IsLabel t (O.MethodProxy info FileInputStream) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FileInputStream
type instance O.AttributeList FileInputStream = FileInputStreamAttributeList
type FileInputStreamAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList FileInputStream = FileInputStreamSignalList
type FileInputStreamSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method FileInputStream::query_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file attribute query string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "FileInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_input_stream_query_info" g_file_input_stream_query_info :: 
    Ptr FileInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "FileInputStream"})
    CString ->                              -- attributes : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileInfo.FileInfo)

-- | Queries a file input stream the given /@attributes@/. This function blocks
-- while querying the stream. For the asynchronous (non-blocking) version
-- of this function, see 'GI.Gio.Objects.FileInputStream.fileInputStreamQueryInfoAsync'. While the
-- stream is blocked, the stream will set the pending flag internally, and
-- any other operations on the stream will fail with 'GI.Gio.Enums.IOErrorEnumPending'.
fileInputStreamQueryInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.FileInputStream.FileInputStream'.
    -> T.Text
    -- ^ /@attributes@/: a file attribute query string.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Gio.FileInfo.FileInfo
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileInfo.FileInfo', or 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
fileInputStreamQueryInfo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileInputStream a, IsCancellable b) =>
a -> Text -> Maybe b -> m FileInfo
fileInputStreamQueryInfo a
stream Text
attributes Maybe b
cancellable = IO FileInfo -> m FileInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo -> m FileInfo) -> IO FileInfo -> m FileInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileInputStream
stream' <- a -> IO (Ptr FileInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
attributes' <- Text -> IO CString
textToCString Text
attributes
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileInfo -> IO () -> IO FileInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileInfo
result <- (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo))
-> (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a b. (a -> b) -> a -> b
$ Ptr FileInputStream
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileInfo)
g_file_input_stream_query_info Ptr FileInputStream
stream' CString
attributes' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileInputStreamQueryInfo" Ptr FileInfo
result
        FileInfo
result' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
        FileInfo -> IO FileInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
     )

#if defined(ENABLE_OVERLOADING)
data FileInputStreamQueryInfoMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m Gio.FileInfo.FileInfo), MonadIO m, IsFileInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileInputStreamQueryInfoMethodInfo a signature where
    overloadedMethod = fileInputStreamQueryInfo

instance O.OverloadedMethodInfo FileInputStreamQueryInfoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.FileInputStream.fileInputStreamQueryInfo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Objects-FileInputStream.html#v:fileInputStreamQueryInfo"
        })


#endif

-- method FileInputStream::query_info_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file attribute query string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_input_stream_query_info_async" g_file_input_stream_query_info_async :: 
    Ptr FileInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "FileInputStream"})
    CString ->                              -- attributes : TBasicType TUTF8
    Int32 ->                                -- io_priority : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Queries the stream information asynchronously.
-- When the operation is finished /@callback@/ will be called.
-- You can then call 'GI.Gio.Objects.FileInputStream.fileInputStreamQueryInfoFinish'
-- to get the result of the operation.
-- 
-- For the synchronous version of this function,
-- see 'GI.Gio.Objects.FileInputStream.fileInputStreamQueryInfo'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be set
fileInputStreamQueryInfoAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.FileInputStream.FileInputStream'.
    -> T.Text
    -- ^ /@attributes@/: a file attribute query string.
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
fileInputStreamQueryInfoAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileInputStream a, IsCancellable b) =>
a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileInputStreamQueryInfoAsync a
stream Text
attributes Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileInputStream
stream' <- a -> IO (Ptr FileInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
attributes' <- Text -> IO CString
textToCString Text
attributes
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileInputStream
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_input_stream_query_info_async Ptr FileInputStream
stream' CString
attributes' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileInputStreamQueryInfoAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileInputStream a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileInputStreamQueryInfoAsyncMethodInfo a signature where
    overloadedMethod = fileInputStreamQueryInfoAsync

instance O.OverloadedMethodInfo FileInputStreamQueryInfoAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.FileInputStream.fileInputStreamQueryInfoAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Objects-FileInputStream.html#v:fileInputStreamQueryInfoAsync"
        })


#endif

-- method FileInputStream::query_info_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileInputStream."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "FileInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_input_stream_query_info_finish" g_file_input_stream_query_info_finish :: 
    Ptr FileInputStream ->                  -- stream : TInterface (Name {namespace = "Gio", name = "FileInputStream"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileInfo.FileInfo)

-- | Finishes an asynchronous info query operation.
fileInputStreamQueryInfoFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileInputStream a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.FileInputStream.FileInputStream'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Gio.FileInfo.FileInfo
    -- ^ __Returns:__ t'GI.Gio.Objects.FileInfo.FileInfo'. /(Can throw 'Data.GI.Base.GError.GError')/
fileInputStreamQueryInfoFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileInputStream a, IsAsyncResult b) =>
a -> b -> m FileInfo
fileInputStreamQueryInfoFinish a
stream b
result_ = IO FileInfo -> m FileInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo -> m FileInfo) -> IO FileInfo -> m FileInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileInputStream
stream' <- a -> IO (Ptr FileInputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO FileInfo -> IO () -> IO FileInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileInfo
result <- (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo))
-> (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a b. (a -> b) -> a -> b
$ Ptr FileInputStream
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileInfo)
g_file_input_stream_query_info_finish Ptr FileInputStream
stream' Ptr AsyncResult
result_'
        Text -> Ptr FileInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileInputStreamQueryInfoFinish" Ptr FileInfo
result
        FileInfo
result' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        FileInfo -> IO FileInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileInputStreamQueryInfoFinishMethodInfo
instance (signature ~ (b -> m Gio.FileInfo.FileInfo), MonadIO m, IsFileInputStream a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileInputStreamQueryInfoFinishMethodInfo a signature where
    overloadedMethod = fileInputStreamQueryInfoFinish

instance O.OverloadedMethodInfo FileInputStreamQueryInfoFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.FileInputStream.fileInputStreamQueryInfoFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Objects-FileInputStream.html#v:fileInputStreamQueryInfoFinish"
        })


#endif