{-# LANGUAGE LambdaCase #-}
import Data.List
import Data.Monoid
import Network
import System.IO
import System.Exit
import Control.Arrow
import Control.Monad.Reader
import Control.Exception
import Hirc.Parser as P
import Hirc.Types
import Text.Parsec (parse)
import Text.Printf
 
server = "irc.freenode.org"
port   = 6667
chan   = "#hirc-testing"
nick   = "hirc"

filename  = server <> (':' : show port)
 
-- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
type Net = ReaderT Bot IO
data Bot = Bot { socket :: Handle }
 
-- 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    = runReaderT run st
 
-- Connect to the server and return the initial bot state
connect :: IO Bot
connect = notify $ do
    h <- connectTo server (PortNumber (fromIntegral port))
    hSetBuffering h NoBuffering
    return (Bot 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
    write "NICK" nick
    write "USER" (nick++" 0 * :hirc bot")
    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)
    case parse P.message filename s of
      Right m -> eval m
      x -> io $ putStrLn $ show x
  where
    forever a = a >> forever a
 
-- Dispatch a command
eval :: Message -> Net ()
eval = \case
    Message _ "PING" [x] ->
      write "PONG" (':' : x)
    Message _ "376" _ -> -- End of /MOTD command.
      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 = 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