-- |Native interpreter for 'Gtk'.
-- Internal.
module Helic.Interpreter.Gtk where

import qualified GI.Gdk as GiGdk
import GI.Gdk (Display)
import qualified GI.Gtk as GiGtk
import Polysemy.Conc (interpretScopedResumable)
import qualified Polysemy.Log as Log

import qualified Helic.Effect.Gtk as Gtk
import Helic.Effect.Gtk (Gtk)
import Helic.Gtk (getDisplay)
import Helic.Stop (tryStop)

-- |Initialize GTK, run the scoped action, then tear down the GTK environment.
bracketGtk ::
  Members [Resource, Log, Embed IO] r =>
  (Display -> Sem (Stop Text : r) a) ->
  Sem (Stop Text : r) a
bracketGtk :: (Display -> Sem (Stop Text : r) a) -> Sem (Stop Text : r) a
bracketGtk =
  Sem (Stop Text : r) Display
-> (Display -> Sem (Stop Text : r) ())
-> (Display -> Sem (Stop Text : r) a)
-> Sem (Stop Text : r) a
forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket Sem (Stop Text : r) Display
acquire Display -> Sem (Stop Text : r) ()
forall a (r :: EffectRow).
(IsDescendantOf Display a, GObject a, Member (Embed IO) r,
 Member (Stop Text) r, Member Log r) =>
a -> Sem r ()
release
  where
    acquire :: Sem (Stop Text : r) Display
acquire = do
      Sem (Stop Text : r) Bool
-> Sem (Stop Text : r) () -> Sem (Stop Text : r) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM ((Bool, Maybe [Text]) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Maybe [Text]) -> Bool)
-> Sem (Stop Text : r) (Bool, Maybe [Text])
-> Sem (Stop Text : r) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Bool, Maybe [Text]) -> Sem (Stop Text : r) (Bool, Maybe [Text])
forall (r :: EffectRow) a.
Members '[Stop Text, Embed IO] r =>
IO a -> Sem r a
tryStop (Maybe [Text] -> IO (Bool, Maybe [Text])
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Text] -> m (Bool, Maybe [Text])
GiGtk.initCheck Maybe [Text]
forall a. Maybe a
Nothing)) do
        Text -> Sem (Stop Text : r) ()
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop Text
"GTK intialization failed"
      Sem (Stop Text : r) Display
forall (r :: EffectRow).
Members '[Stop Text, Embed IO] r =>
Sem r Display
getDisplay
    release :: a -> Sem r ()
release a
display = do
      Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug Text
"Quitting the GTK main loop"
      IO () -> Sem r ()
forall (r :: EffectRow). Member (Embed IO) r => IO () -> Sem r ()
ignoreException do
        a -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m ()
GiGdk.displayFlush a
display
        a -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m ()
GiGdk.displayClose a
display
      IO () -> Sem r ()
forall (r :: EffectRow) a.
Members '[Stop Text, Embed IO] r =>
IO a -> Sem r a
tryStop IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
GiGtk.mainQuit

-- |Interpret 'Gtk' natively, using the "GI.Gtk" and "Gi.Gdk" libraries.
-- This uses 'Scoped' to bracket the initialization and termination of the GTK environment.
interpretGtk ::
  Members [Resource, Log, Embed IO] r =>
  InterpreterFor (Scoped Display (Gtk Display) !! Text) r
interpretGtk :: InterpreterFor (Scoped Display (Gtk Display) !! Text) r
interpretGtk =
  (forall x.
 (Display -> Sem (Stop Text : r) x) -> Sem (Stop Text : r) x)
-> (forall (r0 :: EffectRow) x.
    Display -> Gtk Display (Sem r0) x -> Sem (Stop Text : r) x)
-> InterpreterFor (Scoped Display (Gtk Display) !! Text) r
forall resource (effect :: (* -> *) -> * -> *) err
       (r :: EffectRow).
(forall x.
 (resource -> Sem (Stop err : r) x) -> Sem (Stop err : r) x)
-> (forall (r0 :: EffectRow) x.
    resource -> effect (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Scoped resource effect !! err) r
interpretScopedResumable forall (r :: EffectRow) a.
Members '[Resource, Log, Embed IO] r =>
(Display -> Sem (Stop Text : r) a) -> Sem (Stop Text : r) a
forall x.
(Display -> Sem (Stop Text : r) x) -> Sem (Stop Text : r) x
bracketGtk \ Display
display -> \case
    Gtk Display (Sem r0) x
Gtk.Main ->
      Sem (Stop Text : r) x
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
GiGtk.main
    Gtk Display (Sem r0) x
Gtk.Resource ->
      Display -> Sem (Stop Text : r) Display
forall (f :: * -> *) a. Applicative f => a -> f a
pure Display
display