-- |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_ GtkClipboard) r =>
  InterpreterFor GtkClipboard r
withGtkClipboard :: forall (r :: EffectRow).
Member (Scoped_ GtkClipboard) r =>
InterpreterFor GtkClipboard r
withGtkClipboard =
  forall (effect :: Effect) (r :: EffectRow).
Member (Scoped_ 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 :: 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
handleGtkClipboard Display
display = \case
  GtkClipboard.Read Selection
selection ->
    forall (f :: * -> *) a (e :: Effect) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader Display
display (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 ->
    forall (f :: * -> *) a (e :: Effect) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader Display
display (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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise (forall (m :: * -> *) a (e :: Effect) (r :: EffectRow).
m a -> Tactical e m r a
runTSimple (Selection -> Text -> Sem r0 ()
f Selection
s Text
t)))
    forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader Display
display do
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ @[] [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound] (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')
    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_ GtkClipboard !! Text) r
interpretGtkClipboard :: forall (r :: EffectRow).
Members '[GtkMain Display, Log, Embed IO, Final IO] r =>
InterpreterFor (Scoped_ GtkClipboard !! Text) r
interpretGtkClipboard =
  forall (e :: Effect) s (r :: EffectRow).
Members '[GtkMain s, Log] r =>
(forall (q :: Effect) (r0 :: EffectRow) x.
 s
 -> e (Sem r0) x
 -> Tactical e (Sem r0) (Stop Text : Opaque q : r) x)
-> InterpreterFor (Scoped_ 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
handleGtkClipboard