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

-- |Send an event to all agents.
broadcast ::
  Members Agents r =>
  Member Log r =>
  Event ->
  Sem r ()
broadcast :: forall (r :: EffectRow).
(Members Agents r, Member Log r) =>
Event -> Sem r ()
broadcast event :: Event
event@(Event InstanceName
_ (AgentId Text
ag) Time
_ Text
text) = do
  forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|broadcasting from #{ag}: #{show text}|]
  forall (tag :: AgentTag) (r :: EffectRow).
(AgentName tag, Member (Agent @@ tag) r) =>
Event -> Sem r ()
runAgent @AgentTmux Event
event
  forall (tag :: AgentTag) (r :: EffectRow).
(AgentName tag, Member (Agent @@ tag) r) =>
Event -> Sem r ()
runAgent @AgentNet Event
event
  forall (tag :: AgentTag) (r :: EffectRow).
(AgentName tag, Member (Agent @@ tag) 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) =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
c ==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.content)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR Event -> Bool
newer
  where
    newer :: Event -> Bool
newer (Event InstanceName
_ AgentId
_ Time
t Text
_) =
      forall dt u i1 i2 diff.
(TimeUnit diff, TimeUnit u, Torsor dt diff, Instant i1 dt,
 Instant i2 dt) =>
i1 -> i2 -> u
diff Time
now Time
t forall a. Ord a => a -> a -> Bool
<= Int64 -> MilliSeconds
MilliSeconds Int64
1000

sanitizeNewlines :: Text -> Text
sanitizeNewlines :: Text -> Text
sanitizeNewlines =
  Text -> Text -> Text -> Text
Text.replace Text
"\r" Text
"\n" 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 event :: Event
event@Event {Text
content :: Text
$sel:content:Event :: Event -> Text
content} =
  Event
event { $sel:content:Event :: Text
content = Text -> Text
sanitizeNewlines Text
content }

-- |Append an event to the history unless the latest event contains the same text, or there was an event within the last
-- second that contained the same text, or the new event has an earlier time stamp than the latest event, 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 -> event :: Event
event@Event {Text
content :: Text
$sel:content:Event :: Event -> Text
content, Time
time :: Time
$sel:time:Event :: Event -> Time
time}) = \case
  Seq Event
Seq.Empty ->
    forall a. a -> Maybe a
Just (forall a. a -> Seq a
Seq.singleton Event
event)
  Seq Event
_ :|> Event InstanceName
_ AgentId
_ Time
latestTime Text
latest | Text
latest forall a. Eq a => a -> a -> Bool
== Text
content Bool -> Bool -> Bool
|| Time
time forall a. Ord a => a -> a -> Bool
< Time
latestTime ->
    forall a. Maybe a
Nothing
  Seq Event
hist | Time -> Event -> Seq Event -> Bool
inRecent Time
now Event
event Seq Event
hist ->
    forall a. Maybe a
Nothing
  Seq Event
hist ->
    forall a. a -> Maybe a
Just (Seq Event
hist forall a. Seq a -> a -> Seq a
|> Event
event)

-- |Add an event to the history unless it is a duplicate.
insertEvent ::
  Members [AtomicState (Seq Event), ChronosTime] r =>
  Event ->
  Sem r Bool
insertEvent :: forall (r :: EffectRow).
Members '[AtomicState (Seq Event), ChronosTime] r =>
Event -> Sem r Bool
insertEvent Event
event = do
  Time
now <- forall t d (r :: EffectRow). Member (Time t d) r => Sem r t
Time.now
  forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ Seq Event
