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

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

import Navi.Data.NaviNote (NaviNote)
import Navi.Data.PollInterval (PollInterval (..), pollIntervalOptDecoder)
import Navi.Event.Toml
  ( ErrorNoteToml,
    RepeatEventToml,
    errorNoteOptDecoder,
    repeatEventOptDecoder,
  )
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TriggerNoteToml -> TriggerNoteToml -> Bool
$c/= :: TriggerNoteToml -> TriggerNoteToml -> Bool
== :: TriggerNoteToml -> TriggerNoteToml -> Bool
$c== :: TriggerNoteToml -> TriggerNoteToml -> Bool
Eq, Int -> TriggerNoteToml -> ShowS
[TriggerNoteToml] -> ShowS
TriggerNoteToml -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TriggerNoteToml] -> ShowS
$cshowList :: [TriggerNoteToml] -> ShowS
show :: TriggerNoteToml -> String
$cshow :: TriggerNoteToml -> String
showsPrec :: Int -> TriggerNoteToml -> ShowS
$cshowsPrec :: Int -> TriggerNoteToml -> ShowS
Show)

makeFieldLabelsNoPrefix ''TriggerNoteToml

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

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

makeFieldLabelsNoPrefix ''MultipleToml

-- | @since 0.1
instance DecodeTOML MultipleToml where
  tomlDecoder :: Decoder MultipleToml
tomlDecoder =
    Command
-> Maybe Text
-> NonEmpty TriggerNoteToml
-> Maybe PollInterval
-> Maybe RepeatEventToml
-> Maybe ErrorNoteToml
-> MultipleToml
MkMultipleToml
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Command
commandDecoder
      forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall a. DecodeTOML a => Text -> Decoder (Maybe a)
getFieldOpt Text
"name"
      forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall a. Decoder a -> Text -> Decoder a
getFieldWith forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"trigger-note"
      forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe PollInterval)
pollIntervalOptDecoder
      forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe RepeatEventToml)
repeatEventOptDecoder
      forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe ErrorNoteToml)
errorNoteOptDecoder