module HaskellWorks.Polysemy.Hedgehog.Effect.Log
  ( interpretDataLogHedgehog,
    getLogEntryCallStack,
  ) where

import qualified Data.Text                                      as Text
import qualified GHC.Stack                                      as GHC
import           HaskellWorks.Polysemy.Prelude

import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
import           HaskellWorks.Polysemy.Hedgehog.Jot
import           Polysemy
import           Polysemy.Log

interpretDataLogHedgehog :: ()
  => Member Hedgehog r
  => (a -> Text)
  -> (a -> GHC.CallStack)
  -> InterpreterFor (DataLog a) r
interpretDataLogHedgehog :: forall (r :: EffectRow) a.
Member Hedgehog r =>
(a -> Text) -> (a -> CallStack) -> InterpreterFor (DataLog a) r
interpretDataLogHedgehog a -> Text
fmt a -> CallStack
cs Sem (DataLog a : r) a
sem = do
  (a -> Sem r ()) -> InterpreterFor (DataLog a) r
forall a (r :: EffectRow).
(a -> Sem r ()) -> InterpreterFor (DataLog a) r
interpretDataLog (\a
a -> CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack (a -> CallStack
cs a
a) (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ a -> Text
fmt a
a) Sem (DataLog a : r) a
sem
{-# inline interpretDataLogHedgehog #-}

getLogEntryCallStack :: LogEntry LogMessage -> GHC.CallStack
getLogEntryCallStack :: LogEntry LogMessage -> CallStack
getLogEntryCallStack = \case
  LogEntry LogMessage
_ UTCTime
_ CallStack
cs -> CallStack
cs