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

import qualified Conc
import Conc (withAsync_)
import Exon (exon)
import Polysemy.Chronos (ChronosTime)
import qualified Polysemy.Log as Log

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)
import Helic.Interpreter (interpreting)

-- |Listen for 'XClipboardEvent's and publish them as 'Event's.
transformXEvents ::
  Members [EventConsumer xr XClipboardEvent, Reader InstanceName] r =>
  Members [Events er Event, XClipboard !! Text, Log, 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 (XClipboard : r) ()
forall (r :: EffectRow).
Member XClipboard r =>
Text -> Selection -> Sem r ()
XClipboard.sync Text
text Selection
selection Sem (XClipboard : r) () -> (Text -> Sem r ()) -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! \ Text
e ->
          Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|Syncing the X clipboard failed: #{e}|]
        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 !! Text, ChronosTime] r =>
  Members [Events xr XClipboardEvent, Log, 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 xr (r :: EffectRow) er a.
(Members
   '[EventConsumer xr XClipboardEvent, Reader InstanceName] r,
 Members
   '[Events er Event, XClipboard !! Text, Log, 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
AgentId
InstanceName
$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 (XClipboard : r) ()
forall (r :: EffectRow). Member XClipboard r => Text -> Sem r ()
XClipboard.set Text
content Sem (XClipboard : r) () -> (Text -> Sem r ()) -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! \ Text
e ->
        Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|Setting the X clipboard failed: #{e}|]