{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

import Control.Monad.IO.Class
import Control.Concurrent
import Control.Concurrent.STM
import qualified Data.ByteString.Char8 as B
import Data.ByteString (ByteString)
import Data.Char
import qualified Data.Conduit as Conduit
import Data.Conduit ((.|))
import qualified Data.Conduit.Binary as Conduit
import Data.Conduit.Cereal
import Data.Function
import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import Data.Sequence (Seq(..),(|>))
import Data.Monoid
import qualified Data.Serialize as S
import Data.Serialize (Get(..), Put(..))
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8,decodeUtf8)
import Network.Tox.Crypto.Transport
import Network.Tox.Crypto.Handlers
import Network.Tox.NodeId
import System.Console.ANSI
import qualified System.Console.Terminal.Size as Term
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import qualified System.Posix.Env.ByteString as B
import System.Posix.IO.ByteString
import System.Posix.Types
import Text.Read

data Key = Key NodeId{-me-} NodeId{-them-}
 deriving (Eq,Ord)

-- Some Global State --

{-# NOINLINE sMe #-}
sMe :: TVar NodeId
sMe = unsafePerformIO $ newTVarIO zero
    where Right zero = (S.decode $ B.replicate 32 '\NUL')

{-# NOINLINE sThem #-}
sThem :: TVar NodeId
sThem = unsafePerformIO $ newTVarIO zero
    where Right zero = (S.decode $ B.replicate 32 '\NUL')

{-# NOINLINE sMap #-}
sMap :: TVar (Map.Map Key ViewSnapshot)
sMap = unsafePerformIO $ newTVarIO (Map.empty)

{-# NOINLINE sScroll #-}
sScroll :: TVar (Map.Map Key (Seq CryptoMessage))
sScroll = unsafePerformIO $ newTVarIO (Map.empty)

-----------------------


puts :: MonadIO m => ByteString -> m ()
puts = liftIO . B.putStrLn

packUtf8 :: String -> ByteString
packUtf8 = encodeUtf8 . T.pack

pshow :: Show a => a -> ByteString
pshow = packUtf8 . show

usage = do
     hPutStrLn stderr "Usage: atox <INPUT-FILE-DESCRIPTOR> <OUTPUT-FILE-DESCRIPTOR>"
     exitFailure

processArgs usage doit [readNum,writeNum] | Just i <- readMaybe readNum
                                          , Just o <- readMaybe writeNum = doit i o
processArgs usage _ _ = usage

main = getArgs >>= processArgs usage doit

pattern IPC = Padding

-- | Interprocess command
data SetCmd = SetME
            | SetTHEM
            | SetView
            | AppendMsg
    deriving (Eq,Bounded,Ord,Enum,Show)

forkToxInputThread myRead = forkIO $ do
    let myconduit = Conduit.sourceHandle myRead  .| conduitGet2 (getCryptoMessage 0 :: Get CryptoMessage) -- :: ConduitT i CryptoMessage IO ()
    Conduit.runConduit (myconduit .| Conduit.awaitForever handle)
 where
    handle (UpToN IPC (B.uncons -> Just (ord -> toEnum -> i,arg))) = updateState i arg
    handle msg = puts (pshow msg)

    updateState SetME arg = case S.decode arg of
                                Left str -> puts (packUtf8 str)
                                Right x  -> liftIO . atomically . writeTVar sMe $ x
    updateState SetTHEM arg = case S.decode arg of
                                Left str -> puts (packUtf8 str)
                                Right x  -> liftIO . atomically . writeTVar sThem $ x
    updateState SetView arg = case S.decode arg of
                                Left str -> puts (packUtf8 str)
                                Right view -> liftIO . atomically $ do
                                    me <- readTVar sMe
                                    them <- readTVar sThem
                                    let key = Key me them
                                    modifyTVar' sMap (Map.insert key view)

    updateState AppendMsg arg
             = case getCryptoMessage 0 `S.runGet` arg of
                 Left str  -> puts (packUtf8 str)
                 Right msg -> liftIO . atomically $ do
                                me <- readTVar sMe
                                them <- readTVar sThem
                                let key = Key me them
                                scroll <- readTVar sScroll
                                let mbCurrentMsgs = Map.lookup key scroll
                                case mbCurrentMsgs of
                                    Nothing -> modifyTVar' sScroll (Map.insert key (Seq.singleton msg))
                                    Just history -> modifyTVar' sScroll (Map.insert key (history |> msg))

doit :: Fd -> Fd -> IO ()
doit myReadFd myWriteFd = do
    myRead <- fdToHandle myReadFd
    myWrite <- fdToHandle myWriteFd
    forkToxInputThread myRead
    terminalInputLoop myWrite

hSend :: MonadIO m => Handle -> CryptoMessage -> m ()
hSend h msg = liftIO $ B.hPutStrLn h (S.runPut $ putCryptoMessage 0 msg)

terminalInputLoop myWriteH = fix $ \loop -> do
    line <- B.getLine
    if "/" `B.isPrefixOf` line then let (B.drop 1 -> cmd, B.drop 1 -> arg) = B.break (==' ') line
                                        in slashCommand myWriteH (B.drop 1 line) arg
                               else hSend myWriteH (UpToN MESSAGE line)
    loop
    
    
slashCommand :: MonadIO m => Handle -> ByteString -> ByteString -> m ()
slashCommand h "quit" _ = do    
   hSend h (OneByte OFFLINE)
   hSend h (OneByte KillPacket)
   puts "Exiting..."
   liftIO $ exitSuccess

slashCommand h "nick" (B.words -> take 1 -> [nick]) = hSend h (UpToN NICKNAME nick)

slashCommand h "away" msg = do
    hSend h (TwoByte USERSTATUS (fromEnum8 Away))
    hSend h (UpToN STATUSMESSAGE msg)

slashCommand h "back" msg = do
    hSend h (TwoByte USERSTATUS (fromEnum8 Online))
    hSend h (UpToN STATUSMESSAGE msg)

slashCommand h cmd _ = do
    puts $ "UNKNOWN COMMAND: " <> cmd