diff --git a/src/Telegram/Bot/Simple/Debug.hs b/src/Telegram/Bot/Simple/Debug.hs index ecdfec8..68e8693 100644 --- a/src/Telegram/Bot/Simple/Debug.hs +++ b/src/Telegram/Bot/Simple/Debug.hs @@ -1,18 +1,36 @@ +{-# 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 @@ -20,44 +38,55 @@ traceTelegramUpdatesWith -> 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