-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.Poppler.Functions
    ( 

 -- * Methods


-- ** dateParse #method:dateParse#

    dateParse                               ,


-- ** getAvailableSigningCertificates #method:getAvailableSigningCertificates#

    getAvailableSigningCertificates         ,


-- ** getBackend #method:getBackend#

    getBackend                              ,


-- ** getCertificateInfoById #method:getCertificateInfoById#

    getCertificateInfoById                  ,


-- ** getNssDir #method:getNssDir#

    getNssDir                               ,


-- ** getVersion #method:getVersion#

    getVersion                              ,


-- ** namedDestFromBytestring #method:namedDestFromBytestring#

    namedDestFromBytestring                 ,


-- ** namedDestToBytestring #method:namedDestToBytestring#

    namedDestToBytestring                   ,


-- ** setNssDir #method:setNssDir#

    setNssDir                               ,


-- ** setNssPasswordCallback #method:setNssPasswordCallback#

    setNssPasswordCallback                  ,




    ) 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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.Poppler.Callbacks as Poppler.Callbacks
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Structs.CertificateInfo as Poppler.CertificateInfo

#else
import qualified GI.Poppler.Callbacks as Poppler.Callbacks
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Structs.CertificateInfo as Poppler.CertificateInfo

#endif

-- function set_nss_password_callback
-- Args: [ Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Poppler" , name = "NssPasswordFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #PopplerNssPasswordFunc that represents a signature annotation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_set_nss_password_callback" poppler_set_nss_password_callback :: 
    FunPtr Poppler.Callbacks.C_NssPasswordFunc -> -- func : TInterface (Name {namespace = "Poppler", name = "NssPasswordFunc"})
    IO ()

-- | A callback which asks for certificate password
-- 
-- /Since: 23.07.0/
setNssPasswordCallback ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poppler.Callbacks.NssPasswordFunc
    -- ^ /@func@/: a t'GI.Poppler.Callbacks.NssPasswordFunc' that represents a signature annotation
    -> m ()
setNssPasswordCallback :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
NssPasswordFunc -> m ()
setNssPasswordCallback NssPasswordFunc
func = 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
    FunPtr C_NssPasswordFunc
func' <- C_NssPasswordFunc -> IO (FunPtr C_NssPasswordFunc)
Poppler.Callbacks.mk_NssPasswordFunc (Maybe (Ptr (FunPtr C_NssPasswordFunc))
-> NssPasswordFunc -> C_NssPasswordFunc
Poppler.Callbacks.wrap_NssPasswordFunc Maybe (Ptr (FunPtr C_NssPasswordFunc))
forall a. Maybe a
Nothing NssPasswordFunc
func)
    FunPtr C_NssPasswordFunc -> IO ()
poppler_set_nss_password_callback FunPtr C_NssPasswordFunc
func'
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_NssPasswordFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_NssPasswordFunc
func'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function set_nss_dir
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_set_nss_dir" poppler_set_nss_dir :: 
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | Set NSS directory
-- 
-- /Since: 23.07.0/
setNssDir ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> m ()
setNssDir :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
setNssDir Text
path = 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
    CString
path' <- Text -> IO CString
textToCString Text
path
    CString -> IO ()
poppler_set_nss_dir CString
path'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function named_dest_to_bytestring
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the named dest string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a location to store the length of the returned bytestring"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TSize
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "a location to store the length of the returned bytestring"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt8))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_named_dest_to_bytestring" poppler_named_dest_to_bytestring :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    IO (Ptr Word8)

-- | Converts a named dest string (e.g. from t'GI.Poppler.Structs.Dest.Dest'.@/named_dest/@) into a
-- bytestring, inverting the transformation of
-- 'GI.Poppler.Functions.namedDestFromBytestring'.
-- 
-- Note that the returned data is not zero terminated and may also
-- contains embedded NUL bytes.
-- 
-- If /@name@/ is not a valid named dest string, returns 'P.Nothing'.
-- 
-- The returned data must be freed using 'GI.GLib.Functions.free'.
-- 
-- /Since: 0.73/
namedDestToBytestring ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the named dest string
    -> m (Maybe ByteString)
    -- ^ __Returns:__ a new bytestring,
    --   or 'P.Nothing'
