Katip higher order scribes

Extras.hs

--| Didn't need this after all, but, at least conceptually, this is kind of nice.
module Katip.Extras where

import Protolude

import Data.IORef
import Katip

ioScribe :: IO Scribe
  -> IO () -- ^ Finalizer, see 'scribeFinalizer'
  -> Scribe
ioScribe getScribe finalizer = Scribe
  { scribeFinalizer = finalizer
  , liPush = \item -> do
      scribe <- getScribe
      liPush scribe item
  }

ioRefScribe :: IO (Scribe -> IO (), Scribe)
ioRefScribe = do
  ref <- newIORef mempty
  let getScribe = do
        readIORef ref
      setScribe newScribe = do
        oldScribe <- atomicModifyIORef ref (\old -> (newScribe, old))
        scribeFinalizer oldScribe
      finalize = setScribe mempty
  pure (setScribe, ioScribe getScribe finalize)