module Control.Monad.MultiPass.Utils.UpdateCtx
( updateCtxFst, updateCtxSnd
, updateCtxLeft, updateCtxRight
)
where
import Control.Exception ( assert )
import Control.Monad.MultiPass
updateCtxFst
:: UpdateThreadContext rootTC (x,y)
-> UpdateThreadContext rootTC x
updateCtxFst updateCtx f =
do (x,_) <- updateCtx (cross f id)
return x
updateCtxSnd
:: UpdateThreadContext rootTC (x,y)
-> UpdateThreadContext rootTC y
updateCtxSnd updateCtx f =
do (_,y) <- updateCtx (cross id f)
return y
cross :: (a -> a') -> (b -> b') -> (a,b) -> (a',b')
cross f g (x,y) = (f x, g y)
updateCtxLeft
:: UpdateThreadContext rootTC (Either x y)
-> UpdateThreadContext rootTC x
updateCtxLeft updateCtx f =
let g (Left x) = Left (f x)
g (Right _) = assert False $ error "updateCtxLeft"
in
do Left x <- updateCtx g
return x
updateCtxRight
:: UpdateThreadContext rootTC (Either x y)
-> UpdateThreadContext rootTC y
updateCtxRight updateCtx f =
let g (Left _) = assert False $ error "updateCtxRight"
g (Right x) = Right (f x)
in
do Right x <- updateCtx g
return x