diff options
Diffstat (limited to 'hirc.hs')
-rw-r--r-- | hirc.hs | 111 |
1 files changed, 0 insertions, 111 deletions
diff --git a/hirc.hs b/hirc.hs deleted file mode 100644 index 6a629fd..0000000 --- a/hirc.hs +++ /dev/null @@ -1,111 +0,0 @@ -{-# 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 |