|
|
|
@ -2,6 +2,7 @@ module Main where
@@ -2,6 +2,7 @@ module Main where
|
|
|
|
|
|
|
|
|
|
import Data.List |
|
|
|
|
import Data.Char (isSpace) |
|
|
|
|
import qualified Data.Text as T |
|
|
|
|
import System.IO |
|
|
|
|
import System.Directory |
|
|
|
|
import Control.Monad |
|
|
|
@ -15,15 +16,15 @@ port = 6667
@@ -15,15 +16,15 @@ port = 6667
|
|
|
|
|
name = "anna" |
|
|
|
|
channels = ["#tildetown", "#bots"] |
|
|
|
|
|
|
|
|
|
data Bot = Bot { socket :: Handle } |
|
|
|
|
type Net = ReaderT Bot IO |
|
|
|
|
data Socket = Socket { socket :: Handle } |
|
|
|
|
type Net = ReaderT Socket IO |
|
|
|
|
|
|
|
|
|
-- Entrypoint |
|
|
|
|
main :: IO () |
|
|
|
|
main = do |
|
|
|
|
handle <- connectTo hostname port |
|
|
|
|
hSetBuffering stdout NoBuffering |
|
|
|
|
runReaderT run Bot { socket = handle } |
|
|
|
|
runReaderT run Socket { socket = handle } |
|
|
|
|
|
|
|
|
|
run :: Net () |
|
|
|
|
run = do |
|
|
|
@ -40,8 +41,8 @@ listen = forever $ do
@@ -40,8 +41,8 @@ listen = forever $ do
|
|
|
|
|
-- Debug print |
|
|
|
|
liftIO $ putStrLn line |
|
|
|
|
tokenDispatch (parseUser $ tail line) (parseChannel tokens) tokens |
|
|
|
|
where parseUser str = userName |
|
|
|
|
where userName = getName str |
|
|
|
|
where parseUser str = username |
|
|
|
|
where username = getName str |
|
|
|
|
|
|
|
|
|
getName :: String -> Maybe String |
|
|
|
|
getName s |
|
|
|
@ -60,7 +61,7 @@ listen = forever $ do
@@ -60,7 +61,7 @@ listen = forever $ do
|
|
|
|
|
tokenDispatch :: Maybe String -> Maybe String -> [String] -> Net () |
|
|
|
|
tokenDispatch _ _ ("PING":_) = pong |
|
|
|
|
tokenDispatch _ _ [] = return () |
|
|
|
|
tokenDispatch (Just userName) (Just chn) ts = if elem "PRIVMSG" ts |
|
|
|
|
tokenDispatch (Just username) (Just chn) ts = if elem "PRIVMSG" ts |
|
|
|
|
then helper |
|
|
|
|
else return () |
|
|
|
|
where helper |
|
|
|
@ -70,6 +71,9 @@ tokenDispatch (Just userName) (Just chn) ts = if elem "PRIVMSG" ts
@@ -70,6 +71,9 @@ tokenDispatch (Just userName) (Just chn) ts = if elem "PRIVMSG" ts
|
|
|
|
|
-- TODO: make reader monad for this? passing chn is a little tedious |
|
|
|
|
"!greets" -> greets chn |
|
|
|
|
"!qotd" -> qotd chn |
|
|
|
|
"!tz" -> if "!tz" == last tokens |
|
|
|
|
then timezone chn username |
|
|
|
|
else timezone chn $ head $ tail tokens |
|
|
|
|
"!rollcall" -> rollcall chn |
|
|
|
|
"!anna" -> anna chn |
|
|
|
|
_ -> return () |
|
|
|
@ -115,9 +119,17 @@ qotd chn = do
@@ -115,9 +119,17 @@ qotd chn = do
|
|
|
|
|
mapM_ (sendMessage chn) textLines |
|
|
|
|
return () |
|
|
|
|
|
|
|
|
|
-- TODO |
|
|
|
|
timezone :: String -> String -> Net () |
|
|
|
|
timezone chn username = undefined |
|
|
|
|
timezone chn username = do |
|
|
|
|
let filepath = "/home/" ++ username ++ "/.tz" |
|
|
|
|
existence <- liftIO $ doesFileExist filepath |
|
|
|
|
if existence |
|
|
|
|
then do |
|
|
|
|
contents <- liftIO $ readFile filepath |
|
|
|
|
let cleanContents = sanitize contents |
|
|
|
|
sendMessage chn cleanContents |
|
|
|
|
else sendMessage chn $ username ++ " has not set their timezone. Use `echo '<timezone here>' > ~/.tz' to add your timezone." |
|
|
|
|
where sanitize = T.unpack . T.replace (T.pack "\n") T.empty . T.pack |
|
|
|
|
|
|
|
|
|
rollcall :: String -> Net () |
|
|
|
|
rollcall chn = sendMessage chn "Hello! I respond to !anna, !qotd, and !greets. My source code is available at https://git.tilde.town/opfez/anna2" |
|
|
|
|