Reverse State Monad

Reverse.hs

{-# LANGUAGE DeriveFunctor #-}

module Reverse where

-- https://tech-blog.capital-match.com/posts/5-the-reverse-state-monad.html

import Control.Monad.State
import qualified Data.Map as M

newtype ReverseState s a = ReverseState { runReverseState :: s -> (a, s) }
  deriving (Functor)

evalReverseState :: ReverseState s a -> s -> a
evalReverseState m s = fst (runReverseState m s)

instance Applicative (ReverseState s) where
  pure a = ReverseState $ \s -> (a, s)
  mf <*> ma = ReverseState $ \s ->
    let (f, past) = runReverseState mf future
        (a, future) = runReverseState ma s
    in (f a, past)

instance Monad (ReverseState s) where
  ma >>= f = ReverseState $ \s ->
    let (a, past) = runReverseState ma future
        (b, future) = runReverseState (f a) s
    in (b, past)

cumulative :: (Monoid w, Traversable t) => t w -> t w
cumulative t =
  evalState (traverse (\a -> state $ \s -> (s <> a, s <> a)) t) mempty

cumulativeR :: (Monoid w, Traversable t) => t w -> t w
cumulativeR t = evalReverseState
  (traverse (\a -> ReverseState $ \s -> (a <> s, a <> s)) t) mempty