started logging (but it's a bit ugly)

app/Logging.hs

@@ -0,0 +1,25 @@
+module Logging(logError, logWarning, logDebug, logInfo) where
+
+import Colog.Core.Severity
+import qualified Colog as Log
+import qualified Data.Text as T
+--this module contains our own specialication of logger functionality,
+--this is usually a bad idea, but as the apis force us to write
+--plain IO actions anyway (run..., bracket, modifyMVar, ...) we
+--we are forced to make logging an IO action and can't parametrize
+--over the Monad. If we already do that we can write our own small
+--helper to wrap our specialcase in IO.
+
+
+logError :: Log.LogAction IO Log.Message -> T.Text -> IO ()
+logError logAction = (Log.usingLoggerT logAction) . Log.logError
+
+logWarning :: Log.LogAction IO Log.Message -> T.Text -> IO ()
+logWarning logAction = (Log.usingLoggerT logAction) . Log.logWarning
+
+logDebug :: Log.LogAction IO Log.Message -> T.Text -> IO ()
+logDebug logAction = (Log.usingLoggerT logAction) . Log.logDebug
+
+logInfo :: Log.LogAction IO Log.Message -> T.Text -> IO ()
+logInfo logAction = (Log.usingLoggerT logAction) . Log.logInfo
+

app/Main.hs

@@ -10,6 +10,7 @@ module Main where
 
 import Control.Concurrent.MVar
 import WaiApp
+import qualified Colog as Log
 
 #ifdef HTTP_SUPPORT
 import qualified Network.Wai.Handler.Warp as HTTP
@@ -28,11 +29,14 @@ import qualified Network.Wai.Handler.FastCGI as FastCGI
 import qualified Network.Wai.Handler.CGI as CGI
 #endif
 
+logAction :: Log.LogAction IO Log.Message
+logAction = undefined
+
 main :: IO ()
 main = do
   serverState <- newMVar newServerState
 #ifdef HTTP_SUPPORT
-  HTTP.runSettings HTTP.defaultSettings $ waiApplication serverState
+  HTTP.runSettings HTTP.defaultSettings $ waiApplication logAction serverState
 #endif
 #ifdef HTTPS_SUPPORT
   HTTPS.runTLS HTTPS.defaultTlsSettings HTTP.defaultSettings $ waiApplication serverState

app/WaiApp.hs

@@ -8,9 +8,10 @@ import Network.Wai.Handler.WebSockets
 import Network.Wai
 import Network.HTTP.Types
 import Control.Concurrent.MVar
+import qualified Colog as Log
 
-waiApplication :: MVar WSA.ServerState -> Application
-waiApplication serverState = websocketsOr WS.defaultConnectionOptions (WSA.application serverState) clientServer
+waiApplication :: Log.LogAction IO Log.Message ->MVar WSA.ServerState -> Application
+waiApplication logAction serverState = websocketsOr WS.defaultConnectionOptions (WSA.application logAction serverState) clientServer
 
 -- this should serve the webclient see Network.Wai.responseFile
 clientServer :: Application

app/WebSocketApp.hs

@@ -11,14 +11,18 @@ import Data.Aeson
 import qualified Data.Aeson.TickLeiste as TL
 import qualified Data.ByteString as B
 import qualified Data.Map.Strict as M
-import Data.Maybe (maybe)
+import Data.Maybe (maybe) -- should be replaced by either
+import Data.Either (either)
 import qualified Data.Text as T
 import qualified Data.TickLeiste as TL
 import qualified Data.UUID as U
 import qualified Data.UUID.V4 as U
 import qualified Network.WebSockets as WS
 import System.IO
+import Control.Monad.IO.Class (liftIO, MonadIO)
 
+import qualified Colog as Log hiding (logError,logWarning,logInfo,logDebug)
+import qualified Logging as Log
 ----------------------------------------------------------------------------------
 ------------------------ NEVER USE putMVar OR takeMVar ---------------------------
 ----------------------------------------------------------------------------------
@@ -50,8 +54,8 @@ type ServerState = M.Map SessionId (MVar SessionState)
 newServerState :: ServerState
 newServerState = M.empty
 
-application :: MVar ServerState -> WS.ServerApp
-application ssMV pending = do
+application :: Log.LogAction IO Log.Message -> MVar ServerState -> WS.ServerApp
+application logAction ssMV pending = do
   -- maybe we want to check that the Path has a maximum length or something
   let requestPath = WS.requestPath $ WS.pendingRequest pending
   if B.null requestPath
@@ -66,20 +70,19 @@ application ssMV pending = do
         bracket
           (addClient requestPath (clientUUID, conn) ssMV)
           (const $ removeClient requestPath (clientUUID, conn) ssMV)
-          (clientLogic conn)
+          (clientLogic logAction conn)
 
-clientLogic :: WS.Connection -> MVar SessionState -> IO ()
-clientLogic conn sessionStateMVar = do
+clientLogic :: Log.LogAction IO Log.Message -> WS.Connection -> MVar SessionState -> IO ()
+clientLogic logAction conn sessionStateMVar = do
   msg <- (WS.receiveData conn :: IO B.ByteString)
-  maybe
-    ( do
-        hPutStr stderr "Unable to parse JSON: "
-        hPrint stderr msg
+  either
+    ( \fmsg -> do
+        Log.logError logAction $ T.pack fmsg
     )
     -- the next line is a bit ugly, maybe there is a better way?
     (\request -> modifyMVar_ sessionStateMVar (\sessionState -> requestHandler conn sessionState request))
-    (decodeStrict msg :: Maybe TL.JSONRequest)
-  clientLogic conn sessionStateMVar
+    (eitherDecodeStrict msg :: Either String TL.JSONRequest)
+  clientLogic logAction conn sessionStateMVar
 
 requestHandler :: WS.Connection -> SessionState -> TL.JSONRequest -> IO SessionState
 requestHandler conn (tl, pl, cls, sem) (TL.SetPlayerTickR playerUUID tick) = do