s -> forall {a}. a -> Maybe a -> (a, Bool)
result Seq Event
s (Time -> Event -> Seq Event -> Maybe (Seq Event)
appendIfValid Time
now Event
event 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 :: forall (r :: EffectRow).
Member (AtomicState (Seq Event)) r =>
Int -> Sem r (Maybe Int)
truncateLog Int
maxHistory =
  forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ Seq Event
evs -> do
    let dropped :: Int
dropped = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Event
evs forall a. Num a => a -> a -> a
- Int
maxHistory
    if Int
dropped forall a. Ord a => a -> a -> Bool
> Int
0
    then (forall a. Int -> Seq a -> Seq a
Seq.drop Int
dropped Seq Event
evs, forall a. a -> Maybe a
Just Int
dropped)
    else (Seq Event
evs, forall a. Maybe a
Nothing)

logTruncation ::
  Member Log r =>
  Int ->
  Sem r ()
logTruncation :: forall (r :: EffectRow). Member Log r => Int -> Sem r ()
logTruncation Int
num =
  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 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 :: forall (r :: EffectRow).
(Members Agents r,
 Members '[AtomicState (Seq Event), ChronosTime, Log] r) =>
Maybe Int -> Event -> Sem r ()
receiveEvent Maybe Int
maxHistory Event
event = do
  forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|listen: #{show event}|]
  forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall (r :: EffectRow).
Members '[AtomicState (Seq Event), ChronosTime] r =>
Event -> Sem r Bool
insertEvent Event
event)
    do
      forall (r :: EffectRow).
(Members Agents r, Member Log r) =>
Event -> Sem r ()
broadcast Event
event
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (r :: EffectRow). Member Log r => Int -> Sem r ()
logTruncation forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (r :: EffectRow).
Member (AtomicState (Seq Event)) r =>
Int -> Sem r (Maybe Int)
truncateLog (forall a. a -> Maybe a -> a
fromMaybe Int
100 Maybe Int
maxHistory)
    do forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|Ignoring duplicate event: #{Event.describe event}|]

-- |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 :: forall (r :: EffectRow).
Members '[AtomicState (Seq Event), ChronosTime, Log] r =>
Int -> Sem r (Maybe Event)
loadEvent Int
index = do
  Time
now <- forall t d (r :: EffectRow). Member (Time t d) r => Sem r t
Time.now
  forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ Seq Event
s -> do
    let rindex :: Int
rindex = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Event
s forall a. Num a => a -> a -> a
- Int
index forall a. Num a => a -> a -> a
- Int
1
    case Seq Event
s forall a. Seq a -> Int -> Maybe a
!? Int
rindex of
      Just Event
event ->
        (forall a. Int -> Seq a -> Seq a
Seq.deleteAt Int
rindex Seq Event
s forall a. Seq a -> a -> Seq a
|> Event
event { $sel:time:Event :: Time
time = Time
now }, forall a. a -> Maybe a
Just Event
event)
      Maybe Event
Nothing ->
        (Seq Event
s, 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 :: forall (r :: EffectRow).
Member (Reader InstanceName) r =>
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 <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  pure (InstanceName
name forall a. Eq a => a -> a -> Bool
== InstanceName
sender Bool -> Bool -> Bool
&& AgentId
source forall a. Eq a => a -> a -> Bool
== AgentId
agentIdNet)

-- |Interpret 'History' using 'AtomicState', broadcasting to agents.
interpretHistory ::
  Members Agents r =>
  Members [Reader InstanceName, AtomicState (Seq Event), ChronosTime, Log] r =>
  Maybe Int ->
  InterpreterFor History r
interpretHistory :: forall (r :: EffectRow).
(Members Agents r,
 Members
   '[Reader InstanceName, AtomicState (Seq Event), ChronosTime, Log]
   r) =>
Maybe Int -> InterpreterFor History r
interpretHistory Maybe Int
maxHistory =
  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 ->
      forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet
    History.Receive Event
event ->
      forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall (r :: EffectRow).
Member (Reader InstanceName) r =>
Event -> Sem r Bool
isNetworkCycle Event
event)
        do forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|Ignoring network cycle event: #{Event.describe event}|]
        do 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 Int
index -> do
      Maybe Event
event <- forall (r :: EffectRow).
Members '[AtomicState (Seq Event), ChronosTime, Log] r =>
Int -> Sem r (Maybe Event)
loadEvent Int
index
      Maybe Event
event forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (r :: EffectRow).
(Members Agents r, Member Log r) =>
Event -> Sem r ()
broadcast Maybe Event
event