diff options
author | Hendrik Jaeger <git-commit@henk.geekmail.org> | 2019-11-30 15:13:31 +0100 |
---|---|---|
committer | Hendrik Jaeger <git-commit@henk.geekmail.org> | 2019-11-30 15:13:31 +0100 |
commit | 1ed9472b5de9e6ded7cafde1bacb4bf44389856c (patch) | |
tree | b7e405b74016710a188e8d03e6f7ffb744d5214b | |
parent | 5530bd9742bc73c2c6631c20c942d3ecd4b81505 (diff) |
Basic functionality
-rw-r--r-- | app/Main.hs | 4 | ||||
-rw-r--r-- | package.yaml | 1 | ||||
-rw-r--r-- | src/Lib.hs | 56 |
3 files changed, 55 insertions, 6 deletions
diff --git a/app/Main.hs b/app/Main.hs index 46af6cf..c4240c4 100644 --- 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 1acd14e..8272231 100644 --- 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 @@ -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) |