blob: 5713cc36bf33fa20dffd4f8eff40e5217a4a7bb8 (
plain)
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
|
{-# 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
|
