Skip to content

Instantly share code, notes, and snippets.

@roberth
Created November 12, 2018 16:08
Show Gist options
  • Save roberth/f8050975b8daf19d42975b52e0d30452 to your computer and use it in GitHub Desktop.
Save roberth/f8050975b8daf19d42975b52e0d30452 to your computer and use it in GitHub Desktop.
Katip higher order scribes
--| 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment