{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module provides toml configuration for the custom service.
module Navi.Services.Custom.Toml
  ( CustomToml (..),
    TriggerNoteToml (..),
  )
where

import Data.List.NonEmpty qualified as NE
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text qualified as T
import Navi.Data.CommandResultParser (CommandResultParserToml, commandResultParserDecoder)
import Navi.Data.NaviNote (NaviNote)
import Navi.Data.PollInterval (PollInterval, pollIntervalOptDecoder)
import Navi.Event.Toml
  ( ErrorNoteToml,
    MultiRepeatEventToml (MultiSomeRepeatsToml),
    errorNoteOptDecoder,
    multiRepeatEventOptDecoder,
  )
import Navi.Prelude
import Navi.Utils (commandDecoder)
import Pythia.Data.Command (Command)

-- | TOML for alerts.
data TriggerNoteToml = MkTriggerNoteToml
  { -- | The text that triggers an alert.
    TriggerNoteToml -> Text
trigger :: Text,
    -- | The notification to send when triggered.
    TriggerNoteToml -> NaviNote
note :: NaviNote
  }
  deriving stock (TriggerNoteToml -> TriggerNoteToml -> Bool
(TriggerNoteToml -> TriggerNoteToml -> Bool)
-> (TriggerNoteToml -> TriggerNoteToml -> Bool)
-> Eq TriggerNoteToml
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TriggerNoteToml -> TriggerNoteToml -> Bool
== :: TriggerNoteToml -> TriggerNoteToml -> Bool
$c/= :: TriggerNoteToml -> TriggerNoteToml -> Bool
/= :: TriggerNoteToml -> TriggerNoteToml -> Bool
Eq, Int -> TriggerNoteToml -> ShowS
[TriggerNoteToml] -> ShowS
TriggerNoteToml -> String
(Int -> TriggerNoteToml -> ShowS)
-> (TriggerNoteToml -> String)
-> ([TriggerNoteToml] -> ShowS)
-> Show TriggerNoteToml
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TriggerNoteToml -> ShowS
showsPrec :: Int -> TriggerNoteToml -> ShowS
$cshow :: TriggerNoteToml -> String
show :: TriggerNoteToml -> String
$cshowList :: [TriggerNoteToml] -> ShowS
showList :: [TriggerNoteToml] -> ShowS
Show)

makeFieldLabelsNoPrefix ''TriggerNoteToml

-- | @since 0.1
instance DecodeTOML TriggerNoteToml where
  tomlDecoder :: Decoder TriggerNoteToml
tomlDecoder =
    Text -> NaviNote -> TriggerNoteToml
MkTriggerNoteToml
      (Text -> NaviNote -> TriggerNoteToml)
-> Decoder Text -> Decoder (NaviNote -> TriggerNoteToml)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Decoder Text
forall a. DecodeTOML a => Text -> Decoder a
getField Text
"trigger"
      Decoder (NaviNote -> TriggerNoteToml)
-> Decoder NaviNote -> Decoder TriggerNoteToml
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder NaviNote
forall a. DecodeTOML a => Decoder a
tomlDecoder

-- | TOML for the custom service.
data CustomToml = MkCustomToml
  { -- | The command to run.
    CustomToml -> Command
command :: Command,
    -- | Determines how we handle errors.
    CustomToml -> Maybe ErrorNoteToml
errEventCfg :: Maybe ErrorNoteToml,
    -- | An optional name to be used with logging.
    CustomToml -> Maybe Text
name :: Maybe Text,
    -- | Custom parsing.
    CustomToml -> Maybe CommandResultParserToml
parser :: Maybe CommandResultParserToml,
    -- | The poll interval.
    CustomToml -> Maybe PollInterval
pollInterval :: Maybe PollInterval,
    -- | Determines how we treat repeat alerts.
    CustomToml -> Maybe (MultiRepeatEventToml Text)
repeatEventCfg :: Maybe (MultiRepeatEventToml Text),
    -- | The alert triggers.
    CustomToml -> NonEmpty TriggerNoteToml
triggerNotes :: NonEmpty TriggerNoteToml
  }
  deriving stock (CustomToml -> CustomToml -> Bool
(CustomToml -> CustomToml -> Bool)
-> (CustomToml -> CustomToml -> Bool) -> Eq CustomToml
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomToml -> CustomToml -> Bool
== :: CustomToml -> CustomToml -> Bool
$c/= :: CustomToml -> CustomToml -> Bool
/= :: CustomToml -> CustomToml -> Bool
Eq, Int -> CustomToml -> ShowS
[CustomToml] -> ShowS
CustomToml -> String
(Int -> CustomToml -> ShowS)
-> (CustomToml -> String)
-> ([CustomToml] -> ShowS)
-> Show CustomToml
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomToml -> ShowS
showsPrec :: Int -> CustomToml -> ShowS
$cshow :: CustomToml -> String
show :: CustomToml -> String
$cshowList :: [CustomToml] -> ShowS
showList :: [CustomToml] -> ShowS
Show)

makeFieldLabelsNoPrefix ''CustomToml

-- | @since 0.1
instance DecodeTOML CustomToml where
  tomlDecoder :: Decoder CustomToml
tomlDecoder = do
    Command
command <- Decoder Command
commandDecoder
    Maybe ErrorNoteToml
errEventCfg <- Decoder (Maybe ErrorNoteToml)
errorNoteOptDecoder
    Maybe Text
name <- Text -> Decoder (Maybe Text)
forall a. DecodeTOML a => Text -> Decoder (Maybe a)
getFieldOpt Text
"name"
    Maybe CommandResultParserToml
parser <- Decoder (Maybe CommandResultParserToml)
commandResultParserDecoder
    Maybe PollInterval
pollInterval <- Decoder (Maybe PollInterval)
pollIntervalOptDecoder
    Maybe (MultiRepeatEventToml Text)
repeatEventCfg <- (Value -> DecodeM Text)
-> Decoder (Maybe (MultiRepeatEventToml Text))
forall a.
Ord a =>
(Value -> DecodeM a) -> Decoder (Maybe (MultiRepeatEventToml a))
multiRepeatEventOptDecoder Value -> DecodeM Text
decodeStr
    NonEmpty TriggerNoteToml
triggerNotes <- Decoder (NonEmpty TriggerNoteToml)
-> Text -> Decoder (NonEmpty TriggerNoteToml)
forall a. Decoder a -> Text -> Decoder a
getFieldWith Decoder (NonEmpty TriggerNoteToml)
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"trigger-note"

    case Maybe (MultiRepeatEventToml Text)
repeatEventCfg of
      Just (MultiSomeRepeatsToml Set Text
txtRefs) -> do
        let triggers :: Set Text
triggers = NonEmpty TriggerNoteToml -> Set Text
mkTriggerTxts NonEmpty TriggerNoteToml
triggerNotes
            d :: Set Text
d = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Text
txtRefs Set Text
triggers
            msg :: String
msg =
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Found repeat-events that referenced non-extant triggers. ",
                  String
"All references should correspond to a note 'trigger': ",
                  Set Text -> String
showSet Set Text
d
                ]
        Bool -> Decoder () -> Decoder ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
