-- |Native interpreters for 'GtkClipboard', for scoped interpretation with 'interpretWithGtk'.
module Helic.Interpreter.GtkClipboard where

import GI.Gdk (Display)

import qualified Helic.Effect.GtkClipboard as GtkClipboard
import Helic.Effect.GtkClipboard (GtkClipboard)
import Helic.Effect.GtkMain (GtkMain)
import Helic.Gtk (clipboardText, setClipboardText, subscribeToClipboard)
import Helic.Interpreter.GtkMain (interpretWithGtk)

-- |Specialization of 'scoped' to 'GtkClipboard' for syntactic sugar.
withGtkClipboard ::
  Member (Scoped resource GtkClipboard) r =>
  InterpreterFor GtkClipboard r
withGtkClipboard :: InterpreterFor GtkClipboard r
withGtkClipboard =
  Sem (GtkClipboard : r) a -> Sem r a
forall resource (effect :: Effect) (r :: EffectRow).
Member (Scoped resource effect) r =>
InterpreterFor effect r
scoped

-- |This handler for 'GtkClipboard' depends on a 'Display', which should optimally be provided by a 'Scoped'
-- interpreter to ensure safe acquisition of the resource.
-- The effect then needs to be scoped using 'withGtkClipboard'.
-- The default implementation for this purpose is 'interpretWithGtk'.
handleGtkClipboard ::
  Members [Log, Embed IO, Final IO] r =>
  Display ->
  GtkClipboard (Sem r0) a ->
  Tactical effect (Sem r0) (Stop Text : r) a
handleGtkClipboard :: Display
-> GtkClipboard (Sem r0) a
-> Tactical effect (Sem r0) (Stop Text : r) a
handleGtkClipboard Display
display = \case
  GtkClipboard.Read Selection
selection ->
    Maybe Text
-> Sem
     (WithTactics effect f (Sem r0) (Stop Text : r)) (f (Maybe Text))
forall (f :: * -> *) a (e :: Effect) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT (Maybe Text
 -> Sem
      (WithTactics effect f (Sem r0) (Stop Text : r)) (f (Maybe Text)))
-> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) (Maybe Text)
-> Sem
     (WithTactics effect f (Sem r0) (Stop Text : r)) (f (Maybe Text))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Display
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r))
     (Maybe Text)
-> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) (Maybe Text)
forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader Display
display (Selection
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r))
     (Maybe Text)
forall (r :: EffectRow).
Members '[Reader Display, Log, Stop Text, Embed IO] r =>
Selection -> Sem r (Maybe Text)
clipboardText Selection
selection)
  GtkClipboard.Write Selection
selection Text
text ->
    () -> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) (f ())
forall (f :: * -> *) a (e :: Effect) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT (() -> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) (f ()))
-> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) ()
-> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) (f ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Display
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r)) ()
-> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) ()
forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader Display
display (Selection
-> Text
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r)) ()
forall (r :: EffectRow).
Members '[Reader Display, Log, Stop Text, Embed IO, Final IO] r =>
Selection -> Text -> Sem r ()
setClipboardText Selection
selection Text
text)
  GtkClipboard.Events Selection -> Text -> Sem r0 ()
f -> do
    let f' :: Selection
-> Text
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r)) ()
f' Selection
s Text
t = Sem
  (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r))
  (f ())
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem (WithTactics effect f (Sem r0) (Stop Text : r)) (f ())
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r))
     (f ())
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise (Sem r0 () -> Tactical effect (Sem r0) (Stop Text : r) ()
forall (m :: * -> *) a (e :: Effect) (r :: EffectRow).
m a -> Tactical e m r a
runTSimple (Selection -> Text -> Sem r0 ()
f Selection
s Text
t)))
    Display
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r)) ()
-> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) ()
forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader Display
display do
      [Selection]
-> (Selection
    -> Sem
         (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r))
         ())
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r)) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ @[] [Item [Selection]
forall a. Bounded a => a
minBound..Item [Selection]
forall a. Bounded a => a
maxBound] ((Selection
 -> Text
 -> Sem
      (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r))
      ())
-> Selection
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r)) ()
forall (r :: EffectRow).
Members '[Reader Display, Log, Stop Text, Embed IO, Final IO] r =>
(Selection -> Text -> Sem r ()) -> Selection -> Sem r ()
subscribeToClipboard Selection
-> Text
-> Sem
     (Reader Display : WithTactics effect f (Sem r0) (Stop Text : r)) ()
f')
    () -> Sem (WithTactics effect f (Sem r0) (Stop Text : r)) (f ())
forall (f :: * -> *) a (e :: Effect) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT ()

-- |Native interpreter for 'GtkClipboard' that requires the effect to be used within a 'withGtkClipboard' region.
interpretGtkClipboard ::
  Members [GtkMain Display, Log, Embed IO, Final IO] r =>
  InterpreterFor (Scoped Display GtkClipboard !! Text) r
interpretGtkClipboard :: InterpreterFor (Scoped Display GtkClipboard !! Text) r
interpretGtkClipboard =
  (forall (r0 :: EffectRow) x.
 Display
 -> GtkClipboard (Sem r0) x
 -> Tactical GtkClipboard (Sem r0) (Stop Text : r) x)
-> InterpreterFor (Scoped Display GtkClipboard !! Text) r
forall (e :: Effect) s (r :: EffectRow).
Members '[GtkMain s, Log] r =>
(forall (r0 :: EffectRow) x.
 s -> e (Sem r0) x -> Tactical e (Sem r0) (Stop Text : r) x)
-> InterpreterFor (Scoped s e !! Text) r
interpretWithGtk forall (r :: EffectRow) (r0 :: EffectRow) a (effect :: Effect).
Members '[Log, Embed IO, Final IO] r =>
Display
-> GtkClipboard (Sem r0) a
-> Tactical effect (Sem r0) (Stop Text : r) a
forall (r0 :: EffectRow) x.
Display
-> GtkClipboard (Sem r0) x
-> Tactical GtkClipboard (Sem r0) (Stop Text : r) x
handleGtkClipboard