{-# LANGUAGE TemplateHaskell #-}

-- | This module provides functionality for handling events.
module Navi.Event
  ( -- * Event type
    Event (..),
    AnyEvent (..),
    runEvent,

    -- * Results
    EventSuccess (..),
    EventError (..),

    -- * Caching previous events/errors
    RepeatEvent (..),
    ErrorNote (..),
    blockRepeat,
    blockErr,
    updatePrevTrigger,
  )
where

import Effects.LoggerNamespace (MonadLoggerNamespace (..), addNamespace)
import Navi.Effects (MonadSystemInfo (..))
import Navi.Event.Types
  ( AnyEvent (..),
    ErrorNote (..),
    Event (..),
    EventError (..),
    EventSuccess (..),
    RepeatEvent (..),
  )
import Navi.Prelude

-- | Runs an event, i.e.,
--
-- 1. Queries the system via 'MonadSystemInfo'.
-- 2. Returns the parsed result.
runEvent ::
  ( HasCallStack,
    MonadLoggerNamespace m,
    MonadSTM m,
    MonadSystemInfo m,
    Show result
  ) =>
  Event result ->
  m (EventSuccess result)
runEvent :: forall (m :: Type -> Type) result.
(HasCallStack, MonadLoggerNamespace m, MonadSTM m,
 MonadSystemInfo m, Show result) =>
Event result -> m (EventSuccess result)
runEvent Event result
event = forall (m :: Type -> Type) a.
MonadLoggerNamespace m =>
Text -> m a -> m a
addNamespace Text
"runEvent" forall a b. (a -> b) -> a -> b
$ do
  result
result <- forall (m :: Type -> Type) result.
(MonadSystemInfo m, HasCallStack) =>
ServiceType result -> m result
query forall a b. (a -> b) -> a -> b
$ Event result
event forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "serviceType" a => a
#serviceType
  $(logInfo) (Text
"Shell returned: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt result
result)
  pure $
    MkEventSuccess
      { result
$sel:result:MkEventSuccess :: result
result :: result
result,
        $sel:repeatEvent:MkEventSuccess :: RepeatEvent result
repeatEvent = Event result
event forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "repeatEvent" a => a
#repeatEvent,
        $sel:raiseAlert:MkEventSuccess :: result -> Maybe NaviNote
raiseAlert = Event result
event forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "raiseAlert" a => a
#raiseAlert
      }
{-# INLINEABLE runEvent #-}

-- | Determines if we should block the event. The semantics are:
--
-- 1. 'AllowRepeats': never block (returns 'False').
-- 2. 'NoRepeats': block only if the parameter @a@ equals the previous @a@
--    stored in our @ref@.
blockRepeat ::
  ( Eq a,
    MonadLoggerNamespace m,
    MonadIORef m,
    Show a
  ) =>
  RepeatEvent a ->
  a ->
  m Bool
blockRepeat :: forall a (m :: Type -> Type).
(Eq a, MonadLoggerNamespace m, MonadIORef m, Show a) =>
RepeatEvent a -> a -> m Bool
blockRepeat RepeatEvent a
repeatEvent a
newVal = forall (m :: Type -> Type) a.
MonadLoggerNamespace m =>
Text -> m a -> m a
addNamespace Text
"blockRepeat" forall a b. (a -> b) -> a -> b
$ do
  case RepeatEvent a
repeatEvent of
    -- Repeat events are allowed, so do not block.
    RepeatEvent a
AllowRepeats -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False
    -- Repeat events are not allowed, must check.
    NoRepeats IORef (Maybe a)
prevRef -> do
      Maybe a
prevVal <- forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef (Maybe a)
prevRef
      $(logDebug) (Text
"Previous value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Maybe a
prevVal)
      $(logDebug) (Text
"New value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt a
newVal)
      if Maybe a
prevVal forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just a
newVal
        then -- Already sent this alert, block.
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True
        else -- New alert, do not block.
        do
          forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe a)
prevRef forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
newVal
          pure Bool
False
{-# INLINEABLE blockRepeat #-}

-- | Determines if we should block the error event. The semantics are:
--
-- 1. 'NoErrNote': always block (returns 'True').
-- 2. 'AllowErrNote' 'AllowRepeats': never block (returns 'False').
-- 3. 'AllowErrNote' 'NoRepeats': block only if we have sent a notifcation
--    for this error before.
blockErr ::
  ( MonadLoggerNamespace m,
    MonadIORef m
  ) =>
  ErrorNote ->
  m Bool
blockErr :: forall (m :: Type -> Type).
(MonadLoggerNamespace m, MonadIORef m) =>
ErrorNote -> m Bool
blockErr ErrorNote
errorEvent = forall (m :: Type -> Type) a.
MonadLoggerNamespace m =>
Text -> m a -> m a
addNamespace Text
"blockErr" forall a b. (a -> b) -> a -> b
$ do
  case ErrorNote
errorEvent of
    -- Error events are off, block.
    ErrorNote
NoErrNote -> do
      $(logDebug) Text
"Error notes are off"
      pure Bool
True
    -- Error events are on and repeats allowed, do not block.
    AllowErrNote RepeatEvent ()
AllowRepeats -> do
      $(logDebug) Text
"Error notes are on and repeats allowed"
      pure Bool
False
    -- Error events are on but repeats not allowed, must check.
    AllowErrNote (NoRepeats IORef (Maybe ())
ref) -> do
      Maybe ()
prevErr <- forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef (Maybe ())
ref
      case Maybe ()
prevErr of
        -- Already sent this error, block
        Just () -> do
          $(logDebug) Text
"Already sent error"
          pure Bool
True
        -- Error not send, do not block
        Maybe ()
Nothing -> do
          $(logDebug) Text
"Send error"
          forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe ())
ref forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ()
          pure Bool
False
{-# INLINEABLE blockErr #-}

-- | If the reference is 'NoRepeats' then we overwrite the previous reference
-- with the new parameter. Otherwise we do nothing.
updatePrevTrigger :: (Eq a, MonadIORef m) => RepeatEvent a -> a -> m ()
updatePrevTrigger :: forall a (m :: Type -> Type).
(Eq a, MonadIORef m) =>
RepeatEvent a -> a -> m ()
updatePrevTrigger RepeatEvent a
repeatEvent a
newVal =
  -- Only overwrite value if it's new
  case RepeatEvent a
repeatEvent of
    NoRepeats IORef (Maybe a)
ref -> do
      Maybe a
val <- forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef (Maybe a)
ref
      forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe a
val forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just a
newVal) forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe a)
ref forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
newVal
    RepeatEvent a
_ -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE updatePrevTrigger #-}