{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Struct to store date, time and timezone information altogether.
-- t'GI.Gst.Structs.DateTime.DateTime' is refcounted and immutable.
-- 
-- Date information is handled using the proleptic Gregorian calendar.
-- 
-- Provides basic creation functions and accessor functions to its fields.

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

module GI.Gst.Structs.DateTime
    ( 

-- * Exported types
    DateTime(..)                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDateTimeMethod                   ,
#endif


-- ** getDay #method:getDay#

#if defined(ENABLE_OVERLOADING)
    DateTimeGetDayMethodInfo                ,
#endif
    dateTimeGetDay                          ,


-- ** getHour #method:getHour#

#if defined(ENABLE_OVERLOADING)
    DateTimeGetHourMethodInfo               ,
#endif
    dateTimeGetHour                         ,


-- ** getMicrosecond #method:getMicrosecond#

#if defined(ENABLE_OVERLOADING)
    DateTimeGetMicrosecondMethodInfo        ,
#endif
    dateTimeGetMicrosecond                  ,


-- ** getMinute #method:getMinute#

#if defined(ENABLE_OVERLOADING)
    DateTimeGetMinuteMethodInfo             ,
#endif
    dateTimeGetMinute                       ,


-- ** getMonth #method:getMonth#

#if defined(ENABLE_OVERLOADING)
    DateTimeGetMonthMethodInfo              ,
#endif
    dateTimeGetMonth                        ,


-- ** getSecond #method:getSecond#

#if defined(ENABLE_OVERLOADING)
    DateTimeGetSecondMethodInfo             ,
#endif
    dateTimeGetSecond                       ,


-- ** getTimeZoneOffset #method:getTimeZoneOffset#

#if defined(ENABLE_OVERLOADING)
    DateTimeGetTimeZoneOffsetMethodInfo     ,
#endif
    dateTimeGetTimeZoneOffset               ,


-- ** getYear #method:getYear#

#if defined(ENABLE_OVERLOADING)
    DateTimeGetYearMethodInfo               ,
#endif
    dateTimeGetYear                         ,


-- ** hasDay #method:hasDay#

#if defined(ENABLE_OVERLOADING)
    DateTimeHasDayMethodInfo                ,
#endif
    dateTimeHasDay                          ,


-- ** hasMonth #method:hasMonth#

#if defined(ENABLE_OVERLOADING)
    DateTimeHasMonthMethodInfo              ,
#endif
    dateTimeHasMonth                        ,


-- ** hasSecond #method:hasSecond#

#if defined(ENABLE_OVERLOADING)
    DateTimeHasSecondMethodInfo             ,
#endif
    dateTimeHasSecond                       ,


-- ** hasTime #method:hasTime#

#if defined(ENABLE_OVERLOADING)
    DateTimeHasTimeMethodInfo               ,
#endif
    dateTimeHasTime                         ,


-- ** hasYear #method:hasYear#

#if defined(ENABLE_OVERLOADING)
    DateTimeHasYearMethodInfo               ,
#endif
    dateTimeHasYear                         ,


-- ** new #method:new#

    dateTimeNew                             ,


-- ** newFromGDateTime #method:newFromGDateTime#

    dateTimeNewFromGDateTime                ,


-- ** newFromIso8601String #method:newFromIso8601String#

    dateTimeNewFromIso8601String            ,


-- ** newFromUnixEpochLocalTime #method:newFromUnixEpochLocalTime#

    dateTimeNewFromUnixEpochLocalTime       ,


-- ** newFromUnixEpochUtc #method:newFromUnixEpochUtc#

    dateTimeNewFromUnixEpochUtc             ,


-- ** newLocalTime #method:newLocalTime#

    dateTimeNewLocalTime                    ,


-- ** newNowLocalTime #method:newNowLocalTime#

    dateTimeNewNowLocalTime                 ,


-- ** newNowUtc #method:newNowUtc#

    dateTimeNewNowUtc                       ,


-- ** newY #method:newY#

    dateTimeNewY                            ,


-- ** newYm #method:newYm#

    dateTimeNewYm                           ,


-- ** newYmd #method:newYmd#

    dateTimeNewYmd                          ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DateTimeRefMethodInfo                   ,
#endif
    dateTimeRef                             ,


-- ** toGDateTime #method:toGDateTime#

#if defined(ENABLE_OVERLOADING)
    DateTimeToGDateTimeMethodInfo           ,
#endif
    dateTimeToGDateTime                     ,


-- ** toIso8601String #method:toIso8601String#

#if defined(ENABLE_OVERLOADING)
    DateTimeToIso8601StringMethodInfo       ,
#endif
    dateTimeToIso8601String                 ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DateTimeUnrefMethodInfo                 ,
#endif
    dateTimeUnref                           ,




    ) 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.DateTime as GLib.DateTime

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

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

foreign import ccall "gst_date_time_get_type" c_gst_date_time_get_type :: 
    IO GType

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

instance B.Types.TypedObject DateTime where
    glibType :: IO GType
glibType = IO GType
c_gst_date_time_get_type

instance B.Types.GBoxed DateTime

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


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

-- method DateTime::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "tzoffset"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Offset from UTC in hours."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "year"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the gregorian year" , 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 gregorian month"
--                 , 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 gregorian 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 of the day"
--                 , 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 of the hour"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "seconds"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second of the minute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new" gst_date_time_new :: 
    CFloat ->                               -- tzoffset : TBasicType TFloat
    Int32 ->                                -- year : TBasicType TInt
    Int32 ->                                -- month : TBasicType TInt
    Int32 ->                                -- day : TBasicType TInt
    Int32 ->                                -- hour : TBasicType TInt
    Int32 ->                                -- minute : TBasicType TInt
    CDouble ->                              -- seconds : TBasicType TDouble
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' using the date and times in the gregorian calendar
-- in the supplied timezone.
-- 
-- /@year@/ should be from 1 to 9999, /@month@/ should be from 1 to 12, /@day@/ from
-- 1 to 31, /@hour@/ from 0 to 23, /@minutes@/ and /@seconds@/ from 0 to 59.
-- 
-- Note that /@tzoffset@/ is a float and was chosen so for being able to handle
-- some fractional timezones, while it still keeps the readability of
-- representing it in hours for most timezones.
-- 
-- If value is -1 then all over value will be ignored. For example
-- if /@month@/ == -1, then t'GI.Gst.Structs.DateTime.DateTime' will created only for /@year@/. If
-- /@day@/ == -1, then t'GI.Gst.Structs.DateTime.DateTime' will created for /@year@/ and /@month@/ and
-- so on.
-- 
-- Free-function: gst_date_time_unref
dateTimeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@tzoffset@/: Offset from UTC in hours.
    -> Int32
    -- ^ /@year@/: the gregorian year
    -> Int32
    -- ^ /@month@/: the gregorian month
    -> Int32
    -- ^ /@day@/: the day of the gregorian month
    -> Int32
    -- ^ /@hour@/: the hour of the day
    -> Int32
    -- ^ /@minute@/: the minute of the hour
    -> Double
    -- ^ /@seconds@/: the second of the minute
    -> m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime'
dateTimeNew :: Float
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> Double
-> m DateTime
dateTimeNew Float
tzoffset Int32
year Int32
month Int32
day Int32
hour Int32
minute Double
seconds = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    let tzoffset' :: CFloat
tzoffset' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
tzoffset
    let seconds' :: CDouble
seconds' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
seconds
    Ptr DateTime
result <- CFloat
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> CDouble
-> IO (Ptr DateTime)
gst_date_time_new CFloat
tzoffset' Int32
year Int32
month Int32
day Int32
hour Int32
minute CDouble
seconds'
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNew" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_from_g_date_time
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "dt"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GDateTime. The new #GstDateTime takes ownership."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_from_g_date_time" gst_date_time_new_from_g_date_time :: 
    Ptr GLib.DateTime.DateTime ->           -- dt : TInterface (Name {namespace = "GLib", name = "DateTime"})
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' from a t'GI.GLib.Structs.DateTime.DateTime' object.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewFromGDateTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GLib.DateTime.DateTime
    -- ^ /@dt@/: the t'GI.GLib.Structs.DateTime.DateTime'. The new t'GI.Gst.Structs.DateTime.DateTime' takes ownership.
    -> m (Maybe DateTime)
    -- ^ __Returns:__ a newly created t'GI.Gst.Structs.DateTime.DateTime',
    -- or 'P.Nothing' on error
dateTimeNewFromGDateTime :: DateTime -> m (Maybe DateTime)
dateTimeNewFromGDateTime DateTime
dt = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
dt' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed DateTime
dt
    Ptr DateTime
result <- Ptr DateTime -> IO (Ptr DateTime)
gst_date_time_new_from_g_date_time Ptr DateTime
dt'
    Maybe DateTime
maybeResult <- Ptr DateTime
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DateTime
result ((Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime))
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ \Ptr DateTime
result' -> do
        DateTime
result'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result'
        DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result''
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
dt
    Maybe DateTime -> IO (Maybe DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DateTime
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_from_iso8601_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ISO 8601-formatted datetime string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_from_iso8601_string" gst_date_time_new_from_iso8601_string :: 
    CString ->                              -- string : TBasicType TUTF8
    IO (Ptr DateTime)

-- | Tries to parse common variants of ISO-8601 datetime strings into a
-- t'GI.Gst.Structs.DateTime.DateTime'. Possible input formats are (for example):
-- 2012-06-30T22:46:43Z, 2012, 2012-06, 2012-06-30, 2012-06-30T22:46:43-0430,
-- 2012-06-30T22:46Z, 2012-06-30T22:46-0430, 2012-06-30 22:46,
-- 2012-06-30 22:46:43, 2012-06-00, 2012-00-00, 2012-00-30, 22:46:43Z, 22:46Z,
-- 22:46:43-0430, 22:46-0430, 22:46:30, 22:46
-- If no date is provided, it is assumed to be \"today\" in the timezone
-- provided (if any), otherwise UTC.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewFromIso8601String ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: ISO 8601-formatted datetime string.
    -> m (Maybe DateTime)
    -- ^ __Returns:__ a newly created t'GI.Gst.Structs.DateTime.DateTime',
    -- or 'P.Nothing' on error
dateTimeNewFromIso8601String :: Text -> m (Maybe DateTime)
dateTimeNewFromIso8601String Text
string = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    Ptr DateTime
result <- CString -> IO (Ptr DateTime)
gst_date_time_new_from_iso8601_string CString
string'
    Maybe DateTime
maybeResult <- Ptr DateTime
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DateTime
result ((Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime))
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ \Ptr DateTime
result' -> do
        DateTime
result'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result'
        DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    Maybe DateTime -> IO (Maybe DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DateTime
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_from_unix_epoch_local_time
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "secs"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "seconds from the Unix epoch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_from_unix_epoch_local_time" gst_date_time_new_from_unix_epoch_local_time :: 
    Int64 ->                                -- secs : TBasicType TInt64
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' using the time since Jan 1, 1970 specified by
-- /@secs@/. The t'GI.Gst.Structs.DateTime.DateTime' is in the local timezone.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewFromUnixEpochLocalTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int64
    -- ^ /@secs@/: seconds from the Unix epoch
    -> m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime'
dateTimeNewFromUnixEpochLocalTime :: Int64 -> m DateTime
dateTimeNewFromUnixEpochLocalTime Int64
secs = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
result <- Int64 -> IO (Ptr DateTime)
gst_date_time_new_from_unix_epoch_local_time Int64
secs
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNewFromUnixEpochLocalTime" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_from_unix_epoch_utc
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "secs"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "seconds from the Unix epoch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_from_unix_epoch_utc" gst_date_time_new_from_unix_epoch_utc :: 
    Int64 ->                                -- secs : TBasicType TInt64
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' using the time since Jan 1, 1970 specified by
-- /@secs@/. The t'GI.Gst.Structs.DateTime.DateTime' is in the UTC timezone.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewFromUnixEpochUtc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int64
    -- ^ /@secs@/: seconds from the Unix epoch
    -> m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime'
dateTimeNewFromUnixEpochUtc :: Int64 -> m DateTime
dateTimeNewFromUnixEpochUtc Int64
secs = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
result <- Int64 -> IO (Ptr DateTime)
gst_date_time_new_from_unix_epoch_utc Int64
secs
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNewFromUnixEpochUtc" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_local_time
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "year"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the gregorian year" , 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 gregorian month, or -1"
--                 , 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 gregorian month, or -1"
--                 , 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 of the day, or -1"
--                 , 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 of the hour, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "seconds"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second of the minute, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_local_time" gst_date_time_new_local_time :: 
    Int32 ->                                -- year : TBasicType TInt
    Int32 ->                                -- month : TBasicType TInt
    Int32 ->                                -- day : TBasicType TInt
    Int32 ->                                -- hour : TBasicType TInt
    Int32 ->                                -- minute : TBasicType TInt
    CDouble ->                              -- seconds : TBasicType TDouble
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' using the date and times in the gregorian calendar
-- in the local timezone.
-- 
-- /@year@/ should be from 1 to 9999, /@month@/ should be from 1 to 12, /@day@/ from
-- 1 to 31, /@hour@/ from 0 to 23, /@minutes@/ and /@seconds@/ from 0 to 59.
-- 
-- If /@month@/ is -1, then the t'GI.Gst.Structs.DateTime.DateTime' created will only contain /@year@/,
-- and all other fields will be considered not set.
-- 
-- If /@day@/ is -1, then the t'GI.Gst.Structs.DateTime.DateTime' created will only contain /@year@/ and
-- /@month@/ and all other fields will be considered not set.
-- 
-- If /@hour@/ is -1, then the t'GI.Gst.Structs.DateTime.DateTime' created will only contain /@year@/ and
-- /@month@/ and /@day@/, and the time fields will be considered not set. In this
-- case /@minute@/ and /@seconds@/ should also be -1.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewLocalTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@year@/: the gregorian year
    -> Int32
    -- ^ /@month@/: the gregorian month, or -1
    -> Int32
    -- ^ /@day@/: the day of the gregorian month, or -1
    -> Int32
    -- ^ /@hour@/: the hour of the day, or -1
    -> Int32
    -- ^ /@minute@/: the minute of the hour, or -1
    -> Double
    -- ^ /@seconds@/: the second of the minute, or -1
    -> m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime'
dateTimeNewLocalTime :: Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Double -> m DateTime
dateTimeNewLocalTime Int32
year Int32
month Int32
day Int32
hour Int32
minute Double
seconds = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    let seconds' :: CDouble
seconds' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
seconds
    Ptr DateTime
result <- Int32
-> Int32 -> Int32 -> Int32 -> Int32 -> CDouble -> IO (Ptr DateTime)
gst_date_time_new_local_time Int32
year Int32
month Int32
day Int32
hour Int32
minute CDouble
seconds'
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNewLocalTime" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_now_local_time
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_now_local_time" gst_date_time_new_now_local_time :: 
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' representing the current date and time.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewNowLocalTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime' which should
    --     be freed with 'GI.Gst.Structs.DateTime.dateTimeUnref'.
dateTimeNewNowLocalTime :: m DateTime
dateTimeNewNowLocalTime  = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
result <- IO (Ptr DateTime)
gst_date_time_new_now_local_time
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNewNowLocalTime" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_now_utc
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_now_utc" gst_date_time_new_now_utc :: 
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' that represents the current instant at Universal
-- coordinated time.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewNowUtc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime' which should
    --   be freed with 'GI.Gst.Structs.DateTime.dateTimeUnref'.
dateTimeNewNowUtc :: m DateTime
dateTimeNewNowUtc  = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
result <- IO (Ptr DateTime)
gst_date_time_new_now_utc
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNewNowUtc" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_y
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "year"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the gregorian year" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_y" gst_date_time_new_y :: 
    Int32 ->                                -- year : TBasicType TInt
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' using the date and times in the gregorian calendar
-- in the local timezone.
-- 
-- /@year@/ should be from 1 to 9999.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewY ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@year@/: the gregorian year
    -> m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime'
dateTimeNewY :: Int32 -> m DateTime
dateTimeNewY Int32
year = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
result <- Int32 -> IO (Ptr DateTime)
gst_date_time_new_y Int32
year
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNewY" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_ym
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "year"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the gregorian year" , 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 gregorian month"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_ym" gst_date_time_new_ym :: 
    Int32 ->                                -- year : TBasicType TInt
    Int32 ->                                -- month : TBasicType TInt
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' using the date and times in the gregorian calendar
-- in the local timezone.
-- 
-- /@year@/ should be from 1 to 9999, /@month@/ should be from 1 to 12.
-- 
-- If value is -1 then all over value will be ignored. For example
-- if /@month@/ == -1, then t'GI.Gst.Structs.DateTime.DateTime' will created only for /@year@/.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewYm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@year@/: the gregorian year
    -> Int32
    -- ^ /@month@/: the gregorian month
    -> m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime'
dateTimeNewYm :: Int32 -> Int32 -> m DateTime
dateTimeNewYm Int32
year Int32
month = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
result <- Int32 -> Int32 -> IO (Ptr DateTime)
gst_date_time_new_ym Int32
year Int32
month
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNewYm" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::new_ymd
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "year"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the gregorian year" , 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 gregorian month"
--                 , 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 gregorian month"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_new_ymd" gst_date_time_new_ymd :: 
    Int32 ->                                -- year : TBasicType TInt
    Int32 ->                                -- month : TBasicType TInt
    Int32 ->                                -- day : TBasicType TInt
    IO (Ptr DateTime)

-- | Creates a new t'GI.Gst.Structs.DateTime.DateTime' using the date and times in the gregorian calendar
-- in the local timezone.
-- 
-- /@year@/ should be from 1 to 9999, /@month@/ should be from 1 to 12, /@day@/ from
-- 1 to 31.
-- 
-- If value is -1 then all over value will be ignored. For example
-- if /@month@/ == -1, then t'GI.Gst.Structs.DateTime.DateTime' will created only for /@year@/. If
-- /@day@/ == -1, then t'GI.Gst.Structs.DateTime.DateTime' will created for /@year@/ and /@month@/ and
-- so on.
-- 
-- Free-function: gst_date_time_unref
dateTimeNewYmd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@year@/: the gregorian year
    -> Int32
    -- ^ /@month@/: the gregorian month
    -> Int32
    -- ^ /@day@/: the day of the gregorian month
    -> m DateTime
    -- ^ __Returns:__ the newly created t'GI.Gst.Structs.DateTime.DateTime'
dateTimeNewYmd :: Int32 -> Int32 -> Int32 -> m DateTime
dateTimeNewYmd Int32
year Int32
month Int32
day = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
result <- Int32 -> Int32 -> Int32 -> IO (Ptr DateTime)
gst_date_time_new_ymd Int32
year Int32
month Int32
day
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeNewYmd" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DateTime::get_day
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_get_day" gst_date_time_get_day :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO Int32

-- | Returns the day of the month of this t'GI.Gst.Structs.DateTime.DateTime'.
-- Call 'GI.Gst.Structs.DateTime.dateTimeHasDay' before, to avoid warnings.
dateTimeGetDay ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Int32
    -- ^ __Returns:__ The day of this t'GI.Gst.Structs.DateTime.DateTime'
dateTimeGetDay :: DateTime -> m Int32
dateTimeGetDay DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Int32
result <- Ptr DateTime -> IO Int32
gst_date_time_get_day Ptr DateTime
datetime'
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateTimeGetDayMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateTimeGetDayMethodInfo DateTime signature where
    overloadedMethod = dateTimeGetDay

#endif

-- method DateTime::get_hour
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_get_hour" gst_date_time_get_hour :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO Int32

-- | Retrieves the hour of the day represented by /@datetime@/ in the gregorian
-- calendar. The return is in the range of 0 to 23.
-- Call 'GI.Gst.Structs.DateTime.dateTimeHasTime' before, to avoid warnings.
dateTimeGetHour ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Int32
    -- ^ __Returns:__ the hour of the day
dateTimeGetHour :: DateTime -> m Int32
dateTimeGetHour DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Int32
result <- Ptr DateTime -> IO Int32
gst_date_time_get_hour Ptr DateTime
datetime'
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateTimeGetHourMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateTimeGetHourMethodInfo DateTime signature where
    overloadedMethod = dateTimeGetHour

#endif

-- method DateTime::get_microsecond
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_get_microsecond" gst_date_time_get_microsecond :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO Int32

-- | Retrieves the fractional part of the seconds in microseconds represented by
-- /@datetime@/ in the gregorian calendar.
dateTimeGetMicrosecond ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Int32
    -- ^ __Returns:__ the microsecond of the second
dateTimeGetMicrosecond :: DateTime -> m Int32
dateTimeGetMicrosecond DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Int32
result <- Ptr DateTime -> IO Int32
gst_date_time_get_microsecond Ptr DateTime
datetime'
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateTimeGetMicrosecondMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateTimeGetMicrosecondMethodInfo DateTime signature where
    overloadedMethod = dateTimeGetMicrosecond

#endif

-- method DateTime::get_minute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_get_minute" gst_date_time_get_minute :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO Int32

-- | Retrieves the minute of the hour represented by /@datetime@/ in the gregorian
-- calendar.
-- Call 'GI.Gst.Structs.DateTime.dateTimeHasTime' before, to avoid warnings.
dateTimeGetMinute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Int32
    -- ^ __Returns:__ the minute of the hour
dateTimeGetMinute :: DateTime -> m Int32
dateTimeGetMinute DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Int32
result <- Ptr DateTime -> IO Int32
gst_date_time_get_minute Ptr DateTime
datetime'
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateTimeGetMinuteMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateTimeGetMinuteMethodInfo DateTime signature where
    overloadedMethod = dateTimeGetMinute

#endif

-- method DateTime::get_month
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_get_month" gst_date_time_get_month :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO Int32

-- | Returns the month of this t'GI.Gst.Structs.DateTime.DateTime'. January is 1, February is 2, etc..
-- Call 'GI.Gst.Structs.DateTime.dateTimeHasMonth' before, to avoid warnings.
dateTimeGetMonth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Int32
    -- ^ __Returns:__ The month of this t'GI.Gst.Structs.DateTime.DateTime'
dateTimeGetMonth :: DateTime -> m Int32
dateTimeGetMonth DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Int32
result <- Ptr DateTime -> IO Int32
gst_date_time_get_month Ptr DateTime
datetime'
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateTimeGetMonthMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateTimeGetMonthMethodInfo DateTime signature where
    overloadedMethod = dateTimeGetMonth

#endif

-- method DateTime::get_second
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_get_second" gst_date_time_get_second :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO Int32

-- | Retrieves the second of the minute represented by /@datetime@/ in the gregorian
-- calendar.
-- Call 'GI.Gst.Structs.DateTime.dateTimeHasTime' before, to avoid warnings.
dateTimeGetSecond ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Int32
    -- ^ __Returns:__ the second represented by /@datetime@/
dateTimeGetSecond :: DateTime -> m Int32
dateTimeGetSecond DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Int32
result <- Ptr DateTime -> IO Int32
gst_date_time_get_second Ptr DateTime
datetime'
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateTimeGetSecondMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateTimeGetSecondMethodInfo DateTime signature where
    overloadedMethod = dateTimeGetSecond

#endif

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

foreign import ccall "gst_date_time_get_time_zone_offset" gst_date_time_get_time_zone_offset :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CFloat

-- | Retrieves the offset from UTC in hours that the timezone specified
-- by /@datetime@/ represents. Timezones ahead (to the east) of UTC have positive
-- values, timezones before (to the west) of UTC have negative values.
-- If /@datetime@/ represents UTC time, then the offset is zero.
dateTimeGetTimeZoneOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Float
    -- ^ __Returns:__ the offset from UTC in hours
dateTimeGetTimeZoneOffset :: DateTime -> m Float
dateTimeGetTimeZoneOffset DateTime
datetime = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    CFloat
result <- Ptr DateTime -> IO CFloat
gst_date_time_get_time_zone_offset Ptr DateTime
datetime'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data DateTimeGetTimeZoneOffsetMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.MethodInfo DateTimeGetTimeZoneOffsetMethodInfo DateTime signature where
    overloadedMethod = dateTimeGetTimeZoneOffset

#endif

-- method DateTime::get_year
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_get_year" gst_date_time_get_year :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO Int32

-- | Returns the year of this t'GI.Gst.Structs.DateTime.DateTime'
-- Call 'GI.Gst.Structs.DateTime.dateTimeHasYear' before, to avoid warnings.
dateTimeGetYear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Int32
    -- ^ __Returns:__ The year of this t'GI.Gst.Structs.DateTime.DateTime'
dateTimeGetYear :: DateTime -> m Int32
dateTimeGetYear DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Int32
result <- Ptr DateTime -> IO Int32
gst_date_time_get_year Ptr DateTime
datetime'
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DateTimeGetYearMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo DateTimeGetYearMethodInfo DateTime signature where
    overloadedMethod = dateTimeGetYear

#endif

-- method DateTime::has_day
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_has_day" gst_date_time_has_day :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | /No description available in the introspection data./
dateTimeHasDay ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@datetime@/\'s day field is set, otherwise 'P.False'
dateTimeHasDay :: DateTime -> m Bool
dateTimeHasDay DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    CInt
result <- Ptr DateTime -> IO CInt
gst_date_time_has_day Ptr DateTime
datetime'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DateTimeHasDayMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo DateTimeHasDayMethodInfo DateTime signature where
    overloadedMethod = dateTimeHasDay

#endif

-- method DateTime::has_month
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_has_month" gst_date_time_has_month :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | /No description available in the introspection data./
dateTimeHasMonth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@datetime@/\'s month field is set, otherwise 'P.False'
dateTimeHasMonth :: DateTime -> m Bool
dateTimeHasMonth DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    CInt
result <- Ptr DateTime -> IO CInt
gst_date_time_has_month Ptr DateTime
datetime'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DateTimeHasMonthMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo DateTimeHasMonthMethodInfo DateTime signature where
    overloadedMethod = dateTimeHasMonth

#endif

-- method DateTime::has_second
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_has_second" gst_date_time_has_second :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | /No description available in the introspection data./
dateTimeHasSecond ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@datetime@/\'s second field is set, otherwise 'P.False'
dateTimeHasSecond :: DateTime -> m Bool
dateTimeHasSecond DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    CInt
result <- Ptr DateTime -> IO CInt
gst_date_time_has_second Ptr DateTime
datetime'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DateTimeHasSecondMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo DateTimeHasSecondMethodInfo DateTime signature where
    overloadedMethod = dateTimeHasSecond

#endif

-- method DateTime::has_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_has_time" gst_date_time_has_time :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | /No description available in the introspection data./
dateTimeHasTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@datetime@/\'s hour and minute fields are set,
    --     otherwise 'P.False'
dateTimeHasTime :: DateTime -> m Bool
dateTimeHasTime DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    CInt
result <- Ptr DateTime -> IO CInt
gst_date_time_has_time Ptr DateTime
datetime'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DateTimeHasTimeMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo DateTimeHasTimeMethodInfo DateTime signature where
    overloadedMethod = dateTimeHasTime

#endif

-- method DateTime::has_year
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , 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 "gst_date_time_has_year" gst_date_time_has_year :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | /No description available in the introspection data./
dateTimeHasYear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@datetime@/\'s year field is set (which should always
    --     be the case), otherwise 'P.False'
dateTimeHasYear :: DateTime -> m Bool
dateTimeHasYear DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    CInt
result <- Ptr DateTime -> IO CInt
gst_date_time_has_year Ptr DateTime
datetime'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DateTimeHasYearMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo DateTimeHasYearMethodInfo DateTime signature where
    overloadedMethod = dateTimeHasYear

#endif

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

foreign import ccall "gst_date_time_ref" gst_date_time_ref :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO (Ptr DateTime)

-- | Atomically increments the reference count of /@datetime@/ by one.
dateTimeRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m DateTime
    -- ^ __Returns:__ the reference /@datetime@/
dateTimeRef :: DateTime -> m DateTime
dateTimeRef DateTime
datetime = IO DateTime -> m DateTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DateTime -> m DateTime) -> IO DateTime -> m DateTime
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Ptr DateTime
result <- Ptr DateTime -> IO (Ptr DateTime)
gst_date_time_ref Ptr DateTime
datetime'
    Text -> Ptr DateTime -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dateTimeRef" Ptr DateTime
result
    DateTime
result' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
DateTime) Ptr DateTime
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result'

