module Shrun.Configuration.Data.WithDisabled
  ( WithDisabled (..),

    -- * Construction
    fromMaybe,
    fromBool,

    -- * Elimination
    toMaybe,
    toBool,
    fromWithDisabled,
    fromDefault,

    -- * Misc
    (<>?),
    (<>?.),
    (<>??),

    -- * Optics
    _With,
    _Without,
    _Disabled,
  )
where

import Shrun.Configuration.Default (Default (def))
import Shrun.Prelude hiding (fromMaybe)

-- | Like Maybe but adds an extra constructor representing a "disabled" state.
-- The idea is that both CLI Args and Toml and have optional fields, but
-- the CLI can also be "disabled", which overrides everything.
--
-- The semigroup is similar to Maybe's:
--
-- - Identity: 'Without'
-- - 'With' is left-biased.
-- - ('Without', 'Disabled') forms a normal submonoid, in particular:
--
-- @
--   'Disabled' <> _ === 'Disabled' === _ <> 'Disabled'
-- @
data WithDisabled a
  = -- | The field.
    With a
  | -- | Missing.
    Without
  | -- | 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)

_With :: Prism' (WithDisabled a) a
_With :: forall a. Prism' (WithDisabled a) a
_With =
  (a -> WithDisabled a)
-> (WithDisabled a -> Either (WithDisabled a) a)
-> Prism (WithDisabled a) (WithDisabled a) a a
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    a -> WithDisabled a
forall a. a -> WithDisabled a
With
    ( \case
        With a
x -> a -> Either (WithDisabled a) a
forall a b. b -> Either a b
Right a
x
        WithDisabled a
y -> WithDisabled a -> Either (WithDisabled a) a
forall a b. a -> Either a b
Left WithDisabled a
y
    )
{-# INLINE _With #-}

_Without :: Prism' (WithDisabled a) ()
_Without :: forall a. Prism' (WithDisabled a) ()
_Without =
  (() -> WithDisabled a)
-> (WithDisabled a -> Either (WithDisabled a) ())
-> Prism (WithDisabled a) (WithDisabled a) () ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (WithDisabled a -> () -> WithDisabled a
forall a b. a -> b -> a
const WithDisabled a
forall a. WithDisabled a
Without)
    ( \case
        WithDisabled a
Without -> () -> Either (WithDisabled a) ()
forall a b. b -> Either a b
Right ()
        WithDisabled a
y -> WithDisabled a -> Either (WithDisabled a) ()
forall a b. a -> Either a b
Left WithDisabled a
y
    )
{-# INLINE _Without #-}

_Disabled :: Prism' (WithDisabled a) ()
_Disabled :: forall a. Prism' (WithDisabled a) ()
_Disabled =
  (() -> WithDisabled a)
-> (WithDisabled a -> Either (WithDisabled a) ())
-> Prism (WithDisabled a) (WithDisabled a) () ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (WithDisabled a -> () -> WithDisabled a
forall a b. a -> b -> a
const WithDisabled a
forall a. WithDisabled a
Disabled)
    ( \case
        WithDisabled a
Disabled -> () -> Either (WithDisabled a) ()
forall a b. b -> Either a b
Right ()
        WithDisabled a
y -> WithDisabled a -> Either (WithDisabled a) ()
forall a b. a -> Either a b
Left WithDisabled a
y
    )
{-# INLINE _Disabled #-}

instance Foldable WithDisabled where
  foldr :: forall a b. (a -> b -> b) -> b -> WithDisabled a -> b
foldr a -> b -> b
f b
e (With a
x) = a -> b -> b
f a
x b
e
  foldr a -> b -> b
_ b
e WithDisabled a
Without = b
e
  foldr a -> b -> b
_ b
e WithDisabled a
Disabled = b
e

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
  WithDisabled (a -> b)
Without <*> WithDisabled a
_ = WithDisabled b
forall a. WithDisabled a
Without
  WithDisabled (a -> b)
_ <*> WithDisabled a
Without = WithDisabled b
forall a. WithDisabled a
Without
  With a -> b
f <*> With a
x = b -> WithDisabled b
forall a. a -> WithDisabled a
With (a -> b
f a
x)

instance Monad WithDisabled where
  WithDisabled a
Disabled >>= :: forall a b.
WithDisabled a -> (a -> WithDisabled b) -> WithDisabled b
>>= a -> WithDisabled b
_ = WithDisabled b
forall a. WithDisabled a
Disabled
  WithDisabled a
Without >>= a -> WithDisabled b
_ = WithDisabled b
forall a. WithDisabled a
Without
  With a
x >>= a -> WithDisabled b
f = a -> WithDisabled b
f a
x

instance Semigroup (WithDisabled a) where
  WithDisabled a
Disabled <> :: WithDisabled a -> WithDisabled a -> WithDisabled a
<> WithDisabled a
_ = WithDisabled a
forall a. WithDisabled a
Disabled
  WithDisabled a
_ <> WithDisabled a
Disabled = WithDisabled a
forall a. WithDisabled a
Disabled
  WithDisabled a
Without <> WithDisabled a
r = WithDisabled a
r
  WithDisabled a
l <> WithDisabled a
_ = WithDisabled a
l

instance Monoid (WithDisabled a) where
  mempty :: WithDisabled a
mempty = WithDisabled a
forall a. WithDisabled a
Without

instance Default (WithDisabled a) where
  def :: WithDisabled a
def = WithDisabled a
forall a. WithDisabled a
Without

-- | 'With' -> 'Just', o/w -> 'Nothing'.
toMaybe :: WithDisabled a -> Maybe a
toMaybe :: forall a. WithDisabled a -> Maybe a
toMaybe (With a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
toMaybe WithDisabled a
_ = Maybe a
forall a. Maybe a
Nothing

toBool :: WithDisabled a -> Bool
toBool :: forall a. WithDisabled a -> Bool
toBool (With a
_) = Bool
True
toBool WithDisabled a
Without = Bool
False
toBool WithDisabled a
Disabled = Bool
False

-- | 'Nothing' -> 'Without', 'Just' -> 'With'.
fromMaybe :: Maybe a -> WithDisabled a
fromMaybe :: forall a. Maybe a -> WithDisabled a
fromMaybe (Just a
x) = a -> WithDisabled a
forall a. a -> WithDisabled a
With a
x
fromMaybe Maybe a
Nothing = WithDisabled a
forall a. WithDisabled a
Without

fromBool :: Bool -> WithDisabled ()
fromBool :: Bool -> WithDisabled ()
fromBool Bool
True = () -> WithDisabled ()
forall a. a -> WithDisabled a
With ()
fromBool Bool
False = WithDisabled ()
forall a. WithDisabled a
Without

-- | Eliminates 'WithDisabled'.
fromWithDisabled :: a -> WithDisabled a -> a
fromWithDisabled :: forall a. a -> WithDisabled a -> a
fromWithDisabled a
_ (With a
y) = a
y
fromWithDisabled a
x WithDisabled a
_ = a
x

-- | Eliminates 'WithDisabled' via its 'Default' instance.
fromDefault :: (Default a) => WithDisabled a -> a
fromDefault :: forall a. Default a => WithDisabled a -> a
fromDefault = a -> WithDisabled a -> a
forall a. a -> WithDisabled a -> a
fromWithDisabled a
forall a. Default a => a
def

-- | @l <>? r@ lifts 'Maybe' @r@ into a 'WithDisabled' per 'fromMaybe' then
-- runs the 'Semigroup'.
(<>?) :: WithDisabled a -> Maybe a -> WithDisabled a
WithDisabled a
wd <>? :: forall a. WithDisabled a -> Maybe a -> WithDisabled a
<>? Maybe a
m = WithDisabled a
wd WithDisabled a -> WithDisabled a -> WithDisabled a
forall a. Semigroup a => a -> a -> a
<> Maybe a -> WithDisabled a
forall a. Maybe a -> WithDisabled a
fromMaybe Maybe a
m

infixr 6 <>?

-- | Like '(<>?)' except we extract a result via 'fromDefault'.
(<>?.) :: (Default a) => WithDisabled a -> Maybe a -> a
WithDisabled a
x <>?. :: forall a. Default a => WithDisabled a -> Maybe a -> a
<>?. Maybe a
y = WithDisabled a -> a
forall a. Default a => WithDisabled a -> a
fromDefault (WithDisabled a
x WithDisabled a -> Maybe a -> WithDisabled a
forall a. WithDisabled a -> Maybe a -> WithDisabled a
<>? Maybe a
y)

infixr 6 <>?.

-- | Like '(<>?)' except we extract a Maybe via 'toMaybe'.
(<>??) :: WithDisabled a -> Maybe a -> Maybe a
WithDisabled a
x <>?? :: forall a. WithDisabled a -> Maybe a -> Maybe a
<>?? Maybe a
y = WithDisabled a -> Maybe a
forall a. WithDisabled a -> Maybe a
toMaybe (WithDisabled a
x WithDisabled a -> Maybe a -> WithDisabled a
forall a. WithDisabled a -> Maybe a -> WithDisabled a
<>? Maybe a
y)

infixr 6 <>??