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

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

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

-- * Helpers

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