{-# options_haddock prune #-}

-- |Core daemon logic, Internal
module Helic.Interpreter.History where

import qualified Chronos
import qualified Data.Sequence as Seq
import Data.Sequence (Seq ((:|>)), (!?), (|>))
import qualified Data.Text as Text
import Exon (exon)
import Polysemy.Chronos (ChronosTime)
import qualified Polysemy.Log as Log
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, content, time))
import Helic.Data.InstanceName (InstanceName)
import qualified Helic.Effect.Agent as Agent
import Helic.Effect.Agent (Agent, AgentName, AgentNet, AgentTag, AgentTmux, AgentX, Agents, agentIdNet, agentName)
import qualified Helic.Effect.History as History
import Helic.Effect.History (History)

-- |Send an event to an agent unless it was published by that agent.
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)

-- |Send an event to all agents.
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

-- |Whether there was an event within the last second that contained the same text as the current 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)

sanitizeNewlines :: Text -> Text
sanitizeNewlines :: Text -> Text
sanitizeNewlines =
  Text -> Text -> Text -> Text
Text.replace Text
"\r" Text
"\n" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
"\r\n" Text
"\n"

sanitize :: Event -> Event
sanitize :: Event -> Event
sanitize e :: Event
e@Event {Text
content :: Text
$sel:content:Event :: Event -> Text
content} =
  Event
e { $sel:content:Event :: Text
content = Text -> Text
sanitizeNewlines Text
content }

-- |Append an event to the history unless the newest event contains the same text or there was an event within the last
-- second that contained the same text, to avoid clobbering due to cycles induced by external programs.
appendIfValid ::
  Chronos.Time ->
  Event ->
  Seq Event ->
  Maybe (Seq Event)
appendIfValid :: Time -> Event -> Seq Event -> Maybe (Seq Event)
appendIfValid Time
now (Event -> Event
sanitize -> e :: Event
e@Event {Text
content :: Text
$sel:content:Event :: Event -> Text
content}) = \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
== Text
content ->
    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)

-- |Add an event to the history unless it is a duplicate.
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)

-- |Remove excess entries from the front of the 'Seq', given a maximum number of entries.
-- Return the number of dropped entries.
truncateLog ::
  Member (AtomicState (Seq Event)) r =>
  Int ->
  Sem r (Maybe Int)
truncateLog :: Int -> Sem r (Maybe Int)
truncateLog Int
maxHistory =
  (Seq Event -> (Seq Event, Maybe Int)) -> Sem r (Maybe Int)
forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ Seq Event
evs -> do
    let dropped :: Int
dropped = Seq Event -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Event
evs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxHistory
    if Int
dropped Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then (Int -> Seq Event -> Seq Event
forall a. Int -> Seq a -> Seq a
Seq.drop Int
dropped Seq Event
evs, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dropped)
    else (Seq Event
evs, Maybe Int
forall a. Maybe a
Nothing)

logTruncation ::
  Member Log r =>
  Int ->
  Sem r ()
logTruncation :: Int -> Sem r ()
logTruncation Int
num =
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|removed #{show num} #{noun} from the history.|]
  where
    noun :: Text
noun =
      if Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"entry" else Text
"entries"

-- |Process an event received from outside.
receiveEvent ::
  Members Agents r =>
  Members [AtomicState (Seq Event), ChronosTime, Log] r =>
  Maybe Int ->
  Event ->
  Sem r ()
receiveEvent :: Maybe Int -> Event -> Sem r ()
receiveEvent Maybe Int
maxHistory Event
e = do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|listen: #{show 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) do
    Event -> Sem r ()
forall (r :: EffectRow).
(Members Agents r, Member Log r) =>
Event -> Sem r ()
broadcast Event
e
    (Int -> Sem r ()) -> Maybe Int -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Int -> Sem r ()
forall (r :: EffectRow). Member Log r => Int -> Sem r ()
logTruncation (Maybe Int -> Sem r ()) -> Sem r (Maybe Int) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Sem r (Maybe Int)
forall (r :: EffectRow).
Member (AtomicState (Seq Event)) r =>
Int -> Sem r (Maybe Int)
truncateLog (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
100 Maybe Int
maxHistory)

