{-# 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 Data.Monoid ((<>))
import qualified Data.Text.Lazy as Text
import qualified Data.Text.Lazy.Encoding as Text
import Debug.Trace (trace)
import Text.Show.Pretty (ppShow)
import qualified Telegram.Bot.API as Telegram
import Telegram.Bot.Simple.BotApp
import Telegram.Bot.Simple.Eff
traceBotDefault
:: (Show model, Show action)
=> BotApp model action
-> BotApp model action
traceBotDefault
= traceTelegramUpdatesJSON
. traceBotActionsShow
. traceBotModelShow
traceTelegramUpdatesWith
:: (Telegram.Update -> String)
-> BotApp model action
-> BotApp model action
traceTelegramUpdatesWith f botApp = botApp
{ botAction = \update -> botAction botApp $! trace (f update) update
}
traceTelegramUpdatesJSON :: BotApp model action -> BotApp model action
traceTelegramUpdatesJSON = traceTelegramUpdatesWith ppAsJSON
traceTelegramUpdatesShow :: BotApp model action -> BotApp model action
traceTelegramUpdatesShow = traceTelegramUpdatesWith ppShow
data TracedAction action
= TracedIncomingAction action
| TracedIssuedAction action
deriving (Eq, Show)
ppTracedAction :: Show action => TracedAction action -> String
ppTracedAction (TracedIncomingAction action) = "Incoming: " <> ppShow action
ppTracedAction (TracedIssuedAction action) = "Issued: " <> ppShow action
traceBotActionsWith
:: (TracedAction action -> String)
-> BotApp model action
-> BotApp model action
traceBotActionsWith f botApp = botApp { botHandler = newHandler }
where
traceAction action = action <$ do
liftIO $ putStrLn (f (TracedIssuedAction action))
newHandler !action model = do
Eff (tell (map (>>= traceAction) actions))
pure newModel
where
(newModel, actions) = runEff $
botHandler botApp
(trace (f (TracedIncomingAction action)) action)
model
traceBotActionsShow
:: Show action => BotApp model action -> BotApp model action
traceBotActionsShow = traceBotActionsWith ppTracedAction
traceBotModelWith
:: (model -> String)
-> BotApp model action
-> BotApp model action
traceBotModelWith f botApp = botApp
{ botInitialModel = newInitialModel
, botHandler = newHandler
}
where
!newInitialModel = traceModel (botInitialModel botApp)
newHandler action !model = traceModel <$> botHandler botApp action model
traceModel = trace <$> f <*> id
traceBotModelShow
:: Show model => BotApp model action -> BotApp model action
traceBotModelShow = traceBotModelWith ppShow
traceBotModelJSON
:: ToJSON model => BotApp model action -> BotApp model action
traceBotModelJSON = traceBotModelWith ppAsJSON
ppAsJSON :: ToJSON a => a -> String
ppAsJSON = Text.unpack . Text.decodeUtf8 . Aeson.encodePretty