GtkMain.hs

-- |API for the GTK main loop.
module Helic.GtkMain where

import Conc (withAsync_)
import Exon (exon)
import qualified 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_ (Gtk s), GtkMain s, Resource] r =>
  Sem r () ->
  Sem r ()
gtkMain onInit =
  scoped_ do
    GtkMain.running =<< Gtk.resource
    raise onInit
    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_ (Gtk s) !! Text, GtkMain s, Resource, Log] r =>
  Sem r () ->
  Sem r ()
loopGtkMain onInit =
  forever do
    GtkMain.run do
      gtkMain @_ @(Scoped_ (Gtk _) : _) (raise onInit) !! \ e ->
        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 =
  GtkMain.access do
    Log.info "Gtk main loop inactive, requesting restart"
    GtkMain.request (stop "Gtk main loop didn't start") <* Log.info "Gtk main loop started"

-- |Run 'loopGtkMain' in a thread.
gtkMainLoop ::
  Members [Scoped_ (Gtk s) !! Text, GtkMain s, Log, Race, Resource, Async] r =>
  Sem r () ->
  Sem r a ->
  Sem r a
gtkMainLoop onInit =
  withAsync_ (loopGtkMain onInit)