summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2015-10-08 20:39:37 +0200
committertv <tv@shackspace.de>2015-10-08 22:03:31 +0200
commitc07b9562e72133ccf5a64e880beb53cb8499a642 (patch)
treeaedff354cfd937f76e304fb539e9ecee375651c3
parent38ab0e0de94353023f3e70eeafdab0db8673bf38 (diff)
Parse IRC messages
-rw-r--r--Hirc/Parser.hs23
-rw-r--r--Hirc/Types.hs26
-rw-r--r--hirc.hs6
3 files changed, 55 insertions, 0 deletions
diff --git a/Hirc/Parser.hs b/Hirc/Parser.hs
new file mode 100644
index 0000000..2cb2451
--- /dev/null
+++ b/Hirc/Parser.hs
@@ -0,0 +1,23 @@
+module Hirc.Parser where
+
+import Data.Char
+import Hirc.Types
+import Text.Parsec
+import Text.Parsec.String
+
+message :: Parser Message
+message =
+ Message <$> optionMaybe (char ':' *> prefix) <* spaces1 <*> command <*> params
+ where
+ spaces1 = skipMany1 space
+ prefix = Prefix <$> nick
+ <*> optionMaybe (char '!' *> user)
+ <*> optionMaybe (char '@' *> host)
+ nick = many1 (noneOf " !@")
+ user = many1 (noneOf " !@")
+ host = many1 (noneOf " !@")
+ command = UnknownCommand <$> many1 nonspace
+ params = many1 (spaces1 *> (trailing <|> middle))
+ trailing = char ':' *> many1 anyChar
+ middle = many1 nonspace
+ nonspace = satisfy (not . isSpace)
diff --git a/Hirc/Types.hs b/Hirc/Types.hs
new file mode 100644
index 0000000..1bb258c
--- /dev/null
+++ b/Hirc/Types.hs
@@ -0,0 +1,26 @@
+module Hirc.Types where
+
+data Message =
+ Message {
+ m_prefix :: Maybe Prefix,
+ m_command :: Command,
+ m_params :: [Param]
+ }
+ deriving Show
+
+type Param = String
+
+data Prefix =
+ Prefix {
+ p_name :: String,
+ p_user :: Maybe String,
+ p_host :: Maybe String
+ }
+ deriving Show
+
+data Command =
+ PRIVMSG Receiver [Receiver] String |
+ UnknownCommand String
+ deriving Show
+
+type Receiver = String
diff --git a/hirc.hs b/hirc.hs
index 86bd135..82b6cd2 100644
--- a/hirc.hs
+++ b/hirc.hs
@@ -1,10 +1,14 @@
import Data.List
+import Data.Monoid
import Network
import System.IO
import System.Exit
import Control.Arrow
import Control.Monad.Reader
import Control.Exception
+import Hirc.Parser as P
+import Hirc.Types
+import Text.Parsec (parse)
import Text.Printf
server = "irc.freenode.org"
@@ -49,12 +53,14 @@ listen :: Handle -> Net ()
listen h = forever $ do
s <- init `fmap` io (hGetLine h)
io (putStrLn s)
+ io (putStrLn $ show $ parse P.message filename s)
if ping s then pong s else eval (clean s)
where
forever a = a >> forever a
clean = drop 1 . dropWhile (/= ':') . drop 1
ping x = "PING :" `isPrefixOf` x
pong x = write "PONG" (':' : drop 6 x)
+ filename = server <> (':' : show port)
-- Dispatch a command
eval :: String -> Net ()