From c07b9562e72133ccf5a64e880beb53cb8499a642 Mon Sep 17 00:00:00 2001 From: tv Date: Thu, 8 Oct 2015 20:39:37 +0200 Subject: Parse IRC messages --- Hirc/Parser.hs | 23 +++++++++++++++++++++++ Hirc/Types.hs | 26 ++++++++++++++++++++++++++ hirc.hs | 6 ++++++ 3 files changed, 55 insertions(+) create mode 100644 Hirc/Parser.hs create mode 100644 Hirc/Types.hs 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 () -- cgit v1.2.3