module Helic.GtkMain where
import Exon (exon)
import Polysemy.Conc (withAsync_)
import qualified Polysemy.Log as Log
import qualified Helic.Effect.Gtk as Gtk
import Helic.Effect.Gtk (Gtk)
import qualified Helic.Effect.GtkMain as GtkMain
import Helic.Effect.GtkMain (GtkMain)
gtkMain ::
Members [Scoped resource (Gtk s), GtkMain s, Resource] r =>
Sem r () ->
Sem r ()
gtkMain :: Sem r () -> Sem r ()
gtkMain Sem r ()
onInit =
Sem (Gtk s : r) () -> Sem r ()
forall resource (effect :: Effect) (r :: EffectRow).
Member (Scoped resource effect) r =>
InterpreterFor effect r
scoped do
s -> Sem (Gtk s : r) ()
forall s (r :: EffectRow). Member (GtkMain s) r => s -> Sem r ()
GtkMain.running (s -> Sem (Gtk s : r) ())
-> Sem (Gtk s : r) s -> Sem (Gtk s : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Gtk s : r) s
forall s (r :: EffectRow). Member (Gtk s) r => Sem r s
Gtk.resource
Sem r () -> Sem (Gtk s : r) ()
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise Sem r ()
onInit
Sem (Gtk s : r) ()
forall s (r :: EffectRow). Member (Gtk s) r => Sem r ()
Gtk.main
loopGtkMain ::
Members [Scoped resource (Gtk s) !! Text, GtkMain s, Resource, Log] r =>
Sem r () ->
Sem r ()
loopGtkMain :: Sem r () -> Sem r ()
loopGtkMain Sem r ()
onInit =
Sem r () -> Sem r ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
Sem r () -> Sem r ()
forall s (r :: EffectRow) a.
Member (GtkMain s) r =>
Sem r a -> Sem r a
GtkMain.run do
Sem (Scoped resource (Gtk s) : r) ()
-> Sem (Scoped resource (Gtk s) : r) ()
forall resource s (r :: EffectRow).
Members '[Scoped resource (Gtk s), GtkMain s, Resource] r =>
Sem r () -> Sem r ()
gtkMain (Sem r () -> Sem (Scoped resource (Gtk s) : r) ()
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise Sem r ()
onInit) Sem (Scoped resource (Gtk s) : r) ()
-> (Text -> Sem r ()) -> Sem r ()
forall err (eff :: Effect) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! \ Text
e ->
Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|Gtk main loop failed: #{e}|]
gtkResource ::
Members [GtkMain s, Log, Stop Text] r =>
Sem r s
gtkResource :: Sem r s
gtkResource =
Sem r s -> Sem r s
forall s (r :: EffectRow).
Member (GtkMain s) r =>
Sem r s -> Sem r s
GtkMain.access do
Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.info Text
"Gtk main loop inactive, requesting restart"
Sem r s -> Sem r s
forall s (r :: EffectRow).
Member (GtkMain s) r =>
Sem r s -> Sem r s
GtkMain.request (Text -> Sem r s
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop Text
"Gtk main loop didn't start") Sem r s -> Sem r () -> Sem r s
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.info Text
"Gtk main loop started"
gtkMainLoop ::
Members [Scoped resource (Gtk s) !! Text, GtkMain s, Log, Race, Resource, Async] r =>
Sem r () ->
Sem r a ->
Sem r a
gtkMainLoop :: Sem r () -> Sem r a -> Sem r a
gtkMainLoop Sem r ()
onInit =
Sem r () -> Sem r a -> Sem r a
forall (r :: EffectRow) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ (Sem r () -> Sem r ()
forall resource s (r :: EffectRow).
Members
'[Scoped resource (Gtk s) !! Text, GtkMain s, Resource, Log] r =>
Sem r () -> Sem r ()
loopGtkMain Sem r ()
onInit)