calamity-commands-0.4.1.0: CalamityCommands/Check.hs

{-# 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 Data.Text qualified as T
import Optics
import Polysemy qualified 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
  { name :: T.Text
  -- ^ The name of the check.
  , callback :: c -> m (Maybe T.Text)
  -- ^ The callback for the check, returns Nothing if it passes, otherwise
  -- returns the reason for it not passing.
  }

$(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 name cb = do
  cb' <- bindSemToM cb
  let cb'' = fromMaybe (Just "failed internally") <.> cb'
  pure $ MkCheck name 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 name cb = MkCheck name (pure . 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 ctx chk = P.embed (callback chk ctx) <&> justToEither . (CheckError (chk ^. #name) <$>)