[Haskell-cafe] Do we have idiom for lifting a state monad into pair of states?

[Roman Cheplyaka]

It's called 'zoom' in various lens libraries.

On 26/03/15 10:28, Ki Yung Ahn wrote:
> Consider you have developed library routines that act on (State s1 a).
> For some reason, you need more than one state simultaneously. Let's say
> two side by side for simple example, that is (State (s1,s2) a). To use
> library functions on one state monad in a two state monad, we need to
> wrapper that lifts actions of (State s1 a) to (State (s1,s2) a).
> 
> It is not difficult to write a lifter for such purposes as below. It is
> kind of like doing liftA in Applicative libarary, but instead of the
> last argument 'a' but on the fist argument 's' of (State s a). This
> seems like an idiom that can often come up. So, I tried some searching
> in some applicative related libraries and monad transformer related
> libraries but haven't found this idiom yet.
> 
> If you had a need for idioms like below, what do you call it? Or, is
> there a way more general way I've missed that makes this a very special
> case of it.
> 
>> import Control.Monad.State
>> import Control.Monad.Error
>> import Control.Applicative
>>
>> -- lift an action over a state into a pair of states
>> --
>> do1st :: State s1 a -> State (s1,s2) a
>> do1st m1 = do (s1, s2) <- get
>>               let (a, s1') = runState m1 s1
>>               put (s1',s2)
>>               return a
>>
>> do2nd :: State s2 a -> State (s1,s2) a
>> do2nd m2 = do (s1, s2) <- get
>>               let (a, s2') = runState m2 s2
>>               put (s1,s2')
>>               return a
>>
>>
>> -- lift an action over a state with error
>> -- into a pair of states with error
>> --
>> do1 :: Error e => ErrorT e (State s1) a -> ErrorT e (State (s1,s2)) a
>> do1 m1 = do (s1, s2) <- lift get
>>             let (ma,s1') = (runState . runErrorT) m1 s1
>>             case ma of
>>               Left e  -> throwError e
>>               Right a -> do lift $ put (s1',s2)
>>                             return a
>>
>>
>> do2 :: Error e => ErrorT e (State s2) a -> ErrorT e (State (s1,s2)) a
>> do2 m2 = do (s1, s2) <- lift get
>>             let (ma,s2') = (runState . runErrorT) m2 s2
>>             case ma of
>>               Left e  -> throwError e
>>               Right a -> do lift $ put (s1,s2')
>>                             return a
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>