#if defined(ENABLE_OVERLOADING)
data DateTimeRefMethodInfo
instance (signature ~ (m DateTime), MonadIO m) => O.MethodInfo DateTimeRefMethodInfo DateTime signature where
    overloadedMethod = dateTimeRef

#endif

-- method DateTime::to_g_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GstDateTime." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_to_g_date_time" gst_date_time_to_g_date_time :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO (Ptr GLib.DateTime.DateTime)

-- | Creates a new t'GI.GLib.Structs.DateTime.DateTime' from a fully defined t'GI.Gst.Structs.DateTime.DateTime' object.
-- 
-- Free-function: g_date_time_unref
dateTimeToGDateTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: GstDateTime.
    -> m (Maybe GLib.DateTime.DateTime)
    -- ^ __Returns:__ a newly created t'GI.GLib.Structs.DateTime.DateTime', or
    -- 'P.Nothing' on error
dateTimeToGDateTime :: DateTime -> m (Maybe DateTime)
dateTimeToGDateTime DateTime
datetime = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    Ptr DateTime
result <- Ptr DateTime -> IO (Ptr DateTime)
gst_date_time_to_g_date_time Ptr DateTime
datetime'
    Maybe DateTime
maybeResult <- Ptr DateTime
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DateTime
result ((Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime))
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ \Ptr DateTime
result' -> do
        DateTime
