{-# options_haddock prune #-}
-- |GTK Helpers, Internal
module Helic.Gtk where

import qualified GI.Gdk as Gdk
import GI.Gdk (Display)
import qualified GI.Gtk as GI

import qualified Helic.Data.GtkState as GtkState
import Helic.Data.GtkState (GtkState)
import Helic.Data.Selection (Selection (Clipboard, Primary, Secondary))

gtkClipboard ::
  MonadIO m =>
  Display ->
  Text ->
  m GI.Clipboard
gtkClipboard :: Display -> Text -> m Clipboard
gtkClipboard Display
display Text
name = do
  Atom
selection <- Text -> Bool -> m Atom
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Bool -> m Atom
Gdk.atomIntern Text
name Bool
False
  Display -> Atom -> m Clipboard
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> Atom -> m Clipboard
GI.clipboardGetForDisplay Display
display Atom
selection

subscribe ::
  MonadIO m =>
  GI.Clipboard ->
  (Text -> IO ()) ->
  m ()
subscribe :: Clipboard -> (Text -> IO ()) -> m ()
subscribe Clipboard
clipboard Text -> IO ()
handle =
  m SignalHandlerId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m SignalHandlerId -> m ()) -> m SignalHandlerId -> m ()
forall a b. (a -> b) -> a -> b
$ Clipboard -> ClipboardOwnerChangeCallback -> m SignalHandlerId
forall a (m :: * -> *).
(IsClipboard a, MonadIO m) =>
a -> ClipboardOwnerChangeCallback -> m SignalHandlerId
GI.onClipboardOwnerChange Clipboard
clipboard \ EventOwnerChange
_ ->
    Clipboard -> ClipboardTextReceivedFunc -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClipboard a) =>
a -> ClipboardTextReceivedFunc -> m ()
GI.clipboardRequestText Clipboard
clipboard ((Maybe Text -> IO ()) -> ClipboardTextReceivedFunc
forall a b. a -> b -> a
const ((Text -> IO ()) -> Maybe Text -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
handle))

clipboardFor ::
  Member (Reader GtkState) r =>
  Selection ->
  Sem r GI.Clipboard
clipboardFor :: Selection -> Sem r Clipboard
clipboardFor = \case
  Selection
Clipboard -> (GtkState -> Clipboard) -> Sem r Clipboard
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks GtkState -> Clipboard
GtkState.clipboard
  Selection
Primary -> (GtkState -> Clipboard) -> Sem r Clipboard
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks GtkState -> Clipboard
GtkState.primary
  Selection
Secondary -> (GtkState -> Clipboard) -> Sem r Clipboard
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks GtkState -> Clipboard
GtkState.secondary

getClipboard ::
  MonadIO m =>
  GI.Clipboard ->
  m (Maybe Text)
getClipboard :: Clipboard -> m (Maybe Text)
getClipboard Clipboard
clipboard =
  Clipboard -> m (Maybe Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClipboard a) =>
a -> m (Maybe Text)
GI.clipboardWaitForText Clipboard
clipboard

getClipboardFor ::
  Members [Reader GtkState, Embed IO] r =>
  Selection ->
  Sem r (Maybe Text)
getClipboardFor :: Selection -> Sem r (Maybe Text)
getClipboardFor Selection
sel = do
  Clipboard
cb <- Selection -> Sem r Clipboard
forall (r :: EffectRow).
Member (Reader GtkState) r =>
Selection -> Sem r Clipboard
clipboardFor Selection
sel
  Clipboard -> Sem r (Maybe Text)
forall (m :: * -> *). MonadIO m => Clipboard -> m (Maybe Text)
getClipboard Clipboard
cb

setClipboard ::
  MonadIO m =>
  GI.Clipboard ->
  Text ->
  m ()
setClipboard :: Clipboard -> Text -> m ()
setClipboard Clipboard
clipboard Text
text =
  Clipboard -> Text -> Int32 -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClipboard a) =>
a -> Text -> Int32 -> m ()
GI.clipboardSetText Clipboard
clipboard Text
text (-Int32
1)

setClipboardFor ::
  Members [Reader GtkState, Embed IO] r =>
  Selection ->
  Text ->
  Sem r ()
setClipboardFor :: Selection -> Text -> Sem r ()
setClipboardFor Selection
sel Text
text = do
  Clipboard
cb <- Selection -> Sem r Clipboard
forall (r :: EffectRow).
Member (Reader GtkState) r =>
Selection -> Sem r Clipboard
clipboardFor Selection
sel
  Clipboard -> Text -> Sem r ()
forall (m :: * -> *). MonadIO m => Clipboard -> Text -> m ()
setClipboard Clipboard
cb Text
text

syncXClipboard ::
  Members [Reader GtkState, Embed IO] r =>
  Text ->
  Selection ->
  Sem r ()
syncXClipboard :: Text -> Selection -> Sem r ()
syncXClipboard Text
text = \case
  Selection
Clipboard -> Sem r ()
forall (f :: * -> *). Applicative f => f ()
unit
  Selection
_ -> do
    Clipboard
cb <- (GtkState -> Clipboard) -> Sem r Clipboard
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks GtkState -> Clipboard
GtkState.clipboard
    Clipboard -> Text -> Sem r ()
forall (m :: * -> *). MonadIO m => Clipboard -> Text -> m ()
setClipboard Clipboard
cb Text
text