{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A date and time. The date is assumed to be in the (proleptic)
-- Gregorian calendar. The time is in UTC if /@utc@/ is 'P.True'. Otherwise,
-- the time is a local time, and /@offset@/ gives the offset from UTC in
-- minutes (such that adding /@offset@/ to the time would give the
-- correct UTC time). If /@utc@/ is 'P.False' and /@offset@/ is 0, then the
-- @/SoupDate/@ represents a \"floating\" time with no associated timezone
-- information.

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

module GI.Soup.Structs.Date
    ( 

-- * Exported types
    Date(..)                                ,
    newZeroDate                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDateMethod                       ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    DateCopyMethodInfo                      ,
#endif
    dateCopy                                ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    DateFreeMethodInfo                      ,
#endif
    dateFree                                ,


-- ** getDay #method:getDay#

#if defined(ENABLE_OVERLOADING)
    DateGetDayMethodInfo                    ,
#endif
    dateGetDay                              ,


-- ** getHour #method:getHour#

#if defined(ENABLE_OVERLOADING)
    DateGetHourMethodInfo                   ,
#endif
    dateGetHour                             ,


-- ** getMinute #method:getMinute#

#if defined(ENABLE_OVERLOADING)
    DateGetMinuteMethodInfo                 ,
#endif
    dateGetMinute                           ,


-- ** getMonth #method:getMonth#

#if defined(ENABLE_OVERLOADING)
    DateGetMonthMethodInfo                  ,
#endif
    dateGetMonth                            ,


-- ** getOffset #method:getOffset#

#if defined(ENABLE_OVERLOADING)
    DateGetOffsetMethodInfo                 ,
#endif
    dateGetOffset                           ,


-- ** getSecond #method:getSecond#

#if defined(ENABLE_OVERLOADING)
    DateGetSecondMethodInfo                 ,
#endif
    dateGetSecond                           ,


-- ** getUtc #method:getUtc#

#if defined(ENABLE_OVERLOADING)
    DateGetUtcMethodInfo                    ,
#endif
    dateGetUtc                              ,


-- ** getYear #method:getYear#

#if defined(ENABLE_OVERLOADING)
    DateGetYearMethodInfo                   ,
#endif
    dateGetYear                             ,


-- ** isPast #method:isPast#

#if defined(ENABLE_OVERLOADING)
    DateIsPastMethodInfo                    ,
#endif
    dateIsPast                              ,


-- ** new #method:new#

    dateNew                                 ,


-- ** newFromNow #method:newFromNow#

    dateNewFromNow                          ,


-- ** newFromString #method:newFromString#

    dateNewFromString                       ,


-- ** newFromTimeT #method:newFromTimeT#

    dateNewFromTimeT                        ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    DateToStringMethodInfo                  ,
#endif
    dateToString                            ,


-- ** toTimeT #method:toTimeT#

#if defined(ENABLE_OVERLOADING)
    DateToTimeTMethodInfo                   ,
#endif
    dateToTimeT                             ,


-- ** toTimeval #method:toTimeval#

#if defined(ENABLE_OVERLOADING)
    DateToTimevalMethodInfo                 ,
#endif
    dateToTimeval                           ,




 -- * Properties
-- ** day #attr:day#
-- | day of the month, 1 to 31

#if defined(ENABLE_OVERLOADING)
    date_day                                ,
#endif
    getDateDay                              ,
    setDateDay                              ,


-- ** hour #attr:hour#
-- | hour of the day, 0 to 23

#if defined(ENABLE_OVERLOADING)
    date_hour                               ,
#endif
    getDateHour                             ,
    setDateHour                             ,


-- ** minute #attr:minute#
-- | minute, 0 to 59

#if defined(ENABLE_OVERLOADING)
    date_minute                             ,
#endif
    getDateMinute                           ,
    setDateMinute                           ,


-- ** month #attr:month#
-- | the month, 1 to 12

#if defined(ENABLE_OVERLOADING)
    date_month                              ,
#endif
    getDateMonth                            ,
    setDateMonth                            ,


-- ** offset #attr:offset#
-- | offset from UTC

#if defined(ENABLE_OVERLOADING)
    date_offset                             ,
#endif
    getDateOffset                           ,
    setDateOffset                           ,


-- ** second #attr:second#
-- | second, 0 to 59 (or up to 61 in the case of leap seconds)

#if defined(ENABLE_OVERLOADING)
    date_second                             ,
#endif
    getDateSecond                           ,
    setDateSecond                           ,


-- ** utc #attr:utc#
-- | 'P.True' if the date is in UTC

#if defined(ENABLE_OVERLOADING)
    date_utc                                ,
#endif
    getDateUtc                              ,
    setDateUtc                              ,


-- ** year #attr:year#
-- | the year, 1 to 9999

#if defined(ENABLE_OVERLOADING)
    date_year                               ,
#endif
    getDateYear                             ,
    setDateYear                             ,




    ) 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.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 qualified GI.GLib.Structs.TimeVal as GLib.TimeVal
import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums

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

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

foreign import ccall "soup_date_get_type" c_soup_date_get_type :: 
    IO GType

type instance O.ParentTypes Date = '[]
instance O.HasParentTypes Date

instance B.Types.TypedObject Date where
    glibType :: IO GType
glibType = IO GType
c_soup_date_get_type

instance B.Types.GBoxed Date

-- | Convert 'Date' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Date where
    toGValue :: Date -> IO GValue
toGValue Date
o = do
        GType
gtype <- IO GType
c_soup_date_get_type
        Date -> (Ptr Date -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Date
o (GType -> (GValue -> Ptr Date -> IO ()) -> Ptr Date -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Date -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Date
fromGValue GValue
gv = do
        Ptr Date
ptr <- GValue -> IO (Ptr Date)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Date)
        (ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Date -> Date
Date Ptr Date
ptr
        
    

-- | Construct a `Date` struct initialized to zero.
newZeroDate :: MonadIO m => m Date
newZeroDate :: m Date
newZeroDate = IO Date -> m Date
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Date -> m Date) -> IO Date -> m Date
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Date)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
32 IO (Ptr Date) -> (Ptr Date -> IO Date) -> IO Date
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
Date

instance tag ~ 'AttrSet => Constructible Date tag where
    new :: (ManagedPtr Date -> Date) -> [AttrOp Date tag] -> m Date
new ManagedPtr Date -> Date
_ [AttrOp Date tag]
attrs = do
        Date
o <- m Date
forall (m :: * -> *). MonadIO m => m Date
newZeroDate
        Date -> [AttrOp Date 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Date
o [AttrOp Date tag]
[AttrOp Date 'AttrSet]
attrs
        Date -> m Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
o


-- | Get the value of the “@year@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' date #year
-- @
getDateYear :: MonadIO m => Date -> m Int32
getDateYear :: Date -> m Int32
getDateYear Date
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO Int32) -> IO Int32)
-> (Ptr Date -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@year@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' date [ #year 'Data.GI.Base.Attributes.:=' value ]
-- @
setDateYear :: MonadIO m => Date -> Int32 -> m ()
setDateYear :: Date -> Int32 -> m ()
setDateYear Date
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO ()) -> IO ()) -> (Ptr Date -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DateYearFieldInfo
instance AttrInfo DateYearFieldInfo where
    type AttrBaseTypeConstraint DateYearFieldInfo = (~) Date
    type AttrAllowedOps DateYearFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DateYearFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DateYearFieldInfo = (~)Int32
    type AttrTransferType DateYearFieldInfo = Int32
    type AttrGetType DateYearFieldInfo = Int32
    type AttrLabel DateYearFieldInfo = "year"
    type AttrOrigin DateYearFieldInfo = Date
    attrGet = getDateYear
    attrSet = setDateYear
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

date_year :: AttrLabelProxy "year"
date_year = AttrLabelProxy

#endif


-- | Get the value of the “@month@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' date #month
-- @
getDateMonth :: MonadIO m => Date -> m Int32
getDateMonth :: Date -> m Int32
getDateMonth Date
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO Int32) -> IO Int32)
-> (Ptr Date -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@month@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' date [ #month 'Data.GI.Base.Attributes.:=' value ]
-- @
setDateMonth :: MonadIO m => Date -> Int32 -> m ()
setDateMonth :: Date -> Int32 -> m ()
setDateMonth Date
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO ()) -> IO ()) -> (Ptr Date -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DateMonthFieldInfo
instance AttrInfo DateMonthFieldInfo where
    type AttrBaseTypeConstraint DateMonthFieldInfo = (~) Date
    type AttrAllowedOps DateMonthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DateMonthFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DateMonthFieldInfo = (~)Int32
    type AttrTransferType DateMonthFieldInfo = Int32
    type AttrGetType DateMonthFieldInfo = Int32
    type AttrLabel DateMonthFieldInfo = "month"
    type AttrOrigin DateMonthFieldInfo = Date
    attrGet = getDateMonth
    attrSet = setDateMonth
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

date_month :: AttrLabelProxy "month"
date_month = AttrLabelProxy

#endif


-- | Get the value of the “@day@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' date #day
-- @
getDateDay :: MonadIO m => Date -> m Int32
getDateDay :: Date -> m Int32
getDateDay Date
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO Int32) -> IO Int32)
-> (Ptr Date -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@day@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' date [ #day 'Data.GI.Base.Attributes.:=' value ]
-- @
setDateDay :: MonadIO m => Date -> Int32 -> m ()
setDateDay :: Date -> Int32 -> m ()
setDateDay Date
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO ()) -> IO ()) -> (Ptr Date -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DateDayFieldInfo
instance AttrInfo DateDayFieldInfo where
    type AttrBaseTypeConstraint DateDayFieldInfo = (~) Date
    type AttrAllowedOps DateDayFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DateDayFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DateDayFieldInfo = (~)Int32
    type AttrTransferType DateDayFieldInfo = Int32
    type AttrGetType DateDayFieldInfo = Int32
    type AttrLabel DateDayFieldInfo = "day"
    type AttrOrigin DateDayFieldInfo = Date
    attrGet = getDateDay
    attrSet = setDateDay
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

date_day :: AttrLabelProxy "day"
date_day = AttrLabelProxy

#endif


-- | Get the value of the “@hour@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' date #hour
-- @
getDateHour :: MonadIO m => Date -> m Int32
getDateHour :: Date -> m Int32
getDateHour Date
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO Int32) -> IO Int32)
-> (Ptr Date -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@hour@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' date [ #hour 'Data.GI.Base.Attributes.:=' value ]
-- @
setDateHour :: MonadIO m => Date -> Int32 -> m ()
setDateHour :: Date -> Int32 -> m ()
setDateHour Date
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO ()) -> IO ()) -> (Ptr Date -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DateHourFieldInfo
instance AttrInfo DateHourFieldInfo where
    type AttrBaseTypeConstraint DateHourFieldInfo = (~) Date
    type AttrAllowedOps DateHourFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DateHourFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DateHourFieldInfo = (~)Int32
    type AttrTransferType DateHourFieldInfo = Int32
    type AttrGetType DateHourFieldInfo = Int32
    type AttrLabel DateHourFieldInfo = "hour"
    type AttrOrigin DateHourFieldInfo = Date
    attrGet = getDateHour
    attrSet = setDateHour
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

date_hour :: AttrLabelProxy "hour"
date_hour = AttrLabelProxy

#endif


-- | Get the value of the “@minute@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' date #minute
-- @
getDateMinute :: MonadIO m => Date -> m Int32
getDateMinute :: Date -> m Int32
getDateMinute Date
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO Int32) -> IO Int32)
-> (Ptr Date -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@minute@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' date [ #minute 'Data.GI.Base.Attributes.:=' value ]
-- @
setDateMinute :: MonadIO m => Date -> Int32 -> m ()
setDateMinute :: Date -> Int32 -> m ()
setDateMinute Date
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO ()) -> IO ()) -> (Ptr Date -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DateMinuteFieldInfo
instance AttrInfo DateMinuteFieldInfo where
    type AttrBaseTypeConstraint DateMinuteFieldInfo = (~) Date
    type AttrAllowedOps DateMinuteFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DateMinuteFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DateMinuteFieldInfo = (~)Int32
    type AttrTransferType DateMinuteFieldInfo = Int32
    type AttrGetType DateMinuteFieldInfo = Int32
    type AttrLabel DateMinuteFieldInfo = "minute"
    type AttrOrigin DateMinuteFieldInfo = Date
    attrGet = getDateMinute
    attrSet = setDateMinute
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

date_minute :: AttrLabelProxy "minute"
date_minute = AttrLabelProxy

#endif


-- | Get the value of the “@second@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' date #second
-- @
getDateSecond :: MonadIO m => Date -> m Int32
getDateSecond :: Date -> m Int32
getDateSecond Date
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO Int32) -> IO Int32)
-> (Ptr Date -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@second@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' date [ #second 'Data.GI.Base.Attributes.:=' value ]
-- @
setDateSecond :: MonadIO m => Date -> Int32 -> m ()
setDateSecond :: Date -> Int32 -> m ()
setDateSecond Date
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO ()) -> IO ()) -> (Ptr Date -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DateSecondFieldInfo
instance AttrInfo DateSecondFieldInfo where
    type AttrBaseTypeConstraint DateSecondFieldInfo = (~) Date
    type AttrAllowedOps DateSecondFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DateSecondFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DateSecondFieldInfo = (~)Int32
    type AttrTransferType DateSecondFieldInfo = Int32
    type AttrGetType DateSecondFieldInfo = Int32
    type AttrLabel DateSecondFieldInfo = "second"
    type AttrOrigin DateSecondFieldInfo = Date
    attrGet = getDateSecond
    attrSet = setDateSecond
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

date_second :: AttrLabelProxy "second"
date_second = AttrLabelProxy

#endif


-- | Get the value of the “@utc@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' date #utc
-- @
getDateUtc :: MonadIO m => Date -> m Bool
getDateUtc :: Date -> m Bool
getDateUtc Date
s = 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
$ Date -> (Ptr Date -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO Bool) -> IO Bool)
-> (Ptr Date -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Date
ptr Ptr Date -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CInt
    let val' :: Bool
val' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
val
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val'

-- | Set the value of the “@utc@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' date [ #utc 'Data.GI.Base.Attributes.:=' value ]
-- @
setDateUtc :: MonadIO m => Date -> Bool -> m ()
setDateUtc :: Date -> Bool -> m ()
setDateUtc Date
s Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO ()) -> IO ()) -> (Ptr Date -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    let val' :: CInt
val' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Date
ptr Ptr Date -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data DateUtcFieldInfo
instance AttrInfo DateUtcFieldInfo where
    type AttrBaseTypeConstraint DateUtcFieldInfo = (~) Date
    type AttrAllowedOps DateUtcFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DateUtcFieldInfo = (~) Bool
    type AttrTransferTypeConstraint DateUtcFieldInfo = (~)Bool
    type AttrTransferType DateUtcFieldInfo = Bool
    type AttrGetType DateUtcFieldInfo = Bool
    type AttrLabel DateUtcFieldInfo = "utc"
    type AttrOrigin DateUtcFieldInfo = Date
    attrGet = getDateUtc
    attrSet = setDateUtc
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

date_utc :: AttrLabelProxy "utc"
date_utc = AttrLabelProxy

#endif


-- | Get the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' date #offset
-- @
getDateOffset :: MonadIO m => Date -> m Int32
getDateOffset :: Date -> m Int32
getDateOffset Date
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO Int32) -> IO Int32)
-> (Ptr Date -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' date [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setDateOffset :: MonadIO m => Date -> Int32 -> m ()
setDateOffset :: Date -> Int32 -> m ()
setDateOffset Date
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Date -> (Ptr Date -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Date
s ((Ptr Date -> IO ()) -> IO ()) -> (Ptr Date -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Date
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Date
ptr Ptr Date -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DateOffsetFieldInfo
instance AttrInfo DateOffsetFieldInfo where
    type AttrBaseTypeConstraint DateOffsetFieldInfo = (~) Date
    type AttrAllowedOps DateOffsetFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DateOffsetFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DateOffsetFieldInfo = (~)Int32
    type AttrTransferType DateOffsetFieldInfo = Int32
    type AttrGetType DateOffsetFieldInfo = Int32
    type AttrLabel DateOffsetFieldInfo = "offset"
    type AttrOrigin DateOffsetFieldInfo = Date
    attrGet = getDateOffset
    attrSet = setDateOffset
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

date_offset :: AttrLabelProxy "offset"
date_offset = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Date
type instance O.AttributeList Date = DateAttributeList
type DateAttributeList = ('[ '("year", DateYearFieldInfo), '("month", DateMonthFieldInfo), '("day", DateDayFieldInfo), '("hour", DateHourFieldInfo), '("minute", DateMinuteFieldInfo), '("second", DateSecondFieldInfo), '("utc", DateUtcFieldInfo), '("offset", DateOffsetFieldInfo)] :: [(Symbol, *)])
#endif

-- method Date::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "year"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the year (1-9999)" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "month"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the month (1-12)" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "day"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the day of the month (1-31, as appropriate for @month)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hour"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the hour (0-23)" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minute"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minute (0-59)" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "second"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the second (0-59, or up to 61 for leap seconds)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Date" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_new" soup_date_new :: 
    Int32 ->                                -- year : TBasicType TInt
    Int32 ->                                -- month : TBasicType TInt
    Int32 ->                                -- day : TBasicType TInt
    Int32 ->                                -- hour : TBasicType TInt
    Int32 ->                                -- minute : TBasicType TInt
    Int32 ->                                -- second : TBasicType TInt
    IO (Ptr Date)

-- | Creates a t'GI.Soup.Structs.Date.Date' representing the indicated time, UTC.
dateNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@year@/: the year (1-9999)
    -> Int32
    -- ^ /@month@/: the month (1-12)
    -> Int32
    -- ^ /@day@/: the day of the month (1-31, as appropriate for /@month@/)
    -> Int32
    -- ^ /@hour@/: the hour (0-23)
    -> Int32
    -- ^ /@minute@/: the minute (0-59)
    -> Int32
    -- ^ /@second@/: the second (0-59, or up to 61 for leap seconds)
    -> m Date
    -- ^ __Returns:__ a new t'GI.Soup.Structs.Date.Date'
dateNew :: Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> m Date
dateNew Int32
year Int32
month Int32
day Int32
hour Int32
minute Int32
second = IO Date -> m Date
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Date -> m Date) -> IO Date -> m Date
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
result <- Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO (Ptr Date)
soup_date_new Int32
year Int32
month Int32
day Int32
hour Int32
minute Int32
second
    Text -> Ptr Date -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateNew" Ptr Date
result
    Date
result' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
Date) Ptr Date
result
    Date -> IO Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Date::new_from_now
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "offset_seconds"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "offset from current time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Date" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_new_from_now" soup_date_new_from_now :: 
    Int32 ->                                -- offset_seconds : TBasicType TInt
    IO (Ptr Date)

-- | Creates a t'GI.Soup.Structs.Date.Date' representing a time /@offsetSeconds@/ after the
-- current time (or before it, if /@offsetSeconds@/ is negative). If
-- offset_seconds is 0, returns the current time.
-- 
-- If /@offsetSeconds@/ would indicate a time not expressible as a
-- \<type>time_t\<\/type>, the return value will be clamped into range.
dateNewFromNow ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@offsetSeconds@/: offset from current time
    -> m Date
    -- ^ __Returns:__ a new t'GI.Soup.Structs.Date.Date'
dateNewFromNow :: Int32 -> m Date
dateNewFromNow Int32
offsetSeconds = IO Date -> m Date
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Date -> m Date) -> IO Date -> m Date
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
result <- Int32 -> IO (Ptr Date)
soup_date_new_from_now Int32
offsetSeconds
    Text -> Ptr Date -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateNewFromNow" Ptr Date
result
    Date
result' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
Date) Ptr Date
result
    Date -> IO Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Date::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "date_string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the date in some plausible format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Date" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_new_from_string" soup_date_new_from_string :: 
    CString ->                              -- date_string : TBasicType TUTF8
    IO (Ptr Date)