namedDestToBytestring :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe ByteString)
namedDestToBytestring Text
name = IO (Maybe ByteString) -> m (Maybe ByteString)
forall a. IO a -> m a
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
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CSize
length_ <- IO (Ptr CSize)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr FCT.CSize)
    Ptr Word8
result <- CString -> Ptr CSize -> IO (Ptr Word8)
poppler_named_dest_to_bytestring CString
name' Ptr CSize
length_
    CSize
length_' <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
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
$ \Ptr Word8
result' -> do
        ByteString
result'' <- (CSize -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength CSize
length_') Ptr Word8
result'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
result'
        ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CSize
length_
    Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
maybeResult


-- function named_dest_from_bytestring
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bytestring data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bytestring length"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TSize
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the bytestring length"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_named_dest_from_bytestring" poppler_named_dest_from_bytestring :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    FCT.CSize ->                            -- length : TBasicType TSize
    IO CString

-- | Converts a bytestring into a zero-terminated string suitable to
-- pass to 'GI.Poppler.Objects.Document.documentFindDest'.
-- 
-- Note that the returned string has no defined encoding and is not
-- suitable for display to the user.
-- 
-- The returned data must be freed using 'GI.GLib.Functions.free'.
-- 
-- /Since: 0.73/
namedDestFromBytestring ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: the bytestring data
    -> m T.Text
    -- ^ __Returns:__ the named dest
namedDestFromBytestring :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m Text
namedDestFromBytestring ByteString
data_ = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: CSize
length_ = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    CString
result <- Ptr Word8 -> CSize -> IO CString
poppler_named_dest_from_bytestring Ptr Word8
data_' CSize
length_
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"namedDestFromBytestring" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    NssPasswordFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function get_version
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_get_version" poppler_get_version :: 
    IO CString

-- | Returns the version of poppler in use.  This result is not to be freed.
getVersion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m T.Text
    -- ^ __Returns:__ the version of poppler.
getVersion :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Text
getVersion  = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    CString
result <- IO CString
poppler_get_version
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getVersion" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    NssPasswordFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function get_nss_dir
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_get_nss_dir" poppler_get_nss_dir :: 
    IO CString

-- | Get NSS directory
-- 
-- /Since: 23.07.0/
getNssDir ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m T.Text
    -- ^ __Returns:__ nss directroy.
getNssDir :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Text
getNssDir  = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    CString
result <- IO CString
poppler_get_nss_dir
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getNssDir" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    NssPasswordFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function get_certificate_info_by_id
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Poppler" , name = "CertificateInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_get_certificate_info_by_id" poppler_get_certificate_info_by_id :: 
    CString ->                              -- id : TBasicType TUTF8
    IO (Ptr Poppler.CertificateInfo.CertificateInfo)

-- | Get certificate by nick name
getCertificateInfoById ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> m Poppler.CertificateInfo.CertificateInfo
    -- ^ __Returns:__ a t'GI.Poppler.Structs.CertificateInfo.CertificateInfo' or 'P.Nothing' if not found
getCertificateInfoById :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m CertificateInfo
getCertificateInfoById Text
id = IO CertificateInfo -> m CertificateInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CertificateInfo -> m CertificateInfo)
-> IO CertificateInfo -> m CertificateInfo
forall a b. (a -> b) -> a -> b
$ do
    CString
id' <- Text -> IO CString
textToCString Text
id
    Ptr CertificateInfo
result <- CString -> IO (Ptr CertificateInfo)
poppler_get_certificate_info_by_id CString
id'
    Text -> Ptr CertificateInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getCertificateInfoById" Ptr CertificateInfo
