module Control.MLens.ExtRef
( module Control.MLens.NewRef
, ExtRef (extRef)
, undoTr
) where
import Control.Monad
import Control.Category
import Prelude hiding ((.), id)
import Control.MLens.NewRef
import Data.MLens
import Data.MLens.Ref
class NewRef m => ExtRef m where
extRef :: Ref m b -> MLens m a b -> a -> m (Ref m a)
undoTr
:: ExtRef m =>
(a -> a -> Bool)
-> Ref m a
-> m ( m (Maybe (m ()))
, m (Maybe (m ()))
)
undoTr eq r = do
ku <- extRef r undoLens ([], [])
let try f = liftM (fmap (writeRef ku) . f) $ readRef ku
return (try undo, try redo)
where
undoLens = lens get set where
get = head . fst
set x (x' : xs, ys) | eq x x' = (x: xs, ys)
set x (xs, _) = (x : xs, [])
undo (x: xs@(_:_), ys) = Just (xs, x: ys)
undo _ = Nothing
redo (xs, y: ys) = Just (y: xs, ys)
redo _ = Nothing