diff --git a/src/Haboli/Euphoria/Command/Simple.hs b/src/Haboli/Euphoria/Command/Simple.hs index 13ef6c2..49c8e5e 100644 --- a/src/Haboli/Euphoria/Command/Simple.hs +++ b/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 @!\@. +pAnyCmd :: (Ord e) => Parsec e T.Text T.Text +pAnyCmd = label "command" $ char '!' *> takeWhileP Nothing (not . isSpace) -pCmd :: T.Text -> Parser () -pCmd cmd = void $ label "command" $ char '!' *> string cmd +-- | @'pCmd' a@ parses commands of the form @!\@ where @cmd@ is equivalent +-- 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 () -pNick name = label "nick" $ do +-- | Parse any nick of the form @\@\@. +pAnyNick :: (Ord e) => Parsec e T.Text T.Text +pAnyNick = label "nick" $ do void $ char '@' - name' <- takeWhile1P Nothing (not . isSpace) - guard $ nickEqual name name' + takeWhile1P Nothing (not . isSpace) -pUntilEof :: Parser T.Text +-- | @'pNick' a@ parses nicks of the form @\@\@ 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 @!\@. +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 @!\ \@\@. +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)