{-# LANGUAGE RecursiveDo #-}
-- | Command handler utilities
module Calamity.Commands.Utils
    ( addCommands
    , buildCommands
    , buildContext ) where

import           Calamity.Cache.Eff
import           Calamity.Metrics.Eff
import           Calamity.Client.Client
import           Calamity.Client.Types
import           Calamity.Commands.Command
import           Calamity.Commands.CommandUtils
import           Calamity.Commands.Context
import           Calamity.Commands.Dsl
import           Calamity.Commands.Handler
import           Calamity.Commands.Error
import           Calamity.Commands.Group
import           Calamity.Commands.ParsePrefix
import           Calamity.Internal.LocalWriter
import           Calamity.Internal.Utils
import           Calamity.Types.Model.Channel
import           Calamity.Types.Model.User
import           Calamity.Types.Snowflake

import           Control.Lens                   hiding ( Context )
import           Control.Monad

import           Data.Char                      ( isSpace )
import qualified Data.HashMap.Lazy              as LH
import qualified Data.Text                      as S
import qualified Data.Text.Lazy                 as L

import qualified Polysemy                       as P
import qualified Polysemy.Error                 as P
import qualified Polysemy.Fail                  as P
import qualified Polysemy.Tagged                as P
import qualified Polysemy.Fixpoint              as P
import qualified Polysemy.Reader                as P

mapLeft :: (e -> e') -> Either e a -> Either e' a
mapLeft :: (e -> e') -> Either e a -> Either e' a
mapLeft f :: e -> e'
f (Left x :: e
x)  = e' -> Either e' a
forall a b. a -> Either a b
Left (e' -> Either e' a) -> e' -> Either e' a
forall a b. (a -> b) -> a -> b
$ e -> e'
f e
x
mapLeft _ (Right x :: a
x) = a -> Either e' a
forall a b. b -> Either a b
Right a
x

data FailReason
  = NoPrefix
  | NoCtx
  | NF [L.Text]
  | ERR Context CommandError

-- | Construct commands and groups from a command DSL, then registers an event
-- handler on the bot that manages running those commands.
--
-- Returns an action to remove the event handler, and the 'CommandHandler' that was constructed
addCommands :: (BotC r, P.Member ParsePrefix r) => P.Sem (DSLState r) a -> P.Sem r (P.Sem r (), CommandHandler, a)
addCommands :: Sem (DSLState r) a -> Sem r (Sem r (), CommandHandler, a)
addCommands m :: Sem (DSLState r) a
m = do
  (handler :: CommandHandler
handler, res :: a
res) <- Sem (DSLState r) a -> Sem r (CommandHandler, a)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
Sem (DSLState r) a -> Sem r (CommandHandler, a)
buildCommands Sem (DSLState r) a
m
  Sem r ()
remove <- forall (r :: [(* -> *) -> * -> *]) t eh ehIO.
(BotC r, ReactConstraints r 'MessageCreateEvt eh ehIO t) =>
EHType 'MessageCreateEvt (Sem r) () -> Sem r (Sem r ())
forall (s :: EventType) (r :: [(* -> *) -> * -> *]) t eh ehIO.
(BotC r, ReactConstraints r s eh ehIO t) =>
EHType s (Sem r) () -> Sem r (Sem r ())
react @'MessageCreateEvt (EHType 'MessageCreateEvt (Sem r) () -> Sem r (Sem r ()))
-> EHType 'MessageCreateEvt (Sem r) () -> Sem r (Sem r ())
forall a b. (a -> b) -> a -> b
$ \msg :: Message
msg -> do
    Either FailReason Context
err <- Sem (Error FailReason : r) Context
-> Sem r (Either FailReason Context)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error FailReason : r) Context
 -> Sem r (Either FailReason Context))
-> Sem (Error FailReason : r) Context
-> Sem r (Either FailReason Context)
forall a b. (a -> b) -> a -> b
$ do
      (prefix :: Text
prefix, rest :: Text
rest) <- FailReason
-> Maybe (Text, Text) -> Sem (Error FailReason : r) (Text, Text)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
P.note FailReason
NoPrefix (Maybe (Text, Text) -> Sem (Error FailReason : r) (Text, Text))
-> Sem (Error FailReason : r) (Maybe (Text, Text))
-> Sem (Error FailReason : r) (Text, Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message -> Sem (Error FailReason : r) (Maybe (Text, Text))
forall (r :: [(* -> *) -> * -> *]).
MemberWithError ParsePrefix r =>
Message -> Sem r (Maybe (Text, Text))
parsePrefix Message
msg
      (command :: Command
command, unparsedParams :: Text
unparsedParams) <- Either FailReason (Command, Text)
-> Sem (Error FailReason : r) (Command, Text)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either FailReason (Command, Text)
 -> Sem (Error FailReason : r) (Command, Text))
-> Either FailReason (Command, Text)
-> Sem (Error FailReason : r) (Command, Text)
forall a b. (a -> b) -> a -> b
$ ([Text] -> FailReason)
-> Either [Text] (Command, Text)
-> Either FailReason (Command, Text)
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft [Text] -> FailReason
NF (Either [Text] (Command, Text)
 -> Either FailReason (Command, Text))
-> Either [Text] (Command, Text)
-> Either FailReason (Command, Text)
forall a b. (a -> b) -> a -> b
$ CommandHandler -> Text -> Either [Text] (Command, Text)
findCommand CommandHandler
handler Text
rest
      Context
ctx <- FailReason -> Maybe Context -> Sem (Error FailReason : r) Context
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
P.note FailReason
NoCtx (Maybe Context -> Sem (Error FailReason : r) Context)
-> Sem (Error FailReason : r) (Maybe Context)
-> Sem (Error FailReason : r) Context
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message
-> Text
-> Command
-> Text
-> Sem (Error FailReason : r) (Maybe Context)
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
Message -> Text -> Command -> Text -> Sem r (Maybe Context)
buildContext Message
msg Text
prefix Command
command Text
unparsedParams
      Either FailReason () -> Sem (Error FailReason : r) ()
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either FailReason () -> Sem (Error FailReason : r) ())
-> (Either CommandError () -> Either FailReason ())
-> Either CommandError ()
-> Sem (Error FailReason : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandError -> FailReason)
-> Either CommandError () -> Either FailReason ()
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft (Context -> CommandError -> FailReason
ERR Context
ctx) (Either CommandError () -> Sem (Error FailReason : r) ())
-> Sem (Error FailReason : r) (Either CommandError ())
-> Sem (Error FailReason : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context
-> Command -> Sem (Error FailReason : r) (Either CommandError ())
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Context -> Command -> Sem r (Either CommandError ())
invokeCommand Context
ctx (Context
ctx Context -> Getting Command Context Command -> Command
forall s a. s -> Getting a s a -> a
^. IsLabel "command" (Getting Command Context Command)
Getting Command Context Command
#command)
      Context -> Sem (Error FailReason : r) Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context
ctx
    case Either FailReason Context
err of
      Left (ERR ctx :: Context
ctx e :: CommandError
e) -> CalamityEvent -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CalamityEvent -> Sem r ()
fire (CalamityEvent -> Sem r ()) -> CalamityEvent -> Sem r ()
forall a b. (a -> b) -> a -> b
$ (Context, CommandError) -> CalamityEvent
forall k (s :: k) a. (Typeable s, Typeable a) => a -> CalamityEvent
customEvt @"command-error" (Context
ctx, CommandError
e)
      Left (NF path :: [Text]
path)   -> CalamityEvent -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CalamityEvent -> Sem r ()
fire (CalamityEvent -> Sem r ()) -> CalamityEvent -> Sem r ()
forall a b. (a -> b) -> a -> b
$ [Text] -> CalamityEvent
forall k (s :: k) a. (Typeable s, Typeable a) => a -> CalamityEvent
customEvt @"command-not-found" [Text]
path
      Left _           -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- ignore if no prefix or if context couldn't be built
      Right ctx :: Context
ctx        -> do
        Counter
cmdInvoke <- Text -> [(Text, Text)] -> Sem r Counter
forall (r :: [(* -> *) -> * -> *]).
MemberWithError MetricEff r =>
Text -> [(Text, Text)] -> Sem r Counter
registerCounter "commands_invoked" [("name", [Text] -> Text
S.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Command -> [Text]
commandPath (Context
ctx Context -> Getting Command Context Command -> Command
forall s a. s -> Getting a s a -> a
^. IsLabel "command" (Getting Command Context Command)
Getting Command Context Command
#command))]
        Sem r Int -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Int -> Sem r ()) -> Sem r Int -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Int -> Counter -> Sem r Int
forall (r :: [(* -> *) -> * -> *]).
MemberWithError MetricEff r =>
Int -> Counter -> Sem r Int
addCounter 1 Counter
cmdInvoke
        CalamityEvent -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CalamityEvent -> Sem r ()
fire (CalamityEvent -> Sem r ()) -> CalamityEvent -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Context -> CalamityEvent
forall k (s :: k) a. (Typeable s, Typeable a) => a -> CalamityEvent
customEvt @"command-invoked" Context
ctx
  (Sem r (), CommandHandler, a)
-> Sem r (Sem r (), CommandHandler, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sem r ()
remove, CommandHandler
handler, a
res)


-- | Run a command DSL, returning the constructed 'CommandHandler'
buildCommands :: forall r a. P.Member (P.Final IO) r
              => P.Sem (DSLState r) a
              -> P.Sem r (CommandHandler, a)
buildCommands :: Sem (DSLState r) a -> Sem r (CommandHandler, a)
buildCommands m :: Sem (DSLState r) a
m = Sem (Fixpoint : r) (CommandHandler, a) -> Sem r (CommandHandler, a)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, MonadFix m) =>
Sem (Fixpoint : r) a -> Sem r a
P.fixpointToFinal (Sem (Fixpoint : r) (CommandHandler, a)
 -> Sem r (CommandHandler, a))
-> Sem (Fixpoint : r) (CommandHandler, a)
-> Sem r (CommandHandler, a)
forall a b. (a -> b) -> a -> b
$ mdo
  (groups :: HashMap Text Group
groups, (cmds :: HashMap Text Command
cmds, a :: a
a)) <- CommandHandler
-> Sem (DSLState r) a
-> Sem
     (Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a))
inner CommandHandler
handler Sem (DSLState r) a
m
  let handler :: CommandHandler
handler = HashMap Text Group -> HashMap Text Command -> CommandHandler
CommandHandler HashMap Text Group
groups HashMap Text Command
cmds
  (CommandHandler, a) -> Sem (Fixpoint : r) (CommandHandler, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommandHandler
handler, a
a)

  where inner :: CommandHandler -> P.Sem (DSLState r) a -> P.Sem (P.Fixpoint ': r) (LH.HashMap S.Text Group, (LH.HashMap S.Text Command, a))
        inner :: CommandHandler
-> Sem (DSLState r) a
-> Sem
     (Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a))
inner h :: CommandHandler
h =
          CommandHandler
-> Sem
     (Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
-> Sem
     (Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader CommandHandler
h (Sem
   (Reader CommandHandler : Fixpoint : r)
   (HashMap Text Group, (HashMap Text Command, a))
 -> Sem
      (Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
    -> Sem
         (Reader CommandHandler : Fixpoint : r)
         (HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
     (Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          [Check]
-> Sem
     (Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
-> Sem
     (Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader [] (Sem
   (Reader [Check] : Reader CommandHandler : Fixpoint : r)
   (HashMap Text Group, (HashMap Text Command, a))
 -> Sem
      (Reader CommandHandler : Fixpoint : r)
      (HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
    -> Sem
         (Reader [Check] : Reader CommandHandler : Fixpoint : r)
         (HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
     (Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (Context -> Text)
-> Sem
     (Reader (Context -> Text)
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
-> Sem
     (Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Context -> Text
forall a b. IsString a => b -> a
defaultHelp (Sem
   (Reader (Context -> Text)
      : Reader [Check] : Reader CommandHandler : Fixpoint : r)
   (HashMap Text Group, (HashMap Text Command, a))
 -> Sem
      (Reader [Check] : Reader CommandHandler : Fixpoint : r)
      (HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
    -> Sem
         (Reader (Context -> Text)
            : Reader [Check] : Reader CommandHandler : Fixpoint : r)
         (HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
     (Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 (k2 :: k1) (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (Tagged "original-help" e : r) a -> Sem (e : r) a
P.untag @"original-help" (Sem
   (Tagged "original-help" (Reader (Context -> Text))
      : Reader [Check] : Reader CommandHandler : Fixpoint : r)
   (HashMap Text Group, (HashMap Text Command, a))
 -> Sem
      (Reader (Context -> Text)
         : Reader [Check] : Reader CommandHandler : Fixpoint : r)
      (HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
    -> Sem
         (Tagged "original-help" (Reader (Context -> Text))
            : Reader [Check] : Reader CommandHandler : Fixpoint : r)
         (HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
     (Reader (Context -> Text)
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (Context -> Text)
-> Sem
     (Reader (Context -> Text)
        : Tagged "original-help" (Reader (Context -> Text))
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
-> Sem
     (Tagged "original-help" (Reader (Context -> Text))
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Context -> Text
forall a b. IsString a => b -> a
defaultHelp (Sem
   (Reader (Context -> Text)
      : Tagged "original-help" (Reader (Context -> Text))
      : Reader [Check] : Reader CommandHandler : Fixpoint : r)
   (HashMap Text Group, (HashMap Text Command, a))
 -> Sem
      (Tagged "original-help" (Reader (Context -> Text))
         : Reader [Check] : Reader CommandHandler : Fixpoint : r)
      (HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
    -> Sem
         (Reader (Context -> Text)
            : Tagged "original-help" (Reader (Context -> Text))
            : Reader [Check] : Reader CommandHandler : Fixpoint : r)
         (HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
     (Tagged "original-help" (Reader (Context -> Text))
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          Maybe Group
-> Sem
     (Reader (Maybe Group)
        : Reader (Context -> Text)
        : Tagged "original-help" (Reader (Context -> Text))
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
-> Sem
     (Reader (Context -> Text)
        : Tagged "original-help" (Reader (Context -> Text))
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Maybe Group
forall a. Maybe a
Nothing (Sem
   (Reader (Maybe Group)
      : Reader (Context -> Text)
      : Tagged "original-help" (Reader (Context -> Text))
      : Reader [Check] : Reader CommandHandler : Fixpoint : r)
   (HashMap Text Group, (HashMap Text Command, a))
 -> Sem
      (Reader (Context -> Text)
         : Tagged "original-help" (Reader (Context -> Text))
         : Reader [Check] : Reader CommandHandler : Fixpoint : r)
      (HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
    -> Sem
         (Reader (Maybe Group)
            : Reader (Context -> Text)
            : Tagged "original-help" (Reader (Context -> Text))
            : Reader [Check] : Reader CommandHandler : Fixpoint : r)
         (HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
     (Reader (Context -> Text)
        : Tagged "original-help" (Reader (Context -> Text))
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall (r :: [(* -> *) -> * -> *]) a.
Monoid (HashMap Text Group) =>
Sem (LocalWriter (HashMap Text Group) : r) a
-> Sem r (HashMap Text Group, a)
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text Group) (Sem
   (LocalWriter (HashMap Text Group)
      : Reader (Maybe Group) : Reader (Context -> Text)
      : Tagged "original-help" (Reader (Context -> Text))
      : Reader [Check] : Reader CommandHandler : Fixpoint : r)
   (HashMap Text Command, a)
 -> Sem
      (Reader (Maybe Group)
         : Reader (Context -> Text)
         : Tagged "original-help" (Reader (Context -> Text))
         : Reader [Check] : Reader CommandHandler : Fixpoint : r)
      (HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
    -> Sem
         (LocalWriter (HashMap Text Group)
            : Reader (Maybe Group) : Reader (Context -> Text)
            : Tagged "original-help" (Reader (Context -> Text))
            : Reader [Check] : Reader CommandHandler : Fixpoint : r)
         (HashMap Text Command, a))
-> Sem (DSLState r) a
-> Sem
     (Reader (Maybe Group)
        : Reader (Context -> Text)
        : Tagged "original-help" (Reader (Context -> Text))
        : Reader [Check] : Reader CommandHandler : Fixpoint : r)
     (HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall (r :: [(* -> *) -> * -> *]) a.
Monoid (HashMap Text Command) =>
Sem (LocalWriter (HashMap Text Command) : r) a
-> Sem r (HashMap Text Command, a)
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text Command)
        defaultHelp :: b -> a
defaultHelp = (a -> b -> a
forall a b. a -> b -> a
const "This command or group has no help.")


-- | Attempt to build the context for a command
buildContext :: BotC r => Message -> L.Text -> Command -> L.Text -> P.Sem r (Maybe Context)
buildContext :: Message -> Text -> Command -> Text -> Sem r (Maybe Context)
buildContext msg :: Message
msg prefix :: Text
prefix command :: Command
command unparsed :: Text
unparsed = (Either String Context -> Maybe Context
forall e a. Either e a -> Maybe a
rightToMaybe (Either String Context -> Maybe Context)
-> Sem r (Either String Context) -> Sem r (Maybe Context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Sem r (Either String Context) -> Sem r (Maybe Context))
-> (Sem (Fail : r) Context -> Sem r (Either String Context))
-> Sem (Fail : r) Context
-> Sem r (Maybe Context)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Fail : r) Context -> Sem r (Either String Context)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (Fail : r) a -> Sem r (Either String a)
P.runFail (Sem (Fail : r) Context -> Sem r (Maybe Context))
-> Sem (Fail : r) Context -> Sem r (Maybe Context)
forall a b. (a -> b) -> a -> b
$ do
  Maybe Guild
guild <- Maybe (Maybe Guild) -> Maybe Guild
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Guild) -> Maybe Guild)
-> Sem (Fail : r) (Maybe (Maybe Guild))
-> Sem (Fail : r) (Maybe Guild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Snowflake Guild -> Sem (Fail : r) (Maybe Guild)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (Snowflake Guild -> Sem (Fail : r) (Maybe Guild))
-> Maybe (Snowflake Guild) -> Sem (Fail : r) (Maybe (Maybe Guild))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` (Message
msg Message
-> Getting
     (Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild))
-> Maybe (Snowflake Guild)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "guildID"
  (Getting
     (Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild)))
Getting (Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild))
#guildID)
  let member :: Maybe Member
member = Maybe Guild
guild Maybe Guild
-> Getting (First Member) (Maybe Guild) Member -> Maybe Member
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Guild -> Const (First Member) Guild)
-> Maybe Guild -> Const (First Member) (Maybe Guild)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Guild -> Const (First Member) Guild)
 -> Maybe Guild -> Const (First Member) (Maybe Guild))
-> ((Member -> Const (First Member) Member)
    -> Guild -> Const (First Member) Guild)
-> Getting (First Member) (Maybe Guild) Member
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "members"
  ((SnowflakeMap Member
    -> Const (First Member) (SnowflakeMap Member))
   -> Guild -> Const (First Member) Guild)
(SnowflakeMap Member -> Const (First Member) (SnowflakeMap Member))
-> Guild -> Const (First Member) Guild
#members ((SnowflakeMap Member
  -> Const (First Member) (SnowflakeMap Member))
 -> Guild -> Const (First Member) Guild)
-> ((Member -> Const (First Member) Member)
    -> SnowflakeMap Member
    -> Const (First Member) (SnowflakeMap Member))
-> (Member -> Const (First Member) Member)
-> Guild
-> Const (First Member) Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Member)
-> Traversal' (SnowflakeMap Member) (IxValue (SnowflakeMap Member))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Snowflake User -> Index (SnowflakeMap Member)
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake User -> Index (SnowflakeMap Member))
-> Snowflake User -> Index (SnowflakeMap Member)
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake User
forall b a. HasID b a => a -> Snowflake b
getID @User Message
msg)
  let gchan :: Maybe GuildChannel
gchan = Maybe Guild
guild Maybe Guild
-> Getting (First GuildChannel) (Maybe Guild) GuildChannel
-> Maybe GuildChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Guild -> Const (First GuildChannel) Guild)
-> Maybe Guild -> Const (First GuildChannel) (Maybe Guild)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Guild -> Const (First GuildChannel) Guild)
 -> Maybe Guild -> Const (First GuildChannel) (Maybe Guild))
-> ((GuildChannel -> Const (First GuildChannel) GuildChannel)
    -> Guild -> Const (First GuildChannel) Guild)
-> Getting (First GuildChannel) (Maybe Guild) GuildChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "channels"
  ((SnowflakeMap GuildChannel
    -> Const (First GuildChannel) (SnowflakeMap GuildChannel))
   -> Guild -> Const (First GuildChannel) Guild)
(SnowflakeMap GuildChannel
 -> Const (First GuildChannel) (SnowflakeMap GuildChannel))
-> Guild -> Const (First GuildChannel) Guild
#channels ((SnowflakeMap GuildChannel
  -> Const (First GuildChannel) (SnowflakeMap GuildChannel))
 -> Guild -> Const (First GuildChannel) Guild)
-> ((GuildChannel -> Const (First GuildChannel) GuildChannel)
    -> SnowflakeMap GuildChannel
    -> Const (First GuildChannel) (SnowflakeMap GuildChannel))
-> (GuildChannel -> Const (First GuildChannel) GuildChannel)
-> Guild
-> Const (First GuildChannel) Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap GuildChannel)
-> Traversal'
     (SnowflakeMap GuildChannel) (IxValue (SnowflakeMap GuildChannel))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Snowflake Channel -> Index (SnowflakeMap GuildChannel)
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake Channel -> Index (SnowflakeMap GuildChannel))
-> Snowflake Channel -> Index (SnowflakeMap GuildChannel)
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID @Channel Message
msg)
  Just channel :: Channel
channel <- case Maybe GuildChannel
gchan of
    Just chan :: GuildChannel
chan -> Maybe Channel -> Sem (Fail : r) (Maybe Channel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Channel -> Sem (Fail : r) (Maybe Channel))
-> (Channel -> Maybe Channel)
-> Channel
-> Sem (Fail : r) (Maybe Channel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Maybe Channel
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Channel -> Sem (Fail : r) (Maybe Channel))
-> Channel -> Sem (Fail : r) (Maybe Channel)
forall a b. (a -> b) -> a -> b
$ GuildChannel -> Channel
GuildChannel' GuildChannel
chan
    _         -> DMChannel -> Channel
DMChannel' (DMChannel -> Channel)
-> Sem (Fail : r) (Maybe DMChannel)
-> Sem (Fail : r) (Maybe Channel)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> Snowflake DMChannel -> Sem (Fail : r) (Maybe DMChannel)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (Snowflake Channel -> Snowflake DMChannel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake Channel -> Snowflake DMChannel)
-> Snowflake Channel -> Snowflake DMChannel
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID @Channel Message
msg)
  Just user :: User
user <- Snowflake User -> Sem (Fail : r) (Maybe User)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake User -> Sem r (Maybe User)
getUser (Snowflake User -> Sem (Fail : r) (Maybe User))
-> Snowflake User -> Sem (Fail : r) (Maybe User)
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake User
forall b a. HasID b a => a -> Snowflake b
getID Message
msg

  Context -> Sem (Fail : r) Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context -> Sem (Fail : r) Context)
-> Context -> Sem (Fail : r) Context
forall a b. (a -> b) -> a -> b
$ Message
-> Maybe Guild
-> Maybe Member
-> Channel
-> User
-> Command
-> Text
-> Text
-> Context
Context Message
msg Maybe Guild
guild Maybe Member
member Channel
channel User
user Command
command Text
prefix Text
unparsed

nextWord :: L.Text -> (L.Text, L.Text)
nextWord :: Text -> (Text, Text)
nextWord = (Char -> Bool) -> Text -> (Text, Text)
L.break Char -> Bool
isSpace (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
L.stripStart

findCommand :: CommandHandler -> L.Text -> Either [L.Text] (Command, L.Text)
findCommand :: CommandHandler -> Text -> Either [Text] (Command, Text)
findCommand handler :: CommandHandler
handler msg :: Text
msg = (Text, Text) -> Either [Text] (Command, Text)
goH ((Text, Text) -> Either [Text] (Command, Text))
-> (Text, Text) -> Either [Text] (Command, Text)
forall a b. (a -> b) -> a -> b
$ Text -> (Text, Text)
nextWord Text
msg
  where
    goH :: (L.Text, L.Text) -> Either [L.Text] (Command, L.Text)
    goH :: (Text, Text) -> Either [Text] (Command, Text)
goH ("", _) = [Text] -> Either [Text] (Command, Text)
forall a b. a -> Either a b
Left []
    goH (x :: Text
x, xs :: Text
xs) = Text
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Text -> Either [Text] a -> Either [Text] a
attachSoFar Text
x
      (((, Text
xs) (Command -> (Command, Text))
-> Either [Text] Command -> Either [Text] (Command, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Command -> Either [Text] Command
forall a. Maybe a -> Either [Text] a
attachInitial (Text -> HashMap Text Command -> Maybe Command
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (CommandHandler
handler CommandHandler
-> Getting
     (HashMap Text Command) CommandHandler (HashMap Text Command)
-> HashMap Text Command
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text Command) CommandHandler (HashMap Text Command))
Getting
  (HashMap Text Command) CommandHandler (HashMap Text Command)
#commands)))
       Either [Text] (Command, Text)
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe Group -> Either [Text] Group
forall a. Maybe a -> Either [Text] a
attachInitial (Text -> HashMap Text Group -> Maybe Group
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (CommandHandler
handler CommandHandler
-> Getting (HashMap Text Group) CommandHandler (HashMap Text Group)
-> HashMap Text Group
forall s a. s -> Getting a s a -> a
^. IsLabel
  "groups"
  (Getting (HashMap Text Group) CommandHandler (HashMap Text Group))
Getting (HashMap Text Group) CommandHandler (HashMap Text Group)
#groups)) Either [Text] Group
-> (Group -> Either [Text] (Command, Text))
-> Either [Text] (Command, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Text) -> Group -> Either [Text] (Command, Text)
goG (Text -> (Text, Text)
nextWord Text
xs)))

    goG :: (L.Text, L.Text) -> Group -> Either [L.Text] (Command, L.Text)
    goG :: (Text, Text) -> Group -> Either [Text] (Command, Text)
goG ("", _) _ = [Text] -> Either [Text] (Command, Text)
forall a b. a -> Either a b
Left []
    goG (x :: Text
x, xs :: Text
xs) g :: Group
g = Text
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Text -> Either [Text] a -> Either [Text] a
attachSoFar Text
x
      (((, Text
xs) (Command -> (Command, Text))
-> Either [Text] Command -> Either [Text] (Command, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Command -> Either [Text] Command
forall a. Maybe a -> Either [Text] a
attachInitial (Text -> HashMap Text Command -> Maybe Command
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (Group
g Group
-> Getting (HashMap Text Command) Group (HashMap Text Command)
-> HashMap Text Command
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting (HashMap Text Command) Group (HashMap Text Command))
Getting (HashMap Text Command) Group (HashMap Text Command)
#commands)))
       Either [Text] (Command, Text)
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe Group -> Either [Text] Group
forall a. Maybe a -> Either [Text] a
attachInitial (Text -> HashMap Text Group -> Maybe Group
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (Group
g Group
-> Getting (HashMap Text Group) Group (HashMap Text Group)
-> HashMap Text Group
forall s a. s -> Getting a s a -> a
^. IsLabel
  "children"
  (Getting (HashMap Text Group) Group (HashMap Text Group))
Getting (HashMap Text Group) Group (HashMap Text Group)
#children)) Either [Text] Group
-> (Group -> Either [Text] (Command, Text))
-> Either [Text] (Command, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Text) -> Group -> Either [Text] (Command, Text)
goG (Text -> (Text, Text)
nextWord Text
xs)))

    attachInitial :: Maybe a -> Either [L.Text] a
    attachInitial :: Maybe a -> Either [Text] a
attachInitial (Just a :: a
a) = a -> Either [Text] a
forall a b. b -> Either a b
Right a
a
    attachInitial Nothing = [Text] -> Either [Text] a
forall a b. a -> Either a b
Left []

    attachSoFar :: L.Text -> Either [L.Text] a -> Either [L.Text] a
    attachSoFar :: Text -> Either [Text] a -> Either [Text] a
attachSoFar cmd :: Text
cmd (Left xs :: [Text]
xs) = [Text] -> Either [Text] a
forall a b. a -> Either a b
Left (Text
cmdText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs)
    attachSoFar _ r :: Either [Text] a
r = Either [Text] a
r