Обмен `mappend` в монаде писателя

Question

Резюме: при использовании монады Writer я хотел бы иметь возможность переключаться между 2 различными версиями mappend без потери состояния.

Я использую два логических флага для отслеживания состояния:

data Flags = F Bool Bool

Теперь я определяю два Monoid случаи, которые отличаются способом, которым они объединяют флаги в 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))

Теперь я могу иметь 2 монады Writer с разными флагами:

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

Теперь у меня могут быть такие операции:

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

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

Теперь я хотел бы построить выражения, как:

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

Для этого мне нужно иметь возможность конвертировать между двумя без потери флагов и, желательно, без разворачивания монады (используя runWriter). Эту часть я не разобрался. Похоже, что я могу попытаться вложить Writers, используя монадный преобразователь, но я не уверен, применимо ли это прямо здесь. Я буду признателен за некоторые рекомендации о том, как лучше реализовать что-то вроде этого.

Answer 1

Вы можете получить что-то разумное, используя mapWriter,

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

Теперь вы можете написать foo лайк

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

Вам может понадобиться обратное, xFromS также. Если бы у вас было более двух разных моноидов, возможно, стоило бы стать более любопытным и написать класс для контейнеров с флагами, например:

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

Затем используйте его, чтобы написать одну функцию, которая заменит sFromX, xFromS и любые другие вам нужно. (Не проверял это все же.)