{-# LANGUAGE UndecidableInstances #-}

-- | This modules provides toml configuration related to events.
module Navi.Event.Toml
  ( -- * Normal events
    RepeatEventToml (..),
    repeatEventOptDecoder,
    repeatEventTomlToVal,
    mRepeatEventTomlToVal,

    -- * Multi events
    MultiRepeatEventToml (..),
    multiRepeatEventOptDecoder,
    multiRepeatEventTomlToVal,
    mMultiRepeatEventTomlToVal,

    -- * Errors
    ErrorNoteToml (..),
    errorNoteOptDecoder,
    errorNoteTomlToVal,
    mErrorNoteTomlToVal,
  )
where

import Data.Set (Set)
import Data.Set qualified as Set
import Navi.Event.Types
  ( ErrorNote (AllowErrNote, NoErrNote),
    RepeatEvent (AllowRepeats, NoRepeats, SomeRepeats),
  )
import Navi.Prelude
import TOML (DecodeM, Value (Array))
import TOML.Value (Value (Boolean))

-- | TOML for 'RepeatEvent'.
data RepeatEventToml
  = NoRepeatsToml
  | AllowRepeatsToml
  deriving stock (RepeatEventToml -> RepeatEventToml -> Bool
(RepeatEventToml -> RepeatEventToml -> Bool)
-> (RepeatEventToml -> RepeatEventToml -> Bool)
-> Eq RepeatEventToml
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepeatEventToml -> RepeatEventToml -> Bool
== :: RepeatEventToml -> RepeatEventToml -> Bool
$c/= :: RepeatEventToml -> RepeatEventToml -> Bool
/= :: RepeatEventToml -> RepeatEventToml -> Bool
Eq, Int -> RepeatEventToml -> ShowS
[RepeatEventToml] -> ShowS
RepeatEventToml -> String
(Int -> RepeatEventToml -> ShowS)
-> (RepeatEventToml -> String)
-> ([RepeatEventToml] -> ShowS)
-> Show RepeatEventToml
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepeatEventToml -> ShowS
showsPrec :: Int -> RepeatEventToml -> ShowS
$cshow :: RepeatEventToml -> String
show :: RepeatEventToml -> String
$cshowList :: [RepeatEventToml] -> ShowS
showList :: [RepeatEventToml] -> ShowS
Show)

-- | @since 0.1
instance DecodeTOML RepeatEventToml where
  tomlDecoder :: Decoder RepeatEventToml
tomlDecoder =
    Decoder Bool
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Bool
-> (Bool -> RepeatEventToml) -> Decoder RepeatEventToml
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
b ->
      if Bool
b
        then RepeatEventToml
AllowRepeatsToml
        else RepeatEventToml
NoRepeatsToml

-- | TOML decoder for optional 'RepeatEventToml' with field name
-- "repeat-events".
--
-- @since 0.1
repeatEventOptDecoder :: Decoder (Maybe RepeatEventToml)
repeatEventOptDecoder :: Decoder (Maybe RepeatEventToml)
repeatEventOptDecoder = Decoder RepeatEventToml -> Text -> Decoder (Maybe RepeatEventToml)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder RepeatEventToml
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"repeat-events"

-- | Constructs a mutable 'RepeatEvent' from 'RepeatEventToml'.
repeatEventTomlToVal :: (MonadIORef m) => RepeatEventToml -> m (RepeatEvent a)
repeatEventTomlToVal :: forall (m :: Type -> Type) a.
MonadIORef m =>
RepeatEventToml -> m (RepeatEvent a)
repeatEventTomlToVal RepeatEventToml
AllowRepeatsToml = RepeatEvent a -> m (RepeatEvent a)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure RepeatEvent a
forall a. RepeatEvent a
AllowRepeats
repeatEventTomlToVal RepeatEventToml
NoRepeatsToml = IORef (Maybe a) -> RepeatEvent a
forall a. IORef (Maybe a) -> RepeatEvent a
NoRepeats (IORef (Maybe a) -> RepeatEvent a)
-> m (IORef (Maybe a)) -> m (RepeatEvent a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> m (IORef (Maybe a))
forall a. HasCallStack => a -> m (IORef a)
forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef Maybe a
forall a. Maybe a
Nothing
{-# INLINEABLE repeatEventTomlToVal #-}

-- | Constructs a mutable 'RepeatEvent' from 'RepeatEventToml'. If none is
-- provided, defaults to 'NoRepeatsToml', i.e., no repeats.
mRepeatEventTomlToVal :: (MonadIORef m) => Maybe RepeatEventToml -> m (RepeatEvent a)
mRepeatEventTomlToVal :: forall (m :: Type -> Type) a.
MonadIORef m =>
Maybe RepeatEventToml -> m (RepeatEvent a)
mRepeatEventTomlToVal Maybe RepeatEventToml
Nothing = RepeatEventToml -> m (RepeatEvent a)
forall (m :: Type -> Type) a.
MonadIORef m =>
RepeatEventToml -> m (RepeatEvent a)
repeatEventTomlToVal RepeatEventToml
NoRepeatsToml
mRepeatEventTomlToVal (Just RepeatEventToml
t) = RepeatEventToml -> m (RepeatEvent a)
forall (m :: Type -> Type) a.
MonadIORef m =>
RepeatEventToml -> m (RepeatEvent a)
repeatEventTomlToVal RepeatEventToml
t
{-# INLINEABLE mRepeatEventTomlToVal #-}

-- | TOML for 'RepeatEvent' that allows repeating some (text) events.
data MultiRepeatEventToml a
  = MultiNoRepeatsToml
  | MultiSomeRepeatsToml (Set a)
  | MultiAllowRepeatsToml
  deriving stock (MultiRepeatEventToml a -> MultiRepeatEventToml a -> Bool
(MultiRepeatEventToml a -> MultiRepeatEventToml a -> Bool)
-> (MultiRepeatEventToml a -> MultiRepeatEventToml a -> Bool)
-> Eq (MultiRepeatEventToml a)
forall a.
Eq a =>
MultiRepeatEventToml a -> MultiRepeatEventToml a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
MultiRepeatEventToml a -> MultiRepeatEventToml a -> Bool
== :: MultiRepeatEventToml a -> MultiRepeatEventToml a -> Bool
$c/= :: forall a.
Eq a =>
MultiRepeatEventToml a -> MultiRepeatEventToml a -> Bool
/= :: MultiRepeatEventToml a -> MultiRepeatEventToml a -> Bool
Eq, Int -> MultiRepeatEventToml a -> ShowS
[MultiRepeatEventToml a] -> ShowS
MultiRepeatEventToml a -> String
(Int -> MultiRepeatEventToml a -> ShowS)
-> (MultiRepeatEventToml a -> String)
-> ([MultiRepeatEventToml a] -> ShowS)
-> Show (MultiRepeatEventToml a)
forall a. Show a => Int -> MultiRepeatEventToml a -> ShowS
forall a. Show a => [MultiRepeatEventToml a] -> ShowS
forall a. Show a => MultiRepeatEventToml a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MultiRepeatEventToml a -> ShowS
showsPrec :: Int -> MultiRepeatEventToml a -> ShowS
$cshow :: forall a. Show a => MultiRepeatEventToml a -> String
show :: MultiRepeatEventToml a -> String
$cshowList :: forall a. Show a => [MultiRepeatEventToml a] -> ShowS
showList :: [MultiRepeatEventToml a] -> ShowS
Show)

-- | @since 0.1
multiRepeatEventTomlDecoder ::
  (Ord a) =>
  (Value -> DecodeM a) ->
  Decoder (MultiRepeatEventToml a)
multiRepeatEventTomlDecoder :: forall a.
Ord a =>
(Value -> DecodeM a) -> Decoder (MultiRepeatEventToml a)
multiRepeatEventTomlDecoder Value -> DecodeM a
decodeA = (Value -> DecodeM (MultiRepeatEventToml a))
-> Decoder (MultiRepeatEventToml a)
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM (MultiRepeatEventToml a))
 -> Decoder (MultiRepeatEventToml a))
-> (Value -> DecodeM (MultiRepeatEventToml a))
-> Decoder (MultiRepeatEventToml a)
forall a b. (a -> b) -> a -> b
$ \case
  Boolean Bool
b ->
    MultiRepeatEventToml a -> DecodeM (MultiRepeatEventToml a)
forall a. a -> DecodeM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
      (MultiRepeatEventToml a -> DecodeM (MultiRepeatEventToml a))
-> MultiRepeatEventToml a -> DecodeM (MultiRepeatEventToml a)
forall a b. (a -> b) -> a -> b
$ if Bool
b
        then MultiRepeatEventToml a
forall a. MultiRepeatEventToml a
MultiAllowRepeatsToml
        else MultiRepeatEventToml a
forall a. MultiRepeatEventToml a
MultiNoRepeatsToml
  Array [Value]
xs -> do
    [a]
ys <- (Value -> DecodeM a) -> [Value] -> DecodeM [a]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> DecodeM a
decodeA [Value]
xs
    pure $ Set a -> MultiRepeatEventToml a
forall a. Set a -> MultiRepeatEventToml a
MultiSomeRepeatsToml (Set a -> MultiRepeatEventToml a)
-> Set a -> MultiRepeatEventToml a
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
ys
  Value
other -> Value -> DecodeM (MultiRepeatEventToml a)
forall a. Value -> DecodeM a
typeMismatch Value
other

-- | TOML decoder for optional 'RepeatEventToml' with field name
-- "repeat-events".
--
-- @since 0.1
multiRepeatEventOptDecoder ::
  (Ord a) =>
  (Value -> DecodeM a) ->
  Decoder (Maybe (MultiRepeatEventToml a))
multiRepeatEventOptDecoder :: forall a.
Ord a =>
(Value -> DecodeM a) -> Decoder (Maybe (MultiRepeatEventToml a))
multiRepeatEventOptDecoder Value -> DecodeM a
decodeA =
  Decoder (MultiRepeatEventToml a)
-> Text -> Decoder (Maybe (MultiRepeatEventToml a))
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith ((Value -> DecodeM a) -> Decoder (MultiRepeatEventToml a)
forall a.
Ord a =>
(Value -> DecodeM a) -> Decoder (MultiRepeatEventToml a)
multiRepeatEventTomlDecoder Value -> DecodeM a
decodeA) Text
"repeat-events"

-- | Constructs a mutable 'RepeatEvent' from 'RepeatEventToml'.
multiRepeatEventTomlToVal ::
  (MonadIORef m, Ord b) =>
  (a -> b) ->
  MultiRepeatEventToml a ->
  m (RepeatEvent b)
multiRepeatEventTomlToVal :: forall (m :: Type -> Type) b a.
(MonadIORef m, Ord b) =>
(a -> b) -> MultiRepeatEventToml a -> m (RepeatEvent b)
multiRepeatEventTomlToVal a -> b
f = \case
  MultiRepeatEventToml a
MultiAllowRepeatsToml -> RepeatEvent b -> m (RepeatEvent b)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure RepeatEvent b
forall a. RepeatEvent a
AllowRepeats
  MultiSomeRepeatsToml Set a
st -> Set b -> IORef (Maybe b) -> RepeatEvent b
forall a. Set a -> IORef (Maybe a) -> RepeatEvent a
SomeRepeats ((a -> b) -> Set a -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f Set a
st) (IORef (Maybe b) -> RepeatEvent b)
-> m (IORef (Maybe b)) -> m (RepeatEvent b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b -> m (IORef (Maybe b))
forall a. HasCallStack => a -> m (IORef a)
forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef Maybe b
forall a. Maybe a
Nothing
  MultiRepeatEventToml a
MultiNoRepeatsToml -> IORef (Maybe b) -> RepeatEvent b
forall a. IORef (Maybe a) -> RepeatEvent a
NoRepeats (IORef (Maybe b) -> RepeatEvent b)
-> m (IORef (Maybe b)) -> m (RepeatEvent b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b -> m (IORef (Maybe b))
forall a. HasCallStack => a -> m (IORef a)
forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef Maybe b
forall a. Maybe a
Nothing
{-# INLINEABLE multiRepeatEventTomlToVal #-}

-- | Constructs a mutable 'RepeatEvent' from 'RepeatEventToml'. If none is
-- provided, defaults to 'NoRepeatsToml', i.e., no repeats.
mMultiRepeatEventTomlToVal ::
  (MonadIORef m, Ord b) =>
  (a -> b) ->
  Maybe (MultiRepeatEventToml a) ->
  m (RepeatEvent b)
mMultiRepeatEventTomlToVal :: forall (m :: Type -> Type) b a.
(MonadIORef m, Ord b) =>
(a -> b) -> Maybe (MultiRepeatEventToml a) -> m (RepeatEvent b)
mMultiRepeatEventTomlToVal a -> b
f Maybe (MultiRepeatEventToml a)
Nothing = (a -> b) -> MultiRepeatEventToml a -> m (RepeatEvent b)
forall (m :: Type -> Type) b a.
(MonadIORef m, Ord b) =>
(a -> b) -> MultiRepeatEventToml a -> m (RepeatEvent b)
multiRepeatEventTomlToVal a -> b
f MultiRepeatEventToml a
forall a. MultiRepeatEventToml a
MultiNoRepeatsToml
mMultiRepeatEventTomlToVal a -> b
f (Just MultiRepeatEventToml a
t) = (a -> b) -> MultiRepeatEventToml a -> m (RepeatEvent b)
forall (m :: Type -> Type) b a.
(MonadIORef m, Ord b) =>
(a -> b) -> MultiRepeatEventToml a -> m (RepeatEvent b)
multiRepeatEventTomlToVal a -> b
f MultiRepeatEventToml a
t
{-# INLINEABLE mMultiRepeatEventTomlToVal #-}

-- | TOML for 'ErrorNote'.
data ErrorNoteToml
  = NoErrNoteToml
  | ErrNoteAllowRepeatsToml
  | ErrNoteNoRepeatsToml
  deriving stock (ErrorNoteToml -> ErrorNoteToml -> Bool
(ErrorNoteToml -> ErrorNoteToml -> Bool)
-> (ErrorNoteToml -> ErrorNoteToml -> Bool) -> Eq ErrorNoteToml
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorNoteToml -> ErrorNoteToml -> Bool
== :: ErrorNoteToml -> ErrorNoteToml -> Bool
$c/= :: ErrorNoteToml -> ErrorNoteToml -> Bool
/= :: ErrorNoteToml -> ErrorNoteToml -> Bool
Eq, Int -> ErrorNoteToml -> ShowS
[ErrorNoteToml] -> ShowS
ErrorNoteToml -> String
(Int -> ErrorNoteToml -> ShowS)
-> (ErrorNoteToml -> String)
-> ([ErrorNoteToml] -> ShowS)
-> Show ErrorNoteToml
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorNoteToml -> ShowS
showsPrec :: Int -> ErrorNoteToml -> ShowS
$cshow :: ErrorNoteToml -> String
show :: ErrorNoteToml -> String
$cshowList :: [ErrorNoteToml] -> ShowS
showList :: [ErrorNoteToml] -> ShowS
Show)

-- | @since 0.1
instance DecodeTOML ErrorNoteToml where
  tomlDecoder :: Decoder ErrorNoteToml
tomlDecoder =
    Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder
      Decoder Text
-> (Text -> Decoder ErrorNoteToml) -> Decoder ErrorNoteToml
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Text
"none" -> ErrorNoteToml -> Decoder ErrorNoteToml
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ErrorNoteToml
NoErrNoteToml
        Text
"repeats" -> ErrorNoteToml -> Decoder ErrorNoteToml
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ErrorNoteToml
ErrNoteAllowRepeatsToml
        Text
"no-repeats" -> ErrorNoteToml -> Decoder ErrorNoteToml
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ErrorNoteToml
ErrNoteNoRepeatsToml
        Text
bad ->
          String -> Decoder ErrorNoteToml
forall a. String -> Decoder a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
            (String -> Decoder ErrorNoteToml)
-> String -> Decoder ErrorNoteToml
forall a b. (a -> b) -> a -> b
$ Text -> String
unpackText
            (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"Unexpected error-events string: ",
                Text
bad,
                Text
". Expected one of <none | repeats | no-repeats>."
              ]

-- | TOML decoder for optional 'ErrorNoteToml' with field name
-- "error-events".
--
-- @since 0.1
errorNoteOptDecoder :: Decoder (Maybe ErrorNoteToml)
errorNoteOptDecoder :: Decoder (Maybe ErrorNoteToml)
errorNoteOptDecoder = Decoder ErrorNoteToml -> Text -> Decoder (Maybe ErrorNoteToml)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder ErrorNoteToml
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"error-events"

-- | Constructs a mutable 'ErrorNote' from 'ErrorNoteToml'.
errorNoteTomlToVal :: (MonadIORef m) => ErrorNoteToml -> m ErrorNote
errorNoteTomlToVal :: forall (m :: Type -> Type).
MonadIORef m =>
ErrorNoteToml -> m ErrorNote
errorNoteTomlToVal ErrorNoteToml
NoErrNoteToml = ErrorNote -> m ErrorNote
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ErrorNote
NoErrNote
errorNoteTomlToVal ErrorNoteToml
ErrNoteAllowRepeatsToml = ErrorNote -> m ErrorNote
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ErrorNote -> m ErrorNote) -> ErrorNote -> m ErrorNote
forall a b. (a -> b) -> a -> b
$ RepeatEvent () -> ErrorNote
AllowErrNote RepeatEvent ()
forall a. RepeatEvent a
AllowRepeats
errorNoteTomlToVal ErrorNoteToml
ErrNoteNoRepeatsToml = RepeatEvent () -> ErrorNote
AllowErrNote (RepeatEvent () -> ErrorNote)
-> (IORef (Maybe ()) -> RepeatEvent ())
-> IORef (Maybe ())
-> ErrorNote
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
. IORef (Maybe ()) -> RepeatEvent ()
forall a. IORef (Maybe a) -> RepeatEvent a
NoRepeats (IORef (Maybe ()) -> ErrorNote)
-> m (IORef (Maybe ())) -> m ErrorNote
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe () -> m (IORef (Maybe ()))
forall a. HasCallStack => a -> m (IORef a)
forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef Maybe ()
forall a. Maybe a
Nothing
{-# INLINEABLE errorNoteTomlToVal #-}

-- | Constructs a mutable 'ErrorNote' from 'ErrorNoteToml'. If none is
-- provided, defaults to 'ErrNoteNoRepeatsToml', i.e., we /do/ send
-- notifications for errors, but we do not send repeats.
mErrorNoteTomlToVal :: (MonadIORef m) => Maybe ErrorNoteToml -> m ErrorNote
mErrorNoteTomlToVal :: forall (m :: Type -> Type).
MonadIORef m =>
Maybe ErrorNoteToml -> m ErrorNote
mErrorNoteTomlToVal Maybe ErrorNoteToml
Nothing = ErrorNoteToml -> m ErrorNote
forall (m :: Type -> Type).
MonadIORef m =>
ErrorNoteToml -> m ErrorNote
errorNoteTomlToVal ErrorNoteToml
ErrNoteNoRepeatsToml
mErrorNoteTomlToVal (Just ErrorNoteToml
t) = ErrorNoteToml -> m ErrorNote
forall (m :: Type -> Type).
MonadIORef m =>
ErrorNoteToml -> m ErrorNote
errorNoteTomlToVal ErrorNoteToml
t
{-# INLINEABLE mErrorNoteTomlToVal #-}