Swapping `mappend` in Writer monad

Question

Summary: While using Writer monad, I would like to be able to switch between 2 different versions of mappend without losing the state.

I use two boolean flags to track some state:

data Flags = F Bool Bool

Now I define two Monoid instances which differ in a way they combine the flags in mappend:

newtype XFlags = XF Flags

instance Monoid XFlags where
  mempty = XF (F True False)
  (XF (F s0 c0)) `mappend` (XF (F s1 c1)) = XF (F (s0 && s1)
  (c0 || c1 || not (s0 || s1)))

newtype SFlags = SF Flags

instance Monoid SFlags where
  mempty = SF (F True False)
  (SF (F s0 c0)) `mappend` (SF (F s1 c1)) = SF (F (s0 && s1) (c0 || c1))

Now I can have 2 Writer monads with different flags handling:

type XInt = WriterT XFlags Identity Int
type SInt = WriterT SFlags Identity Int

Now I can have operations like:

xplus :: XInt -> XInt -> XInt
xplus = liftM2 (+)

splus :: SInt -> SInt -> SInt
splus = liftM2 (+)

Now to I would like to build expressions like:

foo = splus (return 1) (xplus (return 2) (return 3))

To do so I need to be able to convert between the two without losing any flags and preferably without unwrapping the monad (using runWriter). This part I have not been figure out. It looks little bit like I can try to nest Writers using monad transformer but I am not sure if it is applicable directly here. I will appreciate some guidance on the best way to implement something like this.

Answer 1

You can get something reasonable using mapWriter.

sFromX :: XInt -> SInt
sFromX = mapWriter (\(x, XF fs) -> (x, SF fs))

Now you can write foo like

foo :: SInt
foo = splus (return 1) (sFromX (xplus (return 2) (return 3)))

You might need the opposite, xFromS as well. If you had more than two different monoids maybe it would be worth getting fancier and writing a class for flag containers, something like:

class FlagContainer a where
  getFlags :: a -> Flags
  makeFromFlags :: Flags -> a

Then use it to write a single function which would replace sFromX, xFromS, and any others you need. (Haven't tested this though.)