{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Kirk.Simple where

import Control.Exception.Base (finally)
import Control.Monad (forever,unless)
import Data.List (intercalate,null)
import Data.Monoid
import Data.Text (isPrefixOf,pack,replace,unpack)
import Network (withSocketsDo,PortID(..),connectTo)
import System.IO (hSetBuffering,hSetNewlineMode,hPutStrLn,hClose,hGetLine,BufferMode(LineBuffering),universalNewlineMode,Handle)

import Kirk.Config


run :: Config -> (Handle -> IO a) -> IO a
run Config{..} f =
    withSocketsDo $ do
      h <- connectTo server_hostname (PortNumber server_port)
      (`finally` hClose h) $ do
        hSetNewlineMode h universalNewlineMode
        hSetBuffering h LineBuffering
        f h


handshake :: Config -> Handle -> IO ()
handshake Config{..} h = do
    hPutStrLn h ("NICK " ++ nick)
    hPutStrLn h ("USER " ++ nick ++ " * 0 :" ++ nick)
    unless (null channels) $ hPutStrLn h ("JOIN " ++ channels)
  where
    channels = intercalate "," $ filter ((=='#') . head) msgtarget


ircAgent :: Config -> Handle -> IO ()
ircAgent Config{..} h = forever $ do
    line <- hGetLine h
    if (isPrefixOf "PING" (pack line)) then
      hPutStrLn h (unpack (replace "PING" "PONG" (pack line)))
    else
      print line


privmsg :: Config -> Handle -> String -> IO ()
privmsg Config{..} h text =
    hPutStrLn h ("PRIVMSG " <> msgtarget' <> " :" <> text)
  where
    msgtarget' = intercalate "," msgtarget