-- | Parses /@dateString@/ and tries to extract a date from it. This
-- recognizes all of the \"HTTP-date\" formats from RFC 2616, all ISO
-- 8601 formats containing both a time and a date, RFC 2822 dates,
-- and reasonable approximations thereof. (Eg, it is lenient about
-- whitespace, leading \"0\"s, etc.)
dateNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@dateString@/: the date in some plausible format
    -> m (Maybe Date)
    -- ^ __Returns:__ a new t'GI.Soup.Structs.Date.Date', or 'P.Nothing' if /@dateString@/
    -- could not be parsed.
dateNewFromString :: Text -> m (Maybe Date)
dateNewFromString Text
dateString = IO (Maybe Date) -> m (Maybe Date)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Date) -> m (Maybe Date))
-> IO (Maybe Date) -> m (Maybe Date)
forall a b. (a -> b) -> a -> b
$ do
    CString
dateString' <- Text -> IO CString
textToCString Text
dateString
    Ptr Date
result <- CString -> IO (Ptr Date)
soup_date_new_from_string CString
dateString'
    Maybe Date
maybeResult <- Ptr Date -> (Ptr Date -> IO Date) -> IO (Maybe Date)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Date
result ((Ptr Date -> IO Date) -> IO (Maybe Date))
-> (Ptr Date -> IO Date) -> IO (Maybe Date)
forall a b. (a -> b) -> a -> b
$ \Ptr Date
result' -> do
        Date
result'' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
Date) Ptr Date
result'
        Date -> IO Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
dateString'
    Maybe Date -> IO (Maybe Date)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Date
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Date::new_from_time_t
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "when"
--           , argType = TBasicType TLong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a <type>time_t</type>"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Date" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_new_from_time_t" soup_date_new_from_time_t :: 
    CLong ->                                -- when : TBasicType TLong
    IO (Ptr Date)

-- | Creates a t'GI.Soup.Structs.Date.Date' corresponding to /@when@/
dateNewFromTimeT ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CLong
    -- ^ /@when@/: a \<type>time_t\<\/type>
    -> m Date
    -- ^ __Returns:__ a new t'GI.Soup.Structs.Date.Date'
dateNewFromTimeT :: CLong -> m Date
dateNewFromTimeT CLong
when_ = IO Date -> m Date
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Date -> m Date) -> IO Date -> m Date
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
result <- CLong -> IO (Ptr Date)
soup_date_new_from_time_t CLong
when_
    Text -> Ptr Date -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateNewFromTimeT" Ptr Date
result
    Date
result' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
Date) Ptr Date
result
    Date -> IO Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Date::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Date" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_copy" soup_date_copy :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO (Ptr Date)

-- | Copies /@date@/.
-- 
-- /Since: 2.24/
dateCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Date
dateCopy :: Date -> m Date
dateCopy Date
date = IO Date -> m Date
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Date -> m Date) -> IO Date -> m Date
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Ptr Date
result <- Ptr Date -> IO (Ptr Date)
soup_date_copy Ptr Date
date'
    Text -> Ptr Date -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateCopy" Ptr Date
result
    Date
result' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
Date) Ptr Date
result
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Date -> IO Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
result'

#if defined(ENABLE_OVERLOADING)
data DateCopyMethodInfo
instance (signature ~ (m Date), MonadIO m) => O.MethodInfo DateCopyMethodInfo Date signature where
    overloadedMethod = dateCopy

#endif

-- method Date::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_free" soup_date_free :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO ()

-- | Frees /@date@/.
-- 
-- /Since: 2.24/
dateFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m ()
dateFree :: Date -> m ()
dateFree Date
date = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Ptr Date -> IO ()
soup_date_free Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DateFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DateFreeMethodInfo Date signature where
    overloadedMethod = dateFree

#endif

-- method Date::get_day
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_get_day" soup_date_get_day :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO Int32

-- | Gets /@date@/\'s day.
-- 
-- /Since: 2.32/
dateGetDay ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Int32
    -- ^ __Returns:__ /@date@/\'s day
dateGetDay :: Date -> m Int32
dateGetDay Date
date = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Int32
result <- Ptr Date -> IO Int32
soup_date_get_day Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateGetDayMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateGetDayMethodInfo Date signature where
    overloadedMethod = dateGetDay

#endif

-- method Date::get_hour
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_get_hour" soup_date_get_hour :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO Int32

-- | Gets /@date@/\'s hour.
-- 
-- /Since: 2.32/
dateGetHour ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Int32
    -- ^ __Returns:__ /@date@/\'s hour
dateGetHour :: Date -> m Int32
dateGetHour Date
date = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Int32
result <- Ptr Date -> IO Int32
soup_date_get_hour Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateGetHourMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateGetHourMethodInfo Date signature where
    overloadedMethod = dateGetHour

#endif

-- method Date::get_minute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_get_minute" soup_date_get_minute :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO Int32

-- | Gets /@date@/\'s minute.
-- 
-- /Since: 2.32/
dateGetMinute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Int32
    -- ^ __Returns:__ /@date@/\'s minute
dateGetMinute :: Date -> m Int32
dateGetMinute Date
date = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Int32
result <- Ptr Date -> IO Int32
soup_date_get_minute Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateGetMinuteMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateGetMinuteMethodInfo Date signature where
    overloadedMethod = dateGetMinute

#endif

-- method Date::get_month
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_get_month" soup_date_get_month :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO Int32

-- | Gets /@date@/\'s month.
-- 
-- /Since: 2.32/
dateGetMonth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Int32
    -- ^ __Returns:__ /@date@/\'s month
dateGetMonth :: Date -> m Int32
dateGetMonth Date
date = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Int32
result <- Ptr Date -> IO Int32
soup_date_get_month Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateGetMonthMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateGetMonthMethodInfo Date signature where
    overloadedMethod = dateGetMonth

#endif

-- method Date::get_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_get_offset" soup_date_get_offset :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO Int32

-- | Gets /@date@/\'s offset from UTC.
-- 
-- /Since: 2.32/
dateGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Int32
    -- ^ __Returns:__ /@date@/\'s offset from UTC. If 'GI.Soup.Structs.Date.dateGetUtc'
    -- returns 'P.False' but 'GI.Soup.Structs.Date.dateGetOffset' returns 0, that means the
    -- date is a \"floating\" time with no associated offset information.
dateGetOffset :: Date -> m Int32
dateGetOffset Date
date = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Int32
result <- Ptr Date -> IO Int32
soup_date_get_offset Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateGetOffsetMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateGetOffsetMethodInfo Date signature where
    overloadedMethod = dateGetOffset

#endif

-- method Date::get_second
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_get_second" soup_date_get_second :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO Int32

-- | Gets /@date@/\'s second.
-- 
-- /Since: 2.32/
dateGetSecond ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Int32
    -- ^ __Returns:__ /@date@/\'s second
dateGetSecond :: Date -> m Int32
dateGetSecond Date
date = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Int32
result <- Ptr Date -> IO Int32
soup_date_get_second Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateGetSecondMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateGetSecondMethodInfo Date signature where
    overloadedMethod = dateGetSecond

