1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
import Data.List
import Data.Monoid
import Network
import System.IO
import System.Exit
import Control.Arrow
import Control.Monad (forever)
import Control.Monad.Reader
import Control.Exception
import Hirc.Parser as P
import Hirc.Types
import Text.Parsec (parse)
import Text.Printf
data Config =
Config {
server :: String,
port :: Int,
chan :: String,
nick :: String
}
deriving Show
-- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
type Net = ReaderT Bot IO
data Bot = Bot {
config :: Config,
socket :: Handle
}
-- Set up actions to run on start and end, and run the main loop
main :: IO ()
main = bracket (connect c) disconnect loop
where
disconnect = hClose . socket
loop st = runReaderT run st
c = Config {
server = "irc.freenode.org",
port = 6667,
chan = "#hirc-testing",
nick = "hirc"
}
-- Connect to the server and return the initial bot state
connect :: Config -> IO Bot
connect c@Config{..} = notify $ do
h <- connectTo server (PortNumber (fromIntegral port))
hSetBuffering h NoBuffering
return (Bot c h)
where
notify a = bracket_
(printf "Connecting to %s ... " server >> hFlush stdout)
(putStrLn "done.")
a
-- We're in the Net monad now, so we've connected successfully
-- Join a channel, and start processing commands
run :: Net ()
run = do
Config{..} <- asks config
write "NICK" nick
write "USER" (nick++" 0 * :hirc bot")
ask >>= listen
-- Process each line from the server
listen :: Bot -> Net ()
listen Bot{config=c@Config{..},socket=h} = forever $ do
s <- init `fmap` io (hGetLine h)
io (putStrLn s)
case parse P.message filename s of
Right m -> eval m
x -> io $ putStrLn $ show x
where
filename = server <> (':' : show port)
-- Dispatch a command
eval :: Message -> Net ()
eval = \case
Message _ "PING" [x] ->
write "PONG" (':' : x)
Message _ "376" _ -> do -- End of /MOTD command.
Config{..} <- asks config
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 ()
privmsg s = do
Config{..} <- asks config
write "PRIVMSG" (chan ++ " :" ++ s)
-- Send a message out to the server we're currently connected to
write :: String -> String -> Net ()
write s t = do
h <- asks socket
io $ hPrintf h "%s %s\r\n" s t
io $ printf "> %s %s\n" s t
-- Convenience.
io :: IO a -> Net a
io = liftIO
|
