module CabalGild.Unstable.Type.Leniency where

import qualified CabalGild.Unstable.Exception.InvalidLeniency as InvalidLeniency
import qualified Control.Monad.Catch as Exception

-- | Represents the leniency of a setting. In other words, should something be
-- lenient\/permissive or strict\/pedantic?
data Leniency
  = Lenient
  | Strict
  deriving (Leniency -> Leniency -> Bool
(Leniency -> Leniency -> Bool)
-> (Leniency -> Leniency -> Bool) -> Eq Leniency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Leniency -> Leniency -> Bool
== :: Leniency -> Leniency -> Bool
$c/= :: Leniency -> Leniency -> Bool
/= :: Leniency -> Leniency -> Bool
Eq, Int -> Leniency -> ShowS
[Leniency] -> ShowS
Leniency -> String
(Int -> Leniency -> ShowS)
-> (Leniency -> String) -> ([Leniency] -> ShowS) -> Show Leniency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Leniency -> ShowS
showsPrec :: Int -> Leniency -> ShowS
$cshow :: Leniency -> String
show :: Leniency -> String
$cshowList :: [Leniency] -> ShowS
showList :: [Leniency] -> ShowS
Show)

-- | Attempts to parse a string as a 'Leniency'.
fromString :: (Exception.MonadThrow m) => String -> m Leniency
fromString :: forall (m :: * -> *). MonadThrow m => String -> m Leniency
fromString String
s = case String
s of
  String
"lenient" -> Leniency -> m Leniency
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Leniency
Lenient
  String
"strict" -> Leniency -> m Leniency
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Leniency
Strict
  String
_ -> InvalidLeniency -> m Leniency
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM (InvalidLeniency -> m Leniency) -> InvalidLeniency -> m Leniency
forall a b. (a -> b) -> a -> b
$ String -> InvalidLeniency
InvalidLeniency.fromString String
s