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
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)