summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2015-10-08 22:01:46 +0200
committertv <tv@shackspace.de>2015-10-08 22:03:31 +0200
commit4c74e39b922ff0d2dd572f90cee0cd842aa40a84 (patch)
tree38e323ba3c84750f4a83a88b4993cb50b9a3e365
parentc07b9562e72133ccf5a64e880beb53cb8499a642 (diff)
Evaluate parsed messages
-rw-r--r--Hirc/Parser.hs4
-rw-r--r--Hirc/Types.hs12
-rw-r--r--hirc.hs31
3 files changed, 26 insertions, 21 deletions
diff --git a/Hirc/Parser.hs b/Hirc/Parser.hs
index 2cb2451..ef34270 100644
--- a/Hirc/Parser.hs
+++ b/Hirc/Parser.hs
@@ -7,7 +7,7 @@ import Text.Parsec.String
message :: Parser Message
message =
- Message <$> optionMaybe (char ':' *> prefix) <* spaces1 <*> command <*> params
+ Message <$> optionMaybe (char ':' *> prefix <* spaces1) <*> command <*> params
where
spaces1 = skipMany1 space
prefix = Prefix <$> nick
@@ -16,7 +16,7 @@ message =
nick = many1 (noneOf " !@")
user = many1 (noneOf " !@")
host = many1 (noneOf " !@")
- command = UnknownCommand <$> many1 nonspace
+ command = many1 nonspace
params = many1 (spaces1 *> (trailing <|> middle))
trailing = char ':' *> many1 anyChar
middle = many1 nonspace
diff --git a/Hirc/Types.hs b/Hirc/Types.hs
index 1bb258c..2567b53 100644
--- a/Hirc/Types.hs
+++ b/Hirc/Types.hs
@@ -1,5 +1,9 @@
module Hirc.Types where
+type Command = String
+type Param = String
+type Receiver = String
+
data Message =
Message {
m_prefix :: Maybe Prefix,
@@ -8,8 +12,6 @@ data Message =
}
deriving Show
-type Param = String
-
data Prefix =
Prefix {
p_name :: String,
@@ -18,9 +20,3 @@ data Prefix =
}
deriving Show
-data Command =
- PRIVMSG Receiver [Receiver] String |
- UnknownCommand String
- deriving Show
-
-type Receiver = String
diff --git a/hirc.hs b/hirc.hs
index 82b6cd2..46a91fb 100644
--- a/hirc.hs
+++ b/hirc.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
import Data.List
import Data.Monoid
import Network
@@ -15,6 +16,8 @@ server = "irc.freenode.org"
port = 6667
chan = "#hirc-testing"
nick = "hirc"
+
+filename = server <> (':' : show port)
-- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
type Net = ReaderT Bot IO
@@ -45,7 +48,6 @@ run :: Net ()
run = do
write "NICK" nick
write "USER" (nick++" 0 * :hirc bot")
- write "JOIN" chan
asks socket >>= listen
-- Process each line from the server
@@ -53,20 +55,27 @@ 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)
+ case parse P.message filename s of
+ Right m -> eval m
+ x -> io $ putStrLn $ show x
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 ()
-eval "!quit" = write "QUIT" ":Exiting" >> io (exitWith ExitSuccess)
-eval x | "!id " `isPrefixOf` x = privmsg (drop 4 x)
-eval _ = return () -- ignore everything else
+eval :: Message -> Net ()
+eval = \case
+ Message _ "PING" [x] ->
+ write "PONG" (':' : x)
+ Message _ "376" _ -> -- End of /MOTD command.
+ write "JOIN" chan
+ Message _ "PRIVMSG" [chan, "!quit"] -> do
+ write "QUIT" ":Exiting"
+ io (exitWith ExitSuccess)
+ Message _ "PRIVMSG" [chan, x] | "!id " `isPrefixOf` x -> do
+ privmsg (drop 4 x)
+ m -> do
+ io (putStrLn $ show m)
+ return () -- ignore everything else
-- Send a privmsg to the current chan + server
privmsg :: String -> Net ()