It had been over two years since I last looked at them, but I returned to Haskell, GUI and GTK4 on Windows. This time, things were more straightforward. To set things up again, I added the following MSYS2 packages to the Stack-supplied MSYS2 with stack exec -- pacman -S:
|
1 2 3 4 5 6 |
stack exec -- pacman -Syu stack exec -- pacman -S mingw-w64-x86_64-pkgconf stack exec -- pacman -S mingw-w64-x86_64-gobject-introspection stack exec -- pacman -S mingw-w64-x86_64-gtksourceview5 stack exec -- pacman -S mingw-w64-x86_64-gtk4 stack exec -- pacman -S mingw-w64-x86_64-atk |
and set PKG_CONFIG_PATH to the mingw64\lib\pkgconfig directory and XDG_DATA_DIRS to the mingw64\share directory (of the Stack-supplied MSYS2). I found it was necessary to install the MSYS2 packages before building the Haskell packages that depend upon them.
MSYS2 package mingw-w64-x86_64-gtk4 does not have a dependancy on mingw-w64-x86_64-atk, but Haskell package gi-gtk >= 4.0 has a dependency on gi-atk. I asked a question about that at the haskell-gi GitHub repository.
A basic gktTest
I named the example package gtkTest, as before, with Main.hs as follows (being the haskell-gi repository’s current “Hello! World” program):
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 |
{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import Control.Monad ( void ) import Data.GI.Base ( AttrOp (..), new, set ) import qualified GI.Gtk as Gtk activate :: Gtk.Application -> IO () activate app = do button <- new Gtk.Button [ #label := "Click me" , On #clicked ( ?self `set` [ #sensitive := False , #label := "Thanks for clicking me" ] ) ] window <- new Gtk.ApplicationWindow [ #application := app , #title := "Hi there" , #child := button ] window.show main :: IO () main = do app <- new Gtk.Application [ #applicationId := "haskell-gi.example" , On #activate (activate ?self) ] void $ app.run Nothing |
with a package.yaml specifying dependencies:
|
1 2 3 4 |
dependencies: - base >= 4.7 && < 5 - gi-gtk >= 4.0 - haskell-gi-base |
and with Stack project-level configuration:
|
1 2 3 4 5 6 |
snapshot: lts-22.39 # GHC 9.6.6 extra-deps: - gi-gtk-4.0.9 - gi-gdk-4.0.9 - gi-gsk-4.0.8 |
I sought to understand how this program worked and, in particular, the use of ?self and app.run.
new
new is used in connection with app, window and button. Module Data.GI.Base.Constructible provides a type class Constructible with a default instance:
|
1 2 3 4 5 6 |
class Constructible obj (tag :: AttrOpTag) where new :: MonadIO m => (ManagedPtr obj -> obj) -> [AttrOp obj tag] -> m obj instance {-# OVERLAPPABLE #-} (GObject obj, tag ~ 'AttrConstruct) => Constructible obj tag where new = constructGObject |
In the code extract above, and other extracts, I have renamed type variables for consistency between extracts.
GI.Gtk.Objects.Application.Application is an instance of GObject.
Data.GI.Base.GObject.constructGObject makes use of Data.GI.Base.Signals.on:
|
1 2 3 4 5 6 7 8 9 10 11 |
on :: forall obj info m. (GObject obj, MonadIO m, SignalInfo info) => obj -> SignalProxy obj info -> ((?self :: obj) => HaskellCallbackType info) -> m SignalHandlerId on o p c = liftIO $ connectSignal @info o w SignalConnectBefore (proxyDetail p) where w :: obj -> HaskellCallbackType info w parent = let ?self = parent in c |
and on binds the implicit parameter ?self.
Given the language extension ImplicitParams, the implicit parameter ?self can be passed to activate.
AttrOp
Data.GI.Base.Attributes.AttrOp is a type with a number of data constructors, including (:=) (assign a value to an attribute) and On (connect the given signal to a signal handler.).
|
1 2 3 4 5 |
On :: forall obj info (tag :: AttrOpTag). (GObject obj, SignalInfo info) => SignalProxy obj info -> ((?self :: obj) => HaskellCallbackType info) -> AttrOp obj tag |
app.run Nothing
In the example, app.run means the same as #run app.
Given the language extension OverloadedRecordDot, app.run is equivalent to getField @"run" app.
Module GHC.Record provides type class HasField which promises getField:
|
1 2 |
class HasField t obj p | t obj -> p where getField :: obj -> p |
Given the language extension VisibleTypeApplications, @"run" in getField @"run" app specifies the type t in type class HasField t obj p. Given the language extentions DataKinds, "run" is a type-level literal of kind String. As app is of type Application, that specifies type obj in type class HasField t obj p.
Module GI.Gtk.Objects.Application provides an instance of HasField
|
1 2 3 4 5 6 7 8 9 10 |
import qualified Data.GI.Base.Overloading as O import qualified GHC.Records as R ... #if MIN_VERSION_base(4,13,0) instance ( info ~ ResolveApplicationMethod t Application , O.OverloadedMethod info Application p , R.HasField t Application p ) => R.HasField t Application p where getField = O.overloadedMethod @info #endif |
Including the instance head (HasField t Application p) as a constraint in the instance context is a ‘trick’ which permits polymorphic fields.
Data.GI.Base.Overloading.overloadedMethod is promised by type class OverloadedMethod:
|
1 2 |
class OverloadedMethod info obj signature where overloadedMethod :: obj -> signature |
Given the language extension VisualTypeApplications, the @info in O.overloadedMethod @info specifies the type info in type class OverloadedMethod info obj s. info is constrained to be equivalent to ResolveApplicationMethod t Application. When t is the type literal "run", that is equal to ApplicationRunMethodInfo (see further below).
Module GI.Gio.Objects.Application provides an instance of OverloadedMethod:
|
1 2 3 4 5 |
instance ( signature ~ (Maybe ([[Char]]) -> m Int32) , MonadIO m , IsApplication obj ) => O.OverloadedMethod ApplicationRunMethodInfo obj signature where overloadedMethod = applicationRun |
|
1 2 3 4 5 |
applicationRun :: (B.CallStack.HasCallStack, MonadIO m, IsApplication obj) => obj -> Maybe ([[Char]]) -> m Int32 |
and module GI.Gtk.Objects.Application provides a type family:
|
1 2 3 4 5 6 |
import qualified Data.Kind as DK import qualified GI.Gio.Objects.Application as Gio.Application ... type family ResolveApplicationMethod (t :: Symbol) (obj :: DK.Type) :: DK.Type where ... ResolveApplicationMethod "run" obj = Gio.Application.ApplicationRunMethodInfo |
A less basic gtkTest
I tried a less basic version of gtkTest, using a Grid of three Button values, with Main.hs:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import Control.Monad ( void ) import Data.GI.Base ( AttrOp (..), new, set ) import Data.Text ( Text ) import qualified GI.Gtk as Gtk activate :: Gtk.Application -> IO () activate app = do grid <- new Gtk.Grid [] button1 <- mkButton "Click me!" button2 <- mkButton "No, click me!" button3 <- mkButton "Better click me!" #attach grid button1 0 0 1 1 #attach grid button2 1 0 1 1 #attach grid button3 0 1 2 1 window <- new Gtk.ApplicationWindow [ #application := app , #title := "Hi there" , #child := grid ] window.show mkButton :: Text -> IO Gtk.Button mkButton label = new Gtk.Button [ #label := label , On #clicked ( ?self `set` [ #sensitive := False , #label := "Thanks for clicking me" ] ) , #hexpand := True ] main :: IO () main = do app <- new Gtk.Application [ #applicationId := "haskell-gi.example" , On #activate (activate ?self) ] void $ app.run Nothing |
The result was as below, but I had to specify #hexpand := True for the buttons to take advantage of the available horizontal space. That is because an ApplicationWindow is a single-child container while a Grid is a multi-child container; the default behaviour is different.
A gtkTest with input and output
I tried a further variation with input (two Entry values) and output (a Label value):
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 |
{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import Control.Monad ( void ) import Data.GI.Base ( AttrOp (..), get, new, on, set ) import Data.Text ( Text ) import qualified Data.Text as T import qualified Data.Text.Read as T import qualified GI.Gtk as Gtk activate :: Gtk.Application -> IO () activate app = do grid <- new Gtk.Grid [ #columnSpacing := 5 , #rowSpacing := 5 , #marginBottom := 5 , #marginEnd := 5 , #marginStart := 5 , #marginTop := 5 ] labelHeight <- mkLabel "Height:" labelRadius <- mkLabel "Radius:" labelResult <- mkLabel "Volume:" labelValue <- mkLabel "None" entryHeight <- mkEntry entryRadius <- mkEntry let update = do hText <- entryHeight `get` #text rText <- entryRadius `get` #text case (T.rational hText, T.rational rText) of (Right (h, _), Right (r, _)) -> labelValue `set` [ #label := T.show $ cone h r ] (_, _) -> labelValue `set` [ #label := "One or both of height and radius is invalid."] void $ on entryHeight #changed update void $ on entryRadius #changed update #attach grid labelHeight 0 0 1 1 #attach grid labelRadius 0 1 1 1 #attach grid labelResult 0 2 1 1 #attach grid labelValue 1 2 1 1 #attach grid entryHeight 1 0 1 1 #attach grid entryRadius 1 1 1 1 window <- new Gtk.ApplicationWindow [ #application := app , #title := "Volume of a cone" , #child := grid ] window.show mkLabel :: Text -> IO Gtk.Label mkLabel label = new Gtk.Label [ #label := label , #halign := Gtk.AlignStart ] mkEntry :: IO Gtk.Entry mkEntry = new Gtk.Entry [ #halign := Gtk.AlignStart ] main :: IO () main = do app <- new Gtk.Application [ #applicationId := "haskell-gi.example" , On #activate (activate ?self) ] void $ app.run Nothing cone :: Double -> Double -> Double cone h r = h * pi * r * r / 3.0 |
The use of Data.Text.show requires Haskell package text >= 2.1.2.
The default value of halign is AlignFill, which centres when there is no meaningful way to stretch.
The result was as below:
