{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- WebKitGeolocationPosition is an opaque struct used to provide position updates to a
-- t'GI.WebKit2.Objects.GeolocationManager.GeolocationManager' using 'GI.WebKit2.Objects.GeolocationManager.geolocationManagerUpdatePosition'.
-- 
-- /Since: 2.26/

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

module GI.WebKit2.Structs.GeolocationPosition
    ( 

-- * Exported types
    GeolocationPosition(..)                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveGeolocationPositionMethod        ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    GeolocationPositionCopyMethodInfo       ,
#endif
    geolocationPositionCopy                 ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    GeolocationPositionFreeMethodInfo       ,
#endif
    geolocationPositionFree                 ,


-- ** new #method:new#

    geolocationPositionNew                  ,


-- ** setAltitude #method:setAltitude#

#if defined(ENABLE_OVERLOADING)
    GeolocationPositionSetAltitudeMethodInfo,
#endif
    geolocationPositionSetAltitude          ,


-- ** setAltitudeAccuracy #method:setAltitudeAccuracy#

#if defined(ENABLE_OVERLOADING)
    GeolocationPositionSetAltitudeAccuracyMethodInfo,
#endif
    geolocationPositionSetAltitudeAccuracy  ,


-- ** setHeading #method:setHeading#

#if defined(ENABLE_OVERLOADING)
    GeolocationPositionSetHeadingMethodInfo ,
#endif
    geolocationPositionSetHeading           ,


-- ** setSpeed #method:setSpeed#

#if defined(ENABLE_OVERLOADING)
    GeolocationPositionSetSpeedMethodInfo   ,
#endif
    geolocationPositionSetSpeed             ,


-- ** setTimestamp #method:setTimestamp#

#if defined(ENABLE_OVERLOADING)
    GeolocationPositionSetTimestampMethodInfo,
#endif
    geolocationPositionSetTimestamp         ,




    ) 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


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

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

foreign import ccall "webkit_geolocation_position_get_type" c_webkit_geolocation_position_get_type :: 
    IO GType

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

instance B.Types.TypedObject GeolocationPosition where
    glibType :: IO GType
glibType = IO GType
c_webkit_geolocation_position_get_type

instance B.Types.GBoxed GeolocationPosition

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


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

-- method GeolocationPosition::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "latitude"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a valid latitude in degrees"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "longitude"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a valid longitude in degrees"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accuracy"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "accuracy of location in meters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "GeolocationPosition" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_geolocation_position_new" webkit_geolocation_position_new :: 
    CDouble ->                              -- latitude : TBasicType TDouble
    CDouble ->                              -- longitude : TBasicType TDouble
    CDouble ->                              -- accuracy : TBasicType TDouble
    IO (Ptr GeolocationPosition)

-- | Create a new t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
-- 
-- /Since: 2.26/
geolocationPositionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Double
    -- ^ /@latitude@/: a valid latitude in degrees
    -> Double
    -- ^ /@longitude@/: a valid longitude in degrees
    -> Double
    -- ^ /@accuracy@/: accuracy of location in meters
    -> m GeolocationPosition
    -- ^ __Returns:__ a newly created t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
geolocationPositionNew :: Double -> Double -> Double -> m GeolocationPosition
geolocationPositionNew Double
latitude Double
longitude Double
accuracy = IO GeolocationPosition -> m GeolocationPosition
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GeolocationPosition -> m GeolocationPosition)
-> IO GeolocationPosition -> m GeolocationPosition
forall a b. (a -> b) -> a -> b
$ do
    let latitude' :: CDouble
latitude' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
latitude
    let longitude' :: CDouble
longitude' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
longitude
    let accuracy' :: CDouble
accuracy' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
accuracy
    Ptr GeolocationPosition
result <- CDouble -> CDouble -> CDouble -> IO (Ptr GeolocationPosition)
webkit_geolocation_position_new CDouble
latitude' CDouble
longitude' CDouble
accuracy'
    Text -> Ptr GeolocationPosition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"geolocationPositionNew" Ptr GeolocationPosition
result
    GeolocationPosition
