packages feed

helic-0.6.0.0: lib/Helic/Interpreter/AgentX.hs

-- |Agent Interpreter for X11, Internal
module Helic.Interpreter.AgentX where

import qualified Conc
import Conc (interpretEventsChan, withAsync_)
import Exon (exon)
import Polysemy.Chronos (ChronosTime)
import qualified Polysemy.Log as Log
import Time (MilliSeconds (MilliSeconds), Seconds (Seconds))

import qualified Helic.Data.Event as Event
import Helic.Data.Event (Event (Event))
import Helic.Data.InstanceName (InstanceName)
import qualified Helic.Data.X11Config
import Helic.Data.X11Config (X11Config)
import Helic.Data.XClipboardEvent (XClipboardEvent (XClipboardEvent))
import Helic.Effect.Agent (Agent (Update), AgentX, agentIdX)
import qualified Helic.Effect.XClipboard as XClipboard
import Helic.Effect.XClipboard (XClipboard)
import Helic.GtkClipboard (subscribeEvents)
import Helic.GtkMain (gtkMainLoop)
import Helic.Interpreter.Agent (interpretAgentIf)
import Helic.Interpreter.Gtk (interpretGtk)
import Helic.Interpreter.GtkClipboard (interpretGtkClipboard)
import Helic.Interpreter.GtkMain (interpretGtkMain)
import Helic.Interpreter.XClipboard (interpretXClipboardGtk)

-- |Listen for 'XClipboardEvent's and publish them as 'Event's.
transformXEvents ::
  Members [EventConsumer XClipboardEvent, Reader InstanceName] r =>
  Members [Events Event, XClipboard !! Text, Log, ChronosTime, Resource, Race, Async] r =>
  Sem r a ->
  Sem r a
transformXEvents =
  withAsync_ do
    Conc.subscribeLoop \case
      XClipboardEvent text selection -> do
        XClipboard.sync text selection !! \ e ->
          Log.error [exon|Syncing the X clipboard failed: #{e}|]
        ev <- Event.now agentIdX text
        Conc.publish ev

-- |Interpret 'Agent' using the X11 clipboard as target.
-- This interpreter also runs a thread that converts events generated by the 'XClipboard' interpreter
-- ('XClipboardEvent') to the main 'Event' type.
interpretAgentX ::
  Members [EventConsumer XClipboardEvent, Events Event, Reader InstanceName, XClipboard !! Text] r =>
  Members [ChronosTime, Log, Race, Resource, Async] r =>
  InterpreterFor Agent r
interpretAgentX =
  transformXEvents .
  interpret \case
    Update Event {..} ->
      XClipboard.set content !! \ e ->
        Log.error [exon|Setting the X clipboard failed: #{e}|]

-- | Interpret 'Agent' for X11 if it is enabled by the configuration.
interpretX ::
  Members [Reader X11Config, Events Event, Reader InstanceName] r =>
  Members [ChronosTime, Log, Error Text, Race, Resource, Mask, Async, Embed IO, Final IO] r =>
  InterpreterFor (Agent @@ AgentX) r
interpretX =
  interpretAgentIf @X11Config $
  interpretEventsChan @XClipboardEvent .
  interpretGtk .
  interpretGtkMain (MilliSeconds 500) (Seconds 10) .
  interpretGtkClipboard .
  gtkMainLoop subscribeEvents .
  interpretXClipboardGtk .
  interpretAgentX .
  insertAt @1