{-# LANGUAGE MonoLocalBinds #-}
module Data.GI.Gtk.ComboBox (
module GI.Gtk.Objects.ComboBox,
comboBoxNewText,
comboBoxSetModelText,
comboBoxGetModelText,
comboBoxAppendText,
comboBoxInsertText,
comboBoxPrependText,
comboBoxRemoveText,
comboBoxGetActiveText,
) where
import Prelude ()
import Prelude.Compat
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO(..))
import Foreign.Ptr (FunPtr, Ptr, nullPtr)
import Foreign.StablePtr (newStablePtr, castStablePtrToPtr, deRefStablePtr, castPtrToStablePtr)
import Data.Text (Text)
import Data.Word (Word32)
import Data.Int (Int32)
import Data.GI.Base.BasicTypes (GObject)
import Data.GI.Base.ManagedPtr (unsafeManagedPtrCastPtr, touchManagedPtr, unsafeCastTo)
import Data.GI.Gtk.ModelView.Types (comboQuark)
import Data.GI.Gtk.ModelView.TreeModel (makeColumnIdString)
import Data.GI.Gtk.ModelView.CustomStore (customStoreSetColumn, customStoreGetRow)
import Data.GI.Gtk.ModelView.SeqStore ( SeqStore(..), seqStoreNew,
seqStoreInsert, seqStorePrepend, seqStoreAppend, seqStoreRemove,
seqStoreSafeGetValue )
import GI.Gtk.Objects.ComboBox
import Data.GI.Gtk.ModelView.CellLayout (CellLayout(..), cellLayoutClear, cellLayoutPackStart, cellLayoutSetDataFunction, cellLayoutGetCells)
import GI.Gtk.Objects.CellRendererText (CellRendererText(..), cellRendererTextNew, setCellRendererTextText)
import GI.GObject.Objects.Object (Object, toObject)
type GQuark = Word32
foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: FunPtr(Ptr () -> IO ())
foreign import ccall "g_object_set_qdata" g_object_set_qdata ::
Ptr Object -> GQuark -> Ptr () -> IO ()
foreign import ccall "g_object_set_qdata_full" g_object_set_qdata_full ::
Ptr Object -> GQuark -> Ptr () -> FunPtr(Ptr () -> IO ()) -> IO ()
objectSetAttribute :: (MonadIO m, GObject o) => o -> GQuark -> Maybe a -> m ()
objectSetAttribute :: o -> GQuark -> Maybe a -> m ()
objectSetAttribute obj :: o
obj attr :: GQuark
attr Nothing = 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 Object
obj' <- o -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr o
obj
Ptr Object -> GQuark -> Ptr () -> IO ()
g_object_set_qdata Ptr Object
obj' (GQuark -> GQuark
forall a b. (Integral a, Num b) => a -> b
fromIntegral GQuark
attr) Ptr ()
forall a. Ptr a
nullPtr
o -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr o
obj
objectSetAttribute obj :: o
obj attr :: GQuark
attr (Just val :: a
val) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
StablePtr a
sPtr <- a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
newStablePtr a
val
Ptr Object
obj' <- o -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr o
obj
Ptr Object -> GQuark -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO ()
g_object_set_qdata_full Ptr Object
obj' GQuark
attr (StablePtr a -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr a
sPtr) FunPtr (Ptr () -> IO ())
destroyStablePtr
o -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr o
obj
foreign import ccall "g_object_get_qdata" g_object_get_qdata ::
Ptr Object -> GQuark -> IO (Ptr ())
objectGetAttributeUnsafe :: (MonadIO m, GObject o) => o -> GQuark -> m (Maybe a)
objectGetAttributeUnsafe :: o -> GQuark -> m (Maybe a)
objectGetAttributeUnsafe obj :: o
obj attr :: GQuark
attr = IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
Ptr Object
obj' <- o -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr o
obj
Ptr ()
sPtr <- Ptr Object -> GQuark -> IO (Ptr ())
g_object_get_qdata Ptr Object
obj' GQuark
attr
o -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr o
obj
if Ptr ()
sPtrPtr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr ()
forall a. Ptr a
nullPtr then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing else
(a -> Maybe a) -> IO a -> IO (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just (IO a -> IO (Maybe a)) -> IO a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$! StablePtr a -> IO a
forall a. StablePtr a -> IO a
deRefStablePtr (Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
sPtr)
comboBoxNewText :: MonadIO m => m ComboBox
comboBoxNewText :: m ComboBox
comboBoxNewText = do
ComboBox
combo <- m ComboBox
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ComboBox
comboBoxNew
ComboBox -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxSetModelText ComboBox
combo
ComboBox -> m ComboBox
forall (m :: * -> *) a. Monad m => a -> m a
return ComboBox
combo
comboBoxSetModelText :: (MonadIO m, IsComboBox self) => self -> m (SeqStore Text)
comboBoxSetModelText :: self -> m (SeqStore Text)
comboBoxSetModelText combo :: self
combo = IO (SeqStore Text) -> m (SeqStore Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SeqStore Text) -> m (SeqStore Text))
-> IO (SeqStore Text) -> m (SeqStore Text)
forall a b. (a -> b) -> a -> b
$ do
CellLayout
layout <- (ManagedPtr CellLayout -> CellLayout) -> self -> IO CellLayout
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr CellLayout -> CellLayout
CellLayout self
combo
CellLayout -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCellLayout a) =>
a -> m ()
cellLayoutClear CellLayout
layout
SeqStore Text
store <- [Text] -> IO (SeqStore Text)
forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
[a] -> m (SeqStore a)
seqStoreNew ([] :: [Text])
self -> Maybe (SeqStore Text) -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsComboBox a, IsTreeModel b) =>
a -> Maybe b -> m ()
comboBoxSetModel self
combo (SeqStore Text -> Maybe (SeqStore Text)
forall a. a -> Maybe a
Just SeqStore Text
store)
let colId :: ColumnId row Text
colId = Int32 -> ColumnId row Text
forall row. Int32 -> ColumnId row Text
makeColumnIdString 0
SeqStore Text -> ColumnId Text Text -> (Text -> Text) -> IO ()
forall (m :: * -> *) (model :: * -> *) row ty.
(MonadIO m, IsTypedTreeModel model) =>
model row -> ColumnId row ty -> (row -> ty) -> m ()
customStoreSetColumn SeqStore Text
store ColumnId Text Text
forall row. ColumnId row Text
colId Text -> Text
forall a. a -> a
id
self -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBox a) =>
a -> Int32 -> m ()
comboBoxSetEntryTextColumn self
combo 0
CellRendererText
ren <- IO CellRendererText
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m CellRendererText
cellRendererTextNew
CellLayout -> CellRendererText -> Bool -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCellLayout a, IsCellRenderer b) =>
a -> b -> Bool -> m ()
cellLayoutPackStart CellLayout
layout CellRendererText
ren Bool
True
CellLayout
-> CellRendererText -> SeqStore Text -> (Text -> IO ()) -> IO ()
forall (m :: * -> *) self cell (model :: * -> *) row.
(MonadIO m, IsCellLayout self, IsCellRenderer cell,
IsTreeModel (model row), IsTypedTreeModel model) =>
self -> cell -> model row -> (row -> IO ()) -> m ()
cellLayoutSetDataFunction CellLayout
layout CellRendererText
ren SeqStore Text
store (CellRendererText -> Text -> IO ()
forall (m :: * -> *) o.
(MonadIO m, IsCellRendererText o) =>
o -> Text -> m ()
setCellRendererTextText CellRendererText
ren)
self -> GQuark -> Maybe (SeqStore Text) -> IO ()
forall (m :: * -> *) o a.
(MonadIO m, GObject o) =>
o -> GQuark -> Maybe a -> m ()
objectSetAttribute self
combo GQuark
comboQuark (SeqStore Text -> Maybe (SeqStore Text)
forall a. a -> Maybe a
Just SeqStore Text
store)
SeqStore Text -> IO (SeqStore Text)
forall (m :: * -> *) a. Monad m => a -> m a
return SeqStore Text
store
comboBoxGetModelText :: (MonadIO m, IsComboBox self) => self -> m (SeqStore Text)
comboBoxGetModelText :: self -> m (SeqStore Text)
comboBoxGetModelText self :: self
self = do
Maybe (SeqStore Text)
maybeStore <- self -> GQuark -> m (Maybe (SeqStore Text))
forall (m :: * -> *) o a.
(MonadIO m, GObject o) =>
o -> GQuark -> m (Maybe a)
objectGetAttributeUnsafe self
self GQuark
comboQuark
case Maybe (SeqStore Text)
maybeStore of
Just store :: SeqStore Text
store -> SeqStore Text -> m (SeqStore Text)
forall (m :: * -> *) a. Monad m => a -> m a
return SeqStore Text
store
Nothing -> [Char] -> m (SeqStore Text)
forall a. HasCallStack => [Char] -> a
error "Could not get required attribute"
comboBoxAppendText :: (MonadIO m, IsComboBox self) => self -> Text -> m Int32
comboBoxAppendText :: self -> Text -> m Int32
comboBoxAppendText self :: self
self text :: Text
text = do
SeqStore Text
store <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
SeqStore Text -> Text -> m Int32
forall (m :: * -> *) a. MonadIO m => SeqStore a -> a -> m Int32
seqStoreAppend SeqStore Text
store Text
text
comboBoxInsertText :: (MonadIO m, IsComboBox self) => self
-> Int32
-> Text
-> m ()
comboBoxInsertText :: self -> Int32 -> Text -> m ()
comboBoxInsertText self :: self
self position :: Int32
position text :: Text
text = do
SeqStore Text
store <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
SeqStore Text -> Int32 -> Text -> m ()
forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> a -> m ()
seqStoreInsert SeqStore Text
store Int32
position Text
text
comboBoxPrependText :: (Applicative m, MonadIO m, IsComboBox self) => self -> Text -> m ()
comboBoxPrependText :: self -> Text -> m ()
comboBoxPrependText self :: self
self text :: Text
text = do
SeqStore Text
store <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
SeqStore Text -> Text -> m ()
forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
SeqStore a -> a -> m ()
seqStorePrepend SeqStore Text
store Text
text
comboBoxRemoveText :: (MonadIO m, IsComboBox self) => self
-> Int32
-> m ()
comboBoxRemoveText :: self -> Int32 -> m ()
comboBoxRemoveText self :: self
self position :: Int32
position = do
SeqStore Text
store <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
SeqStore Text -> Int32 -> m ()
forall (m :: * -> *) a. MonadIO m => SeqStore a -> Int32 -> m ()
seqStoreRemove SeqStore Text
store Int32
position
comboBoxGetActiveText :: (MonadIO m, IsComboBox self) => self -> m (Maybe Text)
comboBoxGetActiveText :: self -> m (Maybe Text)
comboBoxGetActiveText self :: self
self = do
Int32
activeId <- self -> m Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBox a) =>
a -> m Int32
comboBoxGetActive self
self
if Int32
activeId Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< 0
then Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
else do
SeqStore Text
seqStore <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
SeqStore Text -> Int32 -> m (Maybe Text)
forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> m (Maybe a)
seqStoreSafeGetValue SeqStore Text
seqStore (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
activeId)