{-# 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 -> Sem r ()
runAgent (Event InstanceName
_ (AgentId Text
eId) Time
_ Text
_) | Text
eId Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== AgentName tag => Text
forall (tag :: AgentTag). AgentName tag => Text
agentName @tag =
  Sem r ()
forall (f :: * -> *). Applicative f => f ()
unit
runAgent Event
e =
  Sem (Agent : r) () -> Sem r ()
forall k1 (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
tag (Event -> Sem (Agent : r) ()
forall (r :: EffectRow). Member Agent r => Event -> Sem r ()
Agent.update Event
e)

broadcast ::
  Members Agents r =>
  Member Log r =>
  Event ->
  Sem r ()
broadcast :: Event -> Sem r ()
broadcast event :: Event
event@(Event InstanceName
_ (AgentId Text
ag) Time
_ Text
text) = do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|broadcasting from #{ag}: #{show text}|]
  Event -> Sem r ()
forall (tag :: AgentTag) (r :: EffectRow).
(AgentName tag, Member (Tagged tag Agent) r) =>
Event -> Sem r ()
runAgent @AgentTmux Event
event
  Event -> Sem r ()
forall (tag :: AgentTag) (r :: EffectRow).
(AgentName tag, Member (Tagged tag Agent) r) =>
Event -> Sem r ()
runAgent @AgentNet Event
event
  Event -> Sem r ()
forall (tag :: AgentTag) (r :: EffectRow).
(AgentName tag, Member (Tagged tag Agent) r) =>
Event -> Sem r ()
runAgent @AgentX Event
event

inRecent ::
  Chronos.Time ->
  Event ->
  Seq Event ->
  Bool
inRecent :: Time -> Event -> Seq Event -> Bool
inRecent Time
now (Event InstanceName
_ AgentId
_ Time
_ Text
c) =
  (Event -> Bool) -> Seq Event -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> (Event -> Text) -> Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Text
Event.content) (Seq Event -> Bool)
-> (Seq Event -> Seq Event) -> Seq Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Bool) -> Seq Event -> Seq Event
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR Event -> Bool
newer
  where
    newer :: Event -> Bool
newer (Event InstanceName
_ AgentId
_ Time
t Text
_) =
      Time -> Time -> Timespan
forall dt u i1 i2.
(TimeUnit u, Torsor dt u, Instant i1 dt, Instant i2 dt) =>
i1 -> i2 -> u
diff Time
now Time
t Timespan -> Timespan -> Bool
forall a. Ord a => a -> a -> Bool
<= Seconds -> Timespan
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert (Int64 -> Seconds
Seconds Int64
1)

appendIfValid ::
  Chronos.Time ->
  Event ->
  Seq Event ->
  Maybe (Seq Event)
appendIfValid :: Time -> Event -> Seq Event -> Maybe (Seq Event)
appendIfValid Time
now Event
e = \case
  Seq Event
Seq.Empty ->
    Seq Event -> Maybe (Seq Event)
forall a. a -> Maybe a
Just (Event -> Seq Event
forall a. a -> Seq a
Seq.singleton Event
e)
  Seq Event
_ :|> Event InstanceName
_ AgentId
_ Time
_ Text
newest | Text
newest Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Event -> Text
Event.content Event
e ->
    Maybe (Seq Event)
forall a. Maybe a
Nothing
  Seq Event
hist | Time -> Event -> Seq Event -> Bool
inRecent Time
now Event
e Seq Event
hist ->
    Maybe (Seq Event)
forall a. Maybe a
Nothing
  Seq Event
hist ->
    Seq Event -> Maybe (Seq Event)
forall a. a -> Maybe a
Just (Seq Event
hist Seq Event -> Event -> Seq Event
forall a. Seq a -> a -> Seq a
|> Event
e)

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

truncateLog ::
  Member (AtomicState (Seq Event)) r =>
  Int ->
  Sem r ()
truncateLog :: Int -> Sem r ()
truncateLog Int
maxHistory =
  (Seq Event -> Seq Event) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' \ Seq Event
evs ->
    if Seq Event -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Event
evs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxHistory
    then Int -> Seq Event -> Seq Event
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq Event
evs
    else Seq Event
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 :: Maybe Int -> Sem r ()
listen Maybe Int
maxHistory =
  (Event -> Sem r ()) -> Sem r ()
forall e token (r :: EffectRow).
Member (EventConsumer token e) r =>
(e -> Sem r ()) -> Sem r ()
Conc.subscribeLoop \ Event
e ->
    Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Event -> Sem r Bool
forall (r :: EffectRow).
Members '[AtomicState (Seq Event), ChronosTime] r =>
Event -> Sem r Bool
insertEvent Event
e) (Event -> Sem r ()
forall (r :: EffectRow).
(Members Agents r, Member Log r) =>
Event -> Sem r ()
broadcast Event
e Sem r () -> Sem r () -> Sem r ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState (Seq Event)) r =>
Int -> Sem r ()
truncateLog (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
100 Maybe Int
maxHistory))