opfez
/
anna2
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Anna.hs
View File

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