-- |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 Polysemy.Final (withWeavingToFinal)
import Polysemy.Reader (runReader)
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 [Resource, Error Text, Race, Async, 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 (m :: * -> *).
(IsDescendantOf Display a, MonadIO m, GObject a) =>
a -> m ()
release \ Display
display -> do
    Clipboard
clipboard <- Display -> Text -> Sem r Clipboard
forall (m :: * -> *). MonadIO m => Display -> Text -> m Clipboard
gtkClipboard Display
display Text
"CLIPBOARD"
    Clipboard
primary <- Display -> Text -> Sem r Clipboard
forall (m :: * -> *). MonadIO m => Display -> Text -> m Clipboard
gtkClipboard Display
display Text
"PRIMARY"
    Clipboard
secondary <- Display -> Text -> Sem r Clipboard
forall (m :: * -> *). MonadIO m => Display -> Text -> m Clipboard
gtkClipboard Display
display Text
"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 -> m ()
release a
display = do
      a -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m ()
Gdk.displayFlush a
display
      a -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m ()
Gdk.displayClose a
display
      m ()
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, Embed IO, Final IO] r =>
  GI.Clipboard ->
  Selection ->
  Sem r ()
subscribeToClipboard :: Clipboard -> Selection -> Sem r ()
subscribeToClipboard Clipboard
clipboard Selection
selection =
  ThroughWeavingToFinal IO (Sem r) () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
ThroughWeavingToFinal m (Sem r) a -> Sem r a
withWeavingToFinal \ f ()
s forall x. f (Sem r x) -> IO (f x)
wv forall x. f x -> Maybe x
_ -> do
    f ()
s f () -> IO () -> IO (f ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Clipboard -> (Text -> IO ()) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Clipboard -> (Text -> IO ()) -> m ()
Gtk.subscribe Clipboard
clipboard \ Text
t ->
      IO (f ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f (Sem r ()) -> IO (f ())
forall x. f (Sem r x) -> IO (f x)
wv (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) Sem r () -> f () -> f (Sem r ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s))

-- |Listen to clipboard events and publish them via 'Events'.
clipboardEvents ::
  Members [Events resource XClipboardEvent, Reader GtkState, 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, 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, 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, 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, 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 r a
forall (r :: EffectRow).
Members '[Resource, Error Text, Race, Async, Embed IO] r =>
InterpreterFor (Reader GtkState) r
withMainLoop (Sem (Reader GtkState : r) a -> Sem r a)
-> (Sem (Reader GtkState : r) a -> Sem (Reader GtkState : r) a)
-> Sem (Reader GtkState : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 resource (r :: EffectRow).
Members
  '[Events resource XClipboardEvent, Reader GtkState, Embed IO,
    Final IO]
  r =>
Sem r ()
clipboardEvents

-- |Interpret 'XClipboard' using a GTK backend.
-- This uses the @gi-gtk@ library to access the X11 clipboard.
interpretXClipboardGtk ::
  Members [Reader GtkState, Embed 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, Embed IO] r =>
Selection -> Sem r (Maybe Text)
getClipboardFor Selection
Clipboard
    Set text ->
      Selection -> Text -> Sem r ()
forall (r :: EffectRow).
Members '[Reader GtkState, Embed IO] r =>
Selection -> Text -> Sem r ()
setClipboardFor Selection
Clipboard Text
text
    Sync text selection ->
      Text -> Selection -> Sem r ()
forall (r :: EffectRow).
Members '[Reader GtkState, Embed IO] r =>
Text -> Selection -> Sem r ()
syncXClipboard Text
text Selection
selection