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

View File

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

View File

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

View File

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