add support for more than one active channel

master
opfez 2021-10-08 13:13:29 +02:00
parent c0a8b7b64d
commit b27ba949e7
1 changed files with 18 additions and 11 deletions

25
Anna.hs
View File

@ -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