diff --git a/src/Affection/Logging.hs b/src/Affection/Logging.hs index f18b30e..6155d2b 100644 --- a/src/Affection/Logging.hs +++ b/src/Affection/Logging.hs @@ -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 () diff --git a/src/Affection/MessageBus/Class.hs b/src/Affection/MessageBus/Class.hs index bca01e1..6f82190 100644 --- a/src/Affection/MessageBus/Class.hs +++ b/src/Affection/MessageBus/Class.hs @@ -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 diff --git a/src/Affection/Subsystems/AffectionJoystick.hs b/src/Affection/Subsystems/AffectionJoystick.hs index 05d40ca..5bef780 100644 --- a/src/Affection/Subsystems/AffectionJoystick.hs +++ b/src/Affection/Subsystems/AffectionJoystick.hs @@ -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" diff --git a/src/Affection/Util.hs b/src/Affection/Util.hs index 6c35fdf..dff005e 100644 --- a/src/Affection/Util.hs +++ b/src/Affection/Util.hs @@ -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