diff --git a/HTMLParsing.hs b/HTMLParsing.hs
new file mode 100644
index 0000000..c8252ce
--- /dev/null
+++ b/HTMLParsing.hs
@@ -0,0 +1,33 @@
+module HTMLParsing
+( getHTTPTitle
+) where
+
+import Data.Tree.NTree.TypeDefs
+import Data.Maybe
+import Text.XML.HXT.Core
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Maybe
+import Network.HTTP
+import Network.URI
+
+-- http://adit.io/posts/2012-04-14-working_with_HTML_in_haskell.html
+
+openUrl :: String -> MaybeT IO String
+openUrl url = case parseURI url of
+ Nothing -> fail ""
+ Just u -> liftIO (getResponseBody =<< simpleHTTP (mkRequest GET u))
+
+css :: ArrowXml a => String -> a XmlTree XmlTree
+css tag = multi (hasName tag)
+
+get :: String -> IO (IOSArrow XmlTree (NTree XNode))
+get url = do
+ contents <- runMaybeT $ openUrl url
+ return $ readString [withParseHTML yes, withWarnings no] (fromMaybe "" contents)
+
+getHTTPTitle :: String -> IO String
+getHTTPTitle url = do
+ httpBody <- get url
+ title <- runX $ httpBody >>> css "title" /> getText
+ return $ head title
\ No newline at end of file
diff --git a/main.hs b/main.hs
new file mode 100644
index 0000000..9cd9876
--- /dev/null
+++ b/main.hs
@@ -0,0 +1,130 @@
+--
+-- A simple, clean IRC bot in Haskell
+--
+-- http://www.haskell.org/haskellwiki/Roll_your_own_IRC_bot
+
+import Data.List
+import Network
+import Network.HTTP
+import System.IO
+import System.Time
+import System.Exit
+import Control.Monad.Reader
+--import Control.Exception -- for base-3, with base-4 use Control.OldException
+import Control.OldException
+import Text.Printf
+import Prelude hiding (catch)
+
+import HTMLParsing
+
+server = "irc.freenode.net"
+port = 6667
+chan = "#cheeseburger"
+nick = "cheesebot"
+
+--
+-- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
+-- A socket and the bot's start time.
+--
+type Net = ReaderT Bot IO
+data Bot = Bot { socket :: Handle, starttime :: ClockTime }
+
+--
+-- Set up actions to run on start and end, and run the main loop
+--
+main :: IO ()
+main = bracket connect disconnect loop
+ where
+ disconnect = hClose . socket
+ loop st = catch (runReaderT run st) (const $ return ())
+
+--
+-- Connect to the server and return the initial bot state
+--
+connect :: IO Bot
+connect = notify $ do
+ t <- getClockTime
+ h <- connectTo server (PortNumber (fromIntegral Main.port))
+ hSetBuffering h NoBuffering
+ return (Bot h t)
+ 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
+ write "NICK" nick
+ write "USER" (nick++" 0 * :tutorial bot")
+ write "JOIN" chan
+ asks socket >>= listen
+
+--
+-- Process each line from the server
+--
+listen :: Handle -> Net ()
+listen h = forever $ do
+ s <- init `fmap` io (hGetLine h)
+ io (putStrLn s)
+ if ping s then pong s else eval (clean s)
+ where
+ forever a = a >> forever a
+ clean = drop 1 . dropWhile (/= ':') . dropWhile (/= ' ')
+ ping x = "PING :" `isPrefixOf` x
+ pong x = write "PONG" (':' : drop 6 x)
+
+--
+-- Dispatch a command
+--
+eval :: String -> Net ()
+eval x | "cheesebot" `isPrefixOf` x = privmsg (answerRequest (drop 9 x))
+eval x | isYouTubeURL x = do
+ youtubeTitle <- io $ getHTTPTitle x
+ privmsg youtubeTitle
+eval _ = return () -- ignore everything else
+
+--
+-- Send a privmsg to the current chan + server
+--
+privmsg :: String -> Net ()
+privmsg s = 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
+
+--
+-- Answer simple request
+--
+answerRequest :: String -> String
+answerRequest x
+ | "/quit" `isInfixOf` x = "Nice try"
+ | ":" `isPrefixOf` x = drop 1 x
+ | "," `isPrefixOf` x = drop 1 x
+ | otherwise = x
+
+--
+-- Youtube
+--
+isYouTubeURL :: String -> Bool
+isYouTubeURL s =
+ "http://www.youtube.com/" `isPrefixOf` s
+ || "https://www.youtube.com/" `isPrefixOf` s
+ || "http://youtu.be/" `isPrefixOf` s
+ || "https://youtu.be/" `isPrefixOf` s
+
+--
+-- Convenience.
+--
+io :: IO a -> Net a
+io = liftIO