{-# LANGUAGE CPP #-}

module Freckle.App.Test.Logging
  ( MonadLogger
  , LoggingT
  , runCapturedLoggingT
  , logLineToText
  ) where

import Freckle.App.Prelude

import Control.Concurrent.Chan
import Control.Monad.Logger
import Data.DList (DList)
import qualified Data.DList as DList
import UnliftIO.Async
import UnliftIO.Exception (finally)

#if !MIN_VERSION_monad_logger(0,3,32)
type LogLine = (Loc, LogSource, LogLevel, LogStr)
#endif

-- | Run a 'LoggingT', capturing and returning any logged messages alongside
--
-- This is 'runWriterLoggingT', but we're not able to supply a 'MonadUnliftIO'
-- instance when using that.
--
runCapturedLoggingT :: MonadUnliftIO m => LoggingT m a -> m (a, [LogLine])
runCapturedLoggingT :: LoggingT m a -> m (a, [LogLine])
runCapturedLoggingT LoggingT m a
f = do
  Chan LogLine
chan <- IO (Chan LogLine) -> m (Chan LogLine)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Chan LogLine)
forall a. IO (Chan a)
newChan
  Async (DList LogLine)
x <- m (DList LogLine) -> m (Async (DList LogLine))
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m (DList LogLine) -> m (Async (DList LogLine)))
-> m (DList LogLine) -> m (Async (DList LogLine))
forall a b. (a -> b) -> a -> b
$ DList LogLine -> Chan LogLine -> m (DList LogLine)
forall (m :: * -> *).
MonadIO m =>
DList LogLine -> Chan LogLine -> m (DList LogLine)
captureLog DList LogLine
forall a. DList a
DList.empty Chan LogLine
chan
  a
a <- Chan LogLine -> LoggingT m a -> m a
forall (m :: * -> *) a.
MonadIO m =>
Chan LogLine -> LoggingT m a -> m a
runChanLoggingT Chan LogLine
chan (LoggingT m a -> m a) -> LoggingT m a -> m a
forall a b. (a -> b) -> a -> b
$ LoggingT m a
f LoggingT m a -> LoggingT m () -> LoggingT m a
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` Text -> LoggingT m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logInfoN Text
doneMessage
  DList LogLine
msgs <- Async (DList LogLine) -> m (DList LogLine)
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait Async (DList LogLine)
x
  (a, [LogLine]) -> m (a, [LogLine])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, DList LogLine -> [LogLine]
forall a. DList a -> [a]
DList.toList DList LogLine
msgs)

captureLog :: MonadIO m => DList LogLine -> Chan LogLine -> m (DList LogLine)
captureLog :: DList LogLine -> Chan LogLine -> m (DList LogLine)
captureLog DList LogLine
acc Chan LogLine
chan = do
  LogLine
ll <- IO LogLine -> m LogLine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LogLine -> m LogLine) -> IO LogLine -> m LogLine
forall a b. (a -> b) -> a -> b
$ Chan LogLine -> IO LogLine
forall a. Chan a -> IO a
readChan Chan LogLine
chan
  let txt :: Text
txt = LogLine -> Text
logLineToText LogLine
ll
  if Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
doneMessage then DList LogLine -> m (DList LogLine)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList LogLine
acc else DList LogLine -> Chan LogLine -> m (DList LogLine)
forall (m :: * -> *).
MonadIO m =>
DList LogLine -> Chan LogLine -> m (DList LogLine)
captureLog (DList LogLine -> LogLine -> DList LogLine
forall a. DList a -> a -> DList a
DList.snoc DList LogLine
acc LogLine
ll) Chan LogLine
chan

doneMessage :: Text
doneMessage :: Text
doneMessage = Text
"%DONE%"

logLineToText :: LogLine -> Text
logLineToText :: LogLine -> Text
logLineToText (Loc
_, Text
_, LogLevel
_, LogStr
str) = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ LogStr -> ByteString
fromLogStr LogStr
str