From 4c74e39b922ff0d2dd572f90cee0cd842aa40a84 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Thu, 8 Oct 2015 22:01:46 +0200
Subject: Evaluate parsed messages

---
 Hirc/Parser.hs |  4 ++--
 Hirc/Types.hs  | 12 ++++--------
 hirc.hs        | 31 ++++++++++++++++++++-----------
 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 ()
-- 
cgit v1.2.3