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)
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
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}|]
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