{-# 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