Revamped command parser

src/Tablebot/Internal/Handler/Command.hs

@@ -68,9 +68,30 @@ parseCommands cs m prefix = case parse (parser cs) "" (messageText m) of
     parser cs' =
       do
         _ <- chunk prefix
-        choice (map toErroringParser cs') <?> "No command with that name was found!"
-    toErroringParser :: CompiledCommand -> Parser (Message -> CompiledDatabaseDiscord ())
-    toErroringParser c = try (chunk $ commandName c) *> (skipSpace1 <|> eof) *> (try (choice $ map toErroringParser $ commandSubcommands c) <|> commandParser c)
+        res <- parser' cs'
+        case res of
+          Nothing -> fail "No command with that name was found!"
+          Just p -> return p
+    parser' :: [CompiledCommand] -> Parser (Maybe (Message -> CompiledDatabaseDiscord ()))
+    parser' cs' =
+      do
+        -- 1. Parse the command name (fails if no such command exists).
+        res <- choice (map matchCommand cs') <|> return Nothing
+        case res of
+          Nothing -> return Nothing
+          Just (command, subcommands) ->
+            do
+              -- 2. Try to get a subcommand.
+              maybeComm <- parser' subcommands
+              case maybeComm of
+                -- 2.1. If there's a subcommand, use that.
+                Just pars -> return (Just pars)
+                -- 2.2. Otherwise, use the main command.
+                Nothing -> Just <$> command
+    matchCommand :: CompiledCommand -> Parser (Maybe (Parser (Message -> CompiledDatabaseDiscord ()), [CompiledCommand]))
+    matchCommand c = do
+      try (chunk (commandName c) *> (skipSpace1 <|> eof))
+      return (Just (commandParser c, commandSubcommands c))
 
 data ReadableError = UnknownError | KnownError String [String]
   deriving (Show, Eq, Ord)

src/Tablebot/Utility/SmartParser.hs

@@ -143,7 +143,7 @@ instance KnownSymbol s => CanParse (Exactly s) where
 newtype WithError (err :: Symbol) x = WErr x
 
 instance (KnownSymbol err, CanParse x) => CanParse (WithError err x) where
-  pars = (WErr <$> pars @x) <?> symbolVal (Proxy :: Proxy err)
+  pars = (WErr <$> try (pars @x)) <?> symbolVal (Proxy :: Proxy err)
 
 -- | Parsing implementation for all integral types
 -- Overlappable due to the really flexible head state