Basic functionality

diff --git a/app/Main.hs b/app/Main.hs
index 46af6cf53cb98c4a5327a6728a78746ee3026663..c4240c49562fe0ca07c1338f32242fd78eb8d850 100644 (file)
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -5,8 +5,8 @@ import qualified Network.Socket as N  -- network
 
 myServer = "irc.netwichtig.de" :: String
 myPort   = 6667 :: N.PortNumber
-myChannels   = ["#shelly-testing", "#shelly"] :: [String]
-myNick   = "shelly" :: String
+myChannels   = ["#nais-testing", "#nais"] :: [String]
+myNick   = "nais" :: String
 
 main :: IO ()
 main = runBirch myServer myPort myNick myChannels

diff --git a/package.yaml b/package.yaml
index 1acd14ebbb24071f38a615a4925ab9ac4bc1d39d..82722319bd1a21989dfcb182ef719ef968afaabe 100644 (file)
--- a/package.yaml
+++ b/package.yaml
@@ -22,6 +22,7 @@ description:         bot for IRC in Haskell
 dependencies:
 - base >= 4.7 && < 5
 - network
+- transformers
 
 library:
   source-dirs: src

diff --git a/src/Lib.hs b/src/Lib.hs
index 12d4dbcb5e36ca56d1c77f0194b248cabac60c1e..43da951ceae339ec899b690c4ab39042552c6f01 100644 (file)
--- 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)