{-# LANGUAGE TemplateHaskell #-}
module CalamityCommands.Context (
CommandContext (..),
ConstructContext (..),
constructContext,
BasicContext (..),
useBasicContext,
) where
import CalamityCommands.Command
import Data.Text qualified as T
import Optics.TH
import Polysemy qualified as P
class CommandContext m c a | c -> m, c -> a where
ctxPrefix :: c -> T.Text
ctxCommand :: c -> Command m c a
ctxUnparsedParams :: c -> T.Text
data ConstructContext msg ctx m' a' m a where
ConstructContext ::
(T.Text, Command m' ctx a', T.Text) ->
msg ->
ConstructContext msg ctx m' a' m (Maybe ctx)
P.makeSem ''ConstructContext
data BasicContext m a = BasicContext
{ forall (m :: * -> *) a. BasicContext m a -> Text
bcPrefix :: T.Text
, forall (m :: * -> *) a.
BasicContext m a -> Command m (BasicContext m a) a
bcCommand :: Command m (BasicContext m a) a
, forall (m :: * -> *) a. BasicContext m a -> Text
bcUnparsedParams :: T.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
$cshowsPrec :: forall (m :: * -> *) a. Int -> BasicContext m a -> ShowS
showsPrec :: Int -> BasicContext m a -> ShowS
$cshow :: forall (m :: * -> *) a. BasicContext m a -> String
show :: BasicContext m a -> String
$cshowList :: forall (m :: * -> *) a. [BasicContext m a] -> ShowS
showList :: [BasicContext m a] -> ShowS
Show)
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 :: forall msg (m :: * -> *) a' (r :: EffectRow) a.
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 :: Effect) (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 (Text
pre, Command m (BasicContext m a') a'
cmd, Text
up) msg
_ -> x -> Sem r x
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> Sem r x)
-> (BasicContext m a' -> x) -> BasicContext m a' -> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BasicContext m a' -> x
BasicContext m a' -> Maybe (BasicContext m a')
forall a. a -> Maybe a
Just (BasicContext m a' -> Sem r x) -> BasicContext m a' -> Sem r x
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
)
$(makeFieldLabelsNoPrefix ''BasicContext)