{-|
Module      : EventLoop.Output.Single
Description : Makeshift server to output a single 'EventLoop.Output.OutputEvent' to the client.
Copyright   : (c) Sebastiaan la Fleur, 2014
License     : BSD3
Maintainer  : sebastiaan.la.fleur@gmail.com
Stability   : experimental
Portability : All

Makeshift server to output a single 'EventLoop.Output.OutputEvent' to the client. The function 'outSingle' is the heart of this module.
-}
module EventLoop.Output.Single (outSingle) where

import qualified Network.Socket     as S
import qualified Network.WebSockets as WS
import qualified Data.Text          as T
import Control.Exception (catch, SomeException, throw)

import EventLoop.EventProcessor (IOMessage)
import EventLoop.Output.OutputEvent
import EventLoop.Output.Graphical
import EventLoop.Output.SystemMessage
import EventLoop.Config
import EventLoop.Json
import EventLoop.CommonTypes

{-|
 Outputs a single 'EventLoop.Output.OutputEvent'. Right now only 'EventLoop.Output.Draw' events are implemented.
 The server automatically determines the maximum 'EventLoop.CommonTypes.Dimension's of the picture and sends a 'EventLoop.Output.Setup' containing those 'EventLoop.CommonTypes.Dimension's.
-}
outSingle :: OutputEvent -> IO ()
outSingle out = S.withSocketsDo $ do
                                    sock <- WS.makeSocket ipadres (fromIntegral port)
                                    pendingConn <- WS.makePendingConnection sock
                                    conn <- WS.acceptRequest pendingConn
                                    let
                                        close = catched sock conn
                                        func  = do
                                                    sendResponse conn setup
                                                    sendResponse conn out'
                                                    sendResponse conn closeMsg
                                                    WS.sendClose conn (T.pack "")
                                                    WS.closeSocket sock
                                    catch func close
                where
                    setup = toIOMessage (setupMessage out)
                    out' = toIOMessage out 
                    closeMsg = toIOMessage closeMessage

-- | Private                    
catched :: S.Socket -> WS.Connection -> SomeException -> IO ()
catched sock conn e = do
                        WS.sendClose conn (T.pack "")
                        WS.closeSocket sock
                        throw e

-- | Private  
setupMessage :: OutputEvent -> OutputEvent
setupMessage (OutGraphical (Draw g _)) = OutSysMessage [CanvasSetup dim]
                                    where
                                        dim = maxDimensions g
setupMessage _ = OutSysMessage [CanvasSetup (512, 512)]                                        

-- | Private 
closeMessage :: OutputEvent
closeMessage = OutSysMessage [Close]

-- | Private     
toIOMessage :: OutputEvent -> IOMessage
toIOMessage = toJsonMessage

-- | Private 
sendResponse :: WS.Connection -> IOMessage -> IO ()
sendResponse conn response = do
                                let
                                    string = show response
                                    text = T.pack string
                                WS.sendTextData conn text 

-- | Private 
maxDimensions :: GObject -> Dimension
maxDimensions (GObject _ prim [])     = maxDimensionsPrim prim
maxDimensions (GObject n prim (c:cs)) = (max w w', max h h')
                                        where
                                            (w, h) = maxDimensions c
                                            (w', h') = maxDimensions (GObject n prim cs)
maxDimensions (Container [])          = (0, 0)
maxDimensions (Container (c:cs))      = (max w w', max h h')
                                        where
                                            (w, h) = maxDimensions c
                                            (w', h') = maxDimensions (Container cs)

-- | Private 
maxDimensionsPrim :: Primitive -> Dimension
maxDimensionsPrim (Text _ _ _ (x, y) size _ str fromCenter) | fromCenter = (x + (fromIntegral $ length str * 10) / 2, y + size / 2)
                                                            | otherwise  = (x + (fromIntegral $ length str * 10), y + size)
maxDimensionsPrim (Line _ _ [])                             = (0, 0)                                                                    
maxDimensionsPrim (Line _ _ [(x, y)])                       = (x, y)
maxDimensionsPrim (Line ec et ((x, y):xs))                  = (max x x', max y y')
                                                        where
                                                            (x', y') = maxDimensionsPrim (Line ec et xs) 
                                                            
maxDimensionsPrim (Rect _ _ _ (x, y) (w, h))                = (x + w / 2, y + h / 2) 
maxDimensionsPrim (Arc _ _ _ (x, y) r _ _)                  = (x + r, y + r)