#endif

-- method Date::get_utc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_get_utc" soup_date_get_utc :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO Int32

-- | Gets /@date@/\'s UTC flag
-- 
-- /Since: 2.32/
dateGetUtc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Int32
    -- ^ __Returns:__ 'P.True' if /@date@/ is UTC.
dateGetUtc :: Date -> m Int32
dateGetUtc Date
date = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Int32
result <- Ptr Date -> IO Int32
soup_date_get_utc Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateGetUtcMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateGetUtcMethodInfo Date signature where
    overloadedMethod = dateGetUtc

#endif

-- method Date::get_year
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_get_year" soup_date_get_year :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO Int32

-- | Gets /@date@/\'s year.
-- 
-- /Since: 2.32/
dateGetYear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Int32
    -- ^ __Returns:__ /@date@/\'s year
dateGetYear :: Date -> m Int32
dateGetYear Date
date = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Int32
result <- Ptr Date -> IO Int32
soup_date_get_year Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateGetYearMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateGetYearMethodInfo Date signature where
    overloadedMethod = dateGetYear

#endif

-- method Date::is_past
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , 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 "soup_date_is_past" soup_date_is_past :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO CInt

-- | Determines if /@date@/ is in the past.
-- 
-- /Since: 2.24/
dateIsPast ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@date@/ is in the past
dateIsPast :: Date -> m Bool
dateIsPast Date
date = 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 Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    CInt
result <- Ptr Date -> IO CInt
soup_date_is_past Ptr Date
date'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DateIsPastMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo DateIsPastMethodInfo Date signature where
    overloadedMethod = dateIsPast

#endif

-- method Date::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "DateFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format to generate the date in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_to_string" soup_date_to_string :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Soup", name = "DateFormat"})
    IO CString

-- | Converts /@date@/ to a string in the format described by /@format@/.
dateToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> Soup.Enums.DateFormat
    -- ^ /@format@/: the format to generate the date in
    -> m T.Text
    -- ^ __Returns:__ /@date@/ as a string
dateToString :: Date -> DateFormat -> m Text
dateToString Date
date DateFormat
format = 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
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (DateFormat -> Int) -> DateFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateFormat -> Int
forall a. Enum a => a -> Int
fromEnum) DateFormat
format
    CString
result <- Ptr Date -> CUInt -> IO CString
soup_date_to_string Ptr Date
date' CUInt
format'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DateToStringMethodInfo
instance (signature ~ (Soup.Enums.DateFormat -> m T.Text), MonadIO m) => O.MethodInfo DateToStringMethodInfo Date signature where
    overloadedMethod = dateToString

#endif

-- method Date::to_time_t
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TLong)
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_to_time_t" soup_date_to_time_t :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    IO CLong

