summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHannes Schulze <haschu0103@outlook.de>2025-06-21 09:42:22 +0200
committerHannes Schulze <haschu0103@outlook.de>2025-06-21 09:42:22 +0200
commit876b51e784f4d86fd538f45680314517bd139678 (patch)
tree663c4ce1991c5ba78f37a57ef08c22f04dcce343
parent75b5dde3a4d62acfc4f354b6dc237062cb83b89b (diff)
use updated gi-gtk
-rw-r--r--.gitmodules3
-rw-r--r--app/Foobar/Application.hs62
-rw-r--r--app/Main.hs43
-rw-r--r--app/foobar.cabal6
-rw-r--r--cabal.project17
-rw-r--r--flake.nix23
-rw-r--r--hie.yaml2
-rw-r--r--lib/cabal.project2
m---------third-party/haskell-gi0
9 files changed, 121 insertions, 37 deletions
diff --git a/.gitmodules b/.gitmodules
new file mode 100644
index 0000000..29c39d7
--- /dev/null
+++ b/.gitmodules
@@ -0,0 +1,3 @@
+[submodule "third-party/haskell-gi"]
+ path = third-party/haskell-gi
+ url = https://github.com/haskell-gi/haskell-gi.git
diff --git a/app/Foobar/Application.hs b/app/Foobar/Application.hs
new file mode 100644
index 0000000..5713cc3
--- /dev/null
+++ b/app/Foobar/Application.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE OverloadedStrings, OverloadedLabels, OverloadedRecordDot, ImplicitParams #-}
+
+module Foobar.Application
+ ( mkApplication
+ ) where
+
+import Data.Maybe (fromJust)
+import Data.GI.Base
+import Data.Text
+import GHC.Generics (Generic)
+import Declarative.Gtk
+
+import qualified GI.Gtk as Gtk
+import qualified GI.Gdk as Gdk
+import qualified GI.Gio as Gio
+import qualified GI.Foobar as FB
+
+mkApplication :: IO Gtk.Application
+mkApplication = new Gtk.Application [ #applicationId := "com.github.hannesschulze.foobar-hs"
+ , On #activate (onActivate ?self) ]
+
+newtype AppState
+ = AppState { stateText :: Text }
+ deriving (Generic)
+
+data Message = MsgQuit | MsgDoSomething
+
+initialState :: AppState
+initialState = AppState { stateText = "Do something" }
+
+appView :: View AppState Message Gtk.Widget
+appView state emit = widget DeclarativeBox [ #children := children
+ , #orientation := Gtk.OrientationVertical
+ , #spacing := 12]
+ where children = [ widget Gtk.Button [ #label :<~ state.stateText
+ , On #clicked (emit MsgDoSomething) ]
+ , widget Gtk.Button [ #label := "Quit"
+ , On #clicked (emit MsgQuit) ] ]
+
+appHandler :: Handler Message AppState
+appHandler MsgQuit _ = pure ()
+appHandler MsgDoSomething s = s.stateText <~ "Did something!"
+
+onActivate :: Gtk.Application -> IO ()
+onActivate app = do
+ provider <- new Gtk.CssProvider []
+ provider.loadFromResource "/foobar/styles/default.css"
+ disp <- Gdk.displayGetDefault
+ Gtk.styleContextAddProviderForDisplay (fromJust disp)
+ provider
+ (fromIntegral Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION)
+ view <- mvh initialState appView appHandler
+ window <- new Gtk.ApplicationWindow [ #application := app
+ , #title := "Test"
+ , #child := view ]
+ _ <- FB.serverProxyNewForBusSync Gio.BusTypeSession
+ []
+ "com.github.hannesschulze.foobar"
+ "/com/github/hannesschulze/foobar/server"
+ (Nothing :: Maybe Gio.Cancellable)
+ window.show
diff --git a/app/Main.hs b/app/Main.hs
index 25ad7d4..4f7e757 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,42 +1,15 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE OverloadedLabels #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE OverloadedStrings, OverloadedRecordDot #-}
import Control.Monad (void)
import Control.Exception (bracket_)
-import Data.Maybe (fromJust)
-import Data.GI.Base
+import System.Environment (getArgs)
+import Foobar.Application (mkApplication)
-import qualified GI.Gtk as Gtk
-import qualified GI.Gdk as Gdk
-import qualified GI.Gio as Gio
import qualified GI.Foobar as FB
-activate :: Gtk.Application -> IO ()
-activate app = do
- provider <- new Gtk.CssProvider []
- provider.loadFromResource "/foobar/styles/default.css"
- disp <- Gdk.displayGetDefault
- Gtk.styleContextAddProviderForDisplay (fromJust disp)
- provider
- (fromIntegral Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION)
- button <- new Gtk.Button [ #label := "Hello, world!" ]
- window <- new Gtk.ApplicationWindow [ #application := app
- , #title := "Test"
- , #child := button ]
- _ <- FB.serverProxyNewForBusSync Gio.BusTypeSession
- []
- "com.github.hannesschulze.foobar"
- "/com/github/hannesschulze/foobar/server"
- (Nothing :: Maybe Gio.Cancellable)
- window.show
-
main :: IO ()
-main = do
- bracket_
- (do FB.stylesRegisterResource; FB.iconsRegisterResource)
- (do FB.stylesUnregisterResource; FB.iconsUnregisterResource) $
- do app <- new Gtk.Application [ #applicationId := "com.github.hannesschulze.foobar-hs"
- , On #activate (activate ?self) ]
- void $ app.run Nothing
+main = bracket_ FB.stylesRegisterResource FB.stylesUnregisterResource $
+ bracket_ FB.iconsRegisterResource FB.iconsUnregisterResource $
+ do args <- getArgs
+ app <- mkApplication
+ void $ app.run (Just ("com.github.hannesschulze.foobar" : args))
diff --git a/app/foobar.cabal b/app/foobar.cabal
index bee0858..9ac41ba 100644
--- a/app/foobar.cabal
+++ b/app/foobar.cabal
@@ -16,5 +16,9 @@ executable foobar
gi-gio,
gi-gtk4,
gi-gdk4,
- gi-foobar
+ gi-foobar,
+ declarative-gtk,
+ optics-core,
+ text
+ other-modules: Foobar.Application
default-language: Haskell2010
diff --git a/cabal.project b/cabal.project
index 1d0b610..bef0a31 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,2 +1,19 @@
packages: lib/hs/gi-foobar.cabal
app/foobar.cabal
+ third-party/haskell-gi/declarative-gtk/declarative-gtk.cabal
+ third-party/haskell-gi/base/haskell-gi-base.cabal
+ third-party/haskell-gi/overloading/haskell-gi-overloading.cabal
+ third-party/haskell-gi/haskell-gi.cabal
+ third-party/haskell-gi/bindings/GModule/gi-gmodule.cabal
+ third-party/haskell-gi/bindings/HarfBuzz/gi-harfbuzz.cabal
+ third-party/haskell-gi/bindings/freetype2/gi-freetype2.cabal
+ third-party/haskell-gi/bindings/Gtk-4.0/gi-gtk4.cabal
+ third-party/haskell-gi/bindings/Gdk-4.0/gi-gdk4.cabal
+ third-party/haskell-gi/bindings/GdkPixbuf/gi-gdkpixbuf.cabal
+ third-party/haskell-gi/bindings/cairo/gi-cairo.cabal
+ third-party/haskell-gi/bindings/Gio/gi-gio.cabal
+ third-party/haskell-gi/bindings/GLib/gi-glib.cabal
+ third-party/haskell-gi/bindings/GObject/gi-gobject.cabal
+ third-party/haskell-gi/bindings/Graphene/gi-graphene.cabal
+ third-party/haskell-gi/bindings/Gsk/gi-gsk.cabal
+ third-party/haskell-gi/bindings/Pango/gi-pango.cabal
diff --git a/flake.nix b/flake.nix
index 7825306..6b22ed9 100644
--- a/flake.nix
+++ b/flake.nix
@@ -15,7 +15,27 @@
let
pkgs = import nixpkgs { inherit system; };
haskell = pkgs.haskellPackages.ghcWithPackages (p:
- with p; [ haskell-language-server haskell-gi-base gi-gtk4 ]);
+ with p; [
+ haskell-language-server
+ base
+ bytestring
+ containers
+ optics
+ ansi-terminal
+ attoparsec
+ cabal-doctest
+ directory
+ doctest
+ filepath
+ mtl
+ pretty-show
+ process
+ regex-tdfa
+ safe
+ xdg-basedir
+ hsc2hs
+ xml-conduit
+ ]);
haskell-shell = pkgs.mkShell {
name = "Haskell";
packages = [
@@ -28,6 +48,7 @@
pkgs.gobject-introspection
pkgs.sassc
];
+ nativeBuildInputs = with pkgs; [ glib pcre2 libsysprof-capture gtk4 expat xorg.libXdmcp util-linux libselinux libsepol lerc fribidi libthai libdatrie ];
hardeningDisable = [ "fortify" ];
};
foobar = (pkgs.callPackage ./nix/package.nix {});
diff --git a/hie.yaml b/hie.yaml
index a5c8943..16e7e1a 100644
--- a/hie.yaml
+++ b/hie.yaml
@@ -16,3 +16,5 @@ cradle:
component: "exe:foobar"
- path: "lib/hs"
component: "lib:gi-foobar"
+ - path: "third-party/haskell-gi/declarative-gtk"
+ component: "lib:declarative-gtk"
diff --git a/lib/cabal.project b/lib/cabal.project
index 3438af7..a96c2e3 100644
--- a/lib/cabal.project
+++ b/lib/cabal.project
@@ -1 +1,3 @@
packages: buildgen.cabal
+ ../third-party/haskell-gi/haskell-gi.cabal
+ ../third-party/haskell-gi/base/haskell-gi-base.cabal
diff --git a/third-party/haskell-gi b/third-party/haskell-gi
new file mode 160000
+Subproject ba14a6f9cfc7e6a4caaf227e6887ce3132cd705