{-# LANGUAGE RecursiveDo #-}

-- | Command handler utilities
module CalamityCommands.Utils (
  buildCommands,
  processCommands,
  handleCommands,
  findCommand,
  CmdInvokeFailReason (..),
) where

import CalamityCommands.AliasType
import CalamityCommands.Command
import CalamityCommands.CommandUtils
import CalamityCommands.Context
import CalamityCommands.Dsl
import CalamityCommands.Error
import CalamityCommands.Group
import CalamityCommands.Handler
import CalamityCommands.Internal.LocalWriter
import CalamityCommands.ParsePrefix

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

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 GHC.Generics (Generic)

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

mapLeft :: (e -> e') -> Either e a -> Either e' a
mapLeft :: (e -> e') -> Either e a -> Either e' a
mapLeft e -> e'
f (Left 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 e -> e'
_ (Right a
x) = a -> Either e' a
forall a b. b -> Either a b
Right a
x

data CmdInvokeFailReason c
  = NoContext
  | NotFound [L.Text]
  | CommandInvokeError c CommandError
  deriving (Int -> CmdInvokeFailReason c -> ShowS
[CmdInvokeFailReason c] -> ShowS
CmdInvokeFailReason c -> String
(Int -> CmdInvokeFailReason c -> ShowS)
-> (CmdInvokeFailReason c -> String)
-> ([CmdInvokeFailReason c] -> ShowS)
-> Show (CmdInvokeFailReason c)
forall c. Show c => Int -> CmdInvokeFailReason c -> ShowS
forall c. Show c => [CmdInvokeFailReason c] -> ShowS
forall c. Show c => CmdInvokeFailReason c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmdInvokeFailReason c] -> ShowS
$cshowList :: forall c. Show c => [CmdInvokeFailReason c] -> ShowS
show :: CmdInvokeFailReason c -> String
$cshow :: forall c. Show c => CmdInvokeFailReason c -> String
showsPrec :: Int -> CmdInvokeFailReason c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> CmdInvokeFailReason c -> ShowS
Show, (forall x. CmdInvokeFailReason c -> Rep (CmdInvokeFailReason c) x)
-> (forall x.
    Rep (CmdInvokeFailReason c) x -> CmdInvokeFailReason c)
-> Generic (CmdInvokeFailReason c)
forall x. Rep (CmdInvokeFailReason c) x -> CmdInvokeFailReason c
forall x. CmdInvokeFailReason c -> Rep (CmdInvokeFailReason c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (CmdInvokeFailReason c) x -> CmdInvokeFailReason c
forall c x. CmdInvokeFailReason c -> Rep (CmdInvokeFailReason c) x
$cto :: forall c x. Rep (CmdInvokeFailReason c) x -> CmdInvokeFailReason c
$cfrom :: forall c x. CmdInvokeFailReason c -> Rep (CmdInvokeFailReason c) x
Generic)

{- | Manages parsing messages and handling commands for a CommandHandler.

 Returns Nothing if the prefix didn't match.

 Returns Right with the context and result if the command succeeded in parsing
 and running, Left with the reason otherwise.
-}
processCommands ::
  ( Monad m
  , P.Members '[ParsePrefix msg, ConstructContext msg c m a, P.Embed m] r
  , CommandContext m c a
  ) =>
  CommandHandler m c a ->
  -- | The message that invoked the command
  msg ->
  P.Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
processCommands :: CommandHandler m c a
-> msg -> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
processCommands CommandHandler m c a
handler msg
msg =
  msg -> Sem r (Maybe (Text, Text))
forall msg (r :: [Effect]).
MemberWithError (ParsePrefix msg) r =>
msg -> Sem r (Maybe (Text, Text))
parsePrefix msg
msg Sem r (Maybe (Text, Text))
-> (Maybe (Text, Text)
    -> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a))))
-> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Text
pre, Text
cmd) -> Either (CmdInvokeFailReason c) (c, a)
-> Maybe (Either (CmdInvokeFailReason c) (c, a))
forall a. a -> Maybe a
Just (Either (CmdInvokeFailReason c) (c, a)
 -> Maybe (Either (CmdInvokeFailReason c) (c, a)))
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
-> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommandHandler m c a
-> msg
-> Text
-> Text
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
forall (m :: * -> *) msg c a (r :: [Effect]).
(Monad m, Members '[ConstructContext msg c m a, Embed m] r,
 CommandContext m c a) =>
