move logging to text

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 ()

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
 

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"

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