Improve debug tracing

- Force updates and actions (to trace them even if not used)
- Pretty print JSON values through Text.decodeUtf8 for better Unicode

Author: fizruk

src/Telegram/Bot/Simple/Debug.hs

@@ -1,63 +1,92 @@
+{-# LANGUAGE BangPatterns #-}
 module Telegram.Bot.Simple.Debug where
 
 import           Control.Monad.Trans        (liftIO)
 import           Control.Monad.Writer       (tell)
 import           Data.Aeson                 (ToJSON)
 import qualified Data.Aeson.Encode.Pretty   as Aeson
-import qualified Data.ByteString.Lazy.Char8 as BSL8
 import           Data.Monoid                ((<>))
+import qualified Data.Text.Lazy             as Text
+import qualified Data.Text.Lazy.Encoding    as Text
 import           Debug.Trace                (trace)
 
 import qualified Telegram.Bot.API           as Telegram
 import           Telegram.Bot.Simple.BotApp
 import           Telegram.Bot.Simple.Eff
 
--- * Trace 'Telegram.Update's
+-- * Bot debug tracing
+
+-- | This a default bot tracing modifier that relies on
+--
+-- * 'traceTelegramUpdatesJSON'
+-- * 'traceBotActionsShow'
+-- * 'traceBotModelShow'
+traceBotDefault
+  :: (Show model, Show action)
+  => BotApp model action
+  -> BotApp model action
+traceBotDefault
+  = traceTelegramUpdatesJSON
+  . traceBotActionsShow
+  . traceBotModelShow
+
+-- ** Trace 'Telegram.Update's
 
 -- | Trace (debug print) every 'Telegram.Update' before parsing it.
 traceTelegramUpdatesWith
   :: (Telegram.Update -> String)    -- ^ How to display an update.
   -> BotApp model action
   -> BotApp model action
 traceTelegramUpdatesWith f botApp = botApp
-  { botAction = \update -> botAction botApp (trace (f update) update)
+  { botAction = \update -> botAction botApp $! trace (f update) update
   }
 
 -- | Trace (debug print) every update as pretty JSON value.
 traceTelegramUpdatesJSON :: BotApp model action -> BotApp model action
-traceTelegramUpdatesJSON = traceTelegramUpdatesWith prettyJSONString
+traceTelegramUpdatesJSON = traceTelegramUpdatesWith ppAsJSON
 
 -- | Trace (debug print) every update using 'Show' instance.
 traceTelegramUpdatesShow :: BotApp model action -> BotApp model action
 traceTelegramUpdatesShow = traceTelegramUpdatesWith show
 
--- * Trace bot actions
+-- ** Trace bot actions
+
+-- | A type of an action to trace.
+data TracedAction action
+  = TracedIncomingAction action  -- ^ An action that's about to be handled.
+  | TracedIssuedAction action    -- ^ An action that's just been issued by some handler.
+  deriving (Eq, Show)
+
+-- | Pretty print 'TraceActionType'.
+ppTracedAction :: Show action => TracedAction action -> String
+ppTracedAction (TracedIncomingAction action) = "Incoming: " <> show action
+ppTracedAction (TracedIssuedAction   action) = "Issued:   " <> show action
 
 -- | Trace (debug print) every incoming and issued action.
 traceBotActionsWith
-  :: (action -> String)     -- ^ How to display an action.
+  :: (TracedAction action -> String)  -- ^ How to display an action.
   -> BotApp model action
   -> BotApp model action
-traceBotActionsWith f botApp = botApp { botHandler = newBotHandler }
+traceBotActionsWith f botApp = botApp { botHandler = newHandler }
   where
     traceAction action = action <$ do
-      liftIO $ putStrLn ("Issued action: " <> f action)
+      liftIO $ putStrLn (f (TracedIssuedAction action))
 
-    newBotHandler action model = do
+    newHandler !action model = do
       Eff (tell (map (>>= traceAction) actions))
       pure newModel
       where
         (newModel, actions) = runEff $
           botHandler botApp
-            (trace ("Incoming action: " <> f action) action)
+            (trace (f (TracedIncomingAction action)) action)
             model
 
 -- | Trace (debug print) bot actions using 'Show' instance.
 traceBotActionsShow
   :: Show action => BotApp model action -> BotApp model action
-traceBotActionsShow = traceBotActionsWith show
+traceBotActionsShow = traceBotActionsWith ppTracedAction
 
--- * Trace bot state model
+-- ** Trace bot state model
 
 -- | Trace (debug print) bot model.
 traceBotModelWith
@@ -81,9 +110,10 @@ traceBotModelShow = traceBotModelWith show
 -- | Trace (debug print) bot model using 'Show' instance.
 traceBotModelJSON
   :: ToJSON model => BotApp model action -> BotApp model action
-traceBotModelJSON = traceBotModelWith prettyJSONString
+traceBotModelJSON = traceBotModelWith ppAsJSON
 
 -- * Helpers
 
-prettyJSONString :: ToJSON a => a -> String
-prettyJSONString = BSL8.unpack . Aeson.encodePretty
+-- | Pretty print a value as JSON.
+ppAsJSON :: ToJSON a => a -> String
+ppAsJSON = Text.unpack . Text.decodeUtf8 . Aeson.encodePretty