{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a blob object.

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

module GI.Ggit.Objects.Blob
    ( 

-- * Exported types
    Blob(..)                                ,
    IsBlob                                  ,
    toBlob                                  ,
    noBlob                                  ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveBlobMethod                       ,
#endif


-- ** getRawContent #method:getRawContent#

#if defined(ENABLE_OVERLOADING)
    BlobGetRawContentMethodInfo             ,
#endif
    blobGetRawContent                       ,


-- ** isBinary #method:isBinary#

#if defined(ENABLE_OVERLOADING)
    BlobIsBinaryMethodInfo                  ,
#endif
    blobIsBinary                            ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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 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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Ggit.Objects.Native as Ggit.Native
import {-# SOURCE #-} qualified GI.Ggit.Objects.Object as Ggit.Object
import {-# SOURCE #-} qualified GI.Ggit.Objects.ObjectFactoryBase as Ggit.ObjectFactoryBase

-- | Memory-managed wrapper type.
newtype Blob = Blob (ManagedPtr Blob)
    deriving (Blob -> Blob -> Bool
(Blob -> Blob -> Bool) -> (Blob -> Blob -> Bool) -> Eq Blob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Blob -> Blob -> Bool
$c/= :: Blob -> Blob -> Bool
== :: Blob -> Blob -> Bool
$c== :: Blob -> Blob -> Bool
Eq)
foreign import ccall "ggit_blob_get_type"
    c_ggit_blob_get_type :: IO GType

instance GObject Blob where
    gobjectType :: IO GType
gobjectType = IO GType
c_ggit_blob_get_type
    

-- | Convert 'Blob' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Blob where
    toGValue :: Blob -> IO GValue
toGValue o :: Blob
o = do
        GType
gtype <- IO GType
c_ggit_blob_get_type
        Blob -> (Ptr Blob -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Blob
o (GType -> (GValue -> Ptr Blob -> IO ()) -> Ptr Blob -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Blob -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Blob
fromGValue gv :: GValue
gv = do
        Ptr Blob
ptr <- GValue -> IO (Ptr Blob)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Blob)
        (ManagedPtr Blob -> Blob) -> Ptr Blob -> IO Blob
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Blob -> Blob
Blob Ptr Blob
ptr
        
    

-- | Type class for types which can be safely cast to `Blob`, for instance with `toBlob`.
class (GObject o, O.IsDescendantOf Blob o) => IsBlob o
instance (GObject o, O.IsDescendantOf Blob o) => IsBlob o

instance O.HasParentTypes Blob
type instance O.ParentTypes Blob = '[Ggit.Object.Object, Ggit.Native.Native, Ggit.ObjectFactoryBase.ObjectFactoryBase, GObject.Object.Object]

-- | Cast to `Blob`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toBlob :: (MonadIO m, IsBlob o) => o -> m Blob
toBlob :: o -> m Blob
toBlob = IO Blob -> m Blob
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Blob -> m Blob) -> (o -> IO Blob) -> o -> m Blob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Blob -> Blob) -> o -> IO Blob
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Blob -> Blob
Blob

-- | A convenience alias for `Nothing` :: `Maybe` `Blob`.
noBlob :: Maybe Blob
noBlob :: Maybe Blob
noBlob = Maybe Blob
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveBlobMethod (t :: Symbol) (o :: *) :: * where
    ResolveBlobMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBlobMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBlobMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBlobMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBlobMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBlobMethod "isBinary" o = BlobIsBinaryMethodInfo
    ResolveBlobMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBlobMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBlobMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBlobMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBlobMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBlobMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBlobMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBlobMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBlobMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBlobMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBlobMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBlobMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBlobMethod "getId" o = Ggit.Object.ObjectGetIdMethodInfo
    ResolveBlobMethod "getOwner" o = Ggit.Object.ObjectGetOwnerMethodInfo
    ResolveBlobMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBlobMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBlobMethod "getRawContent" o = BlobGetRawContentMethodInfo
    ResolveBlobMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBlobMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBlobMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBlobMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Blob
type instance O.AttributeList Blob = BlobAttributeList
type BlobAttributeList = ('[ '("native", Ggit.Native.NativeNativePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Blob::get_raw_content
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blob"
--           , argType = TInterface Name { namespace = "Ggit" , name = "Blob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlob." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return value of the length of the data."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "return value of the length of the data."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt8))
-- throws : False
-- Skip return : False

foreign import ccall "ggit_blob_get_raw_content" ggit_blob_get_raw_content :: 
    Ptr Blob ->                             -- blob : TInterface (Name {namespace = "Ggit", name = "Blob"})
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr Word8)

-- | Gets a read-only buffer with the raw contents of /@blob@/.
-- 
-- A pointer to the raw contents of /@blob@/ is returned.
-- This pointer is owned internally by /@object@/ and must
-- not be free\'d. The pointer may be invalidated at a later
-- time.
blobGetRawContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlob a) =>
    a
    -- ^ /@blob@/: a t'GI.Ggit.Objects.Blob.Blob'.
    -> m (Maybe ByteString)
    -- ^ __Returns:__ the blob content or
    --          'P.Nothing' if the blob does not have any content.
blobGetRawContent :: a -> m (Maybe ByteString)
blobGetRawContent blob :: a
blob = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Blob
blob' <- a -> IO (Ptr Blob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
blob
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word8
result <- Ptr Blob -> Ptr Word64 -> IO (Ptr Word8)
ggit_blob_get_raw_content Ptr Blob
blob' Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Maybe ByteString
maybeResult <- Ptr Word8 -> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Word8
result ((Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Word8
result' -> do
        ByteString
result'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
result'
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
blob
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlobGetRawContentMethodInfo
instance (signature ~ (m (Maybe ByteString)), MonadIO m, IsBlob a) => O.MethodInfo BlobGetRawContentMethodInfo a signature where
    overloadedMethod = blobGetRawContent

#endif

-- method Blob::is_binary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blob"
--           , argType = TInterface Name { namespace = "Ggit" , name = "Blob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlob." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_blob_is_binary" ggit_blob_is_binary :: 
    Ptr Blob ->                             -- blob : TInterface (Name {namespace = "Ggit", name = "Blob"})
    IO CInt

-- | Check whether the blob is binary.
blobIsBinary ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlob a) =>
    a
    -- ^ /@blob@/: a t'GI.Ggit.Objects.Blob.Blob'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the blob is binary, 'P.False' otherwise.
blobIsBinary :: a -> m Bool
blobIsBinary blob :: a
blob = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Blob
blob' <- a -> IO (Ptr Blob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
blob
    CInt
result <- Ptr Blob -> IO CInt
ggit_blob_is_binary Ptr Blob
blob'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
blob
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BlobIsBinaryMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBlob a) => O.MethodInfo BlobIsBinaryMethodInfo a signature where
    overloadedMethod = blobIsBinary

#endif