content: module MessageSystem where
  
  import Network.Socket
  import System.IO
  import Control.Exception
  import Control.Concurrent
  import Control.Monad (when)
  import Control.Monad.Fix (fix)
  
  type MsgId = Int
  data Message = Message {msgId :: Int, msg ::String}
  
  messageSystem :: IO ()
  messageSystem = do sock <- socket AF_INET Stream 0
                     channel <- initServer sock
                     acceptConnectionsLoop sock channel 0
  
  {-|
    Init function to configure the socket following the next steps:
     * Create a new channel for the communications.
     * Bind the socket to listen in the port configured.
     * Set max number of queued connections. Mandatory
     * Invoke [newChan] function to sets up the read and write end of a channel by initialising [Chan] with
       empty @MVar@s for read and empty @MVar@ for write
       Thanks to haskell infer types, [newChan] know that [Chan a] is the same than the one we return in the function
       [Chan Message]
  -}
  initServer:: Socket -> IO (Chan Message)
  initServer sock =  do channel <- newChan
                        setSocketOption sock ReuseAddr 1
                        bind sock (SockAddrInet 1981 iNADDR_ANY)
                        listen sock 2
                        return channel
  
  {-| [accept] function create a socket connection when a new connection from a client is open.
      [forkIO] creates a new thread  to run the 'IO' computation passed as the first argument.
      Finally make a recursive call to block the program in [accept] waiting for a new connection. -}
  acceptConnectionsLoop :: Socket -> Chan Message -> MsgId -> IO ()
  acceptConnectionsLoop sock channel msgId = do conn <- accept sock
                                                forkIO $ processClientConnection conn channel msgId
                                                acceptConnectionsLoop sock channel (msgId + 1)
  
  {-| We use [writeChan] function together with a channel and Message type to define a high order function [broadcast]
     which it will be used for the communication between clients.
     The function [createHandle] transform a [sock] into a [handle] to communicate directly with the owner of that socket
   -}
  processClientConnection :: (Socket, SockAddr) -> Chan Message -> MsgId -> IO ()
  processClientConnection (sock, _) channel msgId = do
                                  let broadcast msg = writeChan channel $ Message msgId msg
                                  handle <- createHandle sock ReadWriteMode
                                  name <- logInClient handle broadcast
                                  newChannel <- duplicateChannel channel
                                  readerThreadId <- readMessage handle newChannel msgId
                                  writeMessage broadcast handle name readerThreadId
  
  {-| Function which passing the [socket] and the [IOMode] we're able to create the handle, which is used to
      interact with the client terminal for input/output of data-}
  createHandle :: Socket -> IOMode -> IO Handle
  createHandle socket ioMode = do handle <- socketToHandle socket ioMode
                                  setBufferMode handle NoBuffering
                                  return handle
  
  {-| Set the Buffering Operations when we read/write into the client terminal-}
  setBufferMode ::Handle -> BufferMode -> IO()
  setBufferMode handler bufferMode = hSetBuffering handler bufferMode
  
  {-| Function to add new client into the system, and inform the current clients about the new one.
     [printTerminalMsg] together with [handle] and the message is used to print the message in the terminal of the client.
      Then we use [readClientInput] together with [handle] to get the input name of the client-}
  logInClient :: Handle -> (String -> IO()) -> IO [Char]
  logInClient handle broadcast =  do printClientMsg handle "Welcome to Politrons message system. How shall I call you?"
                                     name <- readClientInput handle
                                     broadcast ("Human " ++ name ++ " has join into the system.")
                                     printClientMsg handle ("Human " ++ name ++ " logged")
                                     return name
  
  {-| Duplicate a 'Channel': the duplicate channel begins empty, but data written to
     either channel from then on will be available from both.  Hence this creates
     a kind of broadcast channel, where data written by anyone is seen by
     everyone else. -}
  duplicateChannel :: Chan Message -> IO (Chan Message)
  duplicateChannel channel = dupChan channel
  
  {-| [forkIO] fork off a thread for reading from the duplicated channel so the pipeline can continue the execution.
     The [forkIO] return a processId/threadId which it can be used to destroy once the client disconnect. -}
  readMessage :: Handle -> Chan Message -> Int -> IO ThreadId
  readMessage handle channel msgNum = do threadId <- forkIO $ readMessagesForever handle channel msgNum
                                         return threadId
  
  {-|
    [fix] function as the documentation describe is used to do recursive operations as anonymous function defined at the beginning
          in this case [loop] is this anonymous function which is invoked forever.
    [readChan] function read the next value from the 'Chan'. Blocks when the channel is empty. Since
               threads blocked in this operation are woken up in FIFO order).
    [when] function execute the operation passed in the parenthesis, and in case is true execute the next operation passed.
  -}
  readMessagesForever:: Handle -> Chan Message -> Int -> IO()
  readMessagesForever handle channel msgNum = fix $ \loop -> do message <- readChan channel
                                                                when (msgNum /= (msgId message)) $ printClientMsg handle (msg message)
                                                                loop
  
  {-| Again, using [fix] function we can use this recursive call to search in every iteration if there's a new input client
      message, and if it does and is not the [exit] command, we broadcast to the rest of the clients.
      With [>>] operator which is an applicative we can compose functions in one line. As here we broadcast and call the recursive function loop-}
  writeMessage:: (String -> IO()) -> Handle -> [Char] -> ThreadId -> IO()
  writeMessage broadcast handle name readerId = fix $ \loop -> do message <- readClientInput handle
                                                                  case message of
                                                                   "exit" -> logOutClient broadcast handle name readerId
                                                                   _      -> broadcast (name ++ ": " ++ message) >> loop
  
  {-| Function that using [hGetLine] read from the client handle the input that has been typed-}
  readClientInput::Handle -> IO [Char]
  readClientInput handle = fmap init (hGetLine handle)
  
  {-| Function to logoff a client, where we do the next composition of functions using applicative [>>]:
      * Print in the terminal of the client that has been logged off,
      * broadcast all client that the client X has logged off
      * Kill the current process loop of reading message from the channel.
      * Close the handle of the client.
  -}
  logOutClient :: (String -> IO()) -> Handle -> [Char] -> ThreadId -> IO()
  logOutClient broadcast handle name readerId = printClientMsg handle (name ++ " logged off")
                                             >> broadcast (name ++ ": Has logged off ")
                                             >> killThread readerId
                                             >> hClose handle
  
  {-| Function to print in the client a message. Every client has a handle associated, which it was created through the channel.
    [hPutStrLn] function is used to print in the client terminal the message received.
  -}
  printClientMsg :: Handle -> [Char] -> IO()
  printClientMsg handle msg = hPutStrLn handle msg