{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Handy.Objects.SwipeGroup.SwipeGroup' object can be used to sync multiple swipeable widgets
-- that implement the t'GI.Handy.Interfaces.Swipeable.Swipeable' interface, such as t'GI.Handy.Objects.Paginator.Paginator', so that
-- animating one of them also animates all the other widgets in the group.
-- 
-- This can be useful for syncing widgets between a window\'s titlebar and
-- content area.
-- 
-- # t'GI.Handy.Objects.SwipeGroup.SwipeGroup' as t'GI.Gtk.Interfaces.Buildable.Buildable'
-- 
-- t'GI.Handy.Objects.SwipeGroup.SwipeGroup' can be created in an UI definition. The list of swipeable
-- widgets is specified with a <swipeables> element containing multiple
-- <swipeable> elements with their ”name” attribute specifying the id of
-- the widgets.
-- 
-- >
-- ><object class="HdySwipeGroup">
-- >  <swipeables>
-- >    <swipeable name="paginator1"/>
-- >    <swipeable name="paginator2"/>
-- >  </swipeables>
-- ></object>
-- 
-- 
-- /Since: 0.0.12/

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

module GI.Handy.Objects.SwipeGroup
    ( 

-- * Exported types
    SwipeGroup(..)                          ,
    IsSwipeGroup                            ,
    toSwipeGroup                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addChild]("GI.Gtk.Interfaces.Buildable#g:method:addChild"), [addSwipeable]("GI.Handy.Objects.SwipeGroup#g:method:addSwipeable"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [constructChild]("GI.Gtk.Interfaces.Buildable#g:method:constructChild"), [customFinished]("GI.Gtk.Interfaces.Buildable#g:method:customFinished"), [customTagEnd]("GI.Gtk.Interfaces.Buildable#g:method:customTagEnd"), [customTagStart]("GI.Gtk.Interfaces.Buildable#g:method:customTagStart"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parserFinished]("GI.Gtk.Interfaces.Buildable#g:method:parserFinished"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeSwipeable]("GI.Handy.Objects.SwipeGroup#g:method:removeSwipeable"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getInternalChild]("GI.Gtk.Interfaces.Buildable#g:method:getInternalChild"), [getName]("GI.Gtk.Interfaces.Buildable#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSwipeables]("GI.Handy.Objects.SwipeGroup#g:method:getSwipeables").
-- 
-- ==== Setters
-- [setBuildableProperty]("GI.Gtk.Interfaces.Buildable#g:method:setBuildableProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setName]("GI.Gtk.Interfaces.Buildable#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSwipeGroupMethod                 ,
#endif

-- ** addSwipeable #method:addSwipeable#

#if defined(ENABLE_OVERLOADING)
    SwipeGroupAddSwipeableMethodInfo        ,
#endif
    swipeGroupAddSwipeable                  ,


-- ** getSwipeables #method:getSwipeables#

#if defined(ENABLE_OVERLOADING)
    SwipeGroupGetSwipeablesMethodInfo       ,
#endif
    swipeGroupGetSwipeables                 ,


-- ** new #method:new#

    swipeGroupNew                           ,


-- ** removeSwipeable #method:removeSwipeable#

#if defined(ENABLE_OVERLOADING)
    SwipeGroupRemoveSwipeableMethodInfo     ,
#endif
    swipeGroupRemoveSwipeable               ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Handy.Interfaces.Swipeable as Handy.Swipeable

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

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

foreign import ccall "hdy_swipe_group_get_type"
    c_hdy_swipe_group_get_type :: IO B.Types.GType

instance B.Types.TypedObject SwipeGroup where
    glibType :: IO GType
glibType = IO GType
c_hdy_swipe_group_get_type

instance B.Types.GObject SwipeGroup

-- | Type class for types which can be safely cast to `SwipeGroup`, for instance with `toSwipeGroup`.
class (SP.GObject o, O.IsDescendantOf SwipeGroup o) => IsSwipeGroup o
instance (SP.GObject o, O.IsDescendantOf SwipeGroup o) => IsSwipeGroup o

instance O.HasParentTypes SwipeGroup
type instance O.ParentTypes SwipeGroup = '[GObject.Object.Object, Gtk.Buildable.Buildable]

-- | Cast to `SwipeGroup`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toSwipeGroup :: (MIO.MonadIO m, IsSwipeGroup o) => o -> m SwipeGroup
toSwipeGroup :: forall (m :: * -> *) o.
(MonadIO m, IsSwipeGroup o) =>
o -> m SwipeGroup
toSwipeGroup = IO SwipeGroup -> m SwipeGroup
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SwipeGroup -> m SwipeGroup)
-> (o -> IO SwipeGroup) -> o -> m SwipeGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SwipeGroup -> SwipeGroup) -> o -> IO SwipeGroup
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SwipeGroup -> SwipeGroup
SwipeGroup

-- | Convert 'SwipeGroup' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe SwipeGroup) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_hdy_swipe_group_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SwipeGroup -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SwipeGroup
P.Nothing = Ptr GValue -> Ptr SwipeGroup -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SwipeGroup
forall a. Ptr a
FP.nullPtr :: FP.Ptr SwipeGroup)
    gvalueSet_ Ptr GValue