-- | Converts /@date@/ to a \<type>time_t\<\/type>, assumming it to be in
-- UTC.
-- 
-- If /@date@/ is not representable as a \<type>time_t\<\/type>, it will be
-- clamped into range. (In particular, some HTTP cookies have
-- expiration dates after \"Y2.038k\" (2038-01-19T03:14:07Z).)
dateToTimeT ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m CLong
    -- ^ __Returns:__ /@date@/ as a \<type>time_t\<\/type>
dateToTimeT :: Date -> m CLong
dateToTimeT Date
date = IO CLong -> m CLong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CLong -> m CLong) -> IO CLong -> m CLong
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    CLong
result <- Ptr Date -> IO CLong
soup_date_to_time_t Ptr Date
date'
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    CLong -> IO CLong
forall (m :: * -> *) a. Monad m => a -> m a
return CLong
result

#if defined(ENABLE_OVERLOADING)
data DateToTimeTMethodInfo
instance (signature ~ (m CLong), MonadIO m) => O.MethodInfo DateToTimeTMethodInfo Date signature where
    overloadedMethod = dateToTimeT

#endif

-- method Date::to_timeval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "date"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupDate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "TimeVal" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GTimeVal structure in which to store the converted time."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_date_to_timeval" soup_date_to_timeval :: 
    Ptr Date ->                             -- date : TInterface (Name {namespace = "Soup", name = "Date"})
    Ptr GLib.TimeVal.TimeVal ->             -- time : TInterface (Name {namespace = "GLib", name = "TimeVal"})
    IO ()

{-# DEPRECATED dateToTimeval ["Do not use t'GI.GLib.Structs.TimeVal.TimeVal', as it\\'s not Y2038-safe."] #-}
-- | Converts /@date@/ to a t'GI.GLib.Structs.TimeVal.TimeVal'.
-- 
-- /Since: 2.24/
dateToTimeval ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Date
    -- ^ /@date@/: a t'GI.Soup.Structs.Date.Date'
    -> m (GLib.TimeVal.TimeVal)
dateToTimeval :: Date -> m TimeVal
dateToTimeval Date
date = IO TimeVal -> m TimeVal
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeVal -> m TimeVal) -> IO TimeVal -> m TimeVal
forall a b. (a -> b) -> a -> b
$ do
    Ptr Date
date' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
date
    Ptr TimeVal
time <- Int -> IO (Ptr TimeVal)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr GLib.TimeVal.TimeVal)
    Ptr Date -> Ptr TimeVal -> IO ()
soup_date_to_timeval Ptr Date
date' Ptr TimeVal
time
    TimeVal
time' <- ((ManagedPtr TimeVal -> TimeVal) -> Ptr TimeVal -> IO TimeVal
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr TimeVal -> TimeVal
GLib.TimeVal.TimeVal) Ptr TimeVal
time
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
date
    TimeVal -> IO TimeVal
forall (m :: * -> *) a. Monad m => a -> m a
return TimeVal
time'

#if defined(ENABLE_OVERLOADING)
data DateToTimevalMethodInfo
instance (signature ~ (m (GLib.TimeVal.TimeVal)), MonadIO m) => O.MethodInfo DateToTimevalMethodInfo Date signature where
    overloadedMethod = dateToTimeval

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDateMethod (t :: Symbol) (o :: *) :: * where
    ResolveDateMethod "copy" o = DateCopyMethodInfo
    ResolveDateMethod "free" o = DateFreeMethodInfo
    ResolveDateMethod "isPast" o = DateIsPastMethodInfo
    ResolveDateMethod "toString" o = DateToStringMethodInfo
    ResolveDateMethod "toTimeT" o = DateToTimeTMethodInfo
    ResolveDateMethod "toTimeval" o = DateToTimevalMethodInfo
    ResolveDateMethod "getDay" o = DateGetDayMethodInfo
    ResolveDateMethod "getHour" o = DateGetHourMethodInfo
    ResolveDateMethod "getMinute" o = DateGetMinuteMethodInfo
    ResolveDateMethod "getMonth" o = DateGetMonthMethodInfo
    ResolveDateMethod "getOffset" o = DateGetOffsetMethodInfo
    ResolveDateMethod "getSecond" o = DateGetSecondMethodInfo
    ResolveDateMethod "getUtc" o = DateGetUtcMethodInfo
    ResolveDateMethod "getYear" o = DateGetYearMethodInfo
    ResolveDateMethod l o = O.MethodResolutionFailed l o

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

#endif