-- | 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 a. m a -> IO a) -> IO (Text, r)) -> m (Text, r)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Text, r)) -> m (Text, r))
-> ((forall a. m a -> IO a) -> IO (Text, r)) -> m (Text, r)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
unlift -> do
  IORef Builder
builderRef <- Builder -> IO (IORef Builder)
forall a. a -> IO (IORef a)
newIORef Builder
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 (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> LogMessage -> Text
showLogMessage Maybe UTCTime
forall a. Maybe a
Nothing LogMessage
msg
            IORef Builder -> (Builder -> Builder) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Builder
builderRef (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
msg' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
"\n")
        , loggerWaitForWrite :: IO ()
loggerWaitForWrite = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , loggerShutdown :: IO ()
loggerShutdown     = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }
  r
r <- m r -> IO r
forall a. m a -> IO a
unlift (m r -> IO r) -> m r -> IO r
forall a b. (a -> b) -> a -> b
$ Logger -> m r
act Logger
logger
  Text
txt <- LazyText -> Text
L.toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
B.toLazyText (Builder -> Text) -> IO Builder -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Builder -> IO Builder
forall a. IORef a -> IO a
readIORef IORef Builder
builderRef
  (Text, r) -> IO (Text, r)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
txt, r
r)