-- |API for the GTK main loop.
-- Internal.
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)

-- |Run the GTK main loop.
-- Before that, initialize the GTK client environment, store the default display in the state of 'GtkMain', and execute
-- the user-supplied initialization action.
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

-- |Run the GTK main loop in an infinite loop, recovering from errors by logging them.
-- After the loop has failed or was terminated, the default implementation waits for 10 seconds before restarting it,
-- but can be forced to start when a consumer tries to use it.
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}|]

-- |Acquire a GTK resource by first examining the value currently stored in 'GtkMain', and if there is none, requesting
-- the GTK main loop to be started.
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"

-- |Run 'loopGtkMain' in a thread.
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)