-- |Event Data Type
module Helic.Data.Event where

import qualified Chronos
import Polysemy.Chronos (ChronosTime)
import qualified Polysemy.Time as Time

import Helic.Data.AgentId (AgentId)
import Helic.Data.InstanceName (InstanceName)

-- |The central data type representing a clipboard event.
data Event =
  Event {
    -- |The host from which the event originated.
    Event -> InstanceName
sender :: InstanceName,
    -- |The entity that caused the event.
    Event -> AgentId
source :: AgentId,
    -- |Timestamp.
    Event -> Time
time :: Chronos.Time,
    -- |Payload.
    Event -> Text
content :: Text
  }
  deriving stock (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

defaultJson ''Event

-- |Construct an event for the current host and time.
now ::
  Members [ChronosTime, Reader InstanceName] r =>
  AgentId ->
  Text ->
  Sem r Event
now :: AgentId -> Text -> Sem r Event
now AgentId
source Text
content = do
  InstanceName
sender <- Sem r InstanceName
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  Time
time <- Sem r Time
forall t d (r :: EffectRow). Member (Time t d) r => Sem r t
Time.now
  pure Event :: InstanceName -> AgentId -> Time -> Text -> Event
Event {Text
Time
InstanceName
AgentId
time :: Time
sender :: InstanceName
content :: Text
source :: AgentId
$sel:content:Event :: Text
$sel:time:Event :: Time
$sel:source:Event :: AgentId
$sel:sender:Event :: InstanceName
..}