module Freckle.App.Test.Logging
  ( runCapturedLoggingT
  ) where

import Freckle.App.Prelude

import Control.Concurrent.Chan
import Control.Monad (forever)
import Control.Monad.Logger
import UnliftIO.Async
import UnliftIO.IORef

-- | Run a 'LoggingT', capturing and returning any logged messages alongside
--
-- I do not know why 'runChanLoggingT' exists presumably for this purpose, but
-- requires so much more effort to ultimately accomplish.
--
runCapturedLoggingT :: MonadUnliftIO m => LoggingT m a -> m (a, [Text])
runCapturedLoggingT :: LoggingT m a -> m (a, [Text])
runCapturedLoggingT LoggingT m a
f = do
  Chan (Loc, Text, LogLevel, LogStr)
chan <- IO (Chan (Loc, Text, LogLevel, LogStr))
-> m (Chan (Loc, Text, LogLevel, LogStr))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Chan (Loc, Text, LogLevel, LogStr))
forall a. IO (Chan a)
newChan
  IORef [Text]
ref <- [Text] -> m (IORef [Text])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
  Async Any
x <- m Any -> m (Async Any)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m Any -> m (Async Any)) -> m Any -> m (Async Any)
forall a b. (a -> b) -> a -> b
$ m () -> m Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m Any) -> m () -> m Any
forall a b. (a -> b) -> a -> b
$ do
    (Loc
_, Text
_, LogLevel
_, LogStr
str) <- IO (Loc, Text, LogLevel, LogStr) -> m (Loc, Text, LogLevel, LogStr)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Loc, Text, LogLevel, LogStr)
 -> m (Loc, Text, LogLevel, LogStr))
-> IO (Loc, Text, LogLevel, LogStr)
-> m (Loc, Text, LogLevel, LogStr)
forall a b. (a -> b) -> a -> b
$ Chan (Loc, Text, LogLevel, LogStr)
-> IO (Loc, Text, LogLevel, LogStr)
forall a. Chan a -> IO a
readChan Chan (Loc, Text, LogLevel, LogStr)
chan
    IORef [Text] -> ([Text] -> [Text]) -> m ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef [Text]
ref ([Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ LogStr -> ByteString
fromLogStr LogStr
str])

  a
a <- Chan (Loc, Text, LogLevel, LogStr) -> LoggingT m a -> m a
forall (m :: * -> *) a.
MonadIO m =>
Chan (Loc, Text, LogLevel, LogStr) -> LoggingT m a -> m a
runChanLoggingT Chan (Loc, Text, LogLevel, LogStr)
chan LoggingT m a
f

  Async Any -> m ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Async Any
x
  [Text]
msgs <- IORef [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [Text]
ref
  (a, [Text]) -> m (a, [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, [Text]
msgs)