module Shrun.Configuration.Data.WithDisabled
  ( WithDisabled (..),
    disabledParser,
    toMaybe,
    (<|?|>),
  )
where

import Shrun.Prelude hiding (fromMaybe)

-- | WithDisabled augments some type with a 'disabled' option. Isomorphic to
-- 'Maybe', it exists to distinguish "missing" vs. explicitly
-- disabled. For instance, we want to be able to disable the parameter
-- notify-action, but we do not want to add another constructor to it, because
-- we want NotifyActionComplete to represent definite actions, hence the user config
-- (CLI and Toml) is 'Maybe (Disabled NotifyActionComplete)' i.e.
--
-- - Just Disabled: NotifyActionComplete explicitly disabled.
-- - Nothing: NotifyActionComplete not given.
-- - Just Enabled _: NotifyActionComplete explicity enabled.
--
-- We have this for the purposes of allowing CLI the override whatever
-- Toml parameter might exist, while at shrun's runtime it is merged to
-- 'Maybe NotifyActionComplete':
--
-- - Nothing: Notifications off.
-- - Just NotifyActionComplete: Notifications on.
data WithDisabled a
  = -- | The field.
    With a
  | -- | Disabled.
    Disabled
  deriving stock (WithDisabled a -> WithDisabled a -> Bool
(WithDisabled a -> WithDisabled a -> Bool)
-> (WithDisabled a -> WithDisabled a -> Bool)
-> Eq (WithDisabled a)
forall a. Eq a => WithDisabled a -> WithDisabled a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithDisabled a -> WithDisabled a -> Bool
== :: WithDisabled a -> WithDisabled a -> Bool
$c/= :: forall a. Eq a => WithDisabled a -> WithDisabled a -> Bool
/= :: WithDisabled a -> WithDisabled a -> Bool
Eq, (forall a b. (a -> b) -> WithDisabled a -> WithDisabled b)
-> (forall a b. a -> WithDisabled b -> WithDisabled a)
-> Functor WithDisabled
forall a b. a -> WithDisabled b -> WithDisabled a
forall a b. (a -> b) -> WithDisabled a -> WithDisabled b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithDisabled a -> WithDisabled b
fmap :: forall a b. (a -> b) -> WithDisabled a -> WithDisabled b
$c<$ :: forall a b. a -> WithDisabled b -> WithDisabled a
<$ :: forall a b. a -> WithDisabled b -> WithDisabled a
Functor, Int -> WithDisabled a -> ShowS
[WithDisabled a] -> ShowS
WithDisabled a -> String
(Int -> WithDisabled a -> ShowS)
-> (WithDisabled a -> String)
-> ([WithDisabled a] -> ShowS)
-> Show (WithDisabled a)
forall a. Show a => Int -> WithDisabled a -> ShowS
forall a. Show a => [WithDisabled a] -> ShowS
forall a. Show a => WithDisabled a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithDisabled a -> ShowS
showsPrec :: Int -> WithDisabled a -> ShowS
$cshow :: forall a. Show a => WithDisabled a -> String
show :: WithDisabled a -> String
$cshowList :: forall a. Show a => [WithDisabled a] -> ShowS
showList :: [WithDisabled a] -> ShowS
Show)

instance Applicative WithDisabled where
  pure :: forall a. a -> WithDisabled a
pure = a -> WithDisabled a
forall a. a -> WithDisabled a
With

  WithDisabled (a -> b)
Disabled <*> :: forall a b.
WithDisabled (a -> b) -> WithDisabled a -> WithDisabled b
<*> WithDisabled a
_ = WithDisabled b
forall a. WithDisabled a
Disabled
  WithDisabled (a -> b)
_ <*> WithDisabled a
Disabled = WithDisabled b
forall a. WithDisabled a
Disabled
  With a -> b
f <*> With a
x = b -> WithDisabled b
forall a. a -> WithDisabled a
With (a -> b
f a
x)

-- We have an Alternative instance because we want one like Maybe that is
-- left-biased. We leave Semigroup/Monoid alone for now as there is no
-- need unless we want to also use the type variable in some way.

instance Alternative WithDisabled where
  empty :: forall a. WithDisabled a
empty = WithDisabled a
forall a. WithDisabled a
Disabled

  With a
x <|> :: forall a. WithDisabled a -> WithDisabled a -> WithDisabled a
<|> WithDisabled a
_ = a -> WithDisabled a
forall a. a -> WithDisabled a
With a
x
  WithDisabled a
Disabled <|> WithDisabled a
y = WithDisabled a
y

instance (DecodeTOML a) => DecodeTOML (WithDisabled a) where
  tomlDecoder :: Decoder (WithDisabled a)
tomlDecoder = Decoder (WithDisabled a)
forall {a}. Decoder (WithDisabled a)
parseText Decoder (WithDisabled a)
-> Decoder (WithDisabled a) -> Decoder (WithDisabled a)
forall a. Decoder a -> Decoder a -> Decoder a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> a -> WithDisabled a
forall a. a -> WithDisabled a
With (a -> WithDisabled a) -> Decoder a -> Decoder (WithDisabled a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder
    where
      parseText :: Decoder (WithDisabled a)
parseText = do
        forall a. DecodeTOML a => Decoder a
tomlDecoder @Text Decoder Text
-> (Text -> Decoder (WithDisabled a)) -> Decoder (WithDisabled a)
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
"off" -> WithDisabled a -> Decoder (WithDisabled a)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure WithDisabled a
forall a. WithDisabled a
Disabled
          Text
other -> String -> Decoder (WithDisabled a)
forall a. String -> Decoder a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Decoder (WithDisabled a))
-> String -> Decoder (WithDisabled a)
forall a b. (a -> b) -> a -> b
$ String
"Expected 'off', received: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
other

instance (Pretty a) => Pretty (WithDisabled a) where
  pretty :: forall ann. WithDisabled a -> Doc ann
pretty = \case
    WithDisabled a
Disabled -> Doc ann
"off"
    With a
x -> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x

disabledParser :: (Applicative f) => Text -> f a -> f (WithDisabled a)
disabledParser :: forall (f :: Type -> Type) a.
Applicative f =>
Text -> f a -> f (WithDisabled a)
disabledParser Text
"off" f a
_ = WithDisabled a -> f (WithDisabled a)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure WithDisabled a
forall a. WithDisabled a
Disabled
disabledParser Text
_ f a
fx = a -> WithDisabled a
forall a. a -> WithDisabled a
With (a -> WithDisabled a) -> f a -> f (WithDisabled a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx

-- | Runs Maybes Alternative instance, then binds with toMaybe. I.e., takes
-- any Just if it exists (left-biased), then performs monadic join.
(<|?|>) :: Maybe (WithDisabled a) -> Maybe (WithDisabled a) -> Maybe a
Maybe (WithDisabled a)
mx <|?|> :: forall a.
Maybe (WithDisabled a) -> Maybe (WithDisabled a) -> Maybe a
<|?|> Maybe (WithDisabled a)
my = (Maybe (WithDisabled a)
mx Maybe (WithDisabled a)
-> Maybe (WithDisabled a) -> Maybe (WithDisabled a)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Maybe (WithDisabled a)
my) Maybe (WithDisabled a) -> (WithDisabled a -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= WithDisabled a -> Maybe a
forall a. WithDisabled a -> Maybe a
toMaybe

infixr 6 <|?|>

toMaybe :: WithDisabled a -> Maybe a
toMaybe :: forall a. WithDisabled a -> Maybe a
toMaybe (With a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
toMaybe WithDisabled a
Disabled = Maybe a
forall a. Maybe a
Nothing