Export parsers for simple commands

src/Haboli/Euphoria/Command/Simple.hs

@@ -15,6 +15,14 @@ module Haboli.Euphoria.Command.Simple
   , cmdSpecific'
   , cmdSpecificArgs
   , cmdSpecificArgs'
+  -- * Parsers for convenience
+  , pAnyCmd
+  , pCmd
+  , pAnyNick
+  , pNick
+  , pUntilEof
+  , pCmdGeneral
+  , pCmdSpecific
   ) where
 
 import           Control.Monad
@@ -29,27 +37,45 @@ import           Haboli.Euphoria.Command
 import           Haboli.Euphoria.Command.Megaparsec
 import           Haboli.Euphoria.Util
 
-type Parser = Parsec () T.Text
+-- | Parse any command of the form @!\<non-space character\>@.
+pAnyCmd :: (Ord e) => Parsec e T.Text T.Text
+pAnyCmd = label "command" $ char '!' *> takeWhileP Nothing (not . isSpace)
 
-pCmd :: T.Text -> Parser ()
+-- | @'pCmd' a@ parses commands of the form @!\<cmd\>@ where @cmd@ is equivalent
-pCmd cmd = void $ label "command" $ char '!' *> string cmd
+-- to @a@.
+pCmd :: (Ord e) => T.Text -> Parsec e T.Text T.Text
+pCmd cmd = do
+  cmd' <- pAnyCmd
+  guard $ cmd == cmd'
+  pure cmd'
 
-pNick :: T.Text -> Parser ()
+-- | Parse any nick of the form @\@\<non-space character\>@.
-pNick name = label "nick" $ do
+pAnyNick :: (Ord e) => Parsec e T.Text T.Text
+pAnyNick = label "nick" $ do
   void $ char '@'
-  name' <- takeWhile1P Nothing (not . isSpace)
+  takeWhile1P Nothing (not . isSpace)
-  guard $ nickEqual name name'
 
-pUntilEof :: Parser T.Text
+-- | @'pNick' a@ parses nicks of the form @\@\<name\>@ where @name@ is
+-- equivalent (but not necessarily equal) to @a@.
+pNick :: (Ord e) => T.Text -> Parsec e T.Text T.Text
+pNick name = do
+  name' <- pAnyNick
+  guard $ nickEqual name name'
+  pure name'
+
+-- | Consume the rest of the input. This parser should never fail.
+pUntilEof :: (Ord e) => Parsec e T.Text T.Text
 pUntilEof = takeWhileP Nothing (const True)
 
-pCmdGeneral :: T.Text -> Parser T.Text
+-- | @'pCmdGeneral' cmd@ parses a general command of the form @!\<cmd\>@.
+pCmdGeneral :: (Ord e) => T.Text -> Parsec e T.Text T.Text
 pCmdGeneral cmd = pCmd cmd *> space *> pUntilEof
 
-pCmdSpecific :: T.Text -> T.Text -> Parser T.Text
+-- | @'pCmdSpecific' cmd name@ parses a specific command of the form @!\<cmd\> \@\<name\>@.
+pCmdSpecific :: (Ord e) => T.Text -> T.Text -> Parsec e T.Text T.Text
 pCmdSpecific cmd name = pCmd cmd *> space1 *> pNick name *> space *> pUntilEof
 
--- | @'cmdGeneral' cmd f' is a general command with no arguments in the form of
+-- | @'cmdGeneral' cmd f@ is a general command with no arguments in the form of
 -- @!cmd@.
 cmdGeneral :: T.Text -> (Message -> Client e ()) -> Command e
 cmdGeneral cmd f = cmdGeneral' cmd $ \msg -> True <$ f msg
@@ -61,7 +87,7 @@ cmdGeneral' cmd f = cmdGeneralArgs' cmd $ \msg args -> if T.null args
   then f msg
   else pure False
 
--- | @'cmdGeneralArgs' cmd f' is a general command with arguments in the form of
+-- | @'cmdGeneralArgs' cmd f@ is a general command with arguments in the form of
 -- @!cmd args@. @f@ is called with the source message and the arguments as
 -- 'T.Text'.
 cmdGeneralArgs :: T.Text -> (Message -> T.Text -> Client e ()) -> Command e
@@ -70,7 +96,7 @@ cmdGeneralArgs cmd f = cmdGeneralArgs' cmd $ \msg args -> True <$ f msg args
 -- | A version of 'cmdGeneralArgs' that allows the command function to decide
 -- whether the command was successful or not.
 cmdGeneralArgs' :: T.Text -> (Message -> T.Text -> Client e Bool) -> Command e
-cmdGeneralArgs' cmd = cmdMega' $ pCmdGeneral cmd
+cmdGeneralArgs' cmd = cmdMega' (pCmdGeneral cmd :: Parsec () T.Text T.Text)
 
 -- | @'cmdSpecific' cmd nick f@ is a specific command with no arguments in the
 -- form of @!cmd \@nick@.
@@ -93,4 +119,4 @@ cmdSpecificArgs cmd name f = cmdSpecificArgs' cmd name $ \msg args -> True <$ f
 -- | A version of 'cmdSpecificArgs' that allows the command function to decide
 -- whether the command was successful or not.
 cmdSpecificArgs' :: T.Text -> T.Text -> (Message -> T.Text -> Client e Bool) -> Command e
-cmdSpecificArgs' cmd name = cmdMega' $ pCmdSpecific cmd name
+cmdSpecificArgs' cmd name = cmdMega' (pCmdSpecific cmd name :: Parsec () T.Text T.Text)