result' <- ((ManagedPtr GeolocationPosition -> GeolocationPosition)
-> Ptr GeolocationPosition -> IO GeolocationPosition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GeolocationPosition -> GeolocationPosition
GeolocationPosition) Ptr GeolocationPosition
result
    GeolocationPosition -> IO GeolocationPosition
forall (m :: * -> *) a. Monad m => a -> m a
return GeolocationPosition
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "webkit_geolocation_position_copy" webkit_geolocation_position_copy :: 
    Ptr GeolocationPosition ->              -- position : TInterface (Name {namespace = "WebKit2", name = "GeolocationPosition"})
    IO (Ptr GeolocationPosition)

-- | Make a copy of the t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
-- 
-- /Since: 2.26/
geolocationPositionCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GeolocationPosition
    -- ^ /@position@/: a t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
    -> m GeolocationPosition
    -- ^ __Returns:__ a copy of /@position@/
geolocationPositionCopy :: GeolocationPosition -> m GeolocationPosition
geolocationPositionCopy GeolocationPosition
position = IO GeolocationPosition -> m GeolocationPosition
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GeolocationPosition -> m GeolocationPosition)
-> IO GeolocationPosition -> m GeolocationPosition
forall a b. (a -> b) -> a -> b
$ do
    Ptr GeolocationPosition
position' <- GeolocationPosition -> IO (Ptr GeolocationPosition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GeolocationPosition
position
    Ptr GeolocationPosition
result <- Ptr GeolocationPosition -> IO (Ptr GeolocationPosition)
webkit_geolocation_position_copy Ptr GeolocationPosition
position'
    Text -> Ptr GeolocationPosition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"geolocationPositionCopy" Ptr GeolocationPosition
result
    GeolocationPosition
result' <- ((ManagedPtr GeolocationPosition -> GeolocationPosition)
-> Ptr GeolocationPosition -> IO GeolocationPosition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GeolocationPosition -> GeolocationPosition
GeolocationPosition) Ptr GeolocationPosition
result
    GeolocationPosition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GeolocationPosition
position
    GeolocationPosition -> IO GeolocationPosition
forall (m :: * -> *) a. Monad m => a -> m a
return GeolocationPosition
result'

#if defined(ENABLE_OVERLOADING)
data GeolocationPositionCopyMethodInfo
instance (signature ~ (m GeolocationPosition), MonadIO m) => O.MethodInfo GeolocationPositionCopyMethodInfo GeolocationPosition signature where
    overloadedMethod = geolocationPositionCopy

#endif

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

foreign import ccall "webkit_geolocation_position_free" webkit_geolocation_position_free :: 
    Ptr GeolocationPosition ->              -- position : TInterface (Name {namespace = "WebKit2", name = "GeolocationPosition"})
    IO ()

-- | Free the t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
-- 
-- /Since: 2.26/
geolocationPositionFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GeolocationPosition
    -- ^ /@position@/: a t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
    -> m ()
geolocationPositionFree :: GeolocationPosition -> m ()
geolocationPositionFree GeolocationPosition
position = 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 GeolocationPosition
position' <- GeolocationPosition -> IO (Ptr GeolocationPosition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GeolocationPosition
position
    Ptr GeolocationPosition -> IO ()
webkit_geolocation_position_free Ptr GeolocationPosition
position'
    GeolocationPosition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GeolocationPosition
position
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GeolocationPositionFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo GeolocationPositionFreeMethodInfo GeolocationPosition signature where
    overloadedMethod = geolocationPositionFree

#endif

-- method GeolocationPosition::set_altitude
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "position"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "GeolocationPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitGeolocationPosition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "altitude"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "altitude in meters" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_geolocation_position_set_altitude" webkit_geolocation_position_set_altitude :: 
    Ptr GeolocationPosition ->              -- position : TInterface (Name {namespace = "WebKit2", name = "GeolocationPosition"})
    CDouble ->                              -- altitude : TBasicType TDouble
    IO ()

-- | Set the /@position@/ altitude
-- 
-- /Since: 2.26/
geolocationPositionSetAltitude ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GeolocationPosition
    -- ^ /@position@/: a t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
    -> Double
    -- ^ /@altitude@/: altitude in meters
    -> m ()