-- |Re-broadcast an older event from the history at the given index (ordered by increasing age) and move it to the end
-- of the history.
loadEvent ::
  Members [AtomicState (Seq Event), ChronosTime, Log] r =>
  Int ->
  Sem r (Maybe Event)
loadEvent :: Int -> Sem r (Maybe Event)
loadEvent Int
index = 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, Maybe Event)) -> Sem r (Maybe Event)
forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ Seq Event
s -> do
    let rindex :: Int
rindex = Seq Event -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Event
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    case (Seq Event
s Seq Event -> Int -> Maybe Event
forall a. Seq a -> Int -> Maybe a
!? Int
rindex) of
      Just Event
event ->
        (Int -> Seq Event -> Seq Event
forall a. Int -> Seq a -> Seq a
Seq.deleteAt Int
rindex Seq Event
s Seq Event -> Event -> Seq Event
forall a. Seq a -> a -> Seq a
|> Event
event { $sel:time:Event :: Time
time = Time
now }, Event -> Maybe Event
forall a. a -> Maybe a
Just Event
event)
      Maybe Event
Nothing ->
        (Seq Event
s, Maybe Event
forall a. Maybe a
Nothing)

-- |In the unlikely case of a remote host sending an event back to this instance and not updating the sender, this will
-- be 'True'.
isNetworkCycle ::
  Member (Reader InstanceName) r =>
  Event ->
  Sem r Bool
isNetworkCycle :: Event -> Sem r Bool
isNetworkCycle Event {Text
Time
AgentId
InstanceName
$sel:source:Event :: Event -> AgentId
$sel:sender:Event :: Event -> InstanceName
content :: Text
time :: Time
source :: AgentId
sender :: InstanceName
$sel:time:Event :: Event -> Time
$sel:content:Event :: Event -> Text
..} = do
  InstanceName
name <- Sem r InstanceName
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  pure (InstanceName
name InstanceName -> InstanceName -> Bool
forall a. Eq a => a -> a -> Bool
== InstanceName
sender Bool -> Bool -> Bool
&& AgentId
source AgentId -> AgentId -> Bool
forall a. Eq a => a -> a -> Bool
== AgentId
agentIdNet)

-- |Interpret 'History' as 'AtomicState', broadcasting to agents.
interpretHistory ::
  Members Agents r =>
  Members [Reader InstanceName, AtomicState (Seq Event), ChronosTime, Log] r =>
  Maybe Int ->
  InterpreterFor History r
interpretHistory :: Maybe Int -> InterpreterFor History r
interpretHistory Maybe Int
maxHistory =
  (forall (rInitial :: EffectRow) x.
 History (Sem rInitial) x -> Sem r x)
-> Sem (History : r) a -> Sem r a
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
    History (Sem rInitial) x
History.Get ->
      Seq Event -> [Event]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Event -> [Event]) -> Sem r (Seq Event) -> Sem r [Event]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (Seq Event)
forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet
    History.Receive event ->
      Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Event -> Sem r Bool
forall (r :: EffectRow).
Member (Reader InstanceName) r =>
Event -> Sem r Bool
isNetworkCycle Event
event) do
        Maybe Int -> Event -> Sem r ()
forall (r :: EffectRow).
(Members Agents r,
 Members '[AtomicState (Seq Event), ChronosTime, Log] r) =>
Maybe Int -> Event -> Sem r ()
receiveEvent Maybe Int
maxHistory Event
event
    History.Load index -> do
      Maybe Event
e <- Int -> Sem r (Maybe Event)
forall (r :: EffectRow).
Members '[AtomicState (Seq Event), ChronosTime, Log] r =>
Int -> Sem r (Maybe Event)
loadEvent Int
index
      Maybe Event
e Maybe Event -> Sem r () -> Sem r (Maybe Event)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Event -> Sem r ()) -> Maybe Event -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Event -> Sem r ()
forall (r :: EffectRow).
(Members Agents r, Member Log r) =>
Event -> Sem r ()
broadcast Maybe Event
e