result'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
GLib.DateTime.DateTime) Ptr DateTime
result'
        DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result''
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Maybe DateTime -> IO (Maybe DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DateTime
maybeResult

#if defined(ENABLE_OVERLOADING)
data DateTimeToGDateTimeMethodInfo
instance (signature ~ (m (Maybe GLib.DateTime.DateTime)), MonadIO m) => O.MethodInfo DateTimeToGDateTimeMethodInfo DateTime signature where
    overloadedMethod = dateTimeToGDateTime

#endif

-- method DateTime::to_iso8601_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GstDateTime." , 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 "gst_date_time_to_iso8601_string" gst_date_time_to_iso8601_string :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CString

-- | Create a minimal string compatible with ISO-8601. Possible output formats
-- are (for example): 2012, 2012-06, 2012-06-23, 2012-06-23T23:30Z,
-- 2012-06-23T23:30+0100, 2012-06-23T23:30:59Z, 2012-06-23T23:30:59+0100
dateTimeToIso8601String ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: GstDateTime.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly allocated string formatted according
    --     to ISO 8601 and only including the datetime fields that are
    --     valid, or 'P.Nothing' in case there was an error. The string should
    --     be freed with 'GI.GLib.Functions.free'.
dateTimeToIso8601String :: DateTime -> m (Maybe Text)
dateTimeToIso8601String DateTime
datetime = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
datetime
    CString
result <- Ptr DateTime -> IO CString
gst_date_time_to_iso8601_string Ptr DateTime
datetime'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DateTimeToIso8601StringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo DateTimeToIso8601StringMethodInfo DateTime signature where
    overloadedMethod = dateTimeToIso8601String

#endif

-- method DateTime::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "datetime"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDateTime" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_date_time_unref" gst_date_time_unref :: 
    Ptr DateTime ->                         -- datetime : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO ()

-- | Atomically decrements the reference count of /@datetime@/ by one.  When the
-- reference count reaches zero, the structure is freed.
dateTimeUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DateTime
    -- ^ /@datetime@/: a t'GI.Gst.Structs.DateTime.DateTime'
    -> m ()
dateTimeUnref :: DateTime -> m ()
dateTimeUnref DateTime
datetime = 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 DateTime
datetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed DateTime
datetime
    Ptr DateTime -> IO ()
gst_date_time_unref Ptr DateTime
datetime'
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
datetime
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DateTimeUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DateTimeUnrefMethodInfo DateTime signature where
    overloadedMethod = dateTimeUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDateTimeMethod (t :: Symbol) (o :: *) :: * where
    ResolveDateTimeMethod "hasDay" o = DateTimeHasDayMethodInfo
    ResolveDateTimeMethod "hasMonth" o = DateTimeHasMonthMethodInfo
    ResolveDateTimeMethod "hasSecond" o = DateTimeHasSecondMethodInfo
    ResolveDateTimeMethod "hasTime" o = DateTimeHasTimeMethodInfo
    ResolveDateTimeMethod "hasYear" o = DateTimeHasYearMethodInfo
    ResolveDateTimeMethod "ref" o = DateTimeRefMethodInfo
    ResolveDateTimeMethod "toGDateTime" o = DateTimeToGDateTimeMethodInfo
    ResolveDateTimeMethod "toIso8601String" o = DateTimeToIso8601StringMethodInfo
    ResolveDateTimeMethod "unref" o = DateTimeUnrefMethodInfo
    ResolveDateTimeMethod "getDay" o = DateTimeGetDayMethodInfo
    ResolveDateTimeMethod "getHour" o = DateTimeGetHourMethodInfo
    ResolveDateTimeMethod "getMicrosecond" o = DateTimeGetMicrosecondMethodInfo
    ResolveDateTimeMethod "getMinute" o = DateTimeGetMinuteMethodInfo
    ResolveDateTimeMethod "getMonth" o = DateTimeGetMonthMethodInfo
    ResolveDateTimeMethod "getSecond" o = DateTimeGetSecondMethodInfo
    ResolveDateTimeMethod "getTimeZoneOffset" o = DateTimeGetTimeZoneOffsetMethodInfo
    ResolveDateTimeMethod "getYear" o = DateTimeGetYearMethodInfo
    ResolveDateTimeMethod l o = O.MethodResolutionFailed l o

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

#endif