geolocationPositionSetAltitude :: GeolocationPosition -> Double -> m ()
geolocationPositionSetAltitude GeolocationPosition
position Double
altitude = 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 GeolocationPosition
position' <- GeolocationPosition -> IO (Ptr GeolocationPosition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GeolocationPosition
position
    let altitude' :: CDouble
altitude' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
altitude
    Ptr GeolocationPosition -> CDouble -> IO ()
webkit_geolocation_position_set_altitude Ptr GeolocationPosition
position' CDouble
altitude'
    GeolocationPosition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GeolocationPosition
position
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GeolocationPositionSetAltitudeMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m) => O.MethodInfo GeolocationPositionSetAltitudeMethodInfo GeolocationPosition signature where
    overloadedMethod = geolocationPositionSetAltitude

#endif

-- method GeolocationPosition::set_altitude_accuracy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "position"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "GeolocationPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitGeolocationPosition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "altitude_accuracy"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "accuracy of position altitude in meters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_geolocation_position_set_altitude_accuracy" webkit_geolocation_position_set_altitude_accuracy :: 
    Ptr GeolocationPosition ->              -- position : TInterface (Name {namespace = "WebKit2", name = "GeolocationPosition"})
    CDouble ->                              -- altitude_accuracy : TBasicType TDouble
    IO ()

-- | Set the accuracy of /@position@/ altitude
-- 
-- /Since: 2.26/
geolocationPositionSetAltitudeAccuracy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GeolocationPosition
    -- ^ /@position@/: a t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
    -> Double
    -- ^ /@altitudeAccuracy@/: accuracy of position altitude in meters
    -> m ()
geolocationPositionSetAltitudeAccuracy :: GeolocationPosition -> Double -> m ()
geolocationPositionSetAltitudeAccuracy GeolocationPosition
position Double
altitudeAccuracy = 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 GeolocationPosition
position' <- GeolocationPosition -> IO (Ptr GeolocationPosition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GeolocationPosition
position
    let altitudeAccuracy' :: CDouble
altitudeAccuracy' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
altitudeAccuracy
    Ptr GeolocationPosition -> CDouble -> IO ()
webkit_geolocation_position_set_altitude_accuracy Ptr GeolocationPosition
position' CDouble
altitudeAccuracy'
    GeolocationPosition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GeolocationPosition
position
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GeolocationPositionSetAltitudeAccuracyMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m) => O.MethodInfo GeolocationPositionSetAltitudeAccuracyMethodInfo GeolocationPosition signature where
    overloadedMethod = geolocationPositionSetAltitudeAccuracy

#endif

-- method GeolocationPosition::set_heading
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "position"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "GeolocationPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitGeolocationPosition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "heading"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "heading in degrees" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_geolocation_position_set_heading" webkit_geolocation_position_set_heading :: 
    Ptr GeolocationPosition ->              -- position : TInterface (Name {namespace = "WebKit2", name = "GeolocationPosition"})
    CDouble ->                              -- heading : TBasicType TDouble
    IO ()

-- | Set the /@position@/ heading, as a positive angle between the direction of movement and the North
-- direction, in clockwise direction.
-- 
-- /Since: 2.26/
geolocationPositionSetHeading ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GeolocationPosition
    -- ^ /@position@/: a t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
    -> Double
    -- ^ /@heading@/: heading in degrees
    -> m ()
geolocationPositionSetHeading :: GeolocationPosition -> Double -> m ()
geolocationPositionSetHeading GeolocationPosition
position Double
heading = 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 GeolocationPosition
position' <- GeolocationPosition -> IO (Ptr GeolocationPosition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GeolocationPosition
position
    let heading' :: CDouble
heading' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
heading
    Ptr GeolocationPosition -> CDouble -> IO ()
webkit_geolocation_position_set_heading Ptr GeolocationPosition
position' CDouble
heading'
    GeolocationPosition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GeolocationPosition
position
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GeolocationPositionSetHeadingMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m) => O.MethodInfo GeolocationPositionSetHeadingMethodInfo GeolocationPosition signature where
    overloadedMethod = geolocationPositionSetHeading

