summaryrefslogtreecommitdiffstats
path: root/hirc.hs
diff options
context:
space:
mode:
Diffstat (limited to 'hirc.hs')
-rw-r--r--hirc.hs111
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