{-# 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 :: BotApp model action -> BotApp model action
traceBotDefault
  = BotApp model action -> BotApp model action
forall model action. BotApp model action -> BotApp model action
traceTelegramUpdatesJSON
  (BotApp model action -> BotApp model action)
-> (BotApp model action -> BotApp model action)
-> BotApp model action
-> BotApp model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotApp model action -> BotApp model action
forall action model.
Show action =>
BotApp model action -> BotApp model action
traceBotActionsShow
  (BotApp model action -> BotApp model action)
-> (BotApp model action -> BotApp model action)
-> BotApp model action
-> BotApp model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotApp model action -> BotApp model action
forall model action.
Show model =>
BotApp model action -> BotApp model action
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 :: (Update -> String) -> BotApp model action -> BotApp model action
traceTelegramUpdatesWith Update -> String
f BotApp model action
botApp = BotApp model action
botApp
  { botAction :: Update -> model -> Maybe action
botAction = \Update
update -> BotApp model action -> Update -> model -> Maybe action
forall model action.
BotApp model action -> Update -> model -> Maybe action
botAction BotApp model action
botApp (Update -> model -> Maybe action)
-> Update -> model -> Maybe action
forall a b. (a -> b) -> a -> b
$! String -> Update -> Update
forall a. String -> a -> a
trace (Update -> String
f Update
update) Update
update
  }

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

-- | Trace (debug print) every update using 'Show' instance.
traceTelegramUpdatesShow :: BotApp model action -> BotApp model action
traceTelegramUpdatesShow :: BotApp model action -> BotApp model action
traceTelegramUpdatesShow = (Update -> String) -> BotApp model action -> BotApp model action
forall model action.
(Update -> String) -> BotApp model action -> BotApp model action
traceTelegramUpdatesWith Update -> String
forall a. Show a => a -> String
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 (TracedAction action -> TracedAction action -> Bool
(TracedAction action -> TracedAction action -> Bool)
-> (TracedAction action -> TracedAction action -> Bool)
-> Eq (TracedAction action)
forall action.
Eq action =>
TracedAction action -> TracedAction action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TracedAction action -> TracedAction action -> Bool
$c/= :: forall action.
Eq action =>
TracedAction action -> TracedAction action -> Bool
== :: TracedAction action -> TracedAction action -> Bool
$c== :: forall action.
Eq action =>
TracedAction action -> TracedAction action -> Bool
Eq, Int -> TracedAction action -> ShowS
[TracedAction action] -> ShowS
TracedAction action -> String
(Int -> TracedAction action -> ShowS)
-> (TracedAction action -> String)
-> ([TracedAction action] -> ShowS)
-> Show (TracedAction action)
forall action. Show action => Int -> TracedAction action -> ShowS
forall action. Show action => [TracedAction action] -> ShowS
forall action. Show action => TracedAction action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TracedAction action] -> ShowS
$cshowList :: forall action. Show action => [TracedAction action] -> ShowS
show :: TracedAction action -> String
$cshow :: forall action. Show action => TracedAction action -> String
showsPrec :: Int -> TracedAction action -> ShowS
$cshowsPrec :: forall action. Show action => Int -> TracedAction action -> ShowS
Show)

-- | Pretty print 'TraceActionType'.
ppTracedAction :: Show action => TracedAction action -> String
ppTracedAction :: TracedAction action -> String
ppTracedAction (TracedIncomingAction action
action) = String
"Incoming: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> action -> String
forall a. Show a => a -> String
ppShow action
action
ppTracedAction (TracedIssuedAction   action
action) = String
"Issued:   " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> action -> String
forall a. Show a => a -> String
ppShow action
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 :: (TracedAction action -> String)
-> BotApp model action -> BotApp model action
traceBotActionsWith TracedAction action -> String
f BotApp model action
botApp = BotApp model action
botApp { botHandler :: action -> model -> Eff action model
botHandler = action -> model -> Eff action model
newHandler }
  where
    traceAction :: Maybe action -> f (Maybe action)
