Gtk.hs

{-# 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 name = do
  selection <- Gdk.atomIntern name False
  GI.clipboardGetForDisplay display selection

subscribe ::
  MonadIO m =>
  GI.Clipboard ->
  (Text -> IO ()) ->
  m ()
subscribe clipboard handle =
  void $ GI.onClipboardOwnerChange clipboard \ _ ->
    GI.clipboardRequestText clipboard (const (traverse_ handle))

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

getClipboard ::
  MonadIO m =>
  GI.Clipboard ->
  m (Maybe Text)
getClipboard clipboard =
  GI.clipboardWaitForText clipboard

getClipboardFor ::
  Members [Reader GtkState, Embed IO] r =>
  Selection ->
  Sem r (Maybe Text)
getClipboardFor sel = do
  cb <- clipboardFor sel
  getClipboard cb

setClipboard ::
  MonadIO m =>
  GI.Clipboard ->
  Text ->
  m ()
setClipboard clipboard text =
  GI.clipboardSetText clipboard text (-1)

setClipboardFor ::
  Members [Reader GtkState, Embed IO] r =>
  Selection ->
  Text ->
  Sem r ()
setClipboardFor sel text = do
  cb <- clipboardFor sel
  setClipboard cb text

syncXClipboard ::
  Members [Reader GtkState, Embed IO] r =>
  Text ->
  Selection ->
  Sem r ()
syncXClipboard text = \case
  Clipboard -> unit
  _ -> do
    cb <- asks GtkState.clipboard
    setClipboard cb text