module HsBot.IRC (ircStart) where

import IO
import List
import Network
import System
import System.IO
import Text.Printf

import HsBot.Base.Conf
import HsBot.Base.Env
import HsBot.Base.State
import HsBot.General.Tools
import HsBot.IRC.User

data IrcMessage = IrcMessage {
      raw :: String,
      from :: String,
      clean :: String,
      isQuery :: Bool
   } deriving Show

ircWrite :: Handle -> String -> String -> IO ()
ircWrite h s t = do
   printf    "> %s %s\n" s t
   hPrintf h "%s %s\r\n" s t

ircPrivMsg :: Handle -> IrcMessage -> Env -> String -> IO ()
ircPrivMsg h msg env@(Env state _) s = do
      ircPrivMsg' $ if isMultiline s then (lines s) else [s]
   where
      ircPrivMsg' [] = return ()
      ircPrivMsg' (x:xs) = 
         let maxMessageSize = 
               envGetInt "maxMessageSize" env 
             receiver = 
               if (isQuery msg) 
                  then from msg 
                  else currentChannel state
          in if length x > maxMessageSize
               then do 
                  ircWrite h "PRIVMSG" (receiver ++ " :" 
                        ++ (take maxMessageSize x) ++ "...")
                  ircWrite h "PRIVMSG" (receiver ++ " :" 
                        ++ "...this message has been cut to " 
                        ++ (show maxMessageSize) ++ " chars")
                  ircPrivMsg' xs
               else do
                  ircWrite h "PRIVMSG" (receiver ++ " :" ++ x)
                  ircPrivMsg' xs

ircStart :: Env -> IO ()
ircStart (DispatchEnv state conf dispatch) = do
   ircChannel <- get "ircChannel" conf
   ircNick <- get "ircNick" conf
   ircPort <- get "ircPort" conf
   ircServer <- get "ircServer" conf
   ircUser <- get "ircUser" conf
   h <- connectTo ircServer (PortNumber $ fromIntegral (read ircPort :: Int))
   hSetBuffering h NoBuffering
   ircWrite h "NICK" ircNick
   ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser
   ircEvalLoop h (DispatchEnv state { isReady = False, currentChannel = ircChannel } conf dispatch)
   return ()

ircEvalLoop :: Handle -> Env -> IO () 
ircEvalLoop h env = do
      t <- hGetLine h
      let s = init t
      env' <- branch s
      ircEvalLoop h env'
   where 
      branch s 
         | ping s = do { pong s; return (env) }
         | otherwise = ircEval h (msg s) env
      ping x = "PING :" `isPrefixOf` x
      pong x = ircWrite h "PONG" (':' : drop 6 x)
      from = drop 1 . takeWhile (/= '!') 
      clean = drop 1 . dropWhile (/= ':') . drop 1
      isQuery x = split x ' ' !! 2 == (envGet "ircNick" env)
      msg s = IrcMessage { 
         raw = s, from = from s, 
         clean = clean s, isQuery = isQuery s
      }

ircEval :: Handle -> IrcMessage -> Env -> IO Env
ircEval h msg env@(DispatchEnv state conf dispatch) = ircEval' (clean msg)
   where
      ircEval' "+x" = do
         ircWrite h "JOIN" (currentChannel state)
         return (env)
      ircEval' "End of /NAMES list." = 
         return (DispatchEnv state { isReady = True } conf dispatch)
      ircEval' cleanMsg = do
         let env' = (Env state { currentSender = from msg } conf)
         (Env s c) <- dispatch cleanMsg sendReplyMsg env'
         return (DispatchEnv s c dispatch)
      sendReplyMsg = ircPrivMsg h msg (castEnv env)