CommandHandler m c a
-> msg
-> Text
-> Text
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
handleCommands CommandHandler m c a
handler msg
msg Text
pre Text
cmd
    Maybe (Text, Text)
Nothing -> Maybe (Either (CmdInvokeFailReason c) (c, a))
-> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either (CmdInvokeFailReason c) (c, a))
forall a. Maybe a
Nothing

{- | Manages finding the invoked command and parsing parameters for a
   CommandHandler.

 Returns Right with the context and result if the command succeeded in parsing
 and running, Left with the reason otherwise.
-}
handleCommands ::
  ( Monad m
  , P.Members '[ConstructContext msg c m a, P.Embed m] r
  , CommandContext m c a
  ) =>
  CommandHandler m c a ->
  -- | The message that invoked the command
  msg ->
  -- | The prefix used
  L.Text ->
  -- | The command string, without a prefix
  L.Text ->
  P.Sem r (Either (CmdInvokeFailReason c) (c, a))
handleCommands :: CommandHandler m c a
-> msg
-> Text
-> Text
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
handleCommands CommandHandler m c a
handler msg
msg Text
prefix Text
cmd = Sem (Error (CmdInvokeFailReason c) : r) (c, a)
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
forall e (r :: [Effect]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error (CmdInvokeFailReason c) : r) (c, a)
 -> Sem r (Either (CmdInvokeFailReason c) (c, a)))
-> Sem (Error (CmdInvokeFailReason c) : r) (c, a)
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
forall a b. (a -> b) -> a -> b
$ do
  (Command m c a
command, Text
unparsedParams) <- Either (CmdInvokeFailReason c) (Command m c a, Text)
-> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text)
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either (CmdInvokeFailReason c) (Command m c a, Text)
 -> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text))
-> (Either [Text] (Command m c a, Text)
    -> Either (CmdInvokeFailReason c) (Command m c a, Text))
-> Either [Text] (Command m c a, Text)
-> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> CmdInvokeFailReason c)
-> Either [Text] (Command m c a, Text)
-> Either (CmdInvokeFailReason c) (Command m c a, Text)
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft [Text] -> CmdInvokeFailReason c
forall c. [Text] -> CmdInvokeFailReason c
NotFound (Either [Text] (Command m c a, Text)
 -> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text))
-> Either [Text] (Command m c a, Text)
-> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text)
forall a b. (a -> b) -> a -> b
$ CommandHandler m c a -> Text -> Either [Text] (Command m c a, Text)
forall c a (m :: * -> *).
CommandHandler m c a -> Text -> Either [Text] (Command m c a, Text)
findCommand CommandHandler m c a
handler Text
cmd
  c
ctx <- CmdInvokeFailReason c
-> Maybe c -> Sem (Error (CmdInvokeFailReason c) : r) c
forall e (r :: [Effect]) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
P.note CmdInvokeFailReason c
forall c. CmdInvokeFailReason c
NoContext (Maybe c -> Sem (Error (CmdInvokeFailReason c) : r) c)
-> Sem (Error (CmdInvokeFailReason c) : r) (Maybe c)
-> Sem (Error (CmdInvokeFailReason c) : r) c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Text, Command m c a, Text)
-> msg -> Sem (Error (CmdInvokeFailReason c) : r) (Maybe c)
forall msg ctx (m' :: * -> *) a' (r :: [Effect]).
MemberWithError (ConstructContext msg ctx m' a') r =>
(Text, Command m' ctx a', Text) -> msg -> Sem r (Maybe ctx)
constructContext (Text
prefix, Command m c a
command, Text
unparsedParams) msg
msg
  a
r <- Either (CmdInvokeFailReason c) a
-> Sem (Error (CmdInvokeFailReason c) : r) a
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either (CmdInvokeFailReason c) a
 -> Sem (Error (CmdInvokeFailReason c) : r) a)