result
    CertificateInfo
result' <- ((ManagedPtr CertificateInfo -> CertificateInfo)
-> Ptr CertificateInfo -> IO CertificateInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CertificateInfo -> CertificateInfo
Poppler.CertificateInfo.CertificateInfo) Ptr CertificateInfo
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
    CertificateInfo -> IO CertificateInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CertificateInfo
result'


-- function get_backend
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Poppler" , name = "Backend" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_get_backend" poppler_get_backend :: 
    IO CUInt

-- | Returns the backend compiled into the poppler library.
getBackend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Poppler.Enums.Backend
    -- ^ __Returns:__ The backend used by poppler
getBackend :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Backend
getBackend  = IO Backend -> m Backend
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Backend -> m Backend) -> IO Backend -> m Backend
forall a b. (a -> b) -> a -> b
$ do
    CUInt
result <- IO CUInt
poppler_get_backend
    let result' :: Backend
result' = (Int -> Backend
forall a. Enum a => Int -> a
toEnum (Int -> Backend) -> (CUInt -> Int) -> CUInt -> Backend
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Backend -> IO Backend
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Backend
result'


-- function get_available_signing_certificates
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "Poppler" , name = "CertificateInfo" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_get_available_signing_certificates" poppler_get_available_signing_certificates :: 
    IO (Ptr (GList (Ptr Poppler.CertificateInfo.CertificateInfo)))

-- | Get all available signing certificate information
getAvailableSigningCertificates ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [Poppler.CertificateInfo.CertificateInfo]
    -- ^ __Returns:__ all available signing certificate information
getAvailableSigningCertificates :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m [CertificateInfo]
getAvailableSigningCertificates  = IO [CertificateInfo] -> m [CertificateInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CertificateInfo] -> m [CertificateInfo])
-> IO [CertificateInfo] -> m [CertificateInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GList (Ptr CertificateInfo))
result <- IO (Ptr (GList (Ptr CertificateInfo)))
poppler_get_available_signing_certificates
    [Ptr CertificateInfo]
result' <- Ptr (GList (Ptr CertificateInfo)) -> IO [Ptr CertificateInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr CertificateInfo))
result
    [CertificateInfo]
result'' <- (Ptr CertificateInfo -> IO CertificateInfo)
-> [Ptr CertificateInfo] -> IO [CertificateInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr CertificateInfo -> CertificateInfo)
-> Ptr CertificateInfo -> IO CertificateInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CertificateInfo -> CertificateInfo
Poppler.CertificateInfo.CertificateInfo) [Ptr CertificateInfo]
result'
    Ptr (GList (Ptr CertificateInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr CertificateInfo))
result
    [CertificateInfo] -> IO [CertificateInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [CertificateInfo]
result''


-- function date_parse
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "string to parse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timet"
--           , argType = TBasicType TLong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an uninitialized #time_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_date_parse" poppler_date_parse :: 
    CString ->                              -- date : TBasicType TUTF8
    FCT.CLong ->                            -- timet : TBasicType TLong
    IO CInt

-- | Parses a PDF format date string and converts it to a @/time_t/@. Returns @/FALSE/@
-- if the parsing fails or the input string is not a valid PDF format date string
-- 
-- /Since: 0.12/
dateParse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@date@/: string to parse
    -> FCT.CLong
    -- ^ /@timet@/: an uninitialized @/time_t/@
    -> m Bool
    -- ^ __Returns:__ @/TRUE/@, if /@timet@/ was set
dateParse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> CLong -> m Bool
dateParse Text
date CLong
timet = IO Bool -> m Bool
forall a. IO a -> m a
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
    CString
date' <- Text -> IO CString
textToCString Text
date
    CInt
result <- CString -> CLong -> IO CInt
poppler_date_parse CString
date' CLong
timet
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
date'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'