gv (P.Just SwipeGroup
obj) = SwipeGroup -> (Ptr SwipeGroup -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SwipeGroup
obj (Ptr GValue -> Ptr SwipeGroup -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SwipeGroup)
gvalueGet_ Ptr GValue
gv = do
        Ptr SwipeGroup
ptr <- Ptr GValue -> IO (Ptr SwipeGroup)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SwipeGroup)
        if Ptr SwipeGroup
ptr Ptr SwipeGroup -> Ptr SwipeGroup -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SwipeGroup
forall a. Ptr a
FP.nullPtr
        then SwipeGroup -> Maybe SwipeGroup
forall a. a -> Maybe a
P.Just (SwipeGroup -> Maybe SwipeGroup)
-> IO SwipeGroup -> IO (Maybe SwipeGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SwipeGroup -> SwipeGroup)
-> Ptr SwipeGroup -> IO SwipeGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SwipeGroup -> SwipeGroup
SwipeGroup Ptr SwipeGroup
ptr
        else Maybe SwipeGroup -> IO (Maybe SwipeGroup)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SwipeGroup
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveSwipeGroupMethod (t :: Symbol) (o :: *) :: * where
    ResolveSwipeGroupMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveSwipeGroupMethod "addSwipeable" o = SwipeGroupAddSwipeableMethodInfo
    ResolveSwipeGroupMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSwipeGroupMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSwipeGroupMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveSwipeGroupMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveSwipeGroupMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveSwipeGroupMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveSwipeGroupMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSwipeGroupMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSwipeGroupMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSwipeGroupMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSwipeGroupMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSwipeGroupMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSwipeGroupMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveSwipeGroupMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSwipeGroupMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSwipeGroupMethod "removeSwipeable" o = SwipeGroupRemoveSwipeableMethodInfo
    ResolveSwipeGroupMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSwipeGroupMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSwipeGroupMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSwipeGroupMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSwipeGroupMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSwipeGroupMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSwipeGroupMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSwipeGroupMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveSwipeGroupMethod "getName" o = Gtk.Buildable.BuildableGetNameMethodInfo
    ResolveSwipeGroupMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSwipeGroupMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSwipeGroupMethod "getSwipeables" o = SwipeGroupGetSwipeablesMethodInfo
    ResolveSwipeGroupMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveSwipeGroupMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSwipeGroupMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSwipeGroupMethod "setName" o = Gtk.Buildable.BuildableSetNameMethodInfo
    ResolveSwipeGroupMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSwipeGroupMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveSwipeGroupMethod t SwipeGroup, O.OverloadedMethod info SwipeGroup p, R.HasField t SwipeGroup p) => R.HasField t SwipeGroup p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveSwipeGroupMethod t SwipeGroup, O.OverloadedMethodInfo info SwipeGroup) => OL.IsLabel t (O.MethodProxy info SwipeGroup) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SwipeGroup = SwipeGroupSignalList
type SwipeGroupSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "hdy_swipe_group_new" hdy_swipe_group_new :: 
    IO (Ptr SwipeGroup)

