-- | A logger that produces in-memory 'Text' values. Mainly useful for
-- testing.
module Log.Backend.Text ( withSimpleTextLogger ) where

import Control.Monad.IO.Unlift
import Data.IORef
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B

import Log.Data
import Log.Internal.Logger

-- | Create an in-memory logger for the duration of the given action,
-- returning both the result of the action and the logger's output as
-- a 'Text' value afterwards.
withSimpleTextLogger :: MonadUnliftIO m => (Logger -> m r) -> m (T.Text, r)
withSimpleTextLogger :: forall (m :: * -> *) r.
MonadUnliftIO m =>
(Logger -> m r) -> m (Text, r)
withSimpleTextLogger Logger -> m r
act = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
unlift -> do
  IORef Builder
builderRef <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
  let logger :: Logger
logger = Logger
        { loggerWriteMessage :: LogMessage -> IO ()
loggerWriteMessage = \LogMessage
msg -> do
            let msg' :: Builder
msg' = Text -> Builder
B.fromText forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> LogMessage -> Text
showLogMessage forall a. Maybe a
Nothing LogMessage
msg
            forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Builder
builderRef (forall a. Semigroup a => a -> a -> a
<> Builder
msg' forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
"\n")
        , loggerWaitForWrite :: IO ()
loggerWaitForWrite = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , loggerShutdown :: IO ()
loggerShutdown     = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }
  r
r <- forall a. m a -> IO a
unlift forall a b. (a -> b) -> a -> b
$ Logger -> m r
act Logger
logger
  Text
txt <- Text -> Text
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
B.toLazyText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef Builder
builderRef
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
txt, r
r)