{-# LANGUAGE TemplateHaskell #-}
module CalamityCommands.Context (
CommandContext (..),
ConstructContext (..),
constructContext,
BasicContext (..),
useBasicContext,
) where
import qualified Data.Text.Lazy as L
import GHC.Generics (Generic)
import qualified Polysemy as P
import CalamityCommands.Command
class CommandContext m c a | c -> m, c -> a where
ctxPrefix :: c -> L.Text
ctxCommand :: c -> Command m c a
ctxUnparsedParams :: c -> L.Text
data ConstructContext msg ctx m' a' m a where
ConstructContext ::
(L.Text, Command m' ctx a', L.Text) ->
msg ->
ConstructContext msg ctx m' a' m (Maybe ctx)
P.makeSem ''ConstructContext
data BasicContext m a = BasicContext
{ BasicContext m a -> Text
bcPrefix :: L.Text
, BasicContext m a -> Command m (BasicContext m a) a
bcCommand :: Command m (BasicContext m a) a
, BasicContext m a -> Text
bcUnparsedParams :: L.Text
}
deriving (Int -> BasicContext m a -> ShowS
[BasicContext m a] -> ShowS
BasicContext m a -> String
(Int -> BasicContext m a -> ShowS)
-> (BasicContext m a -> String)
-> ([BasicContext m a] -> ShowS)
-> Show (BasicContext m a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) a. Int -> BasicContext m a -> ShowS
forall (m :: * -> *) a. [BasicContext m a] -> ShowS
forall (m :: * -> *) a. BasicContext m a -> String
showList :: [BasicContext m a] -> ShowS
$cshowList :: forall (m :: * -> *) a. [BasicContext m a] -> ShowS
show :: BasicContext m a -> String
$cshow :: forall (m :: * -> *) a. BasicContext m a -> String
showsPrec :: Int -> BasicContext m a -> ShowS
$cshowsPrec :: forall (m :: * -> *) a. Int -> BasicContext m a -> ShowS
Show, (forall x. BasicContext m a -> Rep (BasicContext m a) x)
-> (forall x. Rep (BasicContext m a) x -> BasicContext m a)
-> Generic (BasicContext m a)
forall x. Rep (BasicContext m a) x -> BasicContext m a
forall x. BasicContext m a -> Rep (BasicContext m a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) a x.
Rep (BasicContext m a) x -> BasicContext m a
forall (m :: * -> *) a x.
BasicContext m a -> Rep (BasicContext m a) x
$cto :: forall (m :: * -> *) a x.
Rep (BasicContext m a) x -> BasicContext m a
$cfrom :: forall (m :: * -> *) a x.
BasicContext m a -> Rep (BasicContext m a) x
Generic)
instance CommandContext m (BasicContext m a) a where
ctxPrefix :: BasicContext m a -> Text
ctxPrefix = BasicContext m a -> Text
forall (m :: * -> *) a. BasicContext m a -> Text
bcPrefix
ctxCommand :: BasicContext m a -> Command m (BasicContext m a) a
ctxCommand = BasicContext m a -> Command m (BasicContext m a) a
forall (m :: * -> *) a.
BasicContext m a -> Command m (BasicContext m a) a
bcCommand
ctxUnparsedParams :: BasicContext m a -> Text
ctxUnparsedParams = BasicContext m a -> Text
forall (m :: * -> *) a. BasicContext m a -> Text
bcUnparsedParams
useBasicContext :: P.Sem (ConstructContext msg (BasicContext m a') m a' ': r) a -> P.Sem r a
useBasicContext :: Sem (ConstructContext msg (BasicContext m a') m a' : r) a
-> Sem r a
useBasicContext =
(forall (rInitial :: EffectRow) x.
ConstructContext msg (BasicContext m a') m a' (Sem rInitial) x
-> Sem r x)
-> Sem (ConstructContext msg (BasicContext m a') m a' : r) a
-> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret
( \case
ConstructContext (pre, cmd, up) _ -> Maybe (BasicContext m a') -> Sem r (Maybe (BasicContext m a'))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (BasicContext m a') -> Sem r (Maybe (BasicContext m a')))
-> (BasicContext m a' -> Maybe (BasicContext m a'))
-> BasicContext m a'
-> Sem r (Maybe (BasicContext m a'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BasicContext m a' -> Maybe (BasicContext m a')
forall a. a -> Maybe a
Just (BasicContext m a' -> Sem r (Maybe (BasicContext m a')))
-> BasicContext m a' -> Sem r (Maybe (BasicContext m a'))
forall a b. (a -> b) -> a -> b
$ Text
-> Command m (BasicContext m a') a' -> Text -> BasicContext m a'
forall (m :: * -> *) a.
Text -> Command m (BasicContext m a) a -> Text -> BasicContext m a
BasicContext Text
pre Command m (BasicContext m a') a'
cmd Text
up
)