I have been having trouble porting applications from gtk3 → gtk4.
In order to create a Gtk.ListView, I seem to need a Gio.ListStore.
The Gio.ListStore constructor requires a GType for a GObject.
If I want to store Strings, that would be a Gtk.StringObject, but how do
get a GType for it.
This doesn’t seem to work
foo <- Gtk.stringObjectNew "foo"
fooGValue <- toGValue foo
fooGType <- gvalueGType fooValue -- Doesn't work
listStore <- new Gio.ListStore [ #itemType := fooType ]
I don’t see any gvalueGType function in Hoogle.
Options:
fooGType <- gvalueType fooGValue
or
fooGType <- gvalueGType_ @(Maybe StringObject)
if you want a GType
Thanks for your help. There doesn’t seem to be much in the way
of example code. I keep web searching. Is there any resource
for things like this that seem important for using haskell-gi.
The next issue I am having is with signals being passed a GObject
when I need a ListItem. I can’t seem to find a recognizable operation
for downcasting GObjects.
I found castTo that seems to work.
I have been experimenting with GTK 4 and your question inspired me to investigate ListView. My initial experiment was a simpler case than your question, but, in the spirit of sharing example code, I had:
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Main
( main
) where
import Control.Monad ( void )
import Control.Monad.Extra ( whenJust )
import Data.GI.Base ( AttrOp (..), castTo, get, new, on, set )
import Data.Text ( Text )
import qualified GI.Gtk as Gtk
activate :: Gtk.Application -> IO ()
activate app = do
stringList <- Gtk.stringListNew (Just exampleList)
singleSelection <- Gtk.singleSelectionNew (Just stringList)
signalListItemFactory <- Gtk.signalListItemFactoryNew
scrolledWindow <- Gtk.scrolledWindowNew
let setupListItem :: Gtk.SignalListItemFactorySetupCallback
setupListItem o = do
mListItem <- castTo Gtk.ListItem o
whenJust mListItem $ \listItem -> do
label <- new Gtk.Label []
#setChild listItem (Just label)
let bindListItem :: Gtk.SignalListItemFactoryBindCallback
bindListItem o1 = do
mListItem <- castTo Gtk.ListItem o1
whenJust mListItem $ \listItem -> do
mO2 <- Gtk.listItemGetItem listItem
whenJust mO2 $ \o2 -> do
mStringObject <- castTo Gtk.StringObject o2
whenJust mStringObject $ \stringObject -> do
mWidget <- #getChild listItem
whenJust mWidget $ \widget -> do
mLabel <- castTo Gtk.Label widget
whenJust mLabel $ \label -> do
string <- get stringObject #string
set label [ #label := string ]
void $ on signalListItemFactory #setup setupListItem
void $ on signalListItemFactory #bind bindListItem
listView <-
Gtk.listViewNew (Just singleSelection) (Just signalListItemFactory)
set scrolledWindow [ #child := listView ]
window <- new Gtk.ApplicationWindow
[ #application := app
, #title := "ListView test"
, #child := scrolledWindow
, #defaultHeight := 200
]
window.show
exampleList :: [Text]
exampleList =
[ "apple"
, "banana"
, "cherry"
, "damson"
, "elderberry"
, "fig"
, "grape"
, "kiwi"
, "lemon"
, "mango"
, "nectarine"
, "orange"
, "peach"
, "quince"
, "raspberry"
, "strawberry"
, "tangerine"
, "watermelon"
]
main :: IO ()
main = do
app <- new Gtk.Application
[ #applicationId := "com.pilgrem.testListView"
, On #activate (activate ?self)
]
void $ app.run Nothing
with stack.yaml:
snapshot: lts-23.1 # GHC 9.8.4
extra-deps:
- gi-gdk-4.0.9
- gi-gsk-4.0.8
- gi-gtk-4.0.11
and package.yaml (extract):
dependencies:
- base >= 4.7 && < 5
- extra
- gi-gtk >= 4.0
- haskell-gi-base
- text
and results:
Very nice. I took a slightly different course using MaybeT rather than whenJust.
With:
import Control.Monad.Trans (liftIO)
import Control.Monad.Trans.Maybe (MaybeT(..))
import GI.GObject (Object)
And:
let bindListItem :: Gtk.SignalListItemFactoryBindCallback
bindListItem o1 = do
st <- runMaybeT $ do
listItem <- MaybeT $ castTo Gtk.ListItem o1
widget <- MaybeT $ #getChild listItem
label <- MaybeT $ castTo Gtk.Label widget
item <- MaybeT $ Gtk.listItemGetItem listItem
stringObject <- MaybeT $ castTo Gtk.StringObject item
liftIO $ do
text <- #getString stringObject
#setText label text
case st of
Nothing -> print "bindListItem failed"
Just () -> return ()
For some reason I required a type declaration if I did:
item <- MaybeT $ #getItem listItem
stringObject <- MaybeT $ castTo Gtk.StringObject (item :: Object)
My second experiment was more complex, in terms of the list model. I used a GI.Gio.Objects.ListStore with my own MyTypeObject type for the items.
For MyTypeObject, I followed the example at haskell-gi/examples/advanced/CustomContainer.hs at master · haskell-gi/haskell-gi · GitHub to create:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Data.MyTypeObject
( MyTypeObject (..)
, MyTypePrivate (..)
) where
import Data.GI.Base
( GObject, ManagedPtr, TypedObject (..), glibType )
import Data.GI.Base.GObject ( DerivedGObject (..), registerGType )
import Data.GI.Base.Overloading ( HasParentTypes, ParentTypes )
import GI.GObject ( Object )
import Data.Text ( Text )
newtype MyTypeObject = MyTypeObject (ManagedPtr MyTypeObject)
instance TypedObject MyTypeObject where
glibType = registerGType MyTypeObject
instance GObject MyTypeObject
data MyTypePrivate = MyTypePrivate
{ fruit :: Maybe Text
, count :: Maybe Int
}
instance DerivedGObject MyTypeObject where
type GObjectParentType MyTypeObject = Object
type GObjectPrivateData MyTypeObject = MyTypePrivate
objectTypeName = "MyTypeObject"
objectClassInit _ = pure ()
objectInstanceInit _ _ = pure $ MyTypePrivate
{ fruit = Nothing
, count = Nothing
}
objectInterfaces = []
instance HasParentTypes MyTypeObject
type instance ParentTypes MyTypeObject = '[Object]
I modified my first experiement to be as follows (I think your use of MaybeT is more expressive, but I have kept with whenJust for now):
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Main
( main
) where
import Control.Monad ( void )
import Control.Monad.Extra ( whenJust )
import Data.MyTypeObject
import Data.GI.Base ( AttrOp (..), castTo, new, on, set )
import Data.GI.Base.GObject
( gobjectGetPrivateData, gobjectSetPrivateData
, registerGType
)
import Data.Text ( Text, pack )
import GI.GObject ( Object, toObject )
import qualified GI.Gio as Gio
import qualified GI.Gtk as Gtk
activate :: Gtk.Application -> IO ()
activate app = do
gType <- registerGType MyTypeObject
listStore <- Gio.listStoreNew gType
myTypeList <- exampleObjects
Gio.listStoreSplice listStore 0 0 myTypeList
singleSelection <- Gtk.singleSelectionNew (Just listStore)
signalListItemFactory <- Gtk.signalListItemFactoryNew
scrolledWindow <- Gtk.scrolledWindowNew
let setupListItem :: Gtk.SignalListItemFactorySetupCallback
setupListItem o = do
mListItem <- castTo Gtk.ListItem o
whenJust mListItem $ \listItem -> do
label <- new Gtk.Label []
#setChild listItem (Just label)
let bindListItem :: Gtk.SignalListItemFactoryBindCallback
bindListItem o1 = do
mListItem <- castTo Gtk.ListItem o1
whenJust mListItem $ \listItem -> do
mO2 <- Gtk.listItemGetItem listItem
whenJust mO2 $ \o2 -> do
mMyTypeObject <- castTo MyTypeObject o2
whenJust mMyTypeObject $ \myTypeObject -> do
mWidget <- #getChild listItem
whenJust mWidget $ \widget -> do
mLabel <- castTo Gtk.Label widget
whenJust mLabel $ \label -> do
myTypePrivate <- gobjectGetPrivateData myTypeObject
let string = case myTypePrivate of
MyTypePrivate (Just f) (Just c) ->
f <> " (" <> pack (show c) <> ")"
MyTypePrivate (Just f) Nothing -> f
MyTypePrivate _ _ -> ""
set label [ #label := string ]
void $ on signalListItemFactory #setup setupListItem
void $ on signalListItemFactory #bind bindListItem
listView <-
Gtk.listViewNew (Just singleSelection) (Just signalListItemFactory)
set scrolledWindow [ #child := listView ]
window <- new Gtk.ApplicationWindow
[ #application := app
, #title := "ListView test (complex)"
, #child := scrolledWindow
, #defaultHeight := 200
]
window.show
exampleFruit :: [Text]
exampleFruit =
[ "apple"
, "banana"
, "cherry"
, "damson"
, "elderberry"
, "fig"
, "grape"
, "kiwi"
, "lemon"
, "mango"
, "nectarine"
, "orange"
, "peach"
, "quince"
, "raspberry"
, "strawberry"
, "tangerine"
, "watermelon"
]
exampleCount :: [Int]
exampleCount = [1 .. 18]
exampleObjects :: IO [Object]
exampleObjects = mapM (toObject =<<) exampleMyType
where
exampleMyType = zipWith go exampleFruit exampleCount
go f c = do
myTypeObject <- new MyTypeObject []
gobjectSetPrivateData myTypeObject $ MyTypePrivate
{ fruit = Just f
, count = Just c
}
pure myTypeObject
main :: IO ()
main = do
app <- new Gtk.Application
[ #applicationId := "com.pilgrem.testListView.complex"
, On #activate (activate ?self)
]
void $ app.run Nothing
and result:
Another nice example. I had focused so much on the haskell-gi/examples/gtk4 that I overlooked the advanced directory for useful infomation.