diff --git a/gi-gtk-hs.cabal b/gi-gtk-hs.cabal --- a/gi-gtk-hs.cabal +++ b/gi-gtk-hs.cabal @@ -1,5 +1,5 @@ name: gi-gtk-hs -version: 0.2.0.1 +version: 0.3.1.0 synopsis: A wrapper for gi-gtk, adding a few more idiomatic API parts on top description: A wrapper for gi-gtk, adding a few more idiomatic API parts on top homepage: https://github.com/haskell-gi/gi-gtk-hs @@ -32,12 +32,12 @@ transformers >=0.3.0.0 && <0.6, containers >=0.5.5.1 && <0.6, text >=1.2 && <1.3, - haskell-gi-base >=0.17 && <0.18, - gi-glib >=2.0.2 && <2.1, - gi-gobject >=2.0.2 && <2.1, - gi-gdk >=3.0.2 && <3.1, - gi-gtk >=3.0.2 && <3.1, - gi-gdkpixbuf >=2.0.2 && <2.1 + haskell-gi-base >=0.18 && <0.19, + gi-glib >=2.0.6 && <2.1, + gi-gobject >=2.0.6 && <2.1, + gi-gdk >=3.0.6 && <3.1, + gi-gtk >=3.0.6 && <3.1, + gi-gdkpixbuf >=2.0.6 && <2.1 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Data/GI/Gtk/ComboBox.hs b/src/Data/GI/Gtk/ComboBox.hs --- a/src/Data/GI/Gtk/ComboBox.hs +++ b/src/Data/GI/Gtk/ComboBox.hs @@ -92,9 +92,9 @@ seqStoreInsert, seqStorePrepend, seqStoreAppend, seqStoreRemove, seqStoreSafeGetValue ) import GI.Gtk.Objects.ComboBox -import Data.GI.Gtk.ModelView.CellLayout (CellLayout(..), cellLayoutClear, cellLayoutPackStart, cellLayoutSetAttributeFunc, cellLayoutGetCells) +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, ObjectK, toObject) +import GI.GObject.Objects.Object (Object, toObject) type GQuark = Word32 @@ -167,7 +167,7 @@ -- 'comboBoxPrependText', 'comboBoxRemoveText' and 'comboBoxGetActiveText' -- can be called on a combo box only once 'comboBoxSetModelText' is called. -- -comboBoxSetModelText :: (MonadIO m, ComboBoxK self) => self -> m (SeqStore Text) +comboBoxSetModelText :: (MonadIO m, IsComboBox self) => self -> m (SeqStore Text) comboBoxSetModelText combo = liftIO $ do layout <- unsafeCastTo CellLayout combo cellLayoutClear layout @@ -178,14 +178,13 @@ comboBoxSetEntryTextColumn combo 0 ren <- cellRendererTextNew cellLayoutPackStart layout ren True - cellLayoutSetAttributeFunc layout ren store (\iter -> do - customStoreGetRow store iter >>= setCellRendererTextText ren) + cellLayoutSetDataFunction layout ren store (setCellRendererTextText ren) objectSetAttribute combo comboQuark (Just store) return store -- | Retrieve the model that was created with 'comboBoxSetModelText'. -- -comboBoxGetModelText :: (MonadIO m, ComboBoxK self) => self -> m (SeqStore Text) +comboBoxGetModelText :: (MonadIO m, IsComboBox self) => self -> m (SeqStore Text) comboBoxGetModelText self = do (Just store) <- objectGetAttributeUnsafe self comboQuark return store @@ -194,7 +193,7 @@ -- you can only use this function with combo boxes constructed with -- 'comboBoxNewText'. Returns the index of the appended text. -- -comboBoxAppendText :: (MonadIO m, ComboBoxK self) => self -> Text -> m Int32 +comboBoxAppendText :: (MonadIO m, IsComboBox self) => self -> Text -> m Int32 comboBoxAppendText self text = do store <- comboBoxGetModelText self seqStoreAppend store text @@ -204,7 +203,7 @@ -- @comboBox@. Note that you can only use this function with combo boxes -- constructed with 'comboBoxNewText'. -- -comboBoxInsertText :: (MonadIO m, ComboBoxK self) => self +comboBoxInsertText :: (MonadIO m, IsComboBox self) => self -> Int32 -- ^ @position@ - An index to insert @text@. -> Text -- ^ @text@ - A string. -> m () @@ -216,7 +215,7 @@ -- you can only use this function with combo boxes constructed with -- 'comboBoxNewText'. -- -comboBoxPrependText :: (Applicative m, MonadIO m, ComboBoxK self) => self -> Text -> m () +comboBoxPrependText :: (Applicative m, MonadIO m, IsComboBox self) => self -> Text -> m () comboBoxPrependText self text = do store <- comboBoxGetModelText self seqStorePrepend store text @@ -224,7 +223,7 @@ -- | Removes the string at @position@ from @comboBox@. Note that you can only -- use this function with combo boxes constructed with 'comboBoxNewText'. -- -comboBoxRemoveText :: (MonadIO m, ComboBoxK self) => self +comboBoxRemoveText :: (MonadIO m, IsComboBox self) => self -> Int32 -- ^ @position@ - Index of the item to remove. -> m () comboBoxRemoveText self position = do @@ -235,7 +234,7 @@ -- selected. Note that you can only use this function with combo boxes -- constructed with 'comboBoxNewText'. -- -comboBoxGetActiveText :: (MonadIO m, ComboBoxK self) => self -> m (Maybe Text) +comboBoxGetActiveText :: (MonadIO m, IsComboBox self) => self -> m (Maybe Text) comboBoxGetActiveText self = do activeId <- comboBoxGetActive self if activeId < 0 diff --git a/src/Data/GI/Gtk/ModelView/CellLayout.hs b/src/Data/GI/Gtk/ModelView/CellLayout.hs --- a/src/Data/GI/Gtk/ModelView/CellLayout.hs +++ b/src/Data/GI/Gtk/ModelView/CellLayout.hs @@ -49,7 +49,8 @@ module GI.Gtk.Interfaces.CellLayout -- , cellLayoutAddColumnAttribute , cellLayoutSetAttributes - , cellLayoutSetAttributeFunc + , cellLayoutSetDataFunction + , cellLayoutSetDataFunc' , convertIterFromParentToChildModel ) where @@ -62,9 +63,9 @@ import GI.Gtk.Objects.TreeModelFilter (TreeModelFilter(..), getTreeModelFilterChildModel, treeModelFilterConvertIterToChildIter) import GI.Gtk.Objects.TreeModelSort (TreeModelSort(..), getTreeModelSortModel, treeModelSortConvertIterToChildIter) import GI.Gtk.Structs.TreeIter - (treeIterStamp, treeIterUserData3, treeIterUserData2, - treeIterUserData, TreeIter(..)) -import GI.Gtk.Objects.CellRenderer (CellRendererK, CellRenderer(..), toCellRenderer) + (getTreeIterStamp, getTreeIterUserData3, getTreeIterUserData2, + getTreeIterUserData, TreeIter(..)) +import GI.Gtk.Objects.CellRenderer (IsCellRenderer, CellRenderer(..), toCellRenderer) import Data.GI.Gtk.ModelView.Types import Data.GI.Gtk.ModelView.TreeModel import Data.GI.Gtk.ModelView.CustomStore (customStoreGetRow) @@ -79,7 +80,7 @@ -- the model contains strings, you could have the \"text\" attribute of a -- 'CellRendererText' get its values from column 2. -- --- cellLayoutAddColumnAttribute :: (MonadIO m, CellLayoutK self, CellRendererK cell) => self +-- cellLayoutAddColumnAttribute :: (MonadIO m, IsCellLayout self, IsCellRenderer cell) => self -- -> cell -- ^ @cell@ - A 'CellRenderer'. -- -> ReadWriteAttr cell a v -- ^ @attribute@ - An attribute of a renderer. -- -> ColumnId row v -- ^ @column@ - The virtual column of the model from which to @@ -105,33 +106,49 @@ -- pass the child model to this function. -- cellLayoutSetAttributes :: (MonadIO m, - CellLayoutK self, - CellRendererK cell, - TreeModelK (model row), - TypedTreeModelK model) + IsCellLayout self, + IsCellRenderer cell, + IsTreeModel (model row), + IsTypedTreeModel model) => self -> cell -- ^ @cell@ - A 'CellRenderer'. -> model row -- ^ @model@ - A model containing rows of type @row@. -> (row -> [AttrOp cell 'AttrSet]) -- ^ Function to set attributes on the cell renderer. -> m () cellLayoutSetAttributes self cell model attributes = - cellLayoutSetAttributeFunc self cell model $ \iter -> do + cellLayoutSetDataFunc' self cell model $ \iter -> do row <- customStoreGetRow model iter set cell (attributes row) +-- | Like 'cellLayoutSetAttributes', but allows any IO action to be used +cellLayoutSetDataFunction :: (MonadIO m, + IsCellLayout self, + IsCellRenderer cell, + IsTreeModel (model row), + IsTypedTreeModel model) + => self + -> cell -- ^ @cell@ - A 'CellRenderer'. + -> model row -- ^ @model@ - A model containing rows of type @row@. + -> (row -> IO ()) -- ^ Function to set data on the cell renderer. + -> m () +cellLayoutSetDataFunction self cell model callback = + cellLayoutSetDataFunc' self cell model $ \iter -> do + row <- customStoreGetRow model iter + callback row + -- | Install a function that looks up a row in the model and sets the -- attributes of the 'CellRenderer' @cell@ using the row's content. -- -cellLayoutSetAttributeFunc :: (MonadIO m, - CellLayoutK self, - CellRendererK cell, - TreeModelK model) +cellLayoutSetDataFunc' :: (MonadIO m, + IsCellLayout self, + IsCellRenderer cell, + IsTreeModel model) => self -> cell -- ^ @cell@ - A 'CellRenderer'. -> model -- ^ @model@ - A model from which to draw data. -> (TreeIter -> IO ()) -- ^ Function to set attributes on the cell renderer. -> m () -cellLayoutSetAttributeFunc self cell model func = liftIO $ do +cellLayoutSetDataFunc' self cell model func = liftIO $ cellLayoutSetCellDataFunc self cell . Just $ \_ (CellRenderer cellPtr') model' iter -> do iter <- convertIterFromParentToChildModel iter model' =<< toTreeModel model CellRenderer cellPtr <- toCellRenderer cell @@ -176,10 +193,10 @@ then return childIter else convertIterFromParentToChildModel childIter child childModel Nothing -> do - stamp <- get iter treeIterStamp - ud1 <- get iter treeIterUserData - ud2 <- get iter treeIterUserData2 - ud3 <- get iter treeIterUserData3 + stamp <- getTreeIterStamp iter + ud1 <- getTreeIterUserData iter + ud2 <- getTreeIterUserData2 iter + ud3 <- getTreeIterUserData3 iter error ("CellLayout: don't know how to convert iter "++show (stamp, ud1, ud2, ud3)++ " from model "++show parentModelPtr++" to model "++ show modelPtr++". Is it possible that you are setting the "++ diff --git a/src/Data/GI/Gtk/ModelView/CustomStore.hs b/src/Data/GI/Gtk/ModelView/CustomStore.hs --- a/src/Data/GI/Gtk/ModelView/CustomStore.hs +++ b/src/Data/GI/Gtk/ModelView/CustomStore.hs @@ -67,18 +67,18 @@ import System.IO.Unsafe (unsafePerformIO) import Data.GI.Base.BasicTypes (GObject(..), GType, CGType(..), gtypeToCGType, gtypeInt, gtypeBoolean, gtypeString, gtypeInvalid) import Data.GI.Base.BasicConversions (gflagsToWord, withTextCString) -import Data.GI.Base.Overloading (ParentTypes) import Data.GI.Base.ManagedPtr (newObject, withManagedPtr) import Data.GI.Base.GValue (GValue(..)) import GI.GObject (Object) import GI.GdkPixbuf.Objects (Pixbuf(..)) import GI.Gtk.Flags (TreeModelFlags(..)) -import GI.Gtk.Interfaces.TreeModel (TreeModel(..), TreeModelK) +import GI.Gtk.Interfaces.TreeModel (TreeModel(..), IsTreeModel(..)) import GI.Gtk.Structs (SelectionData(..), TreePath(..), TreeIter, treePathCopy, selectionDataCopy) import Data.GI.Gtk.ModelView.Types import GI.Gtk.Structs.TreeIter - (treeIterUserData3, treeIterUserData2, treeIterUserData, - treeIterStamp, TreeIter(..)) + (getTreeIterStamp, getTreeIterUserData, getTreeIterUserData2, getTreeIterUserData3, + setTreeIterStamp, setTreeIterUserData, setTreeIterUserData2, setTreeIterUserData3, + TreeIter(..)) import Data.GI.Base (newBoxed, set, get) import Data.GI.Base.Attributes (AttrOp(..)) import Data.GI.Base.Utils (maybeFromPtr) @@ -86,15 +86,14 @@ treeIterOverwrite :: MonadIO m => TreeIter -> TreeIter -> m () treeIterOverwrite iterOut iterIn = do - stamp <- get iterIn treeIterStamp - ud1 <- get iterIn treeIterUserData - ud2 <- get iterIn treeIterUserData2 - ud3 <- get iterIn treeIterUserData3 - set iterOut [ - treeIterStamp := stamp, - treeIterUserData := ud1, - treeIterUserData2 := ud2, - treeIterUserData3 := ud3] + stamp <- getTreeIterStamp iterIn + ud1 <- getTreeIterUserData iterIn + ud2 <- getTreeIterUserData2 iterIn + ud3 <- getTreeIterUserData3 iterIn + setTreeIterStamp iterOut stamp + setTreeIterUserData iterOut ud1 + setTreeIterUserData2 iterOut ud2 + setTreeIterUserData3 iterOut ud3 -- A 'CustomStore' is backed by a Gtk2HsStore -- which is an instance of the GtkTreeModel GInterface @@ -106,9 +105,7 @@ -- models 'Data.GI.Gtk.ModelView.ListStore.ListStore' or -- 'Data.GI.Gtk.ModelView.TreeStore.TreeStore'. newtype CustomStore private row = CustomStore (ForeignPtr (CustomStore private row)) - -type instance ParentTypes (CustomStore private row) = CustomStoreParentTypes -type CustomStoreParentTypes = '[TreeModel, Object] +instance IsTreeModel (CustomStore private row) instance GObject (CustomStore private row) where gobjectIsInitiallyUnowned _ = False @@ -124,7 +121,7 @@ -- | Set or update a column mapping. This function should be used before -- the model is installed into a widget since the number of defined -- columns are only checked once by widgets. -customStoreSetColumn :: (MonadIO m, TypedTreeModelK model) +customStoreSetColumn :: (MonadIO m, IsTypedTreeModel model) => model row -- ^ the store in which to allocate a new column -> (ColumnId row ty) -- ^ the column that should be set -> (row -> ty) -- ^ the function that sets the property @@ -221,7 +218,7 @@ -- optionally the 'DragSourceIface' and the 'DragDestIface'. If the latter two -- are set to @Nothing@ a dummy interface is substituted that rejects every -- drag and drop. -customStoreNew :: (MonadIO m, TreeModelK (model row), TypedTreeModelK model) => +customStoreNew :: (MonadIO m, IsTreeModel (model row), IsTypedTreeModel model) => private -- ^ Any private data the store needs to store. Usually an 'IORef'. -> (CustomStore private row -> model row) -> TreeModelIface row -- ^ Functions necessary to implement the 'TreeModel' interface. @@ -254,7 +251,7 @@ -- | Extract a row of the given model at the given 'TreeIter'. -- -customStoreGetRow :: (MonadIO m, TypedTreeModelK model) => model row -> TreeIter -> m row +customStoreGetRow :: (MonadIO m, IsTypedTreeModel model) => model row -> TreeIter -> m row customStoreGetRow model iter = liftIO $ case toTypedTreeModel model of TypedTreeModel model -> do diff --git a/src/Data/GI/Gtk/ModelView/ForestStore.hs b/src/Data/GI/Gtk/ModelView/ForestStore.hs --- a/src/Data/GI/Gtk/ModelView/ForestStore.hs +++ b/src/Data/GI/Gtk/ModelView/ForestStore.hs @@ -74,7 +74,6 @@ import Foreign.ForeignPtr (ForeignPtr) import Data.GI.Base.BasicTypes (GObject(..), GObject) -import Data.GI.Base.Overloading (ParentTypes) import Data.GI.Base.ManagedPtr (withManagedPtr) import Data.GI.Gtk.ModelView.Types @@ -85,18 +84,17 @@ import GI.GObject.Objects.Object (Object(..)) import GI.Gtk.Interfaces.TreeModel (treeModelRowDeleted, treeModelRowInserted, - treeModelRowChanged, toTreeModel, TreeModel(..), + treeModelRowChanged, toTreeModel, TreeModel(..), IsTreeModel(..), treeModelRowHasChildToggled) import GI.Gtk.Functions (treeSetRowDragData, treeGetRowDragData) import GI.Gtk.Structs.TreePath (TreePath) import GI.Gtk.Structs.TreeIter - (treeIterUserData3, treeIterUserData2, treeIterUserData, - treeIterStamp, TreeIter(..)) -import Data.GI.Base (get) + (getTreeIterUserData3, getTreeIterUserData2, getTreeIterUserData, + getTreeIterStamp, setTreeIterUserData3, setTreeIterUserData2, + setTreeIterUserData, setTreeIterStamp, TreeIter(..)) +import Data.GI.Base (get, new) import Unsafe.Coerce (unsafeCoerce) -import Data.GI.Base.Constructible (Constructible(..)) -import Data.GI.Base.Attributes (AttrOp(..)) -------------------------------------------- -- internal model data types @@ -105,18 +103,20 @@ data ForestStoreIter = ForestStoreIter Int32 Word32 Word32 Word32 fromForestStoreIter :: MonadIO m => ForestStoreIter -> m TreeIter -fromForestStoreIter (ForestStoreIter s u1 u2 u3) = new TreeIter [ - treeIterStamp := s, - treeIterUserData := unsafeCoerce u1, - treeIterUserData2 := unsafeCoerce u2, - treeIterUserData3 := unsafeCoerce u3] +fromForestStoreIter (ForestStoreIter s u1 u2 u3) = do + i <- new TreeIter [] + setTreeIterStamp i s + setTreeIterUserData i $ unsafeCoerce u1 + setTreeIterUserData2 i $ unsafeCoerce u2 + setTreeIterUserData3 i $ unsafeCoerce u3 + return i toForestStoreIter :: MonadIO m => TreeIter -> m ForestStoreIter toForestStoreIter iter = do - stamp <- get iter treeIterStamp - u1 <- get iter treeIterUserData - u2 <- get iter treeIterUserData2 - u3 <- get iter treeIterUserData3 + stamp <- getTreeIterStamp iter + u1 <- getTreeIterUserData iter + u2 <- getTreeIterUserData2 iter + u3 <- getTreeIterUserData3 iter return $ ForestStoreIter stamp (unsafeCoerce u1) (unsafeCoerce u2) (unsafeCoerce u3) forestStoreIterSetStamp :: ForestStoreIter -> Int32 -> ForestStoreIter @@ -130,14 +130,13 @@ mkForestStore :: CustomStore (IORef (Store a)) a -> ForestStore a mkForestStore (CustomStore ptr) = ForestStore ptr -type instance ParentTypes (ForestStore a) = ForestStoreParentTypes -type ForestStoreParentTypes = '[TreeModel, Object] +instance IsTreeModel (ForestStore a) instance GObject (ForestStore a) where gobjectIsInitiallyUnowned _ = False gobjectType _ = gobjectType (undefined :: TreeModel) -instance TypedTreeModelK ForestStore +instance IsTypedTreeModel ForestStore -- | Maximum number of nodes on each level. -- diff --git a/src/Data/GI/Gtk/ModelView/SeqStore.hs b/src/Data/GI/Gtk/ModelView/SeqStore.hs --- a/src/Data/GI/Gtk/ModelView/SeqStore.hs +++ b/src/Data/GI/Gtk/ModelView/SeqStore.hs @@ -75,45 +75,43 @@ TreeModelIface(..), customStoreNew, DragDestIface(..), DragSourceIface(..), CustomStore(..)) import Data.GI.Base.BasicTypes (GObject(..), GObject) -import Data.GI.Base.Overloading (ParentTypes) import Data.GI.Base.ManagedPtr (withManagedPtr) import GI.Gtk.Interfaces.TreeModel (treeModelRowDeleted, treeModelRowInserted, - treeModelRowChanged, toTreeModel, TreeModel(..)) + treeModelRowChanged, toTreeModel, TreeModel(..), IsTreeModel(..)) import GI.GObject.Objects.Object (Object(..)) import GI.Gtk.Functions (treeGetRowDragData, treeSetRowDragData) import GI.Gtk.Flags (TreeModelFlags(..)) import Control.Monad.IO.Class (MonadIO) import GI.Gtk.Structs.TreeIter - (treeIterUserData3, treeIterUserData2, treeIterStamp, - treeIterUserData, TreeIter(..)) -import Data.GI.Base (get) + (setTreeIterUserData3, setTreeIterUserData2, setTreeIterStamp, + setTreeIterUserData, getTreeIterUserData, TreeIter(..)) +import Data.GI.Base (get, new) import Data.Word (Word32) import Unsafe.Coerce (unsafeCoerce) -import Data.GI.Base.Constructible (Constructible(..)) -import Data.GI.Base.Attributes (AttrOp(..)) import Foreign.Ptr (nullPtr) seqStoreIterNew :: MonadIO m => Int32 -> Int32 -> m TreeIter -seqStoreIterNew s u1 = new TreeIter [ - treeIterStamp := s, - treeIterUserData := unsafeCoerce u1, - treeIterUserData2 := nullPtr, - treeIterUserData3 := nullPtr] +seqStoreIterNew s u1 = do + i <- new TreeIter [] + setTreeIterStamp i s + setTreeIterUserData i $ unsafeCoerce u1 + setTreeIterUserData2 i nullPtr + setTreeIterUserData3 i nullPtr + return i newtype SeqStore a = SeqStore (ForeignPtr (CustomStore (IORef (Seq a)) a)) mkSeqStore :: CustomStore (IORef (Seq a)) a -> SeqStore a mkSeqStore (CustomStore ptr) = SeqStore ptr -type instance ParentTypes (SeqStore a) = SeqStoreParentTypes -type SeqStoreParentTypes = '[TreeModel, Object] +instance IsTreeModel (SeqStore a) instance GObject (SeqStore a) where gobjectIsInitiallyUnowned _ = False gobjectType _ = gobjectType (undefined :: TreeModel) -instance TypedTreeModelK SeqStore +instance IsTypedTreeModel SeqStore -- | Create a new 'TreeModel' that contains a list of elements. seqStoreNew :: (Applicative m, MonadIO m) => [a] -> m (SeqStore a) @@ -174,7 +172,7 @@ -- | Convert a 'TreeIterRaw' to an an index into the 'SeqStore'. Note that this -- function merely extracts the second element of the 'TreeIterRaw'. seqStoreIterToIndex :: (Applicative m, MonadIO m) => TreeIter -> m Int32 -seqStoreIterToIndex i = unsafeCoerce <$> get i treeIterUserData +seqStoreIterToIndex i = unsafeCoerce <$> getTreeIterUserData i -- | Default drag functions for 'Data.GI.Gtk.ModelView.SeqStore'. These -- functions allow the rows of the model to serve as drag source. Any row is diff --git a/src/Data/GI/Gtk/ModelView/TreeModel.hs b/src/Data/GI/Gtk/ModelView/TreeModel.hs --- a/src/Data/GI/Gtk/ModelView/TreeModel.hs +++ b/src/Data/GI/Gtk/ModelView/TreeModel.hs @@ -173,7 +173,7 @@ -- | Read the value of at a specific column and 'TreeIter'. -- -treeModelGetValue :: TreeModelK self => self +treeModelGetValue :: IsTreeModel self => self -> TreeIter -> ColumnId row ty -- ^ @column@ - The column to lookup the value at. -> IO ty @@ -181,7 +181,7 @@ GI.treeModelGetValue self iter colId >>= getter -- | Gets the a `TreeIter` or Nothing if the path is invalid or empty -treeModelGetIter :: (MonadIO m, TreeModelK model) => model -> TreePath -> m (Maybe TreeIter) +treeModelGetIter :: (MonadIO m, IsTreeModel model) => model -> TreePath -> m (Maybe TreeIter) treeModelGetIter model path = treePathGetDepth path >>= \case 0 -> return Nothing diff --git a/src/Data/GI/Gtk/ModelView/Types.hs b/src/Data/GI/Gtk/ModelView/Types.hs --- a/src/Data/GI/Gtk/ModelView/Types.hs +++ b/src/Data/GI/Gtk/ModelView/Types.hs @@ -37,7 +37,7 @@ -- module Data.GI.Gtk.ModelView.Types ( TypedTreeModel(..), - TypedTreeModelK, + IsTypedTreeModel, toTypedTreeModel, unsafeTreeModelToGeneric, @@ -89,19 +89,17 @@ import Data.GI.Base.BasicTypes (ForeignPtrNewtype, UnexpectedNullPointerReturn, GObject(..)) import Data.GI.Base.ManagedPtr (withManagedPtr) import Data.GI.Base.GValue (GValue) -import Data.GI.Base.Overloading (ParentTypes) import GI.GObject.Objects.Object (Object(..)) -import GI.Gtk.Interfaces.TreeModel (TreeModel) -import GI.Gtk.Objects.TreeModelSort (TreeModelSort) -import GI.Gtk.Objects.TreeSelection (TreeSelectionK, treeSelectionCountSelectedRows, treeSelectionGetSelectedRows) +import GI.Gtk.Interfaces.TreeModel (TreeModel, IsTreeModel(..)) +import GI.Gtk.Objects.TreeModelSort (TreeModelSort, IsTreeModelSort(..)) +import GI.Gtk.Objects.TreeSelection (IsTreeSelection, treeSelectionCountSelectedRows, treeSelectionGetSelectedRows) import GI.Gtk.Objects.TreeModelFilter (TreeModelFilter) -import GI.Gtk.Interfaces.TreeSortable (TreeSortable) +import GI.Gtk.Interfaces.TreeSortable (TreeSortable, IsTreeSortable(..)) import GI.GLib.Functions (quarkFromString) import GI.GdkPixbuf.Objects.Pixbuf (Pixbuf(..)) import GI.Gtk.Structs.TreeIter - (treeIterUserData3, treeIterUserData2, treeIterUserData, - treeIterStamp, TreeIter(..), treeIterCopy) -import GI.Gtk.Structs.TreePath (TreePath(..), treePathGetIndices, treePathNewFromIndices, treePathNew, treePathGetDepth) + (TreeIter(..), treeIterCopy) +import GI.Gtk.Structs.TreePath (TreePath(..), treePathGetIndices, treePathAppendIndex, treePathNew, treePathGetDepth) import Data.GI.Base.Constructible (Constructible(..)) import Data.GI.Base.Attributes (AttrOp(..)) import Unsafe.Coerce (unsafeCoerce) @@ -116,24 +114,25 @@ newtype TypedTreeModel row = TypedTreeModel (ForeignPtr (TypedTreeModel row)) -class TypedTreeModelK model where +class IsTypedTreeModel model where dummy :: model a -> a dummy _ = error "not used" -- this is to get the right kind for model :: * -> * -- TODO: when haddock is fixed we can use an explicit kind annotation -toTypedTreeModel :: TypedTreeModelK model => model row -> TypedTreeModel row +toTypedTreeModel :: IsTypedTreeModel model => model row -> TypedTreeModel row toTypedTreeModel = unsafeCoerce# unsafeTreeModelToGeneric :: TreeModel -> model row unsafeTreeModelToGeneric = unsafeCoerce# -instance TypedTreeModelK TypedTreeModel +instance IsTypedTreeModel TypedTreeModel newtype TypedTreeModelSort row = TypedTreeModelSort (ForeignPtr (TypedTreeModelSort row)) -type instance ParentTypes (TypedTreeModelSort row) = TypedTreeModelSortParentTypes -type TypedTreeModelSortParentTypes = '[TreeModelSort, TreeSortable, TreeModel, Object] +instance IsTreeModelSort (TypedTreeModelSort row) +instance IsTreeSortable (TypedTreeModelSort row) +instance IsTreeModel (TypedTreeModelSort row) instance GObject (TypedTreeModelSort row) where gobjectIsInitiallyUnowned _ = False @@ -142,14 +141,14 @@ unsafeTreeModelSortToGeneric :: TreeModelSort -> TypedTreeModelSort row unsafeTreeModelSortToGeneric = unsafeCoerce# -instance TypedTreeModelK TypedTreeModelSort +instance IsTypedTreeModel TypedTreeModelSort newtype TypedTreeModelFilter row = TypedTreeModelFilter (ForeignPtr (TypedTreeModelFilter row)) unsafeTreeModelFilterToGeneric :: TreeModelFilter -> TypedTreeModelFilter row unsafeTreeModelFilterToGeneric = unsafeCoerce# -instance TypedTreeModelK TypedTreeModelFilter +instance IsTypedTreeModel TypedTreeModelFilter -- | TreePath is a list of indices to specify a subtree or node in a -- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel'. The node that correspond @@ -163,7 +162,11 @@ -- treePathNewFromIndices' :: MonadIO m => [Int32] -> m TreePath treePathNewFromIndices' [] = treePathNew -treePathNewFromIndices' x = treePathNewFromIndices x +treePathNewFromIndices' x = do + path <- treePathNew + mapM_ (treePathAppendIndex path) x + return path + -- TODO (once every one has Gtk+ 3.12) use treePathNewFromIndices x treePathGetIndices' :: MonadIO m => TreePath -> m [Int32] treePathGetIndices' path = treePathGetDepth path >>= \case @@ -176,7 +179,7 @@ maybeWithTreePath :: MonadIO m => Maybe [Int32] -> (TreePath -> m a) -> m a maybeWithTreePath mbTp act = maybe (act (TreePath nullForeignPtr)) (`withTreePath` act) mbTp -treeSelectionGetSelectedRows' :: (MonadIO m, TreeSelectionK sel) => sel -> m [TreePath] +treeSelectionGetSelectedRows' :: (MonadIO m, IsTreeSelection sel) => sel -> m [TreePath] treeSelectionGetSelectedRows' sel = treeSelectionCountSelectedRows sel >>= \case 0 -> return [] _ -> liftIO $ (fst <$> treeSelectionGetSelectedRows sel) `catch` (\(_::UnexpectedNullPointerReturn) -> return [])