-- | Create a new t'GI.Handy.Objects.SwipeGroup.SwipeGroup' object.
-- 
-- /Since: 0.0.12/
swipeGroupNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SwipeGroup
    -- ^ __Returns:__ The newly created t'GI.Handy.Objects.SwipeGroup.SwipeGroup' object
swipeGroupNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SwipeGroup
swipeGroupNew  = IO SwipeGroup -> m SwipeGroup
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SwipeGroup -> m SwipeGroup) -> IO SwipeGroup -> m SwipeGroup
forall a b. (a -> b) -> a -> b
$ do
    Ptr SwipeGroup
result <- IO (Ptr SwipeGroup)
hdy_swipe_group_new
    Text -> Ptr SwipeGroup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"swipeGroupNew" Ptr SwipeGroup
result
    SwipeGroup
result' <- ((ManagedPtr SwipeGroup -> SwipeGroup)
-> Ptr SwipeGroup -> IO SwipeGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SwipeGroup -> SwipeGroup
SwipeGroup) Ptr SwipeGroup
result
    SwipeGroup -> IO SwipeGroup
forall (m :: * -> *) a. Monad m => a -> m a
return SwipeGroup
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SwipeGroup::add_swipeable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "SwipeGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdySwipeGroup" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "swipeable"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "Swipeable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #HdySwipeable to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "hdy_swipe_group_add_swipeable" hdy_swipe_group_add_swipeable :: 
    Ptr SwipeGroup ->                       -- self : TInterface (Name {namespace = "Handy", name = "SwipeGroup"})
    Ptr Handy.Swipeable.Swipeable ->        -- swipeable : TInterface (Name {namespace = "Handy", name = "Swipeable"})
    IO ()

-- | When the widget is destroyed or no longer referenced elsewhere, it will
-- be removed from the swipe group.
-- 
-- /Since: 0.0.12/
swipeGroupAddSwipeable ::
    (B.CallStack.HasCallStack, MonadIO m, IsSwipeGroup a, Handy.Swipeable.IsSwipeable b) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.SwipeGroup.SwipeGroup'
    -> b
    -- ^ /@swipeable@/: the t'GI.Handy.Interfaces.Swipeable.Swipeable' to add
    -> m ()
swipeGroupAddSwipeable :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSwipeGroup a, IsSwipeable b) =>
a -> b -> m ()
swipeGroupAddSwipeable a
self b
swipeable = 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 SwipeGroup
self' <- a -> IO (Ptr SwipeGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Swipeable
swipeable' <- b -> IO (Ptr Swipeable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
swipeable
    Ptr SwipeGroup -> Ptr Swipeable -> IO ()
hdy_swipe_group_add_swipeable Ptr SwipeGroup
self' Ptr Swipeable
swipeable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
swipeable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SwipeGroupAddSwipeableMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSwipeGroup a, Handy.Swipeable.IsSwipeable b) => O.OverloadedMethod SwipeGroupAddSwipeableMethodInfo a signature where
    overloadedMethod = swipeGroupAddSwipeable

instance O.OverloadedMethodInfo SwipeGroupAddSwipeableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Handy.Objects.SwipeGroup.swipeGroupAddSwipeable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-handy-0.0.8/docs/GI-Handy-Objects-SwipeGroup.html#v:swipeGroupAddSwipeable"
        }


#endif

-- method SwipeGroup::get_swipeables
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "SwipeGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdySwipeGroup" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "Handy" , name = "Swipeable" }))
-- throws : False
-- Skip return : False

foreign import ccall "hdy_swipe_group_get_swipeables" hdy_swipe_group_get_swipeables :: 
    Ptr SwipeGroup ->                       -- self : TInterface (Name {namespace = "Handy", name = "SwipeGroup"})
    IO (Ptr (GSList (Ptr Handy.Swipeable.Swipeable)))

-- | Returns the list of swipeables associated with /@self@/.
-- 
-- /Since: 0.0.12/
swipeGroupGetSwipeables ::
    (B.CallStack.HasCallStack, MonadIO m, IsSwipeGroup a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.SwipeGroup.SwipeGroup'
    -> m [Handy.Swipeable.Swipeable]
    -- ^ __Returns:__ a t'GI.GLib.Structs.SList.SList' of
    --   swipeables. The list is owned by libhandy and should not be modified.
swipeGroupGetSwipeables :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSwipeGroup a) =>
a -> m [Swipeable]
swipeGroupGetSwipeables a
self = IO [Swipeable] -> m [Swipeable]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Swipeable] -> m [Swipeable])
-> IO [Swipeable] -> m [Swipeable]
forall a b. (a -> b) -> a -> b
$ do
    Ptr SwipeGroup
