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

import Polysemy.Chronos (ChronosTime)
import qualified Polysemy.Conc as Conc
import Polysemy.Conc (EventConsumer, Events, withAsync_)
import Polysemy.Tagged (Tagged, untag)

import qualified Helic.Data.Event as Event
import Helic.Data.Event (Event (Event))
import Helic.Data.InstanceName (InstanceName)
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)

-- |Listen for 'XClipboardEvent's and publish them as 'Event's.
transformXEvents ::
  Member (Reader InstanceName) r =>
  Members [EventConsumer xr XClipboardEvent, Events er Event, XClipboard, ChronosTime, Resource, Race, Async] r =>
  Sem r a ->
  Sem r a
transformXEvents :: Sem r a -> Sem r a
transformXEvents =
  Sem r () -> Sem r a -> Sem r a
forall (r :: EffectRow) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ do
    (XClipboardEvent -> Sem r ()) -> Sem r ()
forall e token (r :: EffectRow).
Member (EventConsumer token e) r =>
(e -> Sem r ()) -> Sem r ()
Conc.subscribeLoop \case
      XClipboardEvent Text
text Selection
selection -> do
        Text -> Selection -> Sem r ()
forall (r :: EffectRow).
Member XClipboard r =>
Text -> Selection -> Sem r ()
XClipboard.sync Text
text Selection
selection
        Event
ev <- AgentId -> Text -> Sem r Event
forall (r :: EffectRow).
Members '[ChronosTime, Reader InstanceName] r =>
AgentId -> Text -> Sem r Event
Event.now AgentId
agentIdX Text
text
        Event -> Sem r ()
forall e resource (r :: EffectRow).
Member (Events resource e) r =>
e -> Sem r ()
Conc.publish Event
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 xr XClipboardEvent, Events er Event, Reader InstanceName, XClipboard, ChronosTime] r =>
  Members [Events xr XClipboardEvent, Error Text, Race, Resource, Async, Embed IO, Final IO] r =>
  InterpreterFor (Tagged AgentX Agent) r
interpretAgentX :: InterpreterFor (Tagged AgentX Agent) r
interpretAgentX Sem (Tagged AgentX Agent : r) a
sem =
  Sem r a -> Sem r a
forall (r :: EffectRow) xr er a.
(Member (Reader InstanceName) r,
 Members
   '[EventConsumer xr XClipboardEvent, Events er Event, XClipboard,
     ChronosTime, Resource, Race, Async]
   r) =>
Sem r a -> Sem r a
transformXEvents (Sem r a -> Sem r a) -> Sem r a -> Sem r a
forall a b. (a -> b) -> a -> b
$
  Sem (Agent : r) a
-> (forall (r0 :: EffectRow) x. Agent (Sem r0) x -> Sem r x)
-> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
Sem (e : r) a
-> (forall (r0 :: EffectRow) x. e (Sem r0) x -> Sem r x) -> Sem r a
interpreting (Sem (Tagged AgentX Agent : r) a -> Sem (Agent : r) a
forall k1 (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
untag Sem (Tagged AgentX Agent : r) a
sem) \case
    Update Event {Text
Time
InstanceName
AgentId
$sel:content:Event :: Event -> Text
$sel:time:Event :: Event -> Time
$sel:source:Event :: Event -> AgentId
$sel:sender:Event :: Event -> InstanceName
content :: Text
time :: Time
source :: AgentId
sender :: InstanceName
..} ->
      Text -> Sem r ()
forall (r :: EffectRow). Member XClipboard r => Text -> Sem r ()
XClipboard.set Text
content