diff options
| -rw-r--r-- | .gitmodules | 3 | ||||
| -rw-r--r-- | app/Foobar/Application.hs | 62 | ||||
| -rw-r--r-- | app/Main.hs | 43 | ||||
| -rw-r--r-- | app/foobar.cabal | 6 | ||||
| -rw-r--r-- | cabal.project | 17 | ||||
| -rw-r--r-- | flake.nix | 23 | ||||
| -rw-r--r-- | hie.yaml | 2 | ||||
| -rw-r--r-- | lib/cabal.project | 2 | ||||
| m--------- | third-party/haskell-gi | 0 |
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 @@ -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 {}); @@ -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 |