d) (Decoder () -> Decoder ()) -> Decoder () -> Decoder ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder ()
forall a. String -> Decoder a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
msg
      Maybe (MultiRepeatEventToml Text)
_ -> () -> Decoder ()
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()

    pure
      $ MkCustomToml
        { Command
command :: Command
command :: Command
command,
          Maybe ErrorNoteToml
errEventCfg :: Maybe ErrorNoteToml
errEventCfg :: Maybe ErrorNoteToml
errEventCfg,
          Maybe Text
name :: Maybe Text
name :: Maybe Text
name,
          Maybe CommandResultParserToml
parser :: Maybe CommandResultParserToml
parser :: Maybe CommandResultParserToml
parser,
          Maybe PollInterval
pollInterval :: Maybe PollInterval
pollInterval :: Maybe PollInterval
pollInterval,
          Maybe (MultiRepeatEventToml Text)
repeatEventCfg :: Maybe (MultiRepeatEventToml Text)
repeatEventCfg :: Maybe (MultiRepeatEventToml Text)
repeatEventCfg,
          NonEmpty TriggerNoteToml
triggerNotes :: NonEmpty TriggerNoteToml
triggerNotes :: NonEmpty TriggerNoteToml
triggerNotes
        }
    where
      decodeStr :: Value -> DecodeM Text
decodeStr (String Text
s) = Text -> DecodeM Text
forall a. a -> DecodeM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
s
      decodeStr Value
other = Value -> DecodeM Text
forall a. Value -> DecodeM a
typeMismatch Value
other

      mkTriggerTxts :: NonEmpty TriggerNoteToml -> Set Text
      mkTriggerTxts :: NonEmpty TriggerNoteToml -> Set Text
mkTriggerTxts =
        [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
          ([Text] -> Set Text)
-> (NonEmpty TriggerNoteToml -> [Text])
-> NonEmpty TriggerNoteToml
-> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList
          (NonEmpty Text -> [Text])
-> (NonEmpty TriggerNoteToml -> NonEmpty Text)
-> NonEmpty TriggerNoteToml
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TriggerNoteToml -> Text)
-> NonEmpty TriggerNoteToml -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic' A_Lens NoIx TriggerNoteToml Text -> TriggerNoteToml -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TriggerNoteToml Text
#trigger)

      showSet :: Set Text -> String
      showSet :: Set Text -> String
showSet =
        Text -> String
unpackText
          (Text -> String) -> (Set Text -> Text) -> Set Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".")
          (Text -> Text) -> (Set Text -> Text) -> Set Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Text] -> Text
T.intercalate Text
", "
          ([Text] -> Text) -> (Set Text -> [Text]) -> Set Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Set Text -> [Text]
forall a. Set a -> [a]
Set.toList