module Main where

import Data.List
import Data.Char (isSpace)
import System.IO
import System.Directory
import Control.Monad
import Control.Monad.IO.Class
import qualified Network.Socket as N
import Control.Monad.Trans.Reader

-- Configuration
hostname = "127.0.0.1"
port     = 6667
name     = "anna"
channels = ["#foo", "#bots"]

data Bot = Bot { socket :: Handle }
type Net = ReaderT Bot IO

-- Entrypoint
main :: IO ()
main = do
  handle <- connectTo hostname port
  hSetBuffering stdout NoBuffering
  runReaderT run Bot { socket = handle }

run :: Net ()
run = do
  sendNick
  sendUser
  joinChannels
  listen

listen :: Net ()
listen = forever $ do
  h <- asks socket
  line <- liftIO $ hGetLine h
  let tokens = words line
  -- Debug print
  liftIO $ putStrLn line
  tokenDispatch (parseUser $ tail line) (parseChannel tokens) tokens
    where parseUser str = userName
            where userName = getName str

                  getName :: String -> Maybe String
                  getName s
                    | comesBefore ' ' '!' s = Nothing
                    | otherwise = Just $ takeWhile (\c -> (c /= '!')) s

                  comesBefore :: Eq a => a -> a -> [a] -> Bool
                  comesBefore c1 c2 arr
                    | elemIndex c1 arr == Nothing = False
                    | elemIndex c2 arr == Nothing = True
                    | otherwise = elemIndex c1 arr < elemIndex c2 arr
          parseChannel ts
            | length ts > 3 = Just $ ts !! 2
            | otherwise     = Nothing

tokenDispatch :: Maybe String -> Maybe String -> [String] -> Net ()
tokenDispatch _ _ ("PING":_) = pong
tokenDispatch _ _ []         = return ()
tokenDispatch (Just userName) (Just chn) ts = if elem "PRIVMSG" ts
                                              then helper
                                              else return ()
  where helper
          | elem "o/" tokens  = updateRightGreets
          | elem "\\o" tokens = updateLeftGreets
          | otherwise         = case head tokens of
              "!greets" -> greets chn
              _         -> return ()
        tokens = case length msgTokens of
          1 -> [rstrip $ tail $ head msgTokens]
          _ -> (tail $ head msgTokens) : ((init $ tail msgTokens) ++ [(rstrip $ last msgTokens)])
        msgTokens = drop 3 ts
        rstrip = reverse . dropWhile isSpace . reverse
tokenDispatch Nothing _ _ = return ()
tokenDispatch _ Nothing _ = return ()

-- Bot commands
updateRightGreets :: Net ()
updateRightGreets = do
  content <- liftIO $ readFile "greets"
  let contentLines = lines content
      rightGreets  = show $ 1 + (read $ head contentLines :: Int)
      leftGreets   = head $ tail contentLines
  liftIO $ removeFile "greets"
  liftIO $ writeFile "greets" $ rightGreets ++ "\n" ++ leftGreets ++ "\n"

updateLeftGreets :: Net ()
updateLeftGreets = do
  content <- liftIO $ readFile "greets"
  let contentLines = lines content
      rightGreets  = head contentLines
      leftGreets   = show $ 1 + (read $ head $ tail contentLines :: Int)
  liftIO $ removeFile "greets"
  liftIO $ writeFile "greets" $ rightGreets ++ "\n" ++ leftGreets ++ "\n"

greets :: String -> Net ()
greets chn = do
  content <- liftIO $ readFile "greets"
  let contentLines = lines content
      displayLine = "o/ - " ++ (head contentLines) ++ " vs \\o - " ++ (head $ tail contentLines)
  sendMessage chn displayLine

timezone :: String -> String -> Net ()
timezone chn username = undefined

-- Basic commands
write :: String -> String -> Net ()
write cmd args = do
  h <- asks socket
  liftIO $ hPutStr h $ cmd ++ " " ++ args ++ "\r\n"

sendNick :: Net ()
sendNick = write "NICK" name

sendUser :: Net ()
sendUser = write "USER" $ name ++ " 0.0.0.0 " ++ name ++ " :" ++ name

sendMessage :: String -> String -> Net ()
sendMessage channel message = write "PRIVMSG" $ channel ++ " :" ++ message

sendAction :: String -> String -> Net ()
sendAction channel action = sendMessage channel $ "\x01ACTION " ++ action ++ "\x01"

joinChannels :: Net ()
joinChannels = mapM_ (\chn -> write "JOIN" chn) channels

pong :: Net ()
pong = write "PONG" $ ":" ++ name ++ "\r\n"

-- Connect to a server given its name and port number
connectTo :: N.HostName -> N.PortNumber -> IO Handle
connectTo host port = do
    addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
    sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
    N.connect sock (N.addrAddress addr)
    N.socketToHandle sock ReadWriteMode