Garmelon/haboli
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Export parsers for simple commands

Browse source
This commit is contained in:
Joscha 2020-04-09 18:54:41 +00:00
parent 822bb9efad
commit 1313d22056
1 changed files with 40 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

54
src/Haboli/Euphoria/Command/Simple.hs
View file

@ -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 cmd = void $ label "command" $ char '!' *> string cmd
-- | @'pCmd' a@ parses commands of the form @!\<cmd\>@ 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 @\@\<non-space character\>@.
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 @\@\<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)