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

import Control.Applicative
import Data.IORef
import Data.Monoid
import Prelude
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 :: (Logger -> IO r) -> IO (T.Text, r)
withSimpleTextLogger :: (Logger -> IO r) -> IO (Text, r)
withSimpleTextLogger Logger -> IO r
act = 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 :: (LogMessage -> IO ()) -> IO () -> IO () -> 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 (m :: * -> *) a. Monad m => a -> m a
return ()
        , loggerShutdown :: IO ()
loggerShutdown     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }
  r
r <- Logger -> IO r
act Logger
logger
  Text
txt <- Text -> Text
L.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
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 (m :: * -> *) a. Monad m => a -> m a
return (Text
txt, r
r)