traceAction (Just action
action) = action -> Maybe action
forall a. a -> Maybe a
Just action
action Maybe action -> f () -> f (Maybe action)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      IO () -> f ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> f ()) -> IO () -> f ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (TracedAction action -> String
f (action -> TracedAction action
forall action. action -> TracedAction action
TracedIssuedAction action
action))
    traceAction Maybe action
Nothing = Maybe action -> f (Maybe action)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe action
forall a. Maybe a
Nothing
    
    newHandler :: action -> model -> Eff action model
newHandler !action
action model
model = do
      Writer [BotM (Maybe action)] () -> Eff action ()
forall action model.
Writer [BotM (Maybe action)] model -> Eff action model
Eff ([BotM (Maybe action)] -> Writer [BotM (Maybe action)] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ((BotM (Maybe action) -> BotM (Maybe action))
-> [BotM (Maybe action)] -> [BotM (Maybe action)]
forall a b. (a -> b) -> [a] -> [b]
map (BotM (Maybe action)
-> (Maybe action -> BotM (Maybe action)) -> BotM (Maybe action)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe action -> BotM (Maybe action)
forall (f :: * -> *). MonadIO f => Maybe action -> f (Maybe action)
traceAction) [BotM (Maybe action)]
actions))
      model -> Eff action model
forall (f :: * -> *) a. Applicative f => a -> f a
pure model
newModel
      where
        (model
newModel, [BotM (Maybe action)]
actions) = Eff action model -> (model, [BotM (Maybe action)])
forall action model.
Eff action model -> (model, [BotM (Maybe action)])
runEff (Eff action model -> (model, [BotM (Maybe action)]))
-> Eff action model -> (model, [BotM (Maybe action)])
forall a b. (a -> b) -> a -> b
$
          BotApp model action -> action -> model -> Eff action model
forall model action.
BotApp model action -> action -> model -> Eff action model
botHandler BotApp model action
botApp
            (String -> action -> action
forall a. String -> a -> a
trace (TracedAction action -> String
f (action -> TracedAction action
forall action. action -> TracedAction action
TracedIncomingAction action
action)) action
action)
            model
model

-- | Trace (debug print) bot actions using 'Show' instance.
traceBotActionsShow
  :: Show action => BotApp model action -> BotApp model action
traceBotActionsShow :: BotApp model action -> BotApp model action
traceBotActionsShow = (TracedAction action -> String)
-> BotApp model action -> BotApp model action
forall action model.
(TracedAction action -> String)
-> BotApp model action -> BotApp model action
traceBotActionsWith TracedAction action -> String
forall action. Show action => TracedAction action -> String
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 :: (model -> String) -> BotApp model action -> BotApp model action
traceBotModelWith model -> String
f BotApp model action
botApp = BotApp model action
botApp
  { botInitialModel :: model
botInitialModel = model
newInitialModel
  , botHandler :: action -> model -> Eff action model
botHandler = action -> model -> Eff action model
newHandler
  }
    where
      !newInitialModel :: model
newInitialModel = model -> model
traceModel (BotApp model action -> model
forall model action. BotApp model action -> model
botInitialModel BotApp model action
botApp)
      newHandler :: action -> model -> Eff action model
newHandler action
action !model
model = model -> model
traceModel (model -> model) -> Eff action model -> Eff action model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BotApp model action -> action -> model -> Eff action model
forall model action.
BotApp model action -> action -> model -> Eff action model
botHandler BotApp model action
botApp action
action model
model
      traceModel :: model -> model
traceModel = String -> model -> model
forall a. String -> a -> a
trace (String -> model -> model)
-> (model -> String) -> model -> model -> model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> model -> String
f (model -> model -> model) -> (model -> model) -> model -> model
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> model -> model
forall a. a -> a
id

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

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

-- * Helpers

-- | Pretty print a value as JSON.
ppAsJSON :: ToJSON a => a -> String
ppAsJSON :: a -> String
ppAsJSON = Text -> String
Text.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty