{-# LANGUAGE UnicodeSyntax, PatternGuards #-}
module IRC (Message(..), Command(..), encode, decode, UserName, ServerName, Prefix(..), send) where

import qualified Network.IRC as Base
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8
import qualified Data.ByteString.UTF8
import qualified Codec.Binary.UTF8.String as UTF8

import System.IO (hFlush, Handle)
import Data.List (intersperse)
import Control.Arrow (first)
import Prelude hiding ((.))
import Prelude.Unicode
import Util ((.))

data Prefix = Server ServerName | NickName String (Maybe UserName) (Maybe ServerName)
  deriving (Show, Read, Eq)

data Message = Message { msg_prefix :: Maybe Prefix, msg_command :: Command }
 deriving (Show, Read, Eq)

data Command
  = PrivMsg { privMsg_target, privMsg_text :: String }
  | Notice { notice_target, notice_text :: String }
  | Quit
  | Welcome
  | Invite { invite_nick, invite_channel :: String }
  | Nick String
  | Pass String
  | Ping { ping_servers :: [ByteString.ByteString] }
  | Pong { pong_servers :: [ByteString.ByteString] }
  | NickNameInUse
  | User { user :: String, mode :: Integer, realname :: String }
  | Join { join_chans :: [String], join_keychans :: [(String, String)] }
  | OtherCommand
  deriving (Show, Read, Eq)
    -- Clearly woefully incomplete, but all geordi needs.

fromBase :: Base.Message → Message
fromBase (Base.Message prefix cmd params) =
  Message (fromPrefix . prefix) $ case (Data.ByteString.Char8.unpack cmd, params) of
    ("PING", x) → Ping x
    ("PRIVMSG", [x, y]) → PrivMsg (utf8dec x) (utf8dec y)
    ("QUIT", _) → Quit
    ("INVITE", [x, y]) → Invite (utf8dec x) (utf8dec y)
    ("001", _) → Welcome
    ("433", _) → NickNameInUse
    _ → OtherCommand
  where
    utf8dec = Data.ByteString.UTF8.toString
    fromPrefix :: Base.Prefix -> Prefix
    fromPrefix (Base.Server n) = Server n
    fromPrefix (Base.NickName n x y) = NickName (utf8dec n) x y

toBase :: Message → Base.Message
toBase (Message prefix command) =
  uncurry (Base.Message $ toPrefix . prefix) $ first Data.ByteString.Char8.pack $ case command of
    Pong x → ("PONG", x)
    Pass x → ("PASS", [utf8enc x])
    Nick x → ("NICK", [utf8enc x])
    User u m n → ("USER", utf8enc . [u, show m, "*", n])
    PrivMsg x y → ("PRIVMSG", [utf8enc x, utf8enc y])
    Notice x y → ("NOTICE", [utf8enc x, utf8enc y])
    Join c kc → ("JOIN", map (utf8enc . concat . intersperse ",") $
      if null kc then [c] else [fst . kc ++ c, snd . kc])
    _ → error "sorry, not implemented"
  where
    utf8enc = Data.ByteString.UTF8.fromString
    toPrefix :: Prefix -> Base.Prefix
    toPrefix (Server n) = Base.Server n
    toPrefix (NickName n x y) = Base.NickName (utf8enc n) x y

encode :: Message → String
encode = Data.ByteString.UTF8.toString . Base.encode . toBase

decode :: ByteString.ByteString → Maybe Message
decode = (fromBase .) . Base.decode

type UserName = Base.UserName
type ServerName = Base.ServerName

send :: Handle → Message → IO ()
send h m = Data.ByteString.Char8.hPutStrLn h (ByteString.pack $ take 510 $ enc 450 $ takeWhile (not . (`elem` "\r\n")) $ encode m) >> hFlush h
  where
    enc n (c:s) | c' ← UTF8.encode [c], n' ← n - length c', n' ≥ 0 ∨ length c' == 1 = c' ++ enc n' s
    enc _ _ = []
  -- Without enc, the last UTF-8 encoded character might get cut in half if its encoding consists of multiple bytes. We want to avoid this because it causes some IRC clients (like irssi) to conclude that the encoding must be something other than UTF-8. As a further complication, while we can be sure that the server will receive messages up to 512 bytes long, it may drop anything after 450 bytes or so as it prepends our prefix when relaying messages to other clients. Hence, we can only reliably encode UTF-8 characters until a message is 450 bytes long. We don't need to immediately truncate after 450 bytes, though; after that limit, we don't truncate until an actual multi-byte character is encountered.