Skip to content

Instantly share code, notes, and snippets.

@DaveCTurner
Created January 5, 2015 09:21
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save DaveCTurner/37258febb57ddaef99b0 to your computer and use it in GitHub Desktop.
Save DaveCTurner/37258febb57ddaef99b0 to your computer and use it in GitHub Desktop.
The 'ClearBefore' monoid, adding the ability to clear a log generated by a Writer.
-- ClearBefore.hs
module ClearBefore where
import Data.Monoid
data ClearBefore a = ClearBefore Bool a
instance Monoid a => Monoid (ClearBefore a) where
mempty = ClearBefore False mempty
mappend (ClearBefore f a) (ClearBefore False b) = ClearBefore f (mappend a b)
mappend _ x = x
runClearBefore :: ClearBefore a -> a
runClearBefore (ClearBefore _ a) = a
-- Main.hs
{-# LANGUAGE FlexibleContexts #-}
module Main (main) where
import ClearBefore
import Control.Applicative
import Control.Monad.Writer
tell_ :: MonadWriter (ClearBefore w) m => w -> m ()
tell_ = tell . ClearBefore False
clear :: (Monoid w, MonadWriter (ClearBefore w) m) => m ()
clear = tell $ ClearBefore True mempty
main :: IO ()
main = do
log <- liftM runClearBefore $ execWriterT $ do
tell_ "a"
tell_ "b"
clear
liftIO $ putStrLn "within writer"
tell_ "c"
tell_ "d"
putStrLn $ "log: " <> log
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment