Listen.hs

{-# options_haddock prune #-}
-- |Daemon Logic, Internal
module Helic.Listen where

import qualified Chronos
import qualified Data.Sequence as Seq
import Data.Sequence (Seq ((:|>)), (|>))
import Polysemy.AtomicState (atomicState')
import Polysemy.Chronos (ChronosTime)
import qualified Polysemy.Conc as Conc
import Polysemy.Conc (EventConsumer)
import qualified Polysemy.Log as Log
import Polysemy.Log (Log)
import Polysemy.Tagged (Tagged, tag)
import qualified Polysemy.Time as Time
import Polysemy.Time (Seconds (Seconds), convert)
import Polysemy.Time.Diff (diff)

import Helic.Data.AgentId (AgentId (AgentId))
import qualified Helic.Data.Event as Event
import Helic.Data.Event (Event (Event))
import qualified Helic.Effect.Agent as Agent
import Helic.Effect.Agent (Agent, AgentName, AgentNet, AgentTag, AgentTmux, AgentX, Agents, agentName)

runAgent ::
  ∀ (tag :: AgentTag) r .
  AgentName tag =>
  Member (Tagged tag Agent) r =>
  Event ->
  Sem r ()
runAgent (Event _ (AgentId eId) _ _) | eId == agentName @tag =
  unit
runAgent e =
  tag (Agent.update e)

broadcast ::
  Members Agents r =>
  Member Log r =>
  Event ->
  Sem r ()
broadcast event@(Event _ (AgentId ag) _ text) = do
  Log.debug [exon|broadcasting from #{ag}: #{show text}|]
  runAgent @AgentTmux event
  runAgent @AgentNet event
  runAgent @AgentX event

inRecent ::
  Chronos.Time ->
  Event ->
  Seq Event ->
  Bool
inRecent now (Event _ _ _ c) =
  any ((c ==) . Event.content) . Seq.takeWhileR newer
  where
    newer (Event _ _ t _) =
      diff now t <= convert (Seconds 1)

appendIfValid ::
  Chronos.Time ->
  Event ->
  Seq Event ->
  Maybe (Seq Event)
appendIfValid now e = \case
  Seq.Empty ->
    Just (Seq.singleton e)
  _ :|> Event _ _ _ newest | newest == Event.content e ->
    Nothing
  hist | inRecent now e hist ->
    Nothing
  hist ->
    Just (hist |> e)

insertEvent ::
  Members [AtomicState (Seq Event), ChronosTime] r =>
  Event ->
  Sem r Bool
insertEvent e = do
  now <- Time.now
  atomicState' \ s -> result s (appendIfValid now e s)
  where
    result s = \case
      Just new -> (new, True)
      Nothing -> (s, False)

truncateLog ::
  Member (AtomicState (Seq Event)) r =>
  Int ->
  Sem r ()
truncateLog maxHistory =
  atomicModify' \ evs ->
    if length evs > maxHistory
    then Seq.drop 1 evs
    else evs

-- |Listen for 'Event' via 'Polysemy.Conc.Events', broadcasting them to agents.
listen ::
  Members Agents r =>
  Members [EventConsumer token Event, AtomicState (Seq Event), ChronosTime, Log] r =>
  Maybe Int ->
  Sem r ()
listen maxHistory =
  Conc.subscribeLoop \ e ->
    whenM (insertEvent e) (broadcast e *> truncateLog (fromMaybe 100 maxHistory))