Basic functionality

1 files changed, 52 insertions, 4 deletions

diff --git a/src/Lib.hs b/src/Lib.hs
index 12d4dbc..43da951 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -2,15 +2,28 @@ module Lib
     ( runBirch
     ) where
 
-import           System.IO            -- base
-import qualified Network.Socket as N  -- network
+import           System.IO                      -- base
+import qualified Network.Socket as N            -- network
+import           Control.Monad.Trans.Reader     -- transformers
+import           Data.List
+import           System.Exit
+
+data Bot = Bot { botSocket :: Handle }
+type Net = ReaderT Bot IO
+
+type Nick = String
+type User = String
+type Realname = String
 
 -- Toplevel program
 runBirch :: String -> N.PortNumber -> String -> [String] -> IO ()
 runBirch myServer myPort myNick myChannels = do
     h <- connectTo myServer myPort
-    write h "NICK" myNick
-    write h "USER" (myNick ++ " 0 * :tutorial bot")
+    register h myNick "tutorial bot"
+    line <- hGetLine h
+    putStrLn line
+    let s = init line
+    if isPing s then pong h s else eval h (clean s)
 --    map (write h "JOIN") myChannels
     write h "JOIN" (head myChannels)
     listen h
@@ -35,6 +48,41 @@ listen :: Handle -> IO ()
 listen h = forever $ do
     line <- hGetLine h
     putStrLn line
+    let s = init line
+    if isPing s then pong h s else eval h (clean s)
   where
     forever :: IO () -> IO ()
     forever a = do a; forever a
+
+clean :: String -> String
+clean = drop 1 . dropWhile (/= ':') . drop 1
+
+isPing :: String -> Bool
+isPing x = "PING :" `isPrefixOf` x
+
+pong :: Handle -> String -> IO ()
+pong h x = write h "PONG" (':' : drop 6 x)
+
+-- Dispatch a command
+eval :: Handle -> String -> IO ()
+eval h "!quit"                    = write h "QUIT" ":Exiting" >> exitSuccess
+eval h x | "!id " `isPrefixOf` x  = privmsg h (drop 4 x)
+eval _ _                          = return () -- ignore everything else
+
+-- Send a privmsg to a channel
+privmsg :: Handle -> String -> IO ()
+privmsg h s = write h "PRIVMSG" ("#nais-testing" ++ " :" ++ s)
+
+-- Register with the server
+register :: Handle -> Nick -> Realname -> IO ()
+register h nick realname = do
+  sendNICK h nick
+  sendUSER h nick realname
+
+-- Send NICK command
+sendNICK :: Handle -> Nick -> IO ()
+sendNICK h nick = write h "NICK" nick
+
+-- Send USER command
+sendUSER :: Handle -> Nick -> Realname -> IO ()
+sendUSER h nick realname = write h "USER" (nick ++ " 0 * :" ++ realname)