telegram-bot-simple-0.4: src/Telegram/Bot/Simple/Debug.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
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
#if defined(MIN_VERSION_GLASGOW_HASKELL)
#if MIN_VERSION_GLASGOW_HASKELL(8,6,2,0)
#else
import           Data.Monoid                     ((<>))
#endif
#endif
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

-- * 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
  }

-- | Trace (debug print) every update as pretty JSON value.
traceTelegramUpdatesJSON :: BotApp model action -> BotApp model action
traceTelegramUpdatesJSON = traceTelegramUpdatesWith ppAsJSON

-- | Trace (debug print) every update using 'Show' instance.
traceTelegramUpdatesShow :: BotApp model action -> BotApp model action
traceTelegramUpdatesShow = traceTelegramUpdatesWith ppShow

-- ** 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: " <> ppShow action
ppTracedAction (TracedIssuedAction   action) = "Issued:   " <> ppShow action

-- | Trace (debug print) every incoming and issued action.
traceBotActionsWith
  :: (TracedAction action -> String)  -- ^ How to display an action.
  -> BotApp model action
  -> BotApp model action
traceBotActionsWith f botApp = botApp { botHandler = newHandler }
  where
    traceAction (Just action) = Just action <$ do
      liftIO $ putStrLn (f (TracedIssuedAction action))
    traceAction Nothing = pure Nothing
    
    newHandler !action model = do
      Eff (tell (map (>>= traceAction) actions))
      pure newModel
      where
        (newModel, actions) = runEff $
          botHandler botApp
            (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 ppTracedAction

-- ** Trace bot state model

-- | Trace (debug print) bot model.
traceBotModelWith
  :: (model -> String)    -- ^ How to display a model.
  -> 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

-- | Trace (debug print) bot model using 'Show' instance.
traceBotModelShow
  :: Show model => BotApp model action -> BotApp model action
traceBotModelShow = traceBotModelWith ppShow

-- | Trace (debug print) bot model using 'Show' instance.
traceBotModelJSON
  :: ToJSON model => BotApp model action -> BotApp model action
traceBotModelJSON = traceBotModelWith ppAsJSON

-- * Helpers

-- | Pretty print a value as JSON.
ppAsJSON :: ToJSON a => a -> String
ppAsJSON = Text.unpack . Text.decodeUtf8 . Aeson.encodePretty