-- |XClipboard Interpreter, Internal
module Helic.Interpreter.XClipboard where

import qualified GI.Gdk as Gdk
import qualified GI.Gtk as GI
import qualified Polysemy.Conc as Conc
import Polysemy.Conc (Events, withAsync_)
import qualified Polysemy.Log as Log
import Polysemy.Log (Log)
import Polysemy.Resource (bracket)

import qualified Helic.Data.GtkState as GtkState
import Helic.Data.GtkState (GtkState (GtkState))
import Helic.Data.Selection (Selection (Clipboard, Primary, Secondary))
import Helic.Data.XClipboardEvent (XClipboardEvent (XClipboardEvent))
import Helic.Effect.XClipboard (XClipboard (Current, Set, Sync))
import qualified Helic.Gtk as Gtk
import Helic.Gtk (getClipboardFor, gtkClipboard, setClipboardFor, syncXClipboard)

-- |Execute a GTK main loop in a baackground thread and interpret @'Reader' 'GtkState'@.
-- The clipboards stored in the state need the main loop running to work properly.
-- The main loop is killed after the interpreted program terminates.
withMainLoop ::
  Members [Log, Error Text, Race, Async, Resource, Embed IO] r =>
  InterpreterFor (Reader GtkState) r
withMainLoop :: InterpreterFor (Reader GtkState) r
withMainLoop Sem (Reader GtkState : r) a
prog = do
  Sem r Display
-> (Display -> Sem r ()) -> (Display -> Sem r a) -> Sem 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 r Display
acquire Display -> Sem r ()
forall a (r :: EffectRow).
(IsDescendantOf Display a, Member (Embed IO) r, Member Log r,
 GObject a) =>
a -> Sem r ()
release \ Display
display -> do
    Clipboard
clipboard <- Either Text Clipboard -> Sem r Clipboard
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either Text Clipboard -> Sem r Clipboard)
-> Sem r (Either Text Clipboard) -> Sem r Clipboard
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Display -> Selection -> Sem r (Either Text Clipboard)
forall (r :: EffectRow).
Member (Embed IO) r =>
Display -> Selection -> Sem r (Either Text Clipboard)
gtkClipboard Display
display Selection
Clipboard
    Clipboard
primary <- Either Text Clipboard -> Sem r Clipboard
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either Text Clipboard -> Sem r Clipboard)
-> Sem r (Either Text Clipboard) -> Sem r Clipboard
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Display -> Selection -> Sem r (Either Text Clipboard)
forall (r :: EffectRow).
Member (Embed IO) r =>
Display -> Selection -> Sem r (Either Text Clipboard)
gtkClipboard Display
display Selection
Primary
    Clipboard
secondary <- Either Text Clipboard -> Sem r Clipboard
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either Text Clipboard -> Sem r Clipboard)
-> Sem r (Either Text Clipboard) -> Sem r Clipboard
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Display -> Selection -> Sem r (Either Text Clipboard)
forall (r :: EffectRow).
Member (Embed IO) r =>
Display -> Selection -> Sem r (Either Text Clipboard)
gtkClipboard Display
display Selection
Secondary
    GtkState -> Sem (Reader GtkState : r) a -> Sem r a
forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader (Clipboard -> Clipboard -> Clipboard -> Display -> GtkState
GtkState Clipboard
clipboard Clipboard
primary Clipboard
secondary Display
display) (Sem (Reader GtkState : r) ()
-> Sem (Reader GtkState : r) a -> Sem (Reader GtkState : r) a
forall (r :: EffectRow) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ Sem (Reader GtkState : r) ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
GI.main Sem (Reader GtkState : r) a
prog)
  where
    acquire :: Sem r Display
acquire = do
      Maybe [Text]
_ <- IO (Maybe [Text]) -> Sem r (Maybe [Text])
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Text] -> m (Maybe [Text])
GI.init Maybe [Text]
forall a. Maybe a
Nothing)
      Text -> Maybe Display -> Sem r Display
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note Text
"couldn't get a GTK display" (Maybe Display -> Sem r Display)
-> Sem r (Maybe Display) -> Sem r Display
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r (Maybe Display)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m (Maybe Display)
Gdk.displayGetDefault
    release :: a -> Sem r ()
release a
display = do
      Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|Quitting the GTK main loop|]
      a -> Sem r ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m ()
Gdk.displayFlush a
display
      a -> Sem r ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m ()
Gdk.displayClose a
display
      Sem r ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
GI.mainQuit

-- |Listen to clipboard events for a specific source, like "primary selection", and publish them via 'Events'.
subscribeToClipboard ::
  Members [Events resource XClipboardEvent, Reader GtkState, Log, Embed IO, Final IO] r =>
  GI.Clipboard ->
  Selection ->
  Sem r ()
subscribeToClipboard :: Clipboard -> Selection -> Sem r ()
subscribeToClipboard Clipboard
clipboard Selection
selection =
  Clipboard -> (Either Text Text -> Sem r ()) -> Sem r ()
forall (r :: EffectRow).
Member (Final IO) r =>
Clipboard -> (Either Text Text -> Sem r ()) -> Sem r ()
Gtk.subscribe Clipboard
clipboard \case
    Right Text
t ->
      XClipboardEvent -> Sem r ()
forall e resource (r :: EffectRow).
Member (Events resource e) r =>
e -> Sem r ()
Conc.publish (Text -> Selection -> XClipboardEvent
XClipboardEvent Text
t Selection
selection)
    Left Text
e ->
      Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.warn [exon|GTK: #{e}|]

-- |Listen to clipboard events and publish them via 'Events'.
clipboardEvents ::
  Members [Events resource XClipboardEvent, Reader GtkState, Log, Embed IO, Final IO] r =>
  Sem r ()
clipboardEvents :: Sem r ()
clipboardEvents = do
  GtkState {Display
Clipboard
$sel:display:GtkState :: GtkState -> Display
$sel:secondary:GtkState :: GtkState -> Clipboard
$sel:primary:GtkState :: GtkState -> Clipboard
$sel:clipboard:GtkState :: GtkState -> Clipboard
display :: Display
secondary :: Clipboard
primary :: Clipboard
clipboard :: Clipboard
..} <- Sem r GtkState
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  Clipboard -> Selection -> Sem r ()
forall resource (r :: EffectRow).
Members
  '[Events resource XClipboardEvent, Reader GtkState, Log, Embed IO,
    Final IO]
  r =>
Clipboard -> Selection -> Sem r ()
subscribeToClipboard Clipboard
clipboard Selection
Clipboard
  Clipboard -> Selection -> Sem r ()
forall resource (r :: EffectRow).
Members
  '[Events resource XClipboardEvent, Reader GtkState, Log, Embed IO,
    Final IO]
  r =>
Clipboard -> Selection -> Sem r ()
subscribeToClipboard Clipboard
primary Selection
Primary
  Clipboard -> Selection -> Sem r ()
forall resource (r :: EffectRow).
Members
  '[Events resource XClipboardEvent, Reader GtkState, Log, Embed IO,
    Final IO]
  r =>
Clipboard -> Selection -> Sem r ()
subscribeToClipboard Clipboard
secondary Selection
Secondary

-- |Run a GTK main loop and listen to clipboard events, publishing them via 'Events'.
listenXClipboard ::
  Members [Events resource XClipboardEvent, Log, Error Text, Race, Resource, Async, Embed IO, Final IO] r =>
  InterpreterFor (Reader GtkState) r
listenXClipboard :: InterpreterFor (Reader GtkState) r
listenXClipboard Sem (Reader GtkState : r) a
sem =
  Sem (Reader GtkState : r) a -> Sem r a
forall (r :: EffectRow).
Members '[Log, Error Text, Race, Async, Resource, Embed IO] r =>
InterpreterFor (Reader GtkState) r
withMainLoop do
    Sem (Reader GtkState : r) ()
forall resource (r :: EffectRow).
Members
  '[Events resource XClipboardEvent, Reader GtkState, Log, Embed IO,
    Final IO]
  r =>
Sem r ()
clipboardEvents
    Sem (Reader GtkState : r) a
sem

-- |Interpret 'XClipboard' using a GTK backend.
-- This uses the @gi-gtk@ library to access the X11 clipboard.
interpretXClipboardGtk ::
  Members [Reader GtkState, Log, Embed IO, Final IO] r =>
  InterpreterFor XClipboard r
interpretXClipboardGtk :: InterpreterFor XClipboard r
interpretXClipboardGtk = do
  (forall (rInitial :: EffectRow) x.
 XClipboard (Sem rInitial) x -> Sem r x)
-> Sem (XClipboard : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    XClipboard (Sem rInitial) x
Current ->
      Selection -> Sem r (Maybe Text)
forall (r :: EffectRow).
Members '[Reader GtkState, Log, Embed IO] r =>
Selection -> Sem r (Maybe Text)
getClipboardFor Selection
Clipboard
    Set text ->
      Selection -> Text -> Sem r ()
forall (r :: EffectRow).
Members '[Reader GtkState, Log, Embed IO, Final IO] r =>
Selection -> Text -> Sem r ()
setClipboardFor Selection
Clipboard Text
text
    Sync text selection ->
      Text -> Selection -> Sem r ()
forall (r :: EffectRow).
Members '[Reader GtkState, Log, Embed IO, Final IO] r =>
Text -> Selection -> Sem r ()
syncXClipboard Text
text Selection
selection