move logging to text

This commit is contained in:
nek0 2019-10-28 17:11:27 +01:00
parent 25fd9acffd
commit d73609297c
4 changed files with 26 additions and 17 deletions

View file

@ -3,6 +3,8 @@
-- from "Debug.Trace".
module Affection.Logging where
import qualified Data.Text as T
import Debug.Trace
-- | The log level definition
@ -15,38 +17,38 @@ data LogLevel
-- | Pure logging function
log
:: LogLevel -- ^ Log level to log to
-> String -- ^ The message string
-> T.Text -- ^ The message string
-> a -- ^ Arbitrary datatype to return
-> a -- ^ Returned data
#if defined(VERBOSE)
log Verbose s = trace ("VERBOSE: " ++ s)
log Verbose s = trace ("VERBOSE: " ++ T.unpack s)
#endif
#if defined(DEBUG) || defined(VERBOSE)
log Debug s = trace ("DEBUG: " ++ s)
log Debug s = trace ("DEBUG: " ++ T.unpack s)
#endif
#if defined(WARN) || defined(DEBUG) || defined(VERBOSE)
log Warn s = trace ("WARN: " ++ s)
log Warn s = trace ("WARN: " ++ T.unpack s)
#endif
#if defined(ERROR) || defined(WARN) || defined(DEBUG) || defined(VERBOSE)
log Error s = trace ("ERROR: " ++ s)
log Error s = trace ("ERROR: " ++ T.unpack s)
#endif
log _ _ = id
-- | Manadic logging function residing in the 'IO' Monad
logIO
:: LogLevel -- ^ Log level to log to
-> String -- ^ The message string
-> T.Text -- ^ The message string
-> IO ()
#if defined(VERBOSE)
logIO Verbose s = traceIO ("VERBOSE: " ++ s)
logIO Verbose s = traceIO ("VERBOSE: " ++ T.unpack s)
#endif
#if defined(DEBUG) || defined(VERBOSE)
logIO Debug s = traceIO ("DEBUG: " ++ s)
logIO Debug s = traceIO ("DEBUG: " ++ T.unpack s)
#endif
#if defined(WARN) || defined(DEBUG) || defined(VERBOSE)
logIO Warn s = traceIO ("WARN: " ++ s)
logIO Warn s = traceIO ("WARN: " ++ T.unpack s)
#endif
#if defined(ERROR) || defined(WARN) || defined(DEBUG) || defined(VERBOSE)
logIO Error s = traceIO ("ERROR: " ++ s)
logIO Error s = traceIO ("ERROR: " ++ T.unpack s)
#endif
logIO _ _ = return ()

View file

@ -17,6 +17,8 @@ import Control.Monad.IO.Class (liftIO)
import Data.UUID
import Data.UUID.V4
import Data.String as S (fromString)
import Affection.Logging
-- | This typeclass defines the behaviour of a participant in the message system
@ -57,7 +59,7 @@ class (Message (Mesg prt us), Show (Mesg prt us)) => Participant prt us where
-- ^ The 'Message' to emit
-> Affection us ()
partEmit p m = do
liftIO $ logIO Verbose $ "Emitting message: " ++ show m
liftIO $ logIO Verbose $ "Emitting message: " <> S.fromString (show m)
l <- partSubscribers p
mapM_ ($ m) l

View file

@ -13,6 +13,7 @@ import Control.Monad (filterM)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Vector as V
import Data.String as S (fromString)
import Foreign.C.Types (CInt(..))
@ -86,7 +87,8 @@ joystickAutoConnect (MsgJoystickDevice _ which SDL.JoyDeviceAdded) = liftIO $ do
[descr] <- V.toList <$>
(V.filter (\(SDL.JoystickDevice _ i) -> i == CInt which) <$>
SDL.availableJoysticks)
logIO Verbose $ "Connecting Joystick " ++ show which ++ " " ++ show descr
logIO Verbose $ "Connecting Joystick " <> fromString (show which) <> " " <>
fromString (show descr)
Just <$> SDL.openJoystick descr
joystickAutoConnect _ = return Nothing
@ -100,15 +102,16 @@ joystickAutoDisconnect
joystickAutoDisconnect js (MsgJoystickDevice _ which SDL.JoyDeviceRemoved) =
liftIO $ do
joyIds <- mapM SDL.getJoystickID js
logIO Verbose $ "These are the Joysticks connected: " ++ show joyIds
logIO Verbose $ "These are the Joysticks connected: " <>
fromString (show joyIds)
d <- filterM (\j -> fmap (== which) (SDL.getJoystickID j)) js
if not (null d)
then do
logIO Verbose $ "disconnected joysticks: " ++ show (head d)
logIO Verbose $ "Disconnecting Joystick " ++ show which
logIO Verbose $ "disconnected joysticks: " <> fromString (show $ head d)
logIO Verbose $ "Disconnecting Joystick " <> fromString (show which)
SDL.closeJoystick (head d)
njoys <- filterM (\j -> return $ head d /= j) js
logIO Verbose $ "returning joysticks: " ++ show njoys
logIO Verbose $ "returning joysticks: " <> fromString (show njoys)
return njoys
else do
logIO Error $ "Error while disconnecting Joystick"

View file

@ -10,6 +10,8 @@ import qualified Graphics.Rendering.OpenGL as GL
import System.Clock
import Data.String (fromString)
import Control.Monad.State
-- | Prehandle SDL events
@ -63,7 +65,7 @@ toggleScreen = do
mapM_ (flip SDL.setWindowMode SDL.Windowed . snd) (drawWindows ad)
return SDL.Windowed
x -> do
liftIO $ logIO Warn ("Unexpected Screen mode: " ++ show x)
liftIO $ logIO Warn ("Unexpected Screen mode: " <> fromString (show x))
return x
now <- liftIO $ getTime Monotonic
put ad