-- |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 :: forall (r :: EffectRow) a.
(Members '[EventConsumer XClipboardEvent, Reader InstanceName] r,
 Members
   '[Events Event, XClipboard !! Text, Log, ChronosTime, Resource,
     Race, Async]
   r) =>
Sem r a -> Sem r a
transformXEvents =
  forall (r :: EffectRow) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ do
    forall e (r :: EffectRow).
Member (EventConsumer e) r =>
(e -> Sem r ()) -> Sem r ()
Conc.subscribeLoop \case
      XClipboardEvent Text
text Selection
selection -> do
        forall (r :: EffectRow).
Member XClipboard r =>
Text -> Selection -> Sem r ()
XClipboard.sync Text
text Selection
selection forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! \ Text
e ->
          forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|Syncing the X clipboard failed: #{e}|]
        Event
ev <- forall (r :: EffectRow).
Members '[ChronosTime, Reader InstanceName] r =>
AgentId -> Text -> Sem r Event
Event.now AgentId
agentIdX Text
text
        forall e (r :: EffectRow). Member (Events 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 XClipboardEvent, Events Event, Reader InstanceName, XClipboard !! Text] r =>
  Members [ChronosTime, Log, Race, Resource, Async] r =>
  InterpreterFor Agent r
interpretAgentX :: forall (r :: EffectRow).
(Members
   '[EventConsumer XClipboardEvent, Events Event, Reader InstanceName,
     XClipboard !! Text]
   r,
 Members '[ChronosTime, Log, Race, Resource, Async] r) =>
InterpreterFor Agent r
interpretAgentX =
  forall (r :: EffectRow) a.
(Members '[EventConsumer XClipboardEvent, Reader InstanceName] r,
 Members
   '[Events Event, XClipboard !! Text, Log, ChronosTime, Resource,
     Race, Async]
   r) =>
Sem r a -> Sem r a
transformXEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \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
..} ->
      forall (r :: EffectRow). Member XClipboard r => Text -> Sem r ()
XClipboard.set Text
content forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! \ Text
e ->
        forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
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 :: forall (r :: EffectRow).
(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 =
  forall {k} conf (r :: EffectRow) (id :: k).
(HasField "enable" conf (Maybe Bool), Member (Reader conf) r) =>
InterpreterFor Agent r -> InterpreterFor (Agent @@ id) r
interpretAgentIf @X11Config forall a b. (a -> b) -> a -> b
$
  forall e (r :: EffectRow).
Members '[Resource, Race, Async, Embed IO] r =>
InterpretersFor '[Events e, EventConsumer e] r
interpretEventsChan @XClipboardEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (r :: EffectRow).
Members '[Reader X11Config, Resource, Log, Embed IO] r =>
InterpreterFor (Scoped_ (Gtk Display) !! Text) r
interpretGtk forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall s wait restart (r :: EffectRow).
(TimeUnit wait, TimeUnit restart,
 Members '[Mask, Resource, Race, Embed IO] r) =>
wait -> restart -> InterpreterFor (GtkMain s) r
interpretGtkMain (Int64 -> MilliSeconds
MilliSeconds Int64
500) (Int64 -> Seconds
Seconds Int64
10) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (r :: EffectRow).
Members '[GtkMain Display, Log, Embed IO, Final IO] r =>
InterpreterFor (Scoped_ GtkClipboard !! Text) r
interpretGtkClipboard forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall s (r :: EffectRow) a.
Members
  '[Scoped_ (Gtk s) !! Text, GtkMain s, Log, Race, Resource, Async]
  r =>
Sem r () -> Sem r a -> Sem r a
gtkMainLoop forall (r :: EffectRow).
Members
  '[Scoped_ GtkClipboard !! Text, Events XClipboardEvent, Log] r =>
Sem r ()
subscribeEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (r :: EffectRow).
Members
  '[Scoped_ GtkClipboard !! Text, Log, Embed IO, Final IO] r =>
InterpreterFor (XClipboard !! Text) r
interpretXClipboardGtk forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (r :: EffectRow).
(Members
   '[EventConsumer XClipboardEvent, Events Event, Reader InstanceName,
     XClipboard !! Text]
   r,
 Members '[ChronosTime, Log, Race, Resource, Async] r) =>
InterpreterFor Agent r
interpretAgentX forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (index :: Nat) (inserted :: EffectRow) (head :: EffectRow)
       (oldTail :: EffectRow) (tail :: EffectRow) (old :: EffectRow)
       (full :: EffectRow) a.
(ListOfLength index head, WhenStuck index InsertAtUnprovidedIndex,
 old ~ Append head oldTail, tail ~ Append inserted oldTail,
 full ~ Append head tail,
 InsertAtIndex index head tail oldTail full inserted) =>
Sem old a -> Sem full a
insertAt @1