-- |Utilities for 'GtkClipboard'.
-- Internal.
module Helic.GtkClipboard where

import Exon (exon)
import qualified Polysemy.Log as Log

import Helic.Data.XClipboardEvent (XClipboardEvent (XClipboardEvent))
import qualified Helic.Effect.GtkClipboard as GtkClipboard
import Helic.Effect.GtkClipboard (GtkClipboard)
import Helic.Interpreter.GtkClipboard (withGtkClipboard)

-- |Registers a callback with GTK's clipboard event system that converts each update into an 'XClipboardEvent' published
-- through 'Events'.
subscribeEvents ::
  Members [Scoped_ GtkClipboard !! Text, Events XClipboardEvent, Log] r =>
  Sem r ()
subscribeEvents :: forall (r :: EffectRow).
Members
  '[Scoped_ GtkClipboard !! Text, Events XClipboardEvent, Log] r =>
Sem r ()
subscribeEvents =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming forall {r :: EffectRow}. Member Log r => Text -> Sem r ()
failure forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow).
Member (Scoped_ GtkClipboard) r =>
InterpreterFor GtkClipboard r
withGtkClipboard do
    forall (r :: EffectRow).
Member GtkClipboard r =>
(Selection -> Text -> Sem r ()) -> Sem r ()
GtkClipboard.events \ Selection
selection Text
t ->
      forall e (r :: EffectRow). Member (Events e) r => e -> Sem r ()
publish (Text -> Selection -> XClipboardEvent
XClipboardEvent Text
t Selection
selection)
  where
    failure :: Text -> Sem r ()
failure Text
e =
      forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|Subscribing to Gtk events failed: #{e}|]