module CalamityCommands.Check (
Check (..),
buildCheck,
buildCheckPure,
runCheck,
) where
import CalamityCommands.Error
import CalamityCommands.Internal.RunIntoM
import CalamityCommands.Internal.Utils
import Control.Lens hiding (Context, (<.>))
import Data.Generics.Labels ()
import Data.Maybe
import qualified Data.Text as T
import GHC.Generics
import qualified Polysemy as P
data Check m c = MkCheck
{
Check m c -> Text
name :: T.Text
,
Check m c -> c -> m (Maybe Text)
callback :: c -> m (Maybe T.Text)
}
deriving ((forall x. Check m c -> Rep (Check m c) x)
-> (forall x. Rep (Check m c) x -> Check m c)
-> Generic (Check m c)
forall x. Rep (Check m c) x -> Check m c
forall x. Check m c -> Rep (Check m c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) c x. Rep (Check m c) x -> Check m c
forall (m :: * -> *) c x. Check m c -> Rep (Check m c) x
$cto :: forall (m :: * -> *) c x. Rep (Check m c) x -> Check m c
$cfrom :: forall (m :: * -> *) c x. Check m c -> Rep (Check m c) x
Generic)
buildCheck :: (Monad m, P.Member (P.Final m) r) => T.Text -> (c -> P.Sem r (Maybe T.Text)) -> P.Sem r (Check m c)
buildCheck :: Text -> (c -> Sem r (Maybe Text)) -> Sem r (Check m c)
buildCheck Text
name c -> Sem r (Maybe Text)
cb = do
c -> m (Maybe (Maybe Text))
cb' <- (c -> Sem r (Maybe Text)) -> Sem r (c -> m (Maybe (Maybe Text)))
forall (m :: * -> *) (r :: EffectRow) p a.
(Monad m, Member (Final m) r) =>
(p -> Sem r a) -> Sem r (p -> m (Maybe a))
bindSemToM c -> Sem r (Maybe Text)
cb
let cb'' :: c -> m (Maybe Text)
cb'' = Maybe Text -> Maybe (Maybe Text) -> Maybe Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"failed internally") (Maybe (Maybe Text) -> Maybe Text)
-> (c -> m (Maybe (Maybe Text))) -> c -> m (Maybe Text)
forall (f :: * -> *) a b c.
Functor f =>
(a -> b) -> (c -> f a) -> c -> f b
<.> c -> m (Maybe (Maybe Text))
cb'
Check m c -> Sem r (Check m c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Check m c -> Sem r (Check m c)) -> Check m c -> Sem r (Check m c)
forall a b. (a -> b) -> a -> b
$ Text -> (c -> m (Maybe Text)) -> Check m c
forall (m :: * -> *) c. Text -> (c -> m (Maybe Text)) -> Check m c
MkCheck Text
name c -> m (Maybe Text)
cb''
buildCheckPure :: Monad m => T.Text -> (c -> Maybe T.Text) -> Check m c
buildCheckPure :: Text -> (c -> Maybe Text) -> Check m c
buildCheckPure Text
name c -> Maybe Text
cb = Text -> (c -> m (Maybe Text)) -> Check m c
forall (m :: * -> *) c. Text -> (c -> m (Maybe Text)) -> Check m c
MkCheck Text
name (Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text))
-> (c -> Maybe Text) -> c -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Maybe Text
cb)
runCheck :: (Monad m, P.Member (P.Embed m) r) => c -> Check m c -> P.Sem r (Either CommandError ())
runCheck :: c -> Check m c -> Sem r (Either CommandError ())
runCheck c
ctx Check m c
chk = m (Maybe Text) -> Sem r (Maybe Text)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (Check m c -> c -> m (Maybe Text)
forall (m :: * -> *) c. Check m c -> c -> m (Maybe Text)
callback Check m c
chk c
ctx) Sem r (Maybe Text)
-> (Maybe Text -> Either CommandError ())
-> Sem r (Either CommandError ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe CommandError -> Either CommandError ()
forall e. Maybe e -> Either e ()
justToEither (Maybe CommandError -> Either CommandError ())
-> (Maybe Text -> Maybe CommandError)
-> Maybe Text
-> Either CommandError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> CommandError
CheckError (Check m c
chk Check m c -> Getting Text (Check m c) Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text (Check m c) Text)
Getting Text (Check m c) Text
#name) (Text -> CommandError) -> Maybe Text -> Maybe CommandError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)