-- | Command invokation preconditions
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

{- | A check for a command.

 Every check for a command must return Nothing for the command to be run.
-}
data Check m c = MkCheck
    { -- | The name of the check.
      Check m c -> Text
name :: T.Text
    , -- | The callback for the check, returns Nothing if it passes, otherwise
      -- returns the reason for it not passing.
      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)

{- | Given the name of a check and a callback in the 'P.Sem' monad, build a check
 by transforming the Polysemy action into an @m@ action.
-}
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''

-- | Given the name of a check and a pure callback function, build a check.
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)

{- | Given an invokation context @c@, run a check and transform the result into an
 @'Either' 'CommandError' ()@.
-}
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
<$>)