{-# LANGUAGE TemplateHaskell #-}

-- | Command invokation preconditions
module CalamityCommands.Check (
  Check (..),
  buildCheck,
  buildCheckPure,
  runCheck,
) where

import CalamityCommands.Error
import CalamityCommands.Internal.RunIntoM
import CalamityCommands.Internal.Utils
import Data.Maybe
import qualified Data.Text as T
import Optics
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)
  }

$(makeFieldLabelsNoPrefix ''Check)

{- | 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 :: OpticKind -> OpticKind) (r :: EffectRow)
       (p :: OpticKind) (a :: OpticKind).
(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 :: OpticKind). a -> Maybe a -> a
fromMaybe (Text -> Maybe Text
forall (a :: OpticKind). a -> Maybe a
Just Text
"failed internally") (Maybe (Maybe Text) -> Maybe Text)
-> (c -> m (Maybe (Maybe Text))) -> c -> m (Maybe Text)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind) (c :: OpticKind).
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 :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Check m c -> Sem r (Check m c)) -> Check m c -> Sem r (Check m c)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text -> (c -> m (Maybe Text)) -> Check m c
forall (m :: OpticKind -> OpticKind) (c :: OpticKind).
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 :: OpticKind -> OpticKind) (c :: OpticKind).
Text -> (c -> m (Maybe Text)) -> Check m c
MkCheck Text
name (Maybe Text -> m (Maybe Text)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Maybe Text -> m (Maybe Text))
-> (c -> Maybe Text) -> c -> m (Maybe Text)
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(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 :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed (Check m c -> c -> m (Maybe Text)
forall (m :: OpticKind -> OpticKind) (c :: OpticKind).
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 :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
f a -> (a -> b) -> f b
<&> Maybe CommandError -> Either CommandError ()
forall (e :: OpticKind). Maybe e -> Either e ()
justToEither (Maybe CommandError -> Either CommandError ())
-> (Maybe Text -> Maybe CommandError)
-> Maybe Text
-> Either CommandError ()
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> CommandError
CheckError (Check m c
chk Check m c -> Optic' A_Lens NoIx (Check m c) Text -> Text
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "name" (Optic' A_Lens NoIx (Check m c) Text)
Optic' A_Lens NoIx (Check m c) Text
#name) (Text -> CommandError) -> Maybe Text -> Maybe CommandError
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$>)