-> (Either CommandError a -> Either (CmdInvokeFailReason c) a)
-> Either CommandError a
-> Sem (Error (CmdInvokeFailReason c) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandError -> CmdInvokeFailReason c)
-> Either CommandError a -> Either (CmdInvokeFailReason c) a
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft (c -> CommandError -> CmdInvokeFailReason c
forall c. c -> CommandError -> CmdInvokeFailReason c
CommandInvokeError c
ctx) (Either CommandError a
 -> Sem (Error (CmdInvokeFailReason c) : r) a)
-> Sem (Error (CmdInvokeFailReason c) : r) (Either CommandError a)
-> Sem (Error (CmdInvokeFailReason c) : r) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< c
-> Command m c a
-> Sem (Error (CmdInvokeFailReason c) : r) (Either CommandError a)
forall (m :: * -> *) (r :: [Effect]) c a.
(Monad m, Member (Embed m) r) =>
c -> Command m c a -> Sem r (Either CommandError a)
invokeCommand c
ctx (c -> Command m c a
forall (m :: * -> *) c a.
CommandContext m c a =>
c -> Command m c a
ctxCommand c
ctx)
  (c, a) -> Sem (Error (CmdInvokeFailReason c) : r) (c, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c
ctx, a
r)

-- | Run a command DSL, returning the constructed 'CommandHandler'
buildCommands ::
  forall r c m a x.
  (Monad m, MonadFix m, P.Member (P.Final m) r) =>
  P.Sem (DSLState m c a r) x ->
  P.Sem r (CommandHandler m c a, x)
buildCommands :: Sem (DSLState m c a r) x -> Sem r (CommandHandler m c a, x)
buildCommands Sem (DSLState m c a r) x
m = Sem (Fixpoint : r) (CommandHandler m c a, x)
-> Sem r (CommandHandler m c a, x)
forall (m :: * -> *) (r :: [Effect]) a.
(Member (Final m) r, MonadFix m) =>
Sem (Fixpoint : r) a -> Sem r a
P.fixpointToFinal (Sem (Fixpoint : r) (CommandHandler m c a, x)
 -> Sem r (CommandHandler m c a, x))
