{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gtk.Objects.PlacesSidebar
    ( 

-- * Exported types
    PlacesSidebar(..)                       ,
    PlacesSidebarK                          ,
    toPlacesSidebar                         ,
    noPlacesSidebar                         ,


 -- * Methods
-- ** placesSidebarAddShortcut
    placesSidebarAddShortcut                ,


-- ** placesSidebarGetLocalOnly
    placesSidebarGetLocalOnly               ,


-- ** placesSidebarGetLocation
    placesSidebarGetLocation                ,


-- ** placesSidebarGetNthBookmark
    placesSidebarGetNthBookmark             ,


-- ** placesSidebarGetOpenFlags
    placesSidebarGetOpenFlags               ,


-- ** placesSidebarGetShowConnectToServer
    placesSidebarGetShowConnectToServer     ,


-- ** placesSidebarGetShowDesktop
    placesSidebarGetShowDesktop             ,


-- ** placesSidebarGetShowEnterLocation
    placesSidebarGetShowEnterLocation       ,


-- ** placesSidebarListShortcuts
    placesSidebarListShortcuts              ,


-- ** placesSidebarNew
    placesSidebarNew                        ,


-- ** placesSidebarRemoveShortcut
    placesSidebarRemoveShortcut             ,


-- ** placesSidebarSetLocalOnly
    placesSidebarSetLocalOnly               ,


-- ** placesSidebarSetLocation
    placesSidebarSetLocation                ,


-- ** placesSidebarSetOpenFlags
    placesSidebarSetOpenFlags               ,


-- ** placesSidebarSetShowConnectToServer
    placesSidebarSetShowConnectToServer     ,


-- ** placesSidebarSetShowDesktop
    placesSidebarSetShowDesktop             ,


-- ** placesSidebarSetShowEnterLocation
    placesSidebarSetShowEnterLocation       ,




 -- * Properties
-- ** LocalOnly
    PlacesSidebarLocalOnlyPropertyInfo      ,
    constructPlacesSidebarLocalOnly         ,
    getPlacesSidebarLocalOnly               ,
    setPlacesSidebarLocalOnly               ,


-- ** Location
    PlacesSidebarLocationPropertyInfo       ,
    constructPlacesSidebarLocation          ,
    getPlacesSidebarLocation                ,
    setPlacesSidebarLocation                ,


-- ** OpenFlags
    PlacesSidebarOpenFlagsPropertyInfo      ,
    constructPlacesSidebarOpenFlags         ,
    getPlacesSidebarOpenFlags               ,
    setPlacesSidebarOpenFlags               ,


-- ** ShowConnectToServer
    PlacesSidebarShowConnectToServerPropertyInfo,
    constructPlacesSidebarShowConnectToServer,
    getPlacesSidebarShowConnectToServer     ,
    setPlacesSidebarShowConnectToServer     ,


-- ** ShowDesktop
    PlacesSidebarShowDesktopPropertyInfo    ,
    constructPlacesSidebarShowDesktop       ,
    getPlacesSidebarShowDesktop             ,
    setPlacesSidebarShowDesktop             ,


-- ** ShowEnterLocation
    PlacesSidebarShowEnterLocationPropertyInfo,
    constructPlacesSidebarShowEnterLocation ,
    getPlacesSidebarShowEnterLocation       ,
    setPlacesSidebarShowEnterLocation       ,




 -- * Signals
-- ** DragActionAsk
    PlacesSidebarDragActionAskCallback      ,
    PlacesSidebarDragActionAskCallbackC     ,
    PlacesSidebarDragActionAskSignalInfo    ,
    afterPlacesSidebarDragActionAsk         ,
    mkPlacesSidebarDragActionAskCallback    ,
    noPlacesSidebarDragActionAskCallback    ,
    onPlacesSidebarDragActionAsk            ,
    placesSidebarDragActionAskCallbackWrapper,
    placesSidebarDragActionAskClosure       ,


-- ** DragActionRequested
    PlacesSidebarDragActionRequestedCallback,
    PlacesSidebarDragActionRequestedCallbackC,
    PlacesSidebarDragActionRequestedSignalInfo,
    afterPlacesSidebarDragActionRequested   ,
    mkPlacesSidebarDragActionRequestedCallback,
    noPlacesSidebarDragActionRequestedCallback,
    onPlacesSidebarDragActionRequested      ,
    placesSidebarDragActionRequestedCallbackWrapper,
    placesSidebarDragActionRequestedClosure ,


-- ** DragPerformDrop
    PlacesSidebarDragPerformDropCallback    ,
    PlacesSidebarDragPerformDropCallbackC   ,
    PlacesSidebarDragPerformDropSignalInfo  ,
    afterPlacesSidebarDragPerformDrop       ,
    mkPlacesSidebarDragPerformDropCallback  ,
    noPlacesSidebarDragPerformDropCallback  ,
    onPlacesSidebarDragPerformDrop          ,
    placesSidebarDragPerformDropCallbackWrapper,
    placesSidebarDragPerformDropClosure     ,


-- ** OpenLocation
    PlacesSidebarOpenLocationCallback       ,
    PlacesSidebarOpenLocationCallbackC      ,
    PlacesSidebarOpenLocationSignalInfo     ,
    afterPlacesSidebarOpenLocation          ,
    mkPlacesSidebarOpenLocationCallback     ,
    noPlacesSidebarOpenLocationCallback     ,
    onPlacesSidebarOpenLocation             ,
    placesSidebarOpenLocationCallbackWrapper,
    placesSidebarOpenLocationClosure        ,


-- ** PopulatePopup
    PlacesSidebarPopulatePopupCallback      ,
    PlacesSidebarPopulatePopupCallbackC     ,
    PlacesSidebarPopulatePopupSignalInfo    ,
    afterPlacesSidebarPopulatePopup         ,
    mkPlacesSidebarPopulatePopupCallback    ,
    noPlacesSidebarPopulatePopupCallback    ,
    onPlacesSidebarPopulatePopup            ,
    placesSidebarPopulatePopupCallbackWrapper,
    placesSidebarPopulatePopupClosure       ,


-- ** ShowConnectToServer
    PlacesSidebarShowConnectToServerCallback,
    PlacesSidebarShowConnectToServerCallbackC,
    PlacesSidebarShowConnectToServerSignalInfo,
    afterPlacesSidebarShowConnectToServer   ,
    mkPlacesSidebarShowConnectToServerCallback,
    noPlacesSidebarShowConnectToServerCallback,
    onPlacesSidebarShowConnectToServer      ,
    placesSidebarShowConnectToServerCallbackWrapper,
    placesSidebarShowConnectToServerClosure ,


-- ** ShowEnterLocation
    PlacesSidebarShowEnterLocationCallback  ,
    PlacesSidebarShowEnterLocationCallbackC ,
    PlacesSidebarShowEnterLocationSignalInfo,
    afterPlacesSidebarShowEnterLocation     ,
    mkPlacesSidebarShowEnterLocationCallback,
    noPlacesSidebarShowEnterLocationCallback,
    onPlacesSidebarShowEnterLocation        ,
    placesSidebarShowEnterLocationCallbackWrapper,
    placesSidebarShowEnterLocationClosure   ,


-- ** ShowErrorMessage
    PlacesSidebarShowErrorMessageCallback   ,
    PlacesSidebarShowErrorMessageCallbackC  ,
    PlacesSidebarShowErrorMessageSignalInfo ,
    afterPlacesSidebarShowErrorMessage      ,
    mkPlacesSidebarShowErrorMessageCallback ,
    noPlacesSidebarShowErrorMessageCallback ,
    onPlacesSidebarShowErrorMessage         ,
    placesSidebarShowErrorMessageCallbackWrapper,
    placesSidebarShowErrorMessageClosure    ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.Atk as Atk
import qualified GI.GObject as GObject
import qualified GI.Gdk as Gdk
import qualified GI.Gio as Gio

newtype PlacesSidebar = PlacesSidebar (ForeignPtr PlacesSidebar)
foreign import ccall "gtk_places_sidebar_get_type"
    c_gtk_places_sidebar_get_type :: IO GType

type instance ParentTypes PlacesSidebar = PlacesSidebarParentTypes
type PlacesSidebarParentTypes = '[ScrolledWindow, Bin, Container, Widget, GObject.Object, Atk.ImplementorIface, Buildable]

instance GObject PlacesSidebar where
    gobjectIsInitiallyUnowned _ = True
    gobjectType _ = c_gtk_places_sidebar_get_type
    

class GObject o => PlacesSidebarK o
instance (GObject o, IsDescendantOf PlacesSidebar o) => PlacesSidebarK o

toPlacesSidebar :: PlacesSidebarK o => o -> IO PlacesSidebar
toPlacesSidebar = unsafeCastTo PlacesSidebar

noPlacesSidebar :: Maybe PlacesSidebar
noPlacesSidebar = Nothing

-- signal PlacesSidebar::drag-action-ask
type PlacesSidebarDragActionAskCallback =
    Int32 ->
    IO Int32

noPlacesSidebarDragActionAskCallback :: Maybe PlacesSidebarDragActionAskCallback
noPlacesSidebarDragActionAskCallback = Nothing

type PlacesSidebarDragActionAskCallbackC =
    Ptr () ->                               -- object
    Int32 ->
    Ptr () ->                               -- user_data
    IO Int32

foreign import ccall "wrapper"
    mkPlacesSidebarDragActionAskCallback :: PlacesSidebarDragActionAskCallbackC -> IO (FunPtr PlacesSidebarDragActionAskCallbackC)

placesSidebarDragActionAskClosure :: PlacesSidebarDragActionAskCallback -> IO Closure
placesSidebarDragActionAskClosure cb = newCClosure =<< mkPlacesSidebarDragActionAskCallback wrapped
    where wrapped = placesSidebarDragActionAskCallbackWrapper cb

placesSidebarDragActionAskCallbackWrapper ::
    PlacesSidebarDragActionAskCallback ->
    Ptr () ->
    Int32 ->
    Ptr () ->
    IO Int32
placesSidebarDragActionAskCallbackWrapper _cb _ actions _ = do
    result <- _cb  actions
    return result

onPlacesSidebarDragActionAsk :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionAskCallback -> m SignalHandlerId
onPlacesSidebarDragActionAsk obj cb = liftIO $ connectPlacesSidebarDragActionAsk obj cb SignalConnectBefore
afterPlacesSidebarDragActionAsk :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionAskCallback -> m SignalHandlerId
afterPlacesSidebarDragActionAsk obj cb = connectPlacesSidebarDragActionAsk obj cb SignalConnectAfter

connectPlacesSidebarDragActionAsk :: (GObject a, MonadIO m) =>
                                     a -> PlacesSidebarDragActionAskCallback -> SignalConnectMode -> m SignalHandlerId
connectPlacesSidebarDragActionAsk obj cb after = liftIO $ do
    cb' <- mkPlacesSidebarDragActionAskCallback (placesSidebarDragActionAskCallbackWrapper cb)
    connectSignalFunPtr obj "drag-action-ask" cb' after

-- signal PlacesSidebar::drag-action-requested
type PlacesSidebarDragActionRequestedCallback =
    Gdk.DragContext ->
    Gio.File ->
    [Gio.File] ->
    IO Int32

noPlacesSidebarDragActionRequestedCallback :: Maybe PlacesSidebarDragActionRequestedCallback
noPlacesSidebarDragActionRequestedCallback = Nothing

type PlacesSidebarDragActionRequestedCallbackC =
    Ptr () ->                               -- object
    Ptr Gdk.DragContext ->
    Ptr Gio.File ->
    Ptr (GList (Ptr Gio.File)) ->
    Ptr () ->                               -- user_data
    IO Int32

foreign import ccall "wrapper"
    mkPlacesSidebarDragActionRequestedCallback :: PlacesSidebarDragActionRequestedCallbackC -> IO (FunPtr PlacesSidebarDragActionRequestedCallbackC)

placesSidebarDragActionRequestedClosure :: PlacesSidebarDragActionRequestedCallback -> IO Closure
placesSidebarDragActionRequestedClosure cb = newCClosure =<< mkPlacesSidebarDragActionRequestedCallback wrapped
    where wrapped = placesSidebarDragActionRequestedCallbackWrapper cb

placesSidebarDragActionRequestedCallbackWrapper ::
    PlacesSidebarDragActionRequestedCallback ->
    Ptr () ->
    Ptr Gdk.DragContext ->
    Ptr Gio.File ->
    Ptr (GList (Ptr Gio.File)) ->
    Ptr () ->
    IO Int32
placesSidebarDragActionRequestedCallbackWrapper _cb _ context dest_file source_file_list _ = do
    context' <- (newObject Gdk.DragContext) context
    dest_file' <- (newObject Gio.File) dest_file
    source_file_list' <- unpackGList source_file_list
    source_file_list'' <- mapM (newObject Gio.File) source_file_list'
    result <- _cb  context' dest_file' source_file_list''
    return result

onPlacesSidebarDragActionRequested :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionRequestedCallback -> m SignalHandlerId
onPlacesSidebarDragActionRequested obj cb = liftIO $ connectPlacesSidebarDragActionRequested obj cb SignalConnectBefore
afterPlacesSidebarDragActionRequested :: (GObject a, MonadIO m) => a -> PlacesSidebarDragActionRequestedCallback -> m SignalHandlerId
afterPlacesSidebarDragActionRequested obj cb = connectPlacesSidebarDragActionRequested obj cb SignalConnectAfter

connectPlacesSidebarDragActionRequested :: (GObject a, MonadIO m) =>
                                           a -> PlacesSidebarDragActionRequestedCallback -> SignalConnectMode -> m SignalHandlerId
connectPlacesSidebarDragActionRequested obj cb after = liftIO $ do
    cb' <- mkPlacesSidebarDragActionRequestedCallback (placesSidebarDragActionRequestedCallbackWrapper cb)
    connectSignalFunPtr obj "drag-action-requested" cb' after

-- signal PlacesSidebar::drag-perform-drop
type PlacesSidebarDragPerformDropCallback =
    Gio.File ->
    [Gio.File] ->
    Int32 ->
    IO ()

noPlacesSidebarDragPerformDropCallback :: Maybe PlacesSidebarDragPerformDropCallback
noPlacesSidebarDragPerformDropCallback = Nothing

type PlacesSidebarDragPerformDropCallbackC =
    Ptr () ->                               -- object
    Ptr Gio.File ->
    Ptr (GList (Ptr Gio.File)) ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkPlacesSidebarDragPerformDropCallback :: PlacesSidebarDragPerformDropCallbackC -> IO (FunPtr PlacesSidebarDragPerformDropCallbackC)

placesSidebarDragPerformDropClosure :: PlacesSidebarDragPerformDropCallback -> IO Closure
placesSidebarDragPerformDropClosure cb = newCClosure =<< mkPlacesSidebarDragPerformDropCallback wrapped
    where wrapped = placesSidebarDragPerformDropCallbackWrapper cb

placesSidebarDragPerformDropCallbackWrapper ::
    PlacesSidebarDragPerformDropCallback ->
    Ptr () ->
    Ptr Gio.File ->
    Ptr (GList (Ptr Gio.File)) ->
    Int32 ->
    Ptr () ->
    IO ()
placesSidebarDragPerformDropCallbackWrapper _cb _ dest_file source_file_list action _ = do
    dest_file' <- (newObject Gio.File) dest_file
    source_file_list' <- unpackGList source_file_list
    source_file_list'' <- mapM (newObject Gio.File) source_file_list'
    _cb  dest_file' source_file_list'' action

onPlacesSidebarDragPerformDrop :: (GObject a, MonadIO m) => a -> PlacesSidebarDragPerformDropCallback -> m SignalHandlerId
onPlacesSidebarDragPerformDrop obj cb = liftIO $ connectPlacesSidebarDragPerformDrop obj cb SignalConnectBefore
afterPlacesSidebarDragPerformDrop :: (GObject a, MonadIO m) => a -> PlacesSidebarDragPerformDropCallback -> m SignalHandlerId
afterPlacesSidebarDragPerformDrop obj cb = connectPlacesSidebarDragPerformDrop obj cb SignalConnectAfter

connectPlacesSidebarDragPerformDrop :: (GObject a, MonadIO m) =>
                                       a -> PlacesSidebarDragPerformDropCallback -> SignalConnectMode -> m SignalHandlerId
connectPlacesSidebarDragPerformDrop obj cb after = liftIO $ do
    cb' <- mkPlacesSidebarDragPerformDropCallback (placesSidebarDragPerformDropCallbackWrapper cb)
    connectSignalFunPtr obj "drag-perform-drop" cb' after

-- signal PlacesSidebar::open-location
type PlacesSidebarOpenLocationCallback =
    Gio.File ->
    [PlacesOpenFlags] ->
    IO ()

noPlacesSidebarOpenLocationCallback :: Maybe PlacesSidebarOpenLocationCallback
noPlacesSidebarOpenLocationCallback = Nothing

type PlacesSidebarOpenLocationCallbackC =
    Ptr () ->                               -- object
    Ptr Gio.File ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkPlacesSidebarOpenLocationCallback :: PlacesSidebarOpenLocationCallbackC -> IO (FunPtr PlacesSidebarOpenLocationCallbackC)

placesSidebarOpenLocationClosure :: PlacesSidebarOpenLocationCallback -> IO Closure
placesSidebarOpenLocationClosure cb = newCClosure =<< mkPlacesSidebarOpenLocationCallback wrapped
    where wrapped = placesSidebarOpenLocationCallbackWrapper cb

placesSidebarOpenLocationCallbackWrapper ::
    PlacesSidebarOpenLocationCallback ->
    Ptr () ->
    Ptr Gio.File ->
    CUInt ->
    Ptr () ->
    IO ()
placesSidebarOpenLocationCallbackWrapper _cb _ location open_flags _ = do
    location' <- (newObject Gio.File) location
    let open_flags' = wordToGFlags open_flags
    _cb  location' open_flags'

onPlacesSidebarOpenLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarOpenLocationCallback -> m SignalHandlerId
onPlacesSidebarOpenLocation obj cb = liftIO $ connectPlacesSidebarOpenLocation obj cb SignalConnectBefore
afterPlacesSidebarOpenLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarOpenLocationCallback -> m SignalHandlerId
afterPlacesSidebarOpenLocation obj cb = connectPlacesSidebarOpenLocation obj cb SignalConnectAfter

connectPlacesSidebarOpenLocation :: (GObject a, MonadIO m) =>
                                    a -> PlacesSidebarOpenLocationCallback -> SignalConnectMode -> m SignalHandlerId
connectPlacesSidebarOpenLocation obj cb after = liftIO $ do
    cb' <- mkPlacesSidebarOpenLocationCallback (placesSidebarOpenLocationCallbackWrapper cb)
    connectSignalFunPtr obj "open-location" cb' after

-- signal PlacesSidebar::populate-popup
type PlacesSidebarPopulatePopupCallback =
    Menu ->
    Maybe Gio.File ->
    Maybe Gio.Volume ->
    IO ()

noPlacesSidebarPopulatePopupCallback :: Maybe PlacesSidebarPopulatePopupCallback
noPlacesSidebarPopulatePopupCallback = Nothing

type PlacesSidebarPopulatePopupCallbackC =
    Ptr () ->                               -- object
    Ptr Menu ->
    Ptr Gio.File ->
    Ptr Gio.Volume ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkPlacesSidebarPopulatePopupCallback :: PlacesSidebarPopulatePopupCallbackC -> IO (FunPtr PlacesSidebarPopulatePopupCallbackC)

placesSidebarPopulatePopupClosure :: PlacesSidebarPopulatePopupCallback -> IO Closure
placesSidebarPopulatePopupClosure cb = newCClosure =<< mkPlacesSidebarPopulatePopupCallback wrapped
    where wrapped = placesSidebarPopulatePopupCallbackWrapper cb

placesSidebarPopulatePopupCallbackWrapper ::
    PlacesSidebarPopulatePopupCallback ->
    Ptr () ->
    Ptr Menu ->
    Ptr Gio.File ->
    Ptr Gio.Volume ->
    Ptr () ->
    IO ()
placesSidebarPopulatePopupCallbackWrapper _cb _ menu selected_item selected_volume _ = do
    menu' <- (newObject Menu) menu
    maybeSelected_item <-
        if selected_item == nullPtr
        then return Nothing
        else do
            selected_item' <- (newObject Gio.File) selected_item
            return $ Just selected_item'
    maybeSelected_volume <-
        if selected_volume == nullPtr
        then return Nothing
        else do
            selected_volume' <- (newObject Gio.Volume) selected_volume
            return $ Just selected_volume'
    _cb  menu' maybeSelected_item maybeSelected_volume

onPlacesSidebarPopulatePopup :: (GObject a, MonadIO m) => a -> PlacesSidebarPopulatePopupCallback -> m SignalHandlerId
onPlacesSidebarPopulatePopup obj cb = liftIO $ connectPlacesSidebarPopulatePopup obj cb SignalConnectBefore
afterPlacesSidebarPopulatePopup :: (GObject a, MonadIO m) => a -> PlacesSidebarPopulatePopupCallback -> m SignalHandlerId
afterPlacesSidebarPopulatePopup obj cb = connectPlacesSidebarPopulatePopup obj cb SignalConnectAfter

connectPlacesSidebarPopulatePopup :: (GObject a, MonadIO m) =>
                                     a -> PlacesSidebarPopulatePopupCallback -> SignalConnectMode -> m SignalHandlerId
connectPlacesSidebarPopulatePopup obj cb after = liftIO $ do
    cb' <- mkPlacesSidebarPopulatePopupCallback (placesSidebarPopulatePopupCallbackWrapper cb)
    connectSignalFunPtr obj "populate-popup" cb' after

-- signal PlacesSidebar::show-connect-to-server
type PlacesSidebarShowConnectToServerCallback =
    IO ()

noPlacesSidebarShowConnectToServerCallback :: Maybe PlacesSidebarShowConnectToServerCallback
noPlacesSidebarShowConnectToServerCallback = Nothing

type PlacesSidebarShowConnectToServerCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkPlacesSidebarShowConnectToServerCallback :: PlacesSidebarShowConnectToServerCallbackC -> IO (FunPtr PlacesSidebarShowConnectToServerCallbackC)

placesSidebarShowConnectToServerClosure :: PlacesSidebarShowConnectToServerCallback -> IO Closure
placesSidebarShowConnectToServerClosure cb = newCClosure =<< mkPlacesSidebarShowConnectToServerCallback wrapped
    where wrapped = placesSidebarShowConnectToServerCallbackWrapper cb

placesSidebarShowConnectToServerCallbackWrapper ::
    PlacesSidebarShowConnectToServerCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
placesSidebarShowConnectToServerCallbackWrapper _cb _ _ = do
    _cb 

onPlacesSidebarShowConnectToServer :: (GObject a, MonadIO m) => a -> PlacesSidebarShowConnectToServerCallback -> m SignalHandlerId
onPlacesSidebarShowConnectToServer obj cb = liftIO $ connectPlacesSidebarShowConnectToServer obj cb SignalConnectBefore
afterPlacesSidebarShowConnectToServer :: (GObject a, MonadIO m) => a -> PlacesSidebarShowConnectToServerCallback -> m SignalHandlerId
afterPlacesSidebarShowConnectToServer obj cb = connectPlacesSidebarShowConnectToServer obj cb SignalConnectAfter

connectPlacesSidebarShowConnectToServer :: (GObject a, MonadIO m) =>
                                           a -> PlacesSidebarShowConnectToServerCallback -> SignalConnectMode -> m SignalHandlerId
connectPlacesSidebarShowConnectToServer obj cb after = liftIO $ do
    cb' <- mkPlacesSidebarShowConnectToServerCallback (placesSidebarShowConnectToServerCallbackWrapper cb)
    connectSignalFunPtr obj "show-connect-to-server" cb' after

-- signal PlacesSidebar::show-enter-location
type PlacesSidebarShowEnterLocationCallback =
    IO ()

noPlacesSidebarShowEnterLocationCallback :: Maybe PlacesSidebarShowEnterLocationCallback
noPlacesSidebarShowEnterLocationCallback = Nothing

type PlacesSidebarShowEnterLocationCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkPlacesSidebarShowEnterLocationCallback :: PlacesSidebarShowEnterLocationCallbackC -> IO (FunPtr PlacesSidebarShowEnterLocationCallbackC)

placesSidebarShowEnterLocationClosure :: PlacesSidebarShowEnterLocationCallback -> IO Closure
placesSidebarShowEnterLocationClosure cb = newCClosure =<< mkPlacesSidebarShowEnterLocationCallback wrapped
    where wrapped = placesSidebarShowEnterLocationCallbackWrapper cb

placesSidebarShowEnterLocationCallbackWrapper ::
    PlacesSidebarShowEnterLocationCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
placesSidebarShowEnterLocationCallbackWrapper _cb _ _ = do
    _cb 

onPlacesSidebarShowEnterLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarShowEnterLocationCallback -> m SignalHandlerId
onPlacesSidebarShowEnterLocation obj cb = liftIO $ connectPlacesSidebarShowEnterLocation obj cb SignalConnectBefore
afterPlacesSidebarShowEnterLocation :: (GObject a, MonadIO m) => a -> PlacesSidebarShowEnterLocationCallback -> m SignalHandlerId
afterPlacesSidebarShowEnterLocation obj cb = connectPlacesSidebarShowEnterLocation obj cb SignalConnectAfter

connectPlacesSidebarShowEnterLocation :: (GObject a, MonadIO m) =>
                                         a -> PlacesSidebarShowEnterLocationCallback -> SignalConnectMode -> m SignalHandlerId
connectPlacesSidebarShowEnterLocation obj cb after = liftIO $ do
    cb' <- mkPlacesSidebarShowEnterLocationCallback (placesSidebarShowEnterLocationCallbackWrapper cb)
    connectSignalFunPtr obj "show-enter-location" cb' after

-- signal PlacesSidebar::show-error-message
type PlacesSidebarShowErrorMessageCallback =
    T.Text ->
    T.Text ->
    IO ()

noPlacesSidebarShowErrorMessageCallback :: Maybe PlacesSidebarShowErrorMessageCallback
noPlacesSidebarShowErrorMessageCallback = Nothing

type PlacesSidebarShowErrorMessageCallbackC =
    Ptr () ->                               -- object
    CString ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkPlacesSidebarShowErrorMessageCallback :: PlacesSidebarShowErrorMessageCallbackC -> IO (FunPtr PlacesSidebarShowErrorMessageCallbackC)

placesSidebarShowErrorMessageClosure :: PlacesSidebarShowErrorMessageCallback -> IO Closure
placesSidebarShowErrorMessageClosure cb = newCClosure =<< mkPlacesSidebarShowErrorMessageCallback wrapped
    where wrapped = placesSidebarShowErrorMessageCallbackWrapper cb

placesSidebarShowErrorMessageCallbackWrapper ::
    PlacesSidebarShowErrorMessageCallback ->
    Ptr () ->
    CString ->
    CString ->
    Ptr () ->
    IO ()
placesSidebarShowErrorMessageCallbackWrapper _cb _ primary secondary _ = do
    primary' <- cstringToText primary
    secondary' <- cstringToText secondary
    _cb  primary' secondary'

onPlacesSidebarShowErrorMessage :: (GObject a, MonadIO m) => a -> PlacesSidebarShowErrorMessageCallback -> m SignalHandlerId
onPlacesSidebarShowErrorMessage obj cb = liftIO $ connectPlacesSidebarShowErrorMessage obj cb SignalConnectBefore
afterPlacesSidebarShowErrorMessage :: (GObject a, MonadIO m) => a -> PlacesSidebarShowErrorMessageCallback -> m SignalHandlerId
afterPlacesSidebarShowErrorMessage obj cb = connectPlacesSidebarShowErrorMessage obj cb SignalConnectAfter

connectPlacesSidebarShowErrorMessage :: (GObject a, MonadIO m) =>
                                        a -> PlacesSidebarShowErrorMessageCallback -> SignalConnectMode -> m SignalHandlerId
connectPlacesSidebarShowErrorMessage obj cb after = liftIO $ do
    cb' <- mkPlacesSidebarShowErrorMessageCallback (placesSidebarShowErrorMessageCallbackWrapper cb)
    connectSignalFunPtr obj "show-error-message" cb' after

-- VVV Prop "local-only"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getPlacesSidebarLocalOnly :: (MonadIO m, PlacesSidebarK o) => o -> m Bool
getPlacesSidebarLocalOnly obj = liftIO $ getObjectPropertyBool obj "local-only"

setPlacesSidebarLocalOnly :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m ()
setPlacesSidebarLocalOnly obj val = liftIO $ setObjectPropertyBool obj "local-only" val

constructPlacesSidebarLocalOnly :: Bool -> IO ([Char], GValue)
constructPlacesSidebarLocalOnly val = constructObjectPropertyBool "local-only" val

data PlacesSidebarLocalOnlyPropertyInfo
instance AttrInfo PlacesSidebarLocalOnlyPropertyInfo where
    type AttrAllowedOps PlacesSidebarLocalOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint PlacesSidebarLocalOnlyPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint PlacesSidebarLocalOnlyPropertyInfo = PlacesSidebarK
    type AttrGetType PlacesSidebarLocalOnlyPropertyInfo = Bool
    type AttrLabel PlacesSidebarLocalOnlyPropertyInfo = "PlacesSidebar::local-only"
    attrGet _ = getPlacesSidebarLocalOnly
    attrSet _ = setPlacesSidebarLocalOnly
    attrConstruct _ = constructPlacesSidebarLocalOnly

-- VVV Prop "location"
   -- Type: TInterface "Gio" "File"
   -- Flags: [PropertyReadable,PropertyWritable]

getPlacesSidebarLocation :: (MonadIO m, PlacesSidebarK o) => o -> m Gio.File
getPlacesSidebarLocation obj = liftIO $ getObjectPropertyObject obj "location" Gio.File

setPlacesSidebarLocation :: (MonadIO m, PlacesSidebarK o, Gio.FileK a) => o -> a -> m ()
setPlacesSidebarLocation obj val = liftIO $ setObjectPropertyObject obj "location" val

constructPlacesSidebarLocation :: (Gio.FileK a) => a -> IO ([Char], GValue)
constructPlacesSidebarLocation val = constructObjectPropertyObject "location" val

data PlacesSidebarLocationPropertyInfo
instance AttrInfo PlacesSidebarLocationPropertyInfo where
    type AttrAllowedOps PlacesSidebarLocationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint PlacesSidebarLocationPropertyInfo = Gio.FileK
    type AttrBaseTypeConstraint PlacesSidebarLocationPropertyInfo = PlacesSidebarK
    type AttrGetType PlacesSidebarLocationPropertyInfo = Gio.File
    type AttrLabel PlacesSidebarLocationPropertyInfo = "PlacesSidebar::location"
    attrGet _ = getPlacesSidebarLocation
    attrSet _ = setPlacesSidebarLocation
    attrConstruct _ = constructPlacesSidebarLocation

-- VVV Prop "open-flags"
   -- Type: TInterface "Gtk" "PlacesOpenFlags"
   -- Flags: [PropertyReadable,PropertyWritable]

getPlacesSidebarOpenFlags :: (MonadIO m, PlacesSidebarK o) => o -> m [PlacesOpenFlags]
getPlacesSidebarOpenFlags obj = liftIO $ getObjectPropertyFlags obj "open-flags"

setPlacesSidebarOpenFlags :: (MonadIO m, PlacesSidebarK o) => o -> [PlacesOpenFlags] -> m ()
setPlacesSidebarOpenFlags obj val = liftIO $ setObjectPropertyFlags obj "open-flags" val

constructPlacesSidebarOpenFlags :: [PlacesOpenFlags] -> IO ([Char], GValue)
constructPlacesSidebarOpenFlags val = constructObjectPropertyFlags "open-flags" val

data PlacesSidebarOpenFlagsPropertyInfo
instance AttrInfo PlacesSidebarOpenFlagsPropertyInfo where
    type AttrAllowedOps PlacesSidebarOpenFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint PlacesSidebarOpenFlagsPropertyInfo = (~) [PlacesOpenFlags]
    type AttrBaseTypeConstraint PlacesSidebarOpenFlagsPropertyInfo = PlacesSidebarK
    type AttrGetType PlacesSidebarOpenFlagsPropertyInfo = [PlacesOpenFlags]
    type AttrLabel PlacesSidebarOpenFlagsPropertyInfo = "PlacesSidebar::open-flags"
    attrGet _ = getPlacesSidebarOpenFlags
    attrSet _ = setPlacesSidebarOpenFlags
    attrConstruct _ = constructPlacesSidebarOpenFlags

-- VVV Prop "show-connect-to-server"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getPlacesSidebarShowConnectToServer :: (MonadIO m, PlacesSidebarK o) => o -> m Bool
getPlacesSidebarShowConnectToServer obj = liftIO $ getObjectPropertyBool obj "show-connect-to-server"

setPlacesSidebarShowConnectToServer :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m ()
setPlacesSidebarShowConnectToServer obj val = liftIO $ setObjectPropertyBool obj "show-connect-to-server" val

constructPlacesSidebarShowConnectToServer :: Bool -> IO ([Char], GValue)
constructPlacesSidebarShowConnectToServer val = constructObjectPropertyBool "show-connect-to-server" val

data PlacesSidebarShowConnectToServerPropertyInfo
instance AttrInfo PlacesSidebarShowConnectToServerPropertyInfo where
    type AttrAllowedOps PlacesSidebarShowConnectToServerPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint PlacesSidebarShowConnectToServerPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint PlacesSidebarShowConnectToServerPropertyInfo = PlacesSidebarK
    type AttrGetType PlacesSidebarShowConnectToServerPropertyInfo = Bool
    type AttrLabel PlacesSidebarShowConnectToServerPropertyInfo = "PlacesSidebar::show-connect-to-server"
    attrGet _ = getPlacesSidebarShowConnectToServer
    attrSet _ = setPlacesSidebarShowConnectToServer
    attrConstruct _ = constructPlacesSidebarShowConnectToServer

-- VVV Prop "show-desktop"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getPlacesSidebarShowDesktop :: (MonadIO m, PlacesSidebarK o) => o -> m Bool
getPlacesSidebarShowDesktop obj = liftIO $ getObjectPropertyBool obj "show-desktop"

setPlacesSidebarShowDesktop :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m ()
setPlacesSidebarShowDesktop obj val = liftIO $ setObjectPropertyBool obj "show-desktop" val

constructPlacesSidebarShowDesktop :: Bool -> IO ([Char], GValue)
constructPlacesSidebarShowDesktop val = constructObjectPropertyBool "show-desktop" val

data PlacesSidebarShowDesktopPropertyInfo
instance AttrInfo PlacesSidebarShowDesktopPropertyInfo where
    type AttrAllowedOps PlacesSidebarShowDesktopPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint PlacesSidebarShowDesktopPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint PlacesSidebarShowDesktopPropertyInfo = PlacesSidebarK
    type AttrGetType PlacesSidebarShowDesktopPropertyInfo = Bool
    type AttrLabel PlacesSidebarShowDesktopPropertyInfo = "PlacesSidebar::show-desktop"
    attrGet _ = getPlacesSidebarShowDesktop
    attrSet _ = setPlacesSidebarShowDesktop
    attrConstruct _ = constructPlacesSidebarShowDesktop

-- VVV Prop "show-enter-location"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getPlacesSidebarShowEnterLocation :: (MonadIO m, PlacesSidebarK o) => o -> m Bool
getPlacesSidebarShowEnterLocation obj = liftIO $ getObjectPropertyBool obj "show-enter-location"

setPlacesSidebarShowEnterLocation :: (MonadIO m, PlacesSidebarK o) => o -> Bool -> m ()
setPlacesSidebarShowEnterLocation obj val = liftIO $ setObjectPropertyBool obj "show-enter-location" val

constructPlacesSidebarShowEnterLocation :: Bool -> IO ([Char], GValue)
constructPlacesSidebarShowEnterLocation val = constructObjectPropertyBool "show-enter-location" val

data PlacesSidebarShowEnterLocationPropertyInfo
instance AttrInfo PlacesSidebarShowEnterLocationPropertyInfo where
    type AttrAllowedOps PlacesSidebarShowEnterLocationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint PlacesSidebarShowEnterLocationPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint PlacesSidebarShowEnterLocationPropertyInfo = PlacesSidebarK
    type AttrGetType PlacesSidebarShowEnterLocationPropertyInfo = Bool
    type AttrLabel PlacesSidebarShowEnterLocationPropertyInfo = "PlacesSidebar::show-enter-location"
    attrGet _ = getPlacesSidebarShowEnterLocation
    attrSet _ = setPlacesSidebarShowEnterLocation
    attrConstruct _ = constructPlacesSidebarShowEnterLocation

type instance AttributeList PlacesSidebar = PlacesSidebarAttributeList
type PlacesSidebarAttributeList = ('[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("hadjustment", ScrolledWindowHadjustmentPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("hscrollbar-policy", ScrolledWindowHscrollbarPolicyPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("kinetic-scrolling", ScrolledWindowKineticScrollingPropertyInfo), '("local-only", PlacesSidebarLocalOnlyPropertyInfo), '("location", PlacesSidebarLocationPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("min-content-height", ScrolledWindowMinContentHeightPropertyInfo), '("min-content-width", ScrolledWindowMinContentWidthPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("open-flags", PlacesSidebarOpenFlagsPropertyInfo), '("overlay-scrolling", ScrolledWindowOverlayScrollingPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("shadow-type", ScrolledWindowShadowTypePropertyInfo), '("show-connect-to-server", PlacesSidebarShowConnectToServerPropertyInfo), '("show-desktop", PlacesSidebarShowDesktopPropertyInfo), '("show-enter-location", PlacesSidebarShowEnterLocationPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("vadjustment", ScrolledWindowVadjustmentPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("vscrollbar-policy", ScrolledWindowVscrollbarPolicyPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("window-placement", ScrolledWindowWindowPlacementPropertyInfo), '("window-placement-set", ScrolledWindowWindowPlacementSetPropertyInfo)] :: [(Symbol, *)])

data PlacesSidebarDragActionAskSignalInfo
instance SignalInfo PlacesSidebarDragActionAskSignalInfo where
    type HaskellCallbackType PlacesSidebarDragActionAskSignalInfo = PlacesSidebarDragActionAskCallback
    connectSignal _ = connectPlacesSidebarDragActionAsk

data PlacesSidebarDragActionRequestedSignalInfo
instance SignalInfo PlacesSidebarDragActionRequestedSignalInfo where
    type HaskellCallbackType PlacesSidebarDragActionRequestedSignalInfo = PlacesSidebarDragActionRequestedCallback
    connectSignal _ = connectPlacesSidebarDragActionRequested

data PlacesSidebarDragPerformDropSignalInfo
instance SignalInfo PlacesSidebarDragPerformDropSignalInfo where
    type HaskellCallbackType PlacesSidebarDragPerformDropSignalInfo = PlacesSidebarDragPerformDropCallback
    connectSignal _ = connectPlacesSidebarDragPerformDrop

data PlacesSidebarOpenLocationSignalInfo
instance SignalInfo PlacesSidebarOpenLocationSignalInfo where
    type HaskellCallbackType PlacesSidebarOpenLocationSignalInfo = PlacesSidebarOpenLocationCallback
    connectSignal _ = connectPlacesSidebarOpenLocation

data PlacesSidebarPopulatePopupSignalInfo
instance SignalInfo PlacesSidebarPopulatePopupSignalInfo where
    type HaskellCallbackType PlacesSidebarPopulatePopupSignalInfo = PlacesSidebarPopulatePopupCallback
    connectSignal _ = connectPlacesSidebarPopulatePopup

data PlacesSidebarShowConnectToServerSignalInfo
instance SignalInfo PlacesSidebarShowConnectToServerSignalInfo where
    type HaskellCallbackType PlacesSidebarShowConnectToServerSignalInfo = PlacesSidebarShowConnectToServerCallback
    connectSignal _ = connectPlacesSidebarShowConnectToServer

data PlacesSidebarShowEnterLocationSignalInfo
instance SignalInfo PlacesSidebarShowEnterLocationSignalInfo where
    type HaskellCallbackType PlacesSidebarShowEnterLocationSignalInfo = PlacesSidebarShowEnterLocationCallback
    connectSignal _ = connectPlacesSidebarShowEnterLocation

data PlacesSidebarShowErrorMessageSignalInfo
instance SignalInfo PlacesSidebarShowErrorMessageSignalInfo where
    type HaskellCallbackType PlacesSidebarShowErrorMessageSignalInfo = PlacesSidebarShowErrorMessageCallback
    connectSignal _ = connectPlacesSidebarShowErrorMessage

type instance SignalList PlacesSidebar = PlacesSidebarSignalList
type PlacesSidebarSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("add", ContainerAddSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("check-resize", ContainerCheckResizeSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("damage-event", WidgetDamageEventSignalInfo), '("delete-event", WidgetDeleteEventSignalInfo), '("destroy", WidgetDestroySignalInfo), '("destroy-event", WidgetDestroyEventSignalInfo), '("direction-changed", WidgetDirectionChangedSignalInfo), '("drag-action-ask", PlacesSidebarDragActionAskSignalInfo), '("drag-action-requested", PlacesSidebarDragActionRequestedSignalInfo), '("drag-begin", WidgetDragBeginSignalInfo), '("drag-data-delete", WidgetDragDataDeleteSignalInfo), '("drag-data-get", WidgetDragDataGetSignalInfo), '("drag-data-received", WidgetDragDataReceivedSignalInfo), '("drag-drop", WidgetDragDropSignalInfo), '("drag-end", WidgetDragEndSignalInfo), '("drag-failed", WidgetDragFailedSignalInfo), '("drag-leave", WidgetDragLeaveSignalInfo), '("drag-motion", WidgetDragMotionSignalInfo), '("drag-perform-drop", PlacesSidebarDragPerformDropSignalInfo), '("draw", WidgetDrawSignalInfo), '("edge-overshot", ScrolledWindowEdgeOvershotSignalInfo), '("edge-reached", ScrolledWindowEdgeReachedSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("grab-broken-event", WidgetGrabBrokenEventSignalInfo), '("grab-focus", WidgetGrabFocusSignalInfo), '("grab-notify", WidgetGrabNotifySignalInfo), '("hide", WidgetHideSignalInfo), '("hierarchy-changed", WidgetHierarchyChangedSignalInfo), '("key-press-event", WidgetKeyPressEventSignalInfo), '("key-release-event", WidgetKeyReleaseEventSignalInfo), '("keynav-failed", WidgetKeynavFailedSignalInfo), '("leave-notify-event", WidgetLeaveNotifyEventSignalInfo), '("map", WidgetMapSignalInfo), '("map-event", WidgetMapEventSignalInfo), '("mnemonic-activate", WidgetMnemonicActivateSignalInfo), '("motion-notify-event", WidgetMotionNotifyEventSignalInfo), '("move-focus", WidgetMoveFocusSignalInfo), '("move-focus-out", ScrolledWindowMoveFocusOutSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("open-location", PlacesSidebarOpenLocationSignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("populate-popup", PlacesSidebarPopulatePopupSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("remove", ContainerRemoveSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-child", ScrolledWindowScrollChildSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("selection-clear-event", WidgetSelectionClearEventSignalInfo), '("selection-get", WidgetSelectionGetSignalInfo), '("selection-notify-event", WidgetSelectionNotifyEventSignalInfo), '("selection-received", WidgetSelectionReceivedSignalInfo), '("selection-request-event", WidgetSelectionRequestEventSignalInfo), '("set-focus-child", ContainerSetFocusChildSignalInfo), '("show", WidgetShowSignalInfo), '("show-connect-to-server", PlacesSidebarShowConnectToServerSignalInfo), '("show-enter-location", PlacesSidebarShowEnterLocationSignalInfo), '("show-error-message", PlacesSidebarShowErrorMessageSignalInfo), '("show-help", WidgetShowHelpSignalInfo), '("size-allocate", WidgetSizeAllocateSignalInfo), '("state-changed", WidgetStateChangedSignalInfo), '("state-flags-changed", WidgetStateFlagsChangedSignalInfo), '("style-set", WidgetStyleSetSignalInfo), '("style-updated", WidgetStyleUpdatedSignalInfo), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method PlacesSidebar::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gtk" "PlacesSidebar"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_new" gtk_places_sidebar_new :: 
    IO (Ptr PlacesSidebar)


placesSidebarNew ::
    (MonadIO m) =>
    m PlacesSidebar
placesSidebarNew  = liftIO $ do
    result <- gtk_places_sidebar_new
    checkUnexpectedReturnNULL "gtk_places_sidebar_new" result
    result' <- (newObject PlacesSidebar) result
    return result'

-- method PlacesSidebar::add_shortcut
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_add_shortcut" gtk_places_sidebar_add_shortcut :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    Ptr Gio.File ->                         -- location : TInterface "Gio" "File"
    IO ()


placesSidebarAddShortcut ::
    (MonadIO m, PlacesSidebarK a, Gio.FileK b) =>
    a ->                                    -- _obj
    b ->                                    -- location
    m ()
placesSidebarAddShortcut _obj location = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let location' = unsafeManagedPtrCastPtr location
    gtk_places_sidebar_add_shortcut _obj' location'
    touchManagedPtr _obj
    touchManagedPtr location
    return ()

-- method PlacesSidebar::get_local_only
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_get_local_only" gtk_places_sidebar_get_local_only :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    IO CInt


placesSidebarGetLocalOnly ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    m Bool
placesSidebarGetLocalOnly _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_places_sidebar_get_local_only _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method PlacesSidebar::get_location
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "File"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_get_location" gtk_places_sidebar_get_location :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    IO (Ptr Gio.File)


placesSidebarGetLocation ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    m Gio.File
placesSidebarGetLocation _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_places_sidebar_get_location _obj'
    checkUnexpectedReturnNULL "gtk_places_sidebar_get_location" result
    result' <- (wrapObject Gio.File) result
    touchManagedPtr _obj
    return result'

-- method PlacesSidebar::get_nth_bookmark
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "File"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_get_nth_bookmark" gtk_places_sidebar_get_nth_bookmark :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    Int32 ->                                -- n : TBasicType TInt32
    IO (Ptr Gio.File)


placesSidebarGetNthBookmark ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- n
    m Gio.File
placesSidebarGetNthBookmark _obj n = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_places_sidebar_get_nth_bookmark _obj' n
    checkUnexpectedReturnNULL "gtk_places_sidebar_get_nth_bookmark" result
    result' <- (wrapObject Gio.File) result
    touchManagedPtr _obj
    return result'

-- method PlacesSidebar::get_open_flags
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "PlacesOpenFlags"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_get_open_flags" gtk_places_sidebar_get_open_flags :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    IO CUInt


placesSidebarGetOpenFlags ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    m [PlacesOpenFlags]
placesSidebarGetOpenFlags _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_places_sidebar_get_open_flags _obj'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

-- method PlacesSidebar::get_show_connect_to_server
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_get_show_connect_to_server" gtk_places_sidebar_get_show_connect_to_server :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    IO CInt


placesSidebarGetShowConnectToServer ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    m Bool
placesSidebarGetShowConnectToServer _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_places_sidebar_get_show_connect_to_server _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method PlacesSidebar::get_show_desktop
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_get_show_desktop" gtk_places_sidebar_get_show_desktop :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    IO CInt


placesSidebarGetShowDesktop ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    m Bool
placesSidebarGetShowDesktop _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_places_sidebar_get_show_desktop _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method PlacesSidebar::get_show_enter_location
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_get_show_enter_location" gtk_places_sidebar_get_show_enter_location :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    IO CInt


placesSidebarGetShowEnterLocation ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    m Bool
placesSidebarGetShowEnterLocation _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_places_sidebar_get_show_enter_location _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method PlacesSidebar::list_shortcuts
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGSList (TInterface "Gio" "File")
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_list_shortcuts" gtk_places_sidebar_list_shortcuts :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    IO (Ptr (GSList (Ptr Gio.File)))


placesSidebarListShortcuts ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    m [Gio.File]
placesSidebarListShortcuts _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_places_sidebar_list_shortcuts _obj'
    checkUnexpectedReturnNULL "gtk_places_sidebar_list_shortcuts" result
    result' <- unpackGSList result
    result'' <- mapM (wrapObject Gio.File) result'
    g_slist_free result
    touchManagedPtr _obj
    return result''

-- method PlacesSidebar::remove_shortcut
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_remove_shortcut" gtk_places_sidebar_remove_shortcut :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    Ptr Gio.File ->                         -- location : TInterface "Gio" "File"
    IO ()


placesSidebarRemoveShortcut ::
    (MonadIO m, PlacesSidebarK a, Gio.FileK b) =>
    a ->                                    -- _obj
    b ->                                    -- location
    m ()
placesSidebarRemoveShortcut _obj location = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let location' = unsafeManagedPtrCastPtr location
    gtk_places_sidebar_remove_shortcut _obj' location'
    touchManagedPtr _obj
    touchManagedPtr location
    return ()

-- method PlacesSidebar::set_local_only
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "local_only", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "local_only", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_set_local_only" gtk_places_sidebar_set_local_only :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    CInt ->                                 -- local_only : TBasicType TBoolean
    IO ()


placesSidebarSetLocalOnly ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- local_only
    m ()
placesSidebarSetLocalOnly _obj local_only = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let local_only' = (fromIntegral . fromEnum) local_only
    gtk_places_sidebar_set_local_only _obj' local_only'
    touchManagedPtr _obj
    return ()

-- method PlacesSidebar::set_location
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_set_location" gtk_places_sidebar_set_location :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    Ptr Gio.File ->                         -- location : TInterface "Gio" "File"
    IO ()


placesSidebarSetLocation ::
    (MonadIO m, PlacesSidebarK a, Gio.FileK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- location
    m ()
placesSidebarSetLocation _obj location = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeLocation <- case location of
        Nothing -> return nullPtr
        Just jLocation -> do
            let jLocation' = unsafeManagedPtrCastPtr jLocation
            return jLocation'
    gtk_places_sidebar_set_location _obj' maybeLocation
    touchManagedPtr _obj
    whenJust location touchManagedPtr
    return ()

-- method PlacesSidebar::set_open_flags
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gtk" "PlacesOpenFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gtk" "PlacesOpenFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_set_open_flags" gtk_places_sidebar_set_open_flags :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    CUInt ->                                -- flags : TInterface "Gtk" "PlacesOpenFlags"
    IO ()


placesSidebarSetOpenFlags ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    [PlacesOpenFlags] ->                    -- flags
    m ()
placesSidebarSetOpenFlags _obj flags = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let flags' = gflagsToWord flags
    gtk_places_sidebar_set_open_flags _obj' flags'
    touchManagedPtr _obj
    return ()

-- method PlacesSidebar::set_show_connect_to_server
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_connect_to_server", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_connect_to_server", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_set_show_connect_to_server" gtk_places_sidebar_set_show_connect_to_server :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    CInt ->                                 -- show_connect_to_server : TBasicType TBoolean
    IO ()


placesSidebarSetShowConnectToServer ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- show_connect_to_server
    m ()
placesSidebarSetShowConnectToServer _obj show_connect_to_server = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let show_connect_to_server' = (fromIntegral . fromEnum) show_connect_to_server
    gtk_places_sidebar_set_show_connect_to_server _obj' show_connect_to_server'
    touchManagedPtr _obj
    return ()

-- method PlacesSidebar::set_show_desktop
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_desktop", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_desktop", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_set_show_desktop" gtk_places_sidebar_set_show_desktop :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    CInt ->                                 -- show_desktop : TBasicType TBoolean
    IO ()


placesSidebarSetShowDesktop ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- show_desktop
    m ()
placesSidebarSetShowDesktop _obj show_desktop = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let show_desktop' = (fromIntegral . fromEnum) show_desktop
    gtk_places_sidebar_set_show_desktop _obj' show_desktop'
    touchManagedPtr _obj
    return ()

-- method PlacesSidebar::set_show_enter_location
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_enter_location", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "PlacesSidebar", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_enter_location", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_places_sidebar_set_show_enter_location" gtk_places_sidebar_set_show_enter_location :: 
    Ptr PlacesSidebar ->                    -- _obj : TInterface "Gtk" "PlacesSidebar"
    CInt ->                                 -- show_enter_location : TBasicType TBoolean
    IO ()


placesSidebarSetShowEnterLocation ::
    (MonadIO m, PlacesSidebarK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- show_enter_location
    m ()
placesSidebarSetShowEnterLocation _obj show_enter_location = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let show_enter_location' = (fromIntegral . fromEnum) show_enter_location
    gtk_places_sidebar_set_show_enter_location _obj' show_enter_location'
    touchManagedPtr _obj
    return ()