diff --git a/CHANGELOG.md b/CHANGELOG.md index 1959bb1..69329a1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,7 @@ # Changelog for haboli ## upcoming -- add `Haboli.Euphoria.Command` module +- add `Haboli.Euphoria.Command` module and submodules - add `Haboli.Euphoria.Listing` module - add `Haboli.Euphoria.Util` module and move `respondingToPing` there - clean up project diff --git a/haboli.cabal b/haboli.cabal index 1e8b7ff..34ce92c 100644 --- a/haboli.cabal +++ b/haboli.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 67a0b5c2b39acab50a31b3d9efa3e4a48e13f1edd28bdbb23b99fc1c8c30bd3b +-- hash: 9151d30bacf2317670dc6ff817bd66ca13bd3798142b0b8ad8fceb78461b4ab1 name: haboli version: 0.3.1.0 @@ -33,6 +33,8 @@ library Haboli.Euphoria.Api Haboli.Euphoria.Client Haboli.Euphoria.Command + Haboli.Euphoria.Command.Megaparsec + Haboli.Euphoria.Command.Simple Haboli.Euphoria.Listing Haboli.Euphoria.Util other-modules: @@ -43,6 +45,7 @@ library aeson , base >=4.7 && <5 , containers + , megaparsec , network , stm , text diff --git a/package.yaml b/package.yaml index 5e8ffaa..29a8bf7 100644 --- a/package.yaml +++ b/package.yaml @@ -17,6 +17,7 @@ dependencies: - base >= 4.7 && < 5 - aeson - containers + - megaparsec - network - stm - text diff --git a/src/Haboli/Euphoria/Command/Megaparsec.hs b/src/Haboli/Euphoria/Command/Megaparsec.hs new file mode 100644 index 0000000..c0767a3 --- /dev/null +++ b/src/Haboli/Euphoria/Command/Megaparsec.hs @@ -0,0 +1,15 @@ +module Haboli.Euphoria.Command.Megaparsec + ( cmdMega + ) where + +import qualified Data.Text as T +import Text.Megaparsec + +import Haboli.Euphoria.Api +import Haboli.Euphoria.Client +import Haboli.Euphoria.Command + +cmdMega :: Parsec e' T.Text a -> (Message -> a -> Client e ()) -> Command e +cmdMega parser f msg = case parse parser "" $ msgContent msg of + Left _ -> pure False + Right a -> True <$ f msg a diff --git a/src/Haboli/Euphoria/Command/Simple.hs b/src/Haboli/Euphoria/Command/Simple.hs new file mode 100644 index 0000000..215fdef --- /dev/null +++ b/src/Haboli/Euphoria/Command/Simple.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Haboli.Euphoria.Command.Simple + ( cmdGeneral + , cmdSpecific + ) where + +import Control.Monad +import Data.Char +import qualified Data.Text as T +import Text.Megaparsec +import Text.Megaparsec.Char + +import Haboli.Euphoria.Api +import Haboli.Euphoria.Client +import Haboli.Euphoria.Command +import Haboli.Euphoria.Command.Megaparsec +import Haboli.Euphoria.Util + +type Parser = Parsec () T.Text + +pCmd :: T.Text -> Parser () +pCmd cmd = void $ label "command" $ char '!' *> string cmd + +pNick :: T.Text -> Parser () +pNick name = label "nick" $ do + void $ char '@' + name' <- takeWhile1P Nothing (not . isSpace) + guard $ nickEqual name name' + +pUntilEof :: Parser T.Text +pUntilEof = takeWhileP Nothing (const True) + +pCmdGeneral :: T.Text -> Parser T.Text +pCmdGeneral cmd = pCmd cmd *> space *> pUntilEof + +cmdGeneral :: T.Text -> (Message -> T.Text -> Client e ()) -> Command e +cmdGeneral cmd = cmdMega $ pCmdGeneral cmd + +pCmdSpecific :: T.Text -> T.Text -> Parser T.Text +pCmdSpecific cmd name = pCmd cmd *> space1 *> pNick name *> space *> pUntilEof + +cmdSpecific :: T.Text -> T.Text -> (Message -> T.Text -> Client e ()) -> Command e +cmdSpecific name cmd = cmdMega $ pCmdSpecific cmd name