self' <- a -> IO (Ptr SwipeGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (GSList (Ptr Swipeable))
result <- Ptr SwipeGroup -> IO (Ptr (GSList (Ptr Swipeable)))
hdy_swipe_group_get_swipeables Ptr SwipeGroup
self'
    [Ptr Swipeable]
result' <- Ptr (GSList (Ptr Swipeable)) -> IO [Ptr Swipeable]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Swipeable))
result
    [Swipeable]
result'' <- (Ptr Swipeable -> IO Swipeable)
-> [Ptr Swipeable] -> IO [Swipeable]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Swipeable -> Swipeable)
-> Ptr Swipeable -> IO Swipeable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Swipeable -> Swipeable
Handy.Swipeable.Swipeable) [Ptr Swipeable]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [Swipeable] -> IO [Swipeable]
forall (m :: * -> *) a. Monad m => a -> m a
return [Swipeable]
result''

#if defined(ENABLE_OVERLOADING)
data SwipeGroupGetSwipeablesMethodInfo
instance (signature ~ (m [Handy.Swipeable.Swipeable]), MonadIO m, IsSwipeGroup a) => O.OverloadedMethod SwipeGroupGetSwipeablesMethodInfo a signature where
    overloadedMethod = swipeGroupGetSwipeables

instance O.OverloadedMethodInfo SwipeGroupGetSwipeablesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Handy.Objects.SwipeGroup.swipeGroupGetSwipeables",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-handy-0.0.8/docs/GI-Handy-Objects-SwipeGroup.html#v:swipeGroupGetSwipeables"
        }


#endif

-- method SwipeGroup::remove_swipeable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "SwipeGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdySwipeGroup" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "swipeable"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "Swipeable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #HdySwipeable to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "hdy_swipe_group_remove_swipeable" hdy_swipe_group_remove_swipeable :: 
    Ptr SwipeGroup ->                       -- self : TInterface (Name {namespace = "Handy", name = "SwipeGroup"})
    Ptr Handy.Swipeable.Swipeable ->        -- swipeable : TInterface (Name {namespace = "Handy", name = "Swipeable"})
    IO ()

-- | Removes a widget from a t'GI.Handy.Objects.SwipeGroup.SwipeGroup'.
-- 
-- /Since: 0.0.12/
swipeGroupRemoveSwipeable ::
    (B.CallStack.HasCallStack, MonadIO m, IsSwipeGroup a, Handy.Swipeable.IsSwipeable b) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.SwipeGroup.SwipeGroup'
    -> b
    -- ^ /@swipeable@/: the t'GI.Handy.Interfaces.Swipeable.Swipeable' to remove
    -> m ()
swipeGroupRemoveSwipeable :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSwipeGroup a, IsSwipeable b) =>
a -> b -> m ()
swipeGroupRemoveSwipeable a
self b
swipeable = 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 SwipeGroup
self' <- a -> IO (Ptr SwipeGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Swipeable
swipeable' <- b -> IO (Ptr Swipeable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
swipeable
    Ptr SwipeGroup -> Ptr Swipeable -> IO ()
hdy_swipe_group_remove_swipeable Ptr SwipeGroup
self' Ptr Swipeable
swipeable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
swipeable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SwipeGroupRemoveSwipeableMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSwipeGroup a, Handy.Swipeable.IsSwipeable b) => O.OverloadedMethod SwipeGroupRemoveSwipeableMethodInfo a signature where
    overloadedMethod = swipeGroupRemoveSwipeable

instance O.OverloadedMethodInfo SwipeGroupRemoveSwipeableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Handy.Objects.SwipeGroup.swipeGroupRemoveSwipeable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-handy-0.0.8/docs/GI-Handy-Objects-SwipeGroup.html#v:swipeGroupRemoveSwipeable"
        }


#endif