#endif

-- method GeolocationPosition::set_speed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "position"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "GeolocationPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitGeolocationPosition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "speed"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "speed in meters per second"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_geolocation_position_set_speed" webkit_geolocation_position_set_speed :: 
    Ptr GeolocationPosition ->              -- position : TInterface (Name {namespace = "WebKit2", name = "GeolocationPosition"})
    CDouble ->                              -- speed : TBasicType TDouble
    IO ()

-- | Set the /@position@/ speed
-- 
-- /Since: 2.26/
geolocationPositionSetSpeed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GeolocationPosition
    -- ^ /@position@/: a t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
    -> Double
    -- ^ /@speed@/: speed in meters per second
    -> m ()
geolocationPositionSetSpeed :: GeolocationPosition -> Double -> m ()
geolocationPositionSetSpeed GeolocationPosition
position Double
speed = 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 GeolocationPosition
position' <- GeolocationPosition -> IO (Ptr GeolocationPosition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GeolocationPosition
position
    let speed' :: CDouble
speed' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
speed
    Ptr GeolocationPosition -> CDouble -> IO ()
webkit_geolocation_position_set_speed Ptr GeolocationPosition
position' CDouble
speed'
    GeolocationPosition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GeolocationPosition
position
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GeolocationPositionSetSpeedMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m) => O.MethodInfo GeolocationPositionSetSpeedMethodInfo GeolocationPosition signature where
    overloadedMethod = geolocationPositionSetSpeed

#endif

-- method GeolocationPosition::set_timestamp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "position"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "GeolocationPosition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitGeolocationPosition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "timestamp in seconds since the epoch, or 0 to use current time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_geolocation_position_set_timestamp" webkit_geolocation_position_set_timestamp :: 
    Ptr GeolocationPosition ->              -- position : TInterface (Name {namespace = "WebKit2", name = "GeolocationPosition"})
    Word64 ->                               -- timestamp : TBasicType TUInt64
    IO ()

-- | Set the /@position@/ timestamp. By default it\'s the time when the /@position@/ was created.
-- 
-- /Since: 2.26/
geolocationPositionSetTimestamp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GeolocationPosition
    -- ^ /@position@/: a t'GI.WebKit2.Structs.GeolocationPosition.GeolocationPosition'
    -> Word64
    -- ^ /@timestamp@/: timestamp in seconds since the epoch, or 0 to use current time
    -> m ()
geolocationPositionSetTimestamp :: GeolocationPosition -> Word64 -> m ()
geolocationPositionSetTimestamp GeolocationPosition
position Word64
timestamp = 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 GeolocationPosition
position' <- GeolocationPosition -> IO (Ptr GeolocationPosition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GeolocationPosition
position
    Ptr GeolocationPosition -> Word64 -> IO ()
webkit_geolocation_position_set_timestamp Ptr GeolocationPosition
position' Word64
timestamp
    GeolocationPosition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GeolocationPosition
position
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GeolocationPositionSetTimestampMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m) => O.MethodInfo GeolocationPositionSetTimestampMethodInfo GeolocationPosition signature where
    overloadedMethod = geolocationPositionSetTimestamp

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveGeolocationPositionMethod (t :: Symbol) (o :: *) :: * where
    ResolveGeolocationPositionMethod "copy" o = GeolocationPositionCopyMethodInfo
    ResolveGeolocationPositionMethod "free" o = GeolocationPositionFreeMethodInfo
    ResolveGeolocationPositionMethod "setAltitude" o = GeolocationPositionSetAltitudeMethodInfo
    ResolveGeolocationPositionMethod "setAltitudeAccuracy" o = GeolocationPositionSetAltitudeAccuracyMethodInfo
    ResolveGeolocationPositionMethod "setHeading" o = GeolocationPositionSetHeadingMethodInfo
    ResolveGeolocationPositionMethod "setSpeed" o = GeolocationPositionSetSpeedMethodInfo
    ResolveGeolocationPositionMethod "setTimestamp" o = GeolocationPositionSetTimestampMethodInfo
    ResolveGeolocationPositionMethod l o = O.MethodResolutionFailed l o

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

#endif