add support for more than one active channel
parent
c0a8b7b64d
commit
b27ba949e7
25
Anna.hs
25
Anna.hs
|
@ -13,7 +13,7 @@ import Control.Monad.Trans.Reader
|
|||
hostname = "127.0.0.1"
|
||||
port = 6667
|
||||
name = "anna"
|
||||
channels = ["#bots"]
|
||||
channels = ["#foo", "#bots"]
|
||||
|
||||
data Bot = Bot { socket :: Handle }
|
||||
type Net = ReaderT Bot IO
|
||||
|
@ -36,9 +36,10 @@ listen :: Net ()
|
|||
listen = forever $ do
|
||||
h <- asks socket
|
||||
line <- liftIO $ hGetLine h
|
||||
let tokens = words line
|
||||
-- Debug print
|
||||
liftIO $ putStrLn line
|
||||
tokenDispatch (parseUser $ tail line) (words line)
|
||||
tokenDispatch (parseUser $ tail line) (parseChannel tokens) tokens
|
||||
where parseUser str = userName
|
||||
where userName = getName str
|
||||
|
||||
|
@ -52,25 +53,29 @@ listen = forever $ do
|
|||
| elemIndex c1 arr == Nothing = False
|
||||
| elemIndex c2 arr == Nothing = True
|
||||
| otherwise = elemIndex c1 arr < elemIndex c2 arr
|
||||
parseChannel ts
|
||||
| length ts > 3 = Just $ ts !! 2
|
||||
| otherwise = Nothing
|
||||
|
||||
tokenDispatch :: Maybe String -> [String] -> Net ()
|
||||
tokenDispatch _ ("PING":_) = pong
|
||||
tokenDispatch _ [] = return ()
|
||||
tokenDispatch (Just userName) ts = if elem "PRIVMSG" ts
|
||||
tokenDispatch :: Maybe String -> Maybe String -> [String] -> Net ()
|
||||
tokenDispatch _ _ ("PING":_) = pong
|
||||
tokenDispatch _ _ [] = return ()
|
||||
tokenDispatch (Just userName) (Just chn) ts = if elem "PRIVMSG" ts
|
||||
then helper
|
||||
else return ()
|
||||
where helper
|
||||
| elem "o/" tokens = updateRightGreets
|
||||
| elem "\\o" tokens = updateLeftGreets
|
||||
| otherwise = case head tokens of
|
||||
"!greets" -> greets $ head channels
|
||||
"!greets" -> greets chn
|
||||
_ -> return ()
|
||||
tokens = case length msgTokens of
|
||||
1 -> [rstrip $ tail $ head msgTokens]
|
||||
_ -> (tail $ head msgTokens) : ((init $ tail msgTokens) ++ [(rstrip $ last msgTokens)])
|
||||
msgTokens = drop 3 ts
|
||||
rstrip = reverse . dropWhile isSpace . reverse
|
||||
tokenDispatch Nothing _ = return ()
|
||||
tokenDispatch Nothing _ _ = return ()
|
||||
tokenDispatch _ Nothing _ = return ()
|
||||
|
||||
-- Bot commands
|
||||
updateRightGreets :: Net ()
|
||||
|
@ -96,9 +101,11 @@ greets chn = do
|
|||
content <- liftIO $ readFile "greets"
|
||||
let contentLines = lines content
|
||||
displayLine = "o/ - " ++ (head contentLines) ++ " vs \\o - " ++ (head $ tail contentLines)
|
||||
liftIO $ putStrLn displayLine
|
||||
sendMessage chn displayLine
|
||||
|
||||
timezone :: String -> String -> Net ()
|
||||
timezone chn username = undefined
|
||||
|
||||
-- Basic commands
|
||||
write :: String -> String -> Net ()
|
||||
write cmd args = do
|
||||
|
|
Loading…
Reference in New Issue