Add command submodules

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

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

package.yaml

@@ -17,6 +17,7 @@ dependencies:
   - base >= 4.7 && < 5
   - aeson
   - containers
+  - megaparsec
   - network
   - stm
   - text

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

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