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

import {-# SOURCE #-} Calamity.Commands.Context
import           Calamity.Commands.Error
import           Calamity.Internal.RunIntoIO
import           Calamity.Internal.Utils

import           Control.Lens                hiding ( (<.>), Context )

import           Data.Generics.Labels        ()
import           Data.Maybe
import qualified Data.Text                   as S
import qualified Data.Text.Lazy              as L

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 = MkCheck
  { Check -> Text
name     :: S.Text
    -- ^ The name of the check.
  , Check -> Context -> IO (Maybe Text)
callback :: Context -> IO (Maybe L.Text)
    -- ^ The callback for the check, returns Nothing if it passes, otherwise
    -- returns the reason for it not passing.
  }
  deriving ( (forall x. Check -> Rep Check x)
-> (forall x. Rep Check x -> Check) -> Generic Check
forall x. Rep Check x -> Check
forall x. Check -> Rep Check x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Check x -> Check
$cfrom :: forall x. Check -> Rep Check 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 IO action.
buildCheck :: P.Member (P.Final IO) r => S.Text -> (Context -> P.Sem r (Maybe L.Text)) -> P.Sem r Check
buildCheck :: Text -> (Context -> Sem r (Maybe Text)) -> Sem r Check
buildCheck Text
name Context -> Sem r (Maybe Text)
cb = do
  Context -> IO (Maybe (Maybe Text))
cb' <- (Context -> Sem r (Maybe Text))
-> Sem r (Context -> IO (Maybe (Maybe Text)))
forall (r :: [(* -> *) -> * -> *]) p a.
Member (Final IO) r =>
(p -> Sem r a) -> Sem r (p -> IO (Maybe a))
bindSemToIO Context -> Sem r (Maybe Text)
cb
  let cb'' :: Context -> IO (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)
-> (Context -> IO (Maybe (Maybe Text)))
-> Context
-> IO (Maybe Text)
forall (f :: * -> *) a b c.
Functor f =>
(a -> b) -> (c -> f a) -> c -> f b
<.> Context -> IO (Maybe (Maybe Text))
cb'
  Check -> Sem r Check
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Check -> Sem r Check) -> Check -> Sem r Check
forall a b. (a -> b) -> a -> b
$ Text -> (Context -> IO (Maybe Text)) -> Check
MkCheck Text
name Context -> IO (Maybe Text)
cb''

-- | Given the name of a check and a pure callback function, build a check.
buildCheckPure :: S.Text -> (Context -> Maybe L.Text) -> Check
buildCheckPure :: Text -> (Context -> Maybe Text) -> Check
buildCheckPure Text
name Context -> Maybe Text
cb = Text -> (Context -> IO (Maybe Text)) -> Check
MkCheck Text
name (Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text))
-> (Context -> Maybe Text) -> Context -> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Maybe Text
cb)

-- | Given an invokation 'Context', run a check and transform the result into an
-- @'Either' 'CommandError' ()@.
runCheck :: P.Member (P.Embed IO) r => Context -> Check -> P.Sem r (Either CommandError ())
runCheck :: Context -> Check -> Sem r (Either CommandError ())
runCheck Context
ctx Check
chk = IO (Maybe Text) -> Sem r (Maybe Text)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (Check -> Context -> IO (Maybe Text)
callback Check
chk Context
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
chk Check -> Getting Text Check Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text Check Text)
Getting Text Check Text
#name) (Text -> CommandError) -> Maybe Text -> Maybe CommandError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)