blob: 8034d11ca9e83fffe4a99a3e1dc7cf5f654451ad (
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
|
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE OverloadedStrings, OverloadedLabels, OverloadedRecordDot, ImplicitParams #-}
module Foobar.Application
( mkApplication
) where
import Data.Maybe (fromJust)
import Data.GI.Base
import GHC.Generics (Generic)
import Declarative.Gtk
import Foobar.Services.Config
import Foobar.Models.Config
import qualified GI.Gtk as Gtk
import qualified GI.Gdk as Gdk
import qualified GI.Gio as Gio
import qualified GI.Foobar as FB
newtype AppState
= AppState { config :: Config }
deriving (Generic)
data Message = MsgConfigChanged
mkApplication :: IO Gtk.Application
mkApplication = new Gtk.Application [ #applicationId := "com.github.hannesschulze.foobar-hs"
, On #activate (onActivate ?self) ]
appView :: View AppState Message Gtk.Widget
appView state _ = widget Gtk.Label [ #label :<~ lbl ]
where lbl = fmap ("Stylesheet: " <>) state.config.general.stylesheet
appHandler :: Handler Message AppState
appHandler MsgConfigChanged s = do newConfig <- loadConfig
s.config <~ newConfig
onActivate :: Gtk.Application -> IO ()
onActivate app = do
initialState <- AppState <$> initConfig
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, emit, _) <- fullMVH initialState appView appHandler
observeConfig (emit MsgConfigChanged)
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
|