-> Sem (Fixpoint : r) (CommandHandler m c a, x)
-> Sem r (CommandHandler m c a, x)
forall a b. (a -> b) -> a -> b
$ mdo
  (HashMap Text (Group m c a, AliasType)
groups, (HashMap Text (Command m c a, AliasType)
cmds, x
a)) <- CommandHandler m c a
-> Sem (DSLState m c a r) x
-> Sem
     (Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
inner CommandHandler m c a
handler Sem (DSLState m c a r) x
m
  let handler :: CommandHandler m c a
handler = HashMap Text (Group m c a, AliasType)
-> HashMap Text (Command m c a, AliasType) -> CommandHandler m c a
forall (m :: * -> *) c a.
HashMap Text (Group m c a, AliasType)
-> HashMap Text (Command m c a, AliasType) -> CommandHandler m c a
CommandHandler HashMap Text (Group m c a, AliasType)
groups HashMap Text (Command m c a, AliasType)
cmds
  (CommandHandler m c a, x)
-> Sem (Fixpoint : r) (CommandHandler m c a, x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommandHandler m c a
handler, x
a)
 where
  inner ::
    CommandHandler m c a ->
    P.Sem (DSLState m c a r) x ->
    P.Sem
      (P.Fixpoint ': r)
      ( LH.HashMap S.Text (Group m c a, AliasType)
      , (LH.HashMap S.Text (Command m c a, AliasType), x)
      )
  inner :: CommandHandler m c a
-> Sem (DSLState m c a r) x
-> Sem
     (Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
inner CommandHandler m c a
h =
    CommandHandler m c a
-> Sem
     (Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
-> Sem
     (Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader CommandHandler m c a
h
      (Sem
   (Reader (CommandHandler m c a) : Fixpoint : r)
   (HashMap Text (Group m c a, AliasType),
    (HashMap Text (Command m c a, AliasType), x))
 -> Sem
      (Fixpoint : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (Reader (CommandHandler m c a) : Fixpoint : r)
         (HashMap Text (Group m c a, AliasType),
          (HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
     (Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Check m c]
-> Sem
     (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
-> Sem
     (Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader []
      (Sem
   (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
   (HashMap Text (Group m c a, AliasType),
    (HashMap Text (Command m c a, AliasType), x))
 -> Sem
      (Reader (CommandHandler m c a) : Fixpoint : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
         (HashMap Text (Group m c a, AliasType),
          (HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
     (Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> Text)
-> Sem
     (Reader (c -> Text)
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
-> Sem
     (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader c -> Text
forall a b. IsString a => b -> a
defaultHelp
      (Sem
   (Reader (c -> Text)
      : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
      : r)
   (HashMap Text (Group m c a, AliasType),
    (HashMap Text (Command m c a, AliasType), x))
 -> Sem
      (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (Reader (c -> Text)
            : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
            : r)
         (HashMap Text (Group m c a, AliasType),
          (HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
     (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 (k2 :: k1) (e :: Effect) (r :: [Effect]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (e :: Effect) (r :: [Effect]) a.
Sem (Tagged "original-help" e : r) a -> Sem (e : r) a
P.untag @"original-help"
      (Sem
   (Tagged "original-help" (Reader (c -> Text))
      : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
      : r)
   (HashMap Text (Group m c a, AliasType),
    (HashMap Text (Command m c a, AliasType), x))
 -> Sem
      (Reader (c -> Text)
         : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
         : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (Tagged "original-help" (Reader (c -> Text))
            : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
            : r)
         (HashMap Text (Group m c a, AliasType),
          (HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
     (Reader (c -> Text)
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> Text)
-> Sem
     (Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
-> Sem
     (Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader c -> Text
forall a b. IsString a => b -> a
defaultHelp
      (Sem
   (Reader (c -> Text)
      : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
      : Reader (CommandHandler m c a) : Fixpoint : r)
   (HashMap Text (Group m c a, AliasType),
    (HashMap Text (Command m c a, AliasType), x))
 -> Sem
      (Tagged "original-help" (Reader (c -> Text))
         : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
         : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (Reader (c -> Text)
            : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
            : Reader (CommandHandler m c a) : Fixpoint : r)
         (HashMap Text (Group m c a, AliasType),
          (HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
     (Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Sem
     (Reader Bool
        : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
-> Sem
     (Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader Bool
False
      (Sem
   (Reader Bool
      : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
      : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
      : r)
   (HashMap Text (Group m c a, AliasType),
    (HashMap Text (Command m c a, AliasType), x))
 -> Sem
      (Reader (c -> Text)
         : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
         : Reader (CommandHandler m c a) : Fixpoint : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (Reader Bool
            : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
            : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
            : r)
         (HashMap Text (Group m c a, AliasType),
          (HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
     (Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 (k2 :: k1) (e :: Effect) (r :: [Effect]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (e :: Effect) (r :: [Effect]) a.
Sem (Tagged "hidden" e : r) a -> Sem (e : r) a
P.untag @"hidden"
      (Sem
   (Tagged "hidden" (Reader Bool)
      : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
      : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
      : r)
   (HashMap Text (Group m c a, AliasType),
    (HashMap Text (Command m c a, AliasType), x))
 -> Sem
      (Reader Bool
         : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
         : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
         : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (Tagged "hidden" (Reader Bool)
            : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
            : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
            : r)
         (HashMap Text (Group m c a, AliasType),
          (HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
     (Reader Bool
        : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Group m c a)
-> Sem
     (Reader (Maybe (Group m c a))
        : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
-> Sem
     (Tagged "hidden" (Reader Bool)
        : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader Maybe (Group m c a)
forall a. Maybe a
Nothing
      (Sem
   (Reader (Maybe (Group m c a))
      : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
      : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
      : Reader (CommandHandler m c a) : Fixpoint : r)
   (HashMap Text (Group m c a, AliasType),
    (HashMap Text (Command m c a, AliasType), x))
 -> Sem
      (Tagged "hidden" (Reader Bool)
         : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
         : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
         : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (Reader (Maybe (Group m c a))
            : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
            : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
            : Reader (CommandHandler m c a) : Fixpoint : r)
         (HashMap Text (Group m c a, AliasType),
          (HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
     (Tagged "hidden" (Reader Bool)
        : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: [Effect]) a.
Monoid (HashMap Text (Group m c a, AliasType)) =>
Sem (LocalWriter (HashMap Text (Group m c a, AliasType)) : r) a
-> Sem r (HashMap Text (Group m c a, AliasType), a)
forall o (r :: [Effect]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text (Group m c a, AliasType))
      (Sem
   (LocalWriter (HashMap Text (Group m c a, AliasType))
      : Reader (Maybe (Group m c a)) : Tagged "hidden" (Reader Bool)
      : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
      : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
      : r)
   (HashMap Text (Command m c a, AliasType), x)
 -> Sem
      (Reader (Maybe (Group m c a))
         : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
         : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
         : Reader (CommandHandler m c a) : Fixpoint : r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
    -> Sem
         (LocalWriter (HashMap Text (Group m c a, AliasType))
            : Reader (Maybe (Group m c a)) : Tagged "hidden" (Reader Bool)
            : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
            : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
            : r)
         (HashMap Text (Command m c a, AliasType), x))
-> Sem (DSLState m c a r) x
-> Sem
     (Reader (Maybe (Group m c a))
        : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: [Effect]) a.
Monoid (HashMap Text (Command m c a, AliasType)) =>
Sem (LocalWriter (HashMap Text (Command m c a, AliasType)) : r) a
-> Sem r (HashMap Text (Command m c a, AliasType), a)
forall o (r :: [Effect]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text (Command m c a, AliasType))
  defaultHelp :: b -> a
defaultHelp = a -> b -> a
forall a b. a -> b -> a
const a
"This command or group has no help."

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

{- | Attempt to find what command was used.

 On error: returns the path of existing groups that were found, so @"group0
 group1 group2 notacommand"@ will error with @Left ["group0", "group1",
 "group2"]@

 On success: returns the command that was invoked, and the remaining text
 after it.

 This function isn't greedy, if you have a group and a command at the same
 level, this will find the command first and ignore the group.
-}
findCommand :: forall c a m. CommandHandler m c a -> L.Text -> Either [L.Text] (Command m c a, L.Text)
findCommand :: CommandHandler m c a -> Text -> Either [Text] (Command m c a, Text)
findCommand CommandHandler m c a
handler Text
msg = (Text, Text) -> Either [Text] (Command m c a, Text)
goH ((Text, Text) -> Either [Text] (Command m c a, Text))
-> (Text, Text) -> Either [Text] (Command m c a, Text)
forall a b. (a -> b) -> a -> b
$ Text -> (Text, Text)
nextWord Text
msg
 where
  goH :: (L.Text, L.Text) -> Either [L.Text] (Command m c a, L.Text)
  goH :: (Text, Text) -> Either [Text] (Command m c a, Text)
goH (Text
"", Text
_) = [Text] -> Either [Text] (Command m c a, Text)
forall a b. a -> Either a b
Left []
  goH (Text
x, Text
xs) =
    Text
-> Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
forall a. Text -> Either [Text] a -> Either [Text] a
attachSoFar
      Text
x
      ( ((,Text
xs) (Command m c a -> (Command m c a, Text))
-> Either [Text] (Command m c a)
-> Either [Text] (Command m c a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Command m c a, AliasType) -> Either [Text] (Command m c a)
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text
-> HashMap Text (Command m c a, AliasType)
-> Maybe (Command m c a, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (CommandHandler m c a
handler CommandHandler m c a
-> Getting
     (HashMap Text (Command m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType)))
Getting
  (HashMap Text (Command m c a, AliasType))
  (CommandHandler m c a)
  (HashMap Text (Command m c a, AliasType))
#commands)))
          Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe (Group m c a, AliasType) -> Either [Text] (Group m c a)
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text
-> HashMap Text (Group m c a, AliasType)
-> Maybe (Group m c a, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (CommandHandler m c a
handler CommandHandler m c a
-> Getting
     (HashMap Text (Group m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "groups"
  (Getting
     (HashMap Text (Group m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType)))
Getting
  (HashMap Text (Group m c a, AliasType))
  (CommandHandler m c a)
  (HashMap Text (Group m c a, AliasType))
#groups)) Either [Text] (Group m c a)
-> (Group m c a -> Either [Text] (Command m c a, Text))
-> Either [Text] (Command m c a, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Text) -> Group m c a -> Either [Text] (Command m c a, Text)
goG (Text -> (Text, Text)
nextWord Text
xs))
      )

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

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

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