-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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                               ,


-- ** getBackend #method:getBackend#

    getBackend                              ,


-- ** getVersion #method:getVersion#

    getVersion                              ,


-- ** namedDestFromBytestring #method:namedDestFromBytestring#

    namedDestFromBytestring                 ,


-- ** namedDestToBytestring #method:namedDestToBytestring#

    namedDestToBytestring                   ,




    ) 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.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.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 {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums

-- function named_dest_to_bytestring
-- Args: [ Arg
--           { argCName = "named_dest"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "a location to store the length of the returned bytestring"
--                 , 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 "a location to store the length of the returned bytestring"
--                    , 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 "poppler_named_dest_to_bytestring" poppler_named_dest_to_bytestring :: 
    CString ->                              -- named_dest : TBasicType TUTF8
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    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
    -> m (Maybe ByteString)
    -- ^ __Returns:__ a new bytestring,
    --   or 'P.Nothing'
namedDestToBytestring :: Text -> m (Maybe ByteString)
namedDestToBytestring Text
namedDest = 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
    CString
namedDest' <- Text -> IO CString
textToCString Text
namedDest
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word8
result <- CString -> Ptr Word64 -> IO (Ptr Word8)
poppler_named_dest_to_bytestring CString
namedDest' 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
$ \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'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
result'
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namedDest'
    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


-- 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bytestring length"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the bytestring length"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = 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)
    Word64 ->                               -- length : TBasicType TUInt64
    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 :: ByteString -> m Text
namedDestFromBytestring ByteString
data_ = IO Text -> m Text
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_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
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 -> Word64 -> IO CString
poppler_named_dest_from_bytestring Ptr Word8
data_' Word64
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_'
    Text -> IO Text
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 :: m Text
getVersion  = IO Text -> m Text
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
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
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 :: m Backend
getBackend  = IO Backend -> m Backend
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 (m :: * -> *) a. Monad m => a -> m a
return Backend
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
--           , 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
--           , 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
    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
    -> CLong
    -- ^ /@timet@/: an uninitialized @/time_t/@
    -> m Bool
    -- ^ __Returns:__ @/TRUE/@, if /@timet@/ was set
dateParse :: Text -> CLong -> m Bool
dateParse Text
date CLong
timet = 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
    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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'