diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+Copyright Péter Diviánszky 2013-2014
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Péter Diviánszky nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/lensref.cabal b/lensref.cabal
new file mode 100644
--- /dev/null
+++ b/lensref.cabal
@@ -0,0 +1,84 @@
+name:               lensref
+version:            0.1
+category:           Control, Data
+synopsis:           References which can be joined and on which lenses can be applied
+description:
+    The lensref package provides and interface an two implementation
+    for references which can be joined and on which lenses can be applied.
+    .
+    * The pure implementation is slow and has memory leaks but probably easier to follow.
+    This is the reference implementation, so if the the other implementation
+    differs this has the right behaviour.
+    * The fast implementation is intended for real usage.
+    .
+    Status:
+    .
+    * The interface is getting stable. You can expect more functionality and minor changes on current functionality.
+    * There are test cases for the first half of the interface.
+    Both implementations fulfil the test cases.
+    * The pure implementation is ready.
+    * The fast implementation is much faster than the pure implementation,
+    but it is far from being as fast as possible.
+    Probably it also leaks memory.
+    .
+    To see what is possible to do with lens references, look at the test cases in "Data.LensRef.Test"
+    .
+    For more information visit the following links:
+    .
+    * <http://www.haskell.org/haskellwiki/LGtk haskell.org wiki page>
+    * <http://lgtk.wordpress.com/ Wordpress blog>
+    * <https://github.com/divipp/lensref GitHub repository>
+    * <http://hackage.haskell.org/package/lensref Haddock documentation (this page)>
+stability:          experimental
+license:            BSD3
+license-file:       LICENSE
+author:             Péter Diviánszky
+homepage:           http://www.haskell.org/haskellwiki/LGtk
+bug-reports:        https://github.com/divipp/lensref/issues
+maintainer:         divipp@gmail.com
+cabal-version:      >= 1.8
+build-type:         Simple
+
+source-repository head
+  type:             git
+  location:         https://github.com/divipp/lensref.git
+
+Flag Pure
+  Description:      Use the pure but slow implementation
+  Default:          False
+
+
+library
+
+  hs-source-dirs:
+                    src
+  build-depends:
+                    base < 5
+                  , transformers >= 0.3 && < 0.5
+                  , mtl >= 2 && < 2.3
+                  , monad-control == 0.3.*
+                  , operational == 0.2.*
+                  , lens == 4.1.*
+                  , containers == 0.5.*
+
+  exposed-modules:
+                    Data.LensRef
+                    Data.LensRef.Common
+                    Data.LensRef.TestEnv
+                    Data.LensRef.Test
+                    Data.LensRef.Pure
+                    Data.LensRef.Fast
+                    Data.LensRef.Default
+  if flag(Pure)
+    cpp-options:
+                    -D__PURE__
+
+  ghc-options: 
+                    -threaded
+                    -Wall 
+                    -fno-warn-incomplete-patterns 
+                    -fno-warn-name-shadowing 
+                    -fno-warn-missing-signatures 
+                    -fno-warn-orphans
+                    -fno-warn-type-defaults
+
diff --git a/src/Data/LensRef.hs b/src/Data/LensRef.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LensRef.hs
@@ -0,0 +1,381 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# OPTIONS_HADDOCK prune #-}
+module Data.LensRef
+    (
+    -- * Core
+
+    -- ** References
+      RefClass (..)
+    , RefSimple
+    , RefWriterOf
+    , RefWriterSimple
+
+    , MonadRefReader (..)
+    , MonadRefWriter (..)
+
+    -- ** Reference creation
+    , MonadRefCreator (..)
+    , Ref
+    , RefReader
+    , RefWriter
+
+    -- ** Dynamic networks
+    , MonadRegister (..)
+    , RegionStatusChange (..)
+
+    -- ** Other
+    , MonadMemo (..)
+
+    -- * Derived constructs
+    , modRef
+    , postponeModification
+--    , undoTr
+
+    , EqRefClass (..)
+    , EqRefSimple, EqRef
+    , hasEffect
+    , toEqRef
+    , fromEqRef
+    , newEqRef
+{-
+    , CorrRef
+    , corrRef
+    , fromCorrRef
+    , correction
+-}
+    ) where
+
+
+import Control.Monad
+import Control.Monad.Identity
+import Control.Lens (Lens', set, united)
+
+--------------------------------
+
+
+{- |
+Type class for references which can be joined and on which lenses can be applied.
+
+The join operation is 'join' from "Control.Monad":
+If @(r :: RefReaderSimple r (RefSimple r a))@ then @(join r :: RefSimple r a)@.
+This is possible because reference operations work with @(RefReaderSimple r (r a))@ instead
+of just @(r a)@. For more compact type signatures, @(RefReaderSimple r (r a))@ is called @(RefSimple r a)@.
+-}
+class (MonadRefWriter (RefWriterSimple r), MonadRefReader (RefReaderSimple r), RefReader (RefReaderSimple r) ~ RefReaderSimple r) => RefClass r where
+
+    {- | unit reference
+    -}
+    unitRef :: RefSimple r ()
+
+    {- | Apply a lens on a reference.
+    -}
+    lensMap :: Lens' a b -> RefSimple r a -> RefSimple r b
+
+    {- | Associated reference reader monad.
+
+    @(RefReaderSimple m)@ is ismoroprhic to @('Reader' x)@ for some @x@.
+    Laws which ensures this isomorphism (@(r :: RefReaderSimple m a)@ is arbitrary):
+
+    prop> r >> return ()  =  return ()
+    prop> liftM2 (,) r r  =  liftM (\a -> (a, a)) r
+
+    See also <http://stackoverflow.com/questions/16123588/what-is-this-special-functor-structure-called>
+    -}
+    type RefReaderSimple r :: * -> *
+
+    {- | Reference read.
+    -}
+    readRefSimple  :: RefSimple r a -> RefReaderSimple r a
+
+    {- | Reference write.
+    -}
+    writeRefSimple :: RefSimple r a -> a -> RefWriterSimple r ()
+
+data family RefWriterOf (m :: * -> *) a :: *
+
+{- |
+There are two associated types of a reference, 'RefReaderSimple' and 'RefWriterSimple' which determines each-other.
+This is implemented by putting only 'RefReaderSimple' into the 'RefClass' class and
+adding a @RefWriterOf@ data family outside of 'RefClass'.
+
+@RefWriterOf@ is hidden from the documentation because you never need it explicitly.
+-}
+type RefWriterSimple m = RefWriterOf (RefReaderSimple m)
+
+-- | Reference wrapped into a RefReaderSimple monad. See the documentation of 'RefClass'.
+type RefSimple r a = RefReaderSimple r (r a)
+
+infixr 8 `lensMap`
+
+-- | TODO
+class Monad m => MonadRefReader m where
+
+    -- | Base reference associated to the reference reader monad
+    type BaseRef m :: * -> *
+
+    liftRefReader :: RefReader m a -> m a
+
+    {- | @readRef@ === @liftRefReader . readRefSimple@
+    -}
+    readRef :: (RefClass r, RefReader m ~ RefReaderSimple r) => RefSimple r a -> m a
+    readRef = liftRefReader . readRefSimple
+
+
+-- | TODO
+type RefReader m = RefReaderSimple (BaseRef m)
+
+-- | TODO
+type RefWriter m = RefWriterSimple (BaseRef m)
+
+-- | TODO
+type Ref m a = RefSimple (BaseRef m) a
+
+
+
+-- | TODO
+class MonadRefReader m => MonadRefWriter m where
+
+    liftRefWriter :: RefWriter m a -> m a
+
+    {- | @writeRef r@ === @liftRefWriter . writeRefSimple r@
+    -}
+    writeRef :: (RefClass r, RefReaderSimple r ~ RefReader m) => RefSimple r a -> a -> m ()
+    writeRef r = liftRefWriter . writeRefSimple r
+
+
+
+
+{- | Monad for reference creation. Reference creation is not a method
+of the 'RefClass' type class to make possible to
+create the same type of references in multiple monads.
+
+For basic usage examples, look into the source of @Data.LensRef.Test@.
+-}
+class (Monad m, RefClass (BaseRef m), MonadRefReader m, MonadMemo m) => MonadRefCreator m where
+
+    {- | Reference creation by extending the state of an existing reference.
+
+    Suppose that @r@ is a reference and @k@ is a lens.
+
+    Law 1: @extRef@ applies @k@ on @r@ backwards, i.e. 
+    the result of @(extRef r k a0)@ should behaves exactly as @(lensMap k r)@.
+
+    prop> (liftM (k .) $ extRef r k a0)  =  return r
+
+    Law 2: @extRef@ does not change the value of @r@:
+
+    prop> (extRef r k a0 >> readRef r)  =  readRef r
+
+    Law 3: Proper initialization of newly defined reference with @a0@:
+
+    prop> (extRef r k a0 >>= readRef)  =  (readRef r >>= set k a0)
+    -}
+    extRef :: Ref m b -> Lens' a b -> a -> m (Ref m a)
+
+    {- | @newRef@ extends the state @s@ in an independent way.
+
+    @newRef@ === @extRef unitRef united@
+    -}
+    newRef :: a -> m (Ref m a)
+    newRef = extRef unitRef united
+
+
+-- | TODO
+class Monad m => MonadMemo m where
+    {- | Lazy monadic evaluation.
+    In case of @y <- memoRead x@, invoking @y@ will invoke @x@ at most once.
+
+    Laws:
+
+     *  @(memoRead x >> return ())@ === @return ()@
+
+     *  @(memoRead x >>= id)@ === @x@
+
+     *  @(memoRead x >>= \y -> liftM2 (,) y y)@ === @liftM (\a -> (a, a)) y@
+
+     *  @(memoRead x >>= \y -> liftM3 (,) y y y)@ === @liftM (\a -> (a, a, a)) y@
+
+     *  ...
+    -}
+    memoRead :: m a -> m (m a)
+{-
+    memoWrite :: Eq b => (b -> m a) -> m (b -> m a)
+
+    future :: (RefReader m a -> m a) -> m a
+-}
+
+-- | Monad for dynamic actions
+class (MonadRefCreator m, MonadRefWriter (Modifier m), MonadRefCreator (Modifier m), BaseRef (Modifier m) ~ BaseRef m, Monad (EffectM m),
+    {- MonadRegister (Modifier m), -}EffectM (Modifier m) ~ EffectM m, Modifier (Modifier m) ~ Modifier m)
+    => MonadRegister m where
+{-
+    onChangeAcc
+        :: Eq b
+        => RefReader m b
+        -> b -> (b -> c)
+        -> (b -> b -> c -> m (c -> m c))
+        -> m (RefReader m c)
+-}
+    onChange :: Eq a => RefReader m a -> (a -> m (m b)) -> m (RefReader m b)
+--    onChange r f = onChangeAcc r undefined undefined $ \b _ _ -> liftM const $ f b
+
+    onChangeSimple :: Eq a => RefReader m a -> (a -> m b) -> m (RefReader m b)
+    onChangeSimple r f = onChange r $ return . f
+
+    onRegionStatusChange :: (RegionStatusChange -> m ()) -> m ()
+
+
+    type EffectM m :: * -> *
+
+    liftEffectM :: EffectM m a -> m a
+
+    type Modifier m :: * -> *
+
+    liftToModifier :: m a -> Modifier m a
+
+    registerCallback :: Functor f => f (Modifier m ()) -> m (f (EffectM m ()))
+
+--    unliftEffectM :: Functor f => f (m ()) -> m (f (EffectM m ()))
+--    registerCallback_ :: Functor f => f (Modifier m ()) -> m (f (m ()))
+--    registerCallback = registerCallback_ >=> unliftEffectM
+
+
+-- | TODO
+data RegionStatusChange = Kill | Block | Unblock deriving (Eq, Ord, Show)
+
+
+
+
+
+-------------- derived constructs
+
+-- | TODO
+postponeModification :: MonadRegister m => Modifier m () -> m ()
+postponeModification = liftEffectM . runIdentity <=< registerCallback . Identity
+
+
+-- | @modRef r f@ === @readRef r >>= writeRef r . f@
+modRef :: (MonadRefWriter m, RefClass r, RefReaderSimple r ~ RefReader m) => RefSimple r a -> (a -> a) -> m ()
+r `modRef` f = readRef r >>= writeRef r . f
+
+
+
+
+
+{- | Reference with inherent equivalence.
+
+-}
+class RefClass r => EqRefClass r where
+    valueIsChanging :: RefSimple r a -> RefReaderSimple r (a -> Bool)
+
+{- | @hasEffect r f@ returns @False@ iff @(modRef m f)@ === @(return ())@.
+
+@hasEffect@ is correct only if @toEqRef@ is applied on a pure reference (a reference which is a pure lens on the hidden state).
+
+@hasEffect@ makes defining auto-sensitive buttons easier, for example.
+-}
+hasEffect
+    :: EqRefClass r
+    => RefSimple r a
+    -> (a -> a)
+    -> RefReaderSimple r Bool
+hasEffect r f = do
+    a <- readRef r
+    ch <- valueIsChanging r
+    return $ ch $ f a
+
+
+-- | TODO
+data EqRefCore r a = EqRefCore (r a) (a -> Bool{-changed-})
+
+{- | RefClasss with inherent equivalence.
+
+@EqRefSimple r a@ === @RefReaderSimple r (exist b . Eq b => (Lens' b a, r b))@
+
+As a reference, @(m :: EqRefSimple r a)@ behaves as
+
+@join $ liftM (uncurry lensMap) m@
+-}
+type EqRefSimple r a = RefReaderSimple r (EqRefCore r a)
+
+-- | TODO
+type EqRef m a = EqRefSimple (BaseRef m) a
+
+{- | @EqRefSimple@ construction.
+-}
+toEqRef :: (RefClass r, Eq a) => RefSimple r a -> EqRefSimple r a
+toEqRef r = do
+    a <- readRef r
+    r_ <- r
+    return $ EqRefCore r_ (/= a)
+
+-- | TODO
+newEqRef :: (MonadRefCreator m, Eq a) => a -> m (EqRef m a) 
+newEqRef = liftM toEqRef . newRef
+
+{- | An @EqRefSimple@ is a normal reference if we forget about the equality.
+
+@fromEqRef m@ === @join $ liftM (uncurry lensMap) m@
+-}
+fromEqRef :: RefClass r => EqRefSimple r a -> RefSimple r a
+fromEqRef m = m >>= \(EqRefCore r _) -> return r
+
+instance RefClass r => EqRefClass (EqRefCore r) where
+    valueIsChanging m = do
+        EqRefCore _r k <- m
+        return k
+
+instance RefClass r => RefClass (EqRefCore r) where
+
+    type (RefReaderSimple (EqRefCore r)) = RefReaderSimple r
+
+    readRefSimple = readRef . fromEqRef
+
+    writeRefSimple = writeRefSimple . fromEqRef
+
+    lensMap l m = do
+        a <- readRef m
+        EqRefCore r k <- m
+        lr <- lensMap l $ return r
+        return $ EqRefCore lr $ \b -> k $ set l b a
+
+    unitRef = toEqRef unitRef
+
+{-
+data CorrBaseRef r a = CorrBaseRef (r a) (a -> Maybe a{-corrected-})
+
+type CorrRef r a = RefReaderSimple r (CorrBaseRef r a)
+
+instance RefClass r => RefClass (CorrBaseRef r) where
+
+    type (RefReaderSimple (CorrBaseRef r)) = RefReaderSimple r
+
+    readRef = readRef . fromCorrRef
+
+    writeRefSimple = writeRefSimple . fromCorrRef
+
+    lensMap l m = do
+        a <- readRef m
+        CorrBaseRef r k <- m
+        lr <- lensMap l $ return r
+        return $ CorrBaseRef lr $ \b -> fmap (^. l) $ k $ set l b a
+
+    unitRef = corrRef (const Nothing) unitRef
+
+fromCorrRef :: RefClass r => CorrRef r a -> RefSimple r a
+fromCorrRef m = m >>= \(CorrBaseRef r _) -> return r
+
+corrRef :: RefClass r => (a -> Maybe a) -> RefSimple r a -> CorrRef r a
+corrRef f r = do
+    r_ <- r
+    return $ CorrBaseRef r_ f
+
+correction :: RefClass r => CorrRef r a -> RefReaderSimple r (a -> Maybe a)
+correction r = do
+    CorrBaseRef _ f <- r
+    return f
+-}
+
+
diff --git a/src/Data/LensRef/Common.hs b/src/Data/LensRef/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LensRef/Common.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_HADDOCK hide #-}
+module Data.LensRef.Common where
+
+import Data.Monoid
+import Control.Concurrent
+import Control.Monad.State
+import Control.Monad.Writer
+import Control.Monad.Reader
+
+import Data.LensRef
+
+----------------
+
+-- Ref-based WriterT
+type RefWriterT w m = ReaderT (Ref m w) m
+
+runRefWriterT :: (MonadRefCreator m, Monoid w) => RefWriterT w m a -> m (a, Ref m w)
+runRefWriterT m = do
+    r <- newRef mempty
+    a <- runReaderT m r
+    return (a, r)
+
+tell' :: (Monoid w, MonadRefCreator m, MonadRefWriter m) => w -> RefWriterT w m ()
+tell' w = ReaderT $ \m -> modRef m (`mappend` w)
+
+-------------
+
+newtype MonadMonoid a = MonadMonoid { runMonadMonoid :: a () }
+
+instance Monad m => Monoid (MonadMonoid m) where
+    mempty = MonadMonoid $ return ()
+    MonadMonoid a `mappend` MonadMonoid b = MonadMonoid $ a >> b
+
+
+------------------------
+
+newtype Morph m n = Morph { runMorph :: forall a . m a -> n a }
+
+type SRef m a = Morph (StateT a m) m
+
+class Monad m => NewRef m where
+    newRef' :: a -> m (SRef m a)
+{-
+instance Monad m => NewRef (StateT LSt m) where
+    newRef' x = do
+        v <- newRef x
+        return $ Morph $ \m -> do
+            x <- readRef v
+            (y, x) <- runStateT m x
+            writeRef v x
+            return y
+-}
+instance NewRef IO where
+    newRef' x = do
+        vx <- liftIO $ newMVar x
+        return $ Morph $ \m -> modifyMVar vx $ liftM swap . runStateT m
+      where
+        swap (a, b) = (b, a)
+
+instance NewRef m => NewRef (StateT s m) where
+    newRef' x = lift $ flip liftM (newRef' x) $ \r ->
+        Morph $ \m -> StateT $ \s -> runMorph r $ flip mapStateT m $ \k -> flip liftM (runStateT k s) $ \((x, w), s) -> ((x, s), w)
+
+instance (Monoid w, NewRef m) => NewRef (WriterT w m) where
+    newRef' x = lift $ flip liftM (newRef' x) $ \r ->
+        Morph $ \m -> WriterT $ runMorph r $ flip mapStateT m $ \k -> flip liftM (runWriterT k) $ \((x, s), w) -> ((x, w), s)
+
+instance NewRef m => NewRef (ReaderT r m) where
+    newRef' x = lift $ flip liftM (newRef' x) $ \r ->
+        Morph $ \m -> ReaderT $ \st -> runMorph r $ flip mapStateT m $ flip runReaderT st
+
+---------------------------
+
+{-
+    memoWrite = memoWrite_
+
+    future = future_
+
+future_ :: (MonadRefCreator m, MonadRefWriter m) => (RefReader m a -> m a) -> m a
+future_ f = do
+    s <- newRef $ error "can't see the future"
+    a <- f $ readRef s
+    writeRef s a
+    return a
+-}
+memoRead_ :: (MonadRefWriter m, MonadRefCreator m) => m a -> m (m a) 
+memoRead_ g = do
+    s <- newRef Nothing
+    return $ readRef s >>= \x -> case x of
+        Just a -> return a
+        _ -> g >>= \a -> do
+            writeRef s $ Just a
+            return a
+
+{-
+memoWrite_ g = do
+    s <- newRef Nothing
+    return $ \b -> readRef s >>= \x -> case x of
+        Just (b', a) | b' == b -> return a
+        _ -> g b >>= \a -> do
+            writeRef s $ Just (b, a)
+            return a
+-}
+
+
diff --git a/src/Data/LensRef/Default.hs b/src/Data/LensRef/Default.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LensRef/Default.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+-- | Default implementation. Points to either to the pure or the fast implementation depending on the cabal flag @PURE@.
+module Data.LensRef.Default
+    ( Register
+    , runRegister
+    ) where
+
+#ifdef __PURE__
+import Data.LensRef.Pure
+#else
+import Data.LensRef.Fast
+#endif
+
+
diff --git a/src/Data/LensRef/Fast.hs b/src/Data/LensRef/Fast.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LensRef/Fast.hs
@@ -0,0 +1,311 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+--{-# OPTIONS_HADDOCK hide #-}
+{- |
+Fast implementation for the @MonadRefCreator@ interface.
+
+TODO
+- elim mem leak: registered events don't allow to release unused refs
+- optimiziation: do not remember values
+- optimiziation: equality check
+-}
+module Data.LensRef.Fast
+    ( Register
+    , runRegister
+    , runTests
+    ) where
+
+import Data.Monoid
+import Control.Applicative hiding (empty)
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Lens
+
+import Data.LensRef
+import Data.LensRef.Common
+import Data.LensRef.TestEnv
+import Data.LensRef.Test
+
+----------------------
+
+newtype Wrap m a
+    = Wrap {unWrap :: m a}
+        deriving (Monad, Functor, Applicative, MonadFix)
+
+instance NewRef m => NewRef (Wrap m) where
+    newRef' x = Wrap $ liftM (\(Morph f) -> Morph $ \g -> Wrap $ f $ mapStateT unWrap g) $ newRef' x
+
+instance MonadTrans Wrap where
+    lift = Wrap
+
+newtype instance RefWriterOf (Wrap m) a
+    = RefWriterOfIO { runRefWriterOfIO :: Wrap m a }
+        deriving (Monad, Applicative, Functor)
+
+----------------------
+
+data Lens__ (m :: * -> *) a = Lens_ 
+    { readPart :: m a
+    , writePart :: a -> m ()
+    , register :: m () -> m ()
+    }
+
+type Lens_ m = Lens__ (Wrap m)
+
+joinLens :: Monad m => Wrap m (Lens_ m a) -> Lens_ m a
+joinLens m = Lens_
+    { readPart = m >>= readPart
+    , writePart = \a -> m >>= \r -> writePart r a
+    , register = \e -> m >>= \r -> register r e
+    }
+
+instance NewRef m => RefClass (Lens_ m) where
+    type RefReaderSimple (Lens_ m) = Wrap m
+
+    readRefSimple = readPart . joinLens
+    writeRefSimple m = RefWriterOfIO . writePart (joinLens m)
+    lensMap l m = do
+        Lens_ r w t <- m
+        return Lens_
+            { readPart = r >>= \a -> return $ a ^. l
+            , writePart = \b -> r >>= \a -> w $ set l b a
+            , register = t
+            }
+    unitRef = return Lens_
+                { readPart = return ()
+                , writePart = const $ return ()
+                , register = \_ -> return ()
+                }
+
+instance NewRef m => MonadRefReader (Wrap m) where
+
+    type BaseRef (Wrap m) = Lens_ m
+
+    liftRefReader = id
+
+instance NewRef m => MonadRefReader (RefWriterOf (Wrap m)) where
+
+    type BaseRef (RefWriterOf (Wrap m)) = Lens_ m
+
+    liftRefReader = RefWriterOfIO
+
+instance NewRef m => MonadRefWriter (RefWriterOf (Wrap m)) where
+    liftRefWriter = id -- RefWriterOfIO . runRefWriterOfIO
+
+{-
+wrap :: NewRef m => IO a -> Wrap m a
+wrap m = Wrap $ liftBaseWith $ const m
+-}
+instance NewRef m => MonadRefCreator (Wrap m) where
+
+    extRef r r2 a0 = do
+        Lens_ rb wb tb <- r
+        b0 <- rb
+        va <- newRef' $ set r2 b0 a0
+        reg <- newRef' $ return ()
+        status <- newRef' True -- True: normal; False:
+        tb $ do
+            s <- runMorph status get
+            when s $ do
+                b <- rb
+                runMorph va $ modify (set r2 b)
+                join $ runMorph reg get
+        return $
+            return Lens_
+                { readPart = runMorph va get
+                , writePart = \a -> do
+                    runMorph va $ put a
+                    runMorph status $ put False
+                    wb $ a ^. r2
+                    runMorph status $ put True
+                    join $ runMorph reg get
+                , register = \m -> runMorph reg $ modify (>> m)
+                }
+
+    newRef a0 = do
+        va <- newRef' a0
+        reg <- newRef' $ return ()
+        return $ return Lens_
+                { readPart = runMorph va get
+                , writePart = \a -> do
+                    runMorph va $ put a
+                    join $ runMorph reg get
+                , register = \m -> runMorph reg $ modify (>> m)
+                }
+
+instance NewRef m => MonadMemo (Wrap m) where
+    memoRead = memoRead_
+{-
+    memoWrite = memoWrite_
+
+    future = future_
+-}
+
+
+instance NewRef m => MonadRefWriter (Wrap m) where
+    liftRefWriter = runRefWriterOfIO
+
+
+---------------------------------
+
+type Register_ m = ReaderT (Ref m (MonadMonoid m, RegionStatusChange -> MonadMonoid m)) m
+
+newtype Reg n a = Reg { unReg :: ReaderT (SLSt n () -> n ()) (Register_ (SLSt n)) a } deriving (Monad, Applicative, Functor)
+
+type SLSt (m :: * -> *) = m
+
+type Register m = Reg (Wrap m)
+{-
+mapReg :: (forall a . m a -> n a) -> Reg m a -> Reg n a
+mapReg ff (Reg m) = Reg $ ReaderT $ \f -> ReaderT $ \r -> StateT $ \s -> 
+    ff $ flip runStateT s $ flip runReaderT (iso undefined undefined `lensMap` r) $ runReaderT m $ undefined f
+
+instance MonadTrans Reg where
+    lift = Reg . lift . lift . lift
+-}
+
+instance MonadFix m => MonadFix (Register m) where
+    mfix f = Reg $ mfix $ unReg . f
+
+instance NewRef m => MonadRefReader (Register m) where
+
+    type BaseRef (Register m) = Lens_ m
+
+    liftRefReader = Reg . lift . lift . liftRefReader
+
+instance NewRef m => MonadRefCreator (Register m) where
+    extRef r l = Reg . lift . lift . extRef r l
+    newRef = Reg . lift . lift . newRef
+
+instance NewRef m => MonadMemo (Register m) where
+    memoRead = memoRead_
+{-
+    memoWrite = memoWrite_
+    future = future_
+-}
+instance NewRef m => MonadRefWriter (Register m) where
+    liftRefWriter = Reg . lift . lift . liftRefWriter
+
+instance NewRef m => MonadRegister (Register m) where
+
+    type EffectM (Register m) = m
+
+    type Modifier (Register m) = Register m
+
+    liftEffectM = Reg . lift . lift . lift
+
+    liftToModifier = id
+
+    onChange r f = onChangeAcc r undefined undefined $ \b _ _ -> liftM const $ f b
+
+    onChangeSimple r f = Reg $ ReaderT $ \ff ->
+        toSend False r undefined undefined $ \b _ _ -> return $ \_ -> evalRegister ff $ f b
+
+    registerCallback f = Reg $ ReaderT $ \ff -> do
+        writerstate <- ask
+        return $ fmap (unWrap . ff . flip runReaderT writerstate . evalRegister ff) f
+
+    onRegionStatusChange g = Reg $ ReaderT $ \ff -> do
+        writerstate <- ask
+        tell' (mempty, MonadMonoid . flip runReaderT writerstate . evalRegister ff . g)
+
+
+evalRegister ff (Reg m) = runReaderT m ff
+
+runRegister :: NewRef m => (forall a . m (m a, a -> m ())) -> Register m a -> m (a, m ())
+runRegister newChan (Reg m) = unWrap $ do
+    (read, write) <- Wrap newChan
+    (a, tick) <- do
+        (a, r) <- runRefWriterT $ runReaderT m $ Wrap . write
+        (w, _) <- readRef r
+        return (a, runMonadMonoid w)
+    return $ (,) a $ unWrap $ forever $ do
+        join $ Wrap read
+        tick
+
+runRegister_ :: NewRef m => (m (Wrap m ())) -> (Wrap m () -> m ()) -> Register m a -> m (a, m ())
+runRegister_ read write (Reg m) = unWrap $ do
+    (a, tick) <- do
+        (a, r) <- runRefWriterT $ runReaderT m $ Wrap . write
+        (w, _) <- readRef r
+        return (a, runMonadMonoid w)
+    return $ (,) a $ unWrap $ forever $ do
+        join $ Wrap read
+        tick
+
+
+onChangeAcc r b0 c0 f = Reg $ ReaderT $ \ff ->
+    toSend True r b0 c0 $ \b b' c' -> liftM (\x -> evalRegister ff . x) $ evalRegister ff $ f b b' c'
+
+toSend
+    :: (Eq b, MonadRefCreator m, MonadRefWriter m)
+    => Bool
+    -> RefReader m b
+    -> b -> (b -> c)
+    -> (b -> b -> c -> {-Either (Register m c)-} Register_ m (c -> Register_ m c))
+    -> Register_ m (RefReader m c)
+toSend memoize rb b0 c0 fb = do
+    let doit st = readRef st >>= runMonadMonoid . fst
+        reg st msg = readRef st >>= runMonadMonoid . ($ msg) . snd
+
+    memoref <- lift $ do
+        b <- liftRefReader rb
+        (c, st1) <- runRefWriterT $ fb b b0 $ c0 b0
+        (val, st2) <- runRefWriterT $ c $ c0 b0
+        doit st1
+        doit st2
+        newRef ((b, (c, val, st1, st2)), [])      -- memo table
+
+    let act = MonadMonoid $ do
+            b <- liftRefReader rb
+            (last@(b', cc@(_, oldval, st1, st2)), memo) <- readRef memoref
+            (_, _, st1, st2) <- if b' == b
+              then
+                return cc
+              else do
+                reg st1 Block
+                reg st2 Kill
+                (c, oldval', st1, _) <- case lookup b memo of
+                  Nothing -> do
+                    (c, st1) <- runRefWriterT $ fb b b' oldval
+                    return (c, c0 b, st1, undefined)
+                  Just cc'@(_, _, st1, _) -> do
+                    reg st1 Unblock
+                    return cc'
+                (val, st2) <- runRefWriterT $ c oldval'
+                let cc = (c, val, st1, st2)
+                writeRef memoref ((b, cc), if memoize then filter ((/= b) . fst) (last:memo) else [])
+                return cc
+            doit st1
+            doit st2
+
+    tell' (act, mempty)
+    return $ readRef $ (_1 . _2 . _2) `lensMap` memoref
+
+--------------------------
+
+instance MonadRegisterRun (Register (Prog TP)) where
+
+    type AsocT (Register (Prog TP)) = TP
+
+    runReg r w m = runRegister_ (liftM unTP r) (w . TP) m
+
+newtype TP = TP { unTP :: Wrap (Prog TP) () }
+
+runTests = do
+    mkTests runTestSimple
+    tests runTest
+
+
+runTest :: (Eq a, Show a) => String -> Register (Prog TP) a -> Prog' (a, Prog' ()) -> IO ()
+runTest name = runTest_ name (TP . lift) runReg
+
+runTestSimple :: Register (Prog TP) () -> IO ()
+runTestSimple m = runTest "" m $ return ((), return ())
+
diff --git a/src/Data/LensRef/Pure.hs b/src/Data/LensRef/Pure.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LensRef/Pure.hs
@@ -0,0 +1,274 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-- {-# OPTIONS_HADDOCK hide #-}
+{- |
+Register reference implementation for the @MonadRefCreator@ interface.
+
+The implementation uses @unsafeCoerce@ internally, but its effect cannot escape.
+-}
+module Data.LensRef.Pure
+    ( Register
+    , runRegister
+    , runTests
+    ) where
+
+import Data.Monoid
+import Control.Applicative
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Arrow (second)
+import qualified Data.Sequence as Seq
+import Control.Lens hiding ((|>))
+import Data.Foldable (toList)
+
+import Unsafe.Coerce
+
+import Data.LensRef
+import Data.LensRef.Common
+import Data.LensRef.TestEnv
+import Data.LensRef.Test
+
+----------------------
+
+newtype instance RefWriterOf (ReaderT s m) a
+    = RefWriterOfReaderT { runRefWriterOfReaderT :: StateT s m a }
+        deriving (Monad, Applicative, Functor, MonadReader s, MonadState s)
+
+----------------------
+
+newtype Lens_ a b = Lens_ {unLens_ :: ALens' a b}
+
+runLens_ :: Reader a (Lens_ a b) -> Lens' a b
+runLens_ r f a = cloneLens (unLens_ $ runReader r a) f a
+
+type LSt = Seq.Seq CC
+
+data CC = forall a . CC (LSt -> a -> a) a
+
+initLSt :: LSt
+initLSt = empty
+
+instance MonadRefReader (Reader LSt) where
+    type BaseRef (Reader LSt) = Lens_ LSt
+    liftRefReader = id
+
+instance Monad m => MonadRefReader (RefWriterOf (ReaderT LSt m)) where
+    type BaseRef (RefWriterOf (ReaderT LSt m)) = Lens_ LSt
+    liftRefReader = RefWriterOfReaderT . gets . runReader
+
+instance MonadRefWriter (RefWriterOf (Reader LSt)) where
+    liftRefWriter = id
+
+instance RefClass (Lens_ LSt) where
+    type RefReaderSimple (Lens_ LSt) = Reader LSt
+
+    readRefSimple = view . runLens_
+    writeRefSimple r a = runLens_ r .= a
+    lensMap l r = return $ Lens_ $ runLens_ r . l
+    unitRef = return $ Lens_ united
+
+instance Monad m => MonadRefReader (StateT LSt m) where
+    type BaseRef (StateT LSt m) = Lens_ LSt
+
+    liftRefReader = gets . runReader
+
+instance Monad m => MonadRefCreator (StateT LSt m) where
+    extRef r r2 a0 = state extend
+      where
+        rk = set (runLens_ r) . (^. r2)
+        kr = set r2 . (^. runLens_ r)
+
+        extend x0 = (return $ Lens_ $ lens get set, x0 Seq.|> CC kr (kr x0 a0))
+          where
+            limit = second toList . Seq.splitAt (Seq.length x0)
+
+            get = unsafeData . head . snd . limit
+
+            set x a = foldl (\x -> (Seq.|>) x . ap_ x) (rk a zs Seq.|> CC kr a) ys where
+                (zs, _ : ys) = limit x
+
+        ap_ :: LSt -> CC -> CC
+        ap_ x (CC f a) = CC f (f x a)
+
+        unsafeData :: CC -> a
+        unsafeData (CC _ a) = unsafeCoerce a
+
+
+instance Monad m => MonadMemo (StateT LSt m) where
+    memoRead = memoRead_
+
+--instance MonadMemo (RefWriterOf (Reader LSt)) where
+--    memoRead = memoRead_
+
+instance Monad m => MonadRefWriter (StateT LSt m) where
+    liftRefWriter = state . runState . runRefWriterOfReaderT
+
+
+---------------------------------
+
+
+type Register_ m
+    = ReaderT (Ref m (MonadMonoid m, RegionStatusChange -> MonadMonoid m)) m
+
+type RegRef m
+    = Ref m (MonadMonoid m, RegionStatusChange -> MonadMonoid m)
+
+newtype Register n a
+    = Register { unRegister :: ReaderT (SLSt n () -> n (), RegRef (SLSt n)) (SLSt n) a }
+        deriving (Monad, Applicative, Functor)
+
+type SLSt = StateT LSt
+{-
+mapReg :: (forall a . m a -> n a) -> Register m a -> Register n a
+mapReg ff (Register m) = Register $ ReaderT $ \f -> ReaderT $ \r -> StateT $ \s -> 
+    ff $ flip runStateT s $ flip runReaderT (iso undefined undefined `lensMap` r) $ runReaderT m $ undefined f
+-}
+instance MonadTrans Register where
+    lift = Register . lift . lift
+
+instance MonadFix m => MonadFix (Register m) where
+    mfix f = Register $ mfix $ unRegister . f
+
+instance Monad m => MonadRefReader (Register m) where
+
+    type BaseRef (Register n) = Lens_ LSt
+
+    liftRefReader = Register . lift . liftRefReader
+
+instance Monad n => MonadRefCreator (Register n) where
+    extRef r l = Register . lift . extRef r l
+    newRef = Register . lift . newRef
+
+instance Monad m => MonadMemo (Register m) where
+    memoRead = memoRead_
+{-
+    memoWrite = memoWrite_
+    future = future_
+-}
+instance Monad n => MonadRefWriter (Register n) where
+    liftRefWriter = Register . lift . liftRefWriter
+
+instance Monad n => MonadRegister (Register n) where
+
+    type EffectM (Register n) = n
+
+    liftEffectM = lift
+
+    type Modifier (Register n) = Register n
+
+    liftToModifier = id
+
+    onChange r f = onChangeAcc r undefined undefined $ \b _ _ -> liftM const $ f b
+
+    registerCallback f = Register $ do
+        st <- ask
+        return $ fmap (fst st . evalRegister st) f
+
+    onRegionStatusChange g = Register $ do
+        st <- ask
+        magnify _2 $ tell' (mempty, MonadMonoid . evalRegister st . g)
+
+evalRegister' ff (Register m) = ReaderT $ \s -> runReaderT m (ff, s)
+
+evalRegister ff (Register m) = runReaderT m ff
+
+runRegister :: Monad m => (forall a . m (m a, a -> m ())) -> Register m a -> m (a, m ())
+runRegister newChan m = do
+    (read, write) <- newChan
+    runRegister_ read write m
+
+
+runRegister_ :: Monad m => m (SLSt m ()) -> (SLSt m () -> m ()) -> Register m a -> m (a, m ())
+runRegister_ read write (Register m) = do
+    ((a, tick), s) <- flip runStateT initLSt $ do
+        r <- newRef mempty
+        a <- runReaderT m (write, r)
+        (w, _) <- readRef r
+        return (a, runMonadMonoid w)
+    let eval s = flip evalStateT s $ forever $ do
+            join $ lift read
+            tick
+    return $ (,) a $ eval s
+
+------------------------------------
+
+onChangeAcc r b0 c0 f = Register $ do
+    ff <- asks fst
+    magnify _2 $ toSend r b0 c0 $ \b b' c' -> liftM (\x -> evalRegister' ff . x) $ evalRegister' ff $ f b b' c'
+
+
+toSend
+    :: (Eq b, MonadRefCreator m, MonadRefWriter m)
+    => RefReader m b
+    -> b -> (b -> c)
+    -> (b -> b -> c -> {-Either (Register m c)-} Register_ m (c -> Register_ m c))
+    -> Register_ m (RefReader m c)
+toSend rb b0 c0 fb = do
+    let doit st = readRef st >>= runMonadMonoid . fst
+        reg st msg = readRef st >>= runMonadMonoid . ($ msg) . snd
+
+    memoref <- lift $ do
+        b <- liftRefReader rb
+        (c, st1) <- runRefWriterT $ fb b b0 $ c0 b0
+        (val, st2) <- runRefWriterT $ c $ c0 b0
+        doit st1
+        doit st2
+        newRef ((b, (c, val, st1, st2)), [])      -- memo table
+
+    let act = MonadMonoid $ do
+            b <- liftRefReader rb
+            (last@(b', cc@(_, oldval, st1, st2)), memo) <- readRef memoref
+            (_, _, st1, st2) <- if b' == b
+              then
+                return cc
+              else do
+                reg st1 Block
+                reg st2 Kill
+                (c, oldval', st1, _) <- case lookup b memo of
+                  Nothing -> do
+                    (c, st1) <- runRefWriterT $ fb b b' oldval
+                    return (c, c0 b, st1, undefined)
+                  Just cc'@(_, _, st1, _) -> do
+                    reg st1 Unblock
+                    return cc'
+                (val, st2) <- runRefWriterT $ c oldval'
+                let cc = (c, val, st1, st2)
+                writeRef memoref ((b, cc), filter ((/= b) . fst) (last:memo))
+                return cc
+            doit st1
+            doit st2
+
+    tell' (act, mempty)
+    return $ readRef $ (_1 . _2 . _2) `lensMap` memoref
+
+------------------------
+
+instance MonadRegisterRun (Register (Prog TP)) where
+
+    type AsocT (Register (Prog TP)) = TP
+
+    runReg r w m = runRegister_ (liftM unTP r) (w . TP) m
+
+newtype TP = TP { unTP :: SLSt (Prog TP) () }
+
+runTests = do
+    mkTests runTestSimple
+    tests runTest
+
+runTest :: (Eq a, Show a) => String -> Register (Prog TP) a -> Prog' (a, Prog' ()) -> IO ()
+runTest name m p = do
+    runTest_ name (TP . lift) runReg m p
+
+runTestSimple :: Register (Prog TP) () -> IO ()
+runTestSimple m = runTest "" m $ return ((), return ())
+
+
+
diff --git a/src/Data/LensRef/Test.hs b/src/Data/LensRef/Test.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LensRef/Test.hs
@@ -0,0 +1,501 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+-- | Tests for the @MonadRefCreator@ interface.
+module Data.LensRef.Test
+    ( -- * Tests for the interface
+      mkTests
+    , tests
+    ) where
+
+import Data.Maybe
+import Control.Monad.State
+import Control.Arrow ((***))
+import Control.Lens
+
+import Data.LensRef
+import Data.LensRef.TestEnv
+
+-----------------------------------------------------------------
+
+{- | 
+@mkTests@ generates a list of error messages which should be emtpy.
+
+Look inside the sources for the tests.
+-}
+mkTests :: (MonadRegisterRun m, MonadRefWriter m, EffectM m ~ Prog (AsocT m), Monad n)
+    => (m () -> n ())
+    -> n ()
+
+mkTests runTest = do
+    newRefTest
+    writeRefsTest
+    extRefTest
+    joinTest
+    joinTest2
+    chainTest0
+    forkTest
+    forkTest2
+    chainTest
+    chainTest'
+    undoTest
+    undoTest2
+    undoTest3
+
+--    writeRefTest
+  where
+
+    newRefTest = runTest $ do
+        r <- newRef (3 :: Int)
+        r ==> 3
+
+
+    writeRefsTest = runTest $ do
+        r1 <- newRef (3 :: Int)
+        r2 <- newRef (13 :: Int)
+        r1 ==> 3
+        r2 ==> 13
+        writeRef r1 4
+        r1 ==> 4
+        r2 ==> 13
+        writeRef r2 0
+        r1 ==> 4
+        r2 ==> 0
+
+    extRefTest = runTest $ do
+        r <- newRef $ Just (3 :: Int)
+        q <- extRef r maybeLens (False, 0)
+        let q1 = _1 `lensMap` q
+            q2 = _2 `lensMap` q
+        r ==> Just 3
+        q ==> (True, 3)
+        writeRef r Nothing
+        r ==> Nothing
+        q ==> (False, 3)
+        q1 ==> False
+        writeRef q1 True
+        r ==> Just 3
+        writeRef q2 1
+        r ==> Just 1
+
+    joinTest = runTest $ do
+        r2 <- newRef (5 :: Int)
+        r1 <- newRef 3
+        rr <- newRef r1
+        r1 ==> 3
+        let r = join $ readRef rr
+        r ==> 3
+        writeRef r1 4
+        r ==> 4
+        writeRef rr r2
+        r ==> 5
+        writeRef r1 4
+        r ==> 5
+        writeRef r2 14
+        r ==> 14
+
+    joinTest2 = runTest $ do
+        r1 <- newRef (3 :: Int)
+        rr <- newRef r1
+        r2 <- newRef 5
+        writeRef rr r2
+        join (readRef rr) ==> 5
+
+    chainTest0 = runTest $ do
+        r <- newRef (1 :: Int)
+        q <- extRef r id 0
+        s <- extRef q id 0
+        r ==> 1
+        q ==> 1
+        s ==> 1
+        writeRef r 2
+        r ==> 2
+        q ==> 2
+        s ==> 2
+        writeRef q 3
+        r ==> 3
+        q ==> 3
+        s ==> 3
+        writeRef s 4
+        r ==> 4
+        q ==> 4
+        s ==> 4
+
+    forkTest = runTest $ do
+        r <- newRef (1 :: Int)
+        q <- extRef r id 0
+        s <- extRef r id 0
+        r ==> 1
+        q ==> 1
+        s ==> 1
+        writeRef r 2
+        r ==> 2
+        q ==> 2
+        s ==> 2
+        writeRef q 3
+        r ==> 3
+        q ==> 3
+        s ==> 3
+        writeRef s 4
+        r ==> 4
+        q ==> 4
+        s ==> 4
+
+    forkTest2 = runTest $ do
+        r <- newRef $ Just (1 :: Int)
+        q <- extRef r maybeLens (False, 0)
+        s <- extRef r maybeLens (False, 0)
+        r ==> Just 1
+        q ==> (True, 1)
+        s ==> (True, 1)
+        writeRef r $ Just 2
+        r ==> Just 2
+        q ==> (True, 2)
+        s ==> (True, 2)
+        writeRef r Nothing
+        r ==> Nothing
+        q ==> (False, 2)
+        s ==> (False, 2)
+        writeRef (_1 `lensMap` q) True
+        r ==> Just 2
+        q ==> (True, 2)
+        s ==> (True, 2)
+        writeRef (_2 `lensMap` q) 3
+        r ==> Just 3
+        q ==> (True, 3)
+        s ==> (True, 3)
+        writeRef (_1 `lensMap` q) False
+        r ==> Nothing
+        q ==> (False, 3)
+        s ==> (False, 3)
+        writeRef (_2 `lensMap` q) 4
+        r ==> Nothing
+        q ==> (False, 4)
+        s ==> (False, 3)
+        writeRef (_1 `lensMap` q) True
+        r ==> Just 4
+        q ==> (True, 4)
+        s ==> (True, 4)
+        writeRef q (False, 5)
+        r ==> Nothing
+        q ==> (False, 5)
+        s ==> (False, 4)
+        writeRef (_1 `lensMap` s) True
+        r ==> Just 4
+        q ==> (True, 4)
+        s ==> (True, 4)
+
+    chainTest = runTest $ do
+        r <- newRef $ Just Nothing
+        q <- extRef r maybeLens (False, Nothing)
+        s <- extRef (_2 `lensMap` q) maybeLens (False, 3 :: Int)
+        writeRef (_1 `lensMap` s) False
+        r ==> Just Nothing
+        q ==> (True, Nothing)
+        s ==> (False, 3)
+        writeRef (_1 `lensMap` q) False
+        r ==> Nothing
+        q ==> (False, Nothing)
+        s ==> (False, 3)
+
+    chainTest' = runTest $ do
+        r <- newRef $ Just $ Just (3 :: Int)
+        q <- extRef r maybeLens (False, Nothing)
+        s <- extRef (_2 `lensMap` q) maybeLens (False, 0 :: Int)
+        r ==> Just (Just 3)
+        q ==> (True, Just 3)
+        s ==> (True, 3)
+        writeRef (_1 `lensMap` s) False
+        r ==> Just Nothing
+        q ==> (True, Nothing)
+        s ==> (False, 3)
+        writeRef (_1 `lensMap` q) False
+        r ==> Nothing
+        q ==> (False, Nothing)
+        s ==> (False, 3)
+        writeRef (_1 `lensMap` s) True
+        r ==> Nothing
+        q ==> (False, Just 3)
+        s ==> (True, 3)
+        writeRef (_1 `lensMap` q) True
+        r ==> Just (Just 3)
+        q ==> (True, Just 3)
+        s ==> (True, 3)
+
+    undoTest = runTest $ do
+        r <- newRef (3 :: Int)
+        q <- extRef r (lens head $ flip (:)) []
+        writeRef r 4
+        q ==> [4, 3]
+
+    undoTest2 = runTest $ do
+        r <- newRef (3 :: Int)
+        q <- extRef r (lens head $ flip (:)) []
+        q ==> [3]
+
+    undoTest3 = runTest $ do
+        r <- newRef (3 :: Int)
+        (undo, redo) <- liftM (liftRefReader *** liftRefReader) $ undoTr (==) r
+        r ==> 3
+        redo === False
+        undo === False
+        writeRef r 4
+        r ==> 4
+        redo === False
+        undo === True
+        writeRef r 5
+        r ==> 5
+        redo === False
+        undo === True
+        push undo
+        r ==> 4
+        redo === True
+        undo === True
+        push undo
+        r ==> 3
+        redo === True
+        undo === False
+        push redo
+        r ==> 4
+        redo === True
+        undo === True
+        writeRef r 6
+        r ==> 6
+        redo === False
+        undo === True
+      where
+        push m = m >>= \x -> maybe (return ()) liftRefWriter x
+        m === t = m >>= \x -> isJust x ==? t
+
+--------------------------
+
+maybeLens :: Lens' (Bool, a) (Maybe a)
+maybeLens = lens (\(b,a) -> if b then Just a else Nothing)
+              (\(_,a) x -> maybe (False, a) (\a' -> (True, a')) x)
+
+-- | Undo-redo state transformation.
+undoTr
+    :: MonadRegister m =>
+       (a -> a -> Bool)     -- ^ equality on state
+    -> Ref m a             -- ^ reference of state
+    ->   m ( RefReader m (Maybe (RefWriter m ()))
+           , RefReader m (Maybe (RefWriter m ()))
+           )  -- ^ undo and redo actions
+undoTr eq r = do
+    ku <- extRef r (undoLens eq) ([], [])
+    let try f = liftM (liftM (writeRefSimple ku) . f) $ readRef ku
+    return (try undo, try redo)
+  where
+    undo (x: xs@(_:_), ys) = Just (xs, x: ys)
+    undo _ = Nothing
+
+    redo (xs, y: ys) = Just (y: xs, ys)
+    redo _ = Nothing
+
+undoLens :: (a -> a -> Bool) -> Lens' ([a],[a]) a
+undoLens eq = lens get set where
+    get = head . fst
+    set (x' : xs, ys) x | eq x x' = (x: xs, ys)
+    set (xs, _) x = (x : xs, [])
+
+
+----------------------------------------------------------------------------
+
+tests :: (MonadRegisterRun m, EffectM m ~ Prog (AsocT m), Monad n, MonadRegister (Modifier m))
+    => (forall a . (Eq a, Show a) => String -> m a -> Prog' (a, Prog' ()) -> n ())
+    -> n ()
+tests runTest = do
+
+    runTest "trivial" (return ()) $ do
+        return ((), return ())
+
+    runTest "message" (message "Hello") $ do
+        message' "Hello"
+        return ((), return ())
+
+    runTest "listener" (listen 1 $ \s -> message $ "Hello " ++ s) $ do
+        message' "listener #0"
+        return $ (,) () $ do
+            send 1 "d"
+            message' "Hello d"
+            send 1 "f"
+            message' "Hello f"
+    --                send 2 "f"
+
+    runTest "listeners" (do
+        listen 1 $ \s -> message $ "Hello " ++ s
+        listen 2 $ \s -> message $ "Hi " ++ s
+        listen 3 $ \s -> do
+            message $ "H_ " ++ s
+            listen 4 $ \s' ->
+                message $ "H " ++ s'
+      ) $ do
+        message' "listener #0"
+        message' "listener #1"
+        message' "listener #2"
+        return $ (,) () $ do
+            send 1 "d"
+            message' "Hello d"
+            send 1 "f"
+            message' "Hello f"
+            send 2 "f"
+            message' "Hi f"
+            send 3 "f"
+            message' "H_ f"
+            message' "listener #3"
+            send 4 "f"
+            message' "H f"
+
+    runTest "postponed0" (postponeModification $ message "hello") $ do
+        return $ (,) () $ do
+            message' "hello"
+
+    runTest "postponed" (do
+        r <- newRef "x"
+        _ <- onChangeSimple (readRef r) message
+        postponeModification $ writeRef r "x"
+        postponeModification $ writeRef r "y"
+        return ()
+            ) $ do
+        message' "x"
+        return $ (,) () $ do
+            message' "y"
+
+    runTest "onChangeSimple" (do
+        r <- newRef "x"
+        listen 1 $ writeRef r
+        _ <- onChangeSimple (readRef r) message
+        return ()
+            ) $ do
+        message' "listener #0"
+        message' "x"
+        return $ (,) () $ do
+            send 1 "x"
+            send 1 "y"
+            message' "y"
+
+    runTest "onChangeSimple + listener" (do
+        r1 <- newRef "x"
+        r2 <- newRef "y"
+        listen 1 $ writeRef r1
+        listen 2 $ writeRef r2
+        _ <- onChangeSimple (liftM2 (++) (readRef r1) (readRef r2)) message
+        return ()
+            ) $ do
+        message' "listener #0"
+        message' "listener #1"
+        message' "xy"
+        return $ (,) () $ do
+            send 1 "x"
+            send 2 "y"
+            send 1 "y"
+            message' "yy"
+            send 2 "y"
+            send 2 "x"
+            message' "yx"
+
+    runTest "onChangeSimple + join" (do
+        r1 <- newRef "x"
+        r2 <- newRef "y"
+        rr <- newRef r1
+        listen 1 $ writeRef r1
+        listen 2 $ writeRef r2
+        listen 3 $ \i -> case i of
+            True  -> writeRef rr r1
+            False -> writeRef rr r2
+        _ <- onChangeSimple (readRef $ join $ readRef rr) message
+        return ()
+            ) $ do
+        message' "listener #0"
+        message' "listener #1"
+        message' "listener #2"
+        message' "x"
+        return $ (,) () $ do
+            send 1 "x"
+            send 2 "y"
+            send 1 "y"
+            message' "y"
+            send 2 "y"
+            send 2 "x"
+            send 3 False
+            message' "x"
+            send 1 "a"
+            send 2 "b"
+            message' "b"
+
+
+    runTest "" (do
+        r <- newRef (0 :: Int)
+        _ <- onChange (readRef r) $ \i -> case i of
+            0 -> return $ do
+                listen 1 $ \s -> do
+                    when (s == "f") $ do
+                        writeRef r 1
+                        rv <- readRef r
+                        message $ show rv
+                    message $ "Hello " ++ s
+
+            1 -> do
+                listen 2 $ \s -> do
+                    when (s == "g") $ writeRef r 0
+                    message $ "Hi " ++ s
+                return $ return ()
+
+        return ()
+              ) $ do
+
+        message' "listener #0"
+        return $ (,) () $ do
+            send 1 "d"
+            message' "Hello d"
+            send 1 "f"
+            message' "1"
+            message' "Hello f"
+            message' "Kill #0"
+            message' "listener #1"
+            send 1 "f"
+            error' "message is not received: 1 \"f\""
+            send 2 "f"
+            message' "Hi f"
+            send 2 "g"
+            message' "Hi g"
+            message' "listener #2"
+            send 2 "g"
+            error' "message is not received: 2 \"g\""
+            send 3 "f"
+            error' "message is not received: 3 \"f\""
+            send 1 "f"
+            message' "1"
+            message' "Hello f"
+            message' "Kill #2"
+            send 2 "f"
+            message' "Hi f"
+{-
+    runTest "" (do
+        r <- newRef $ Just (3 :: Int)
+        q <- extRef r maybeLens (False, 0)
+        let q1 = _1 `lensMap` q
+            q2 = _2 `lensMap` q
+        _ <- onChange (readRef r) $ \r -> return $ message $ show r
+        _ <- onChange (readRef q) $ \r -> return $ message $ show r
+        postponeModification $ writeRef r Nothing
+        postponeModification $ writeRef q1 True
+        postponeModification $ writeRef q2 1
+        ) $ do
+        message' "Just 3"
+        message' "(True,3)"
+        return $ (,) () $ do
+            message' "Nothing"
+            message' "(False,3)"
+            message' "Just 3"
+            message' "(True,3)"
+            message' "Just 1"
+            message' "(True,1)"
+            return ()
+-}
+
+
diff --git a/src/Data/LensRef/TestEnv.hs b/src/Data/LensRef/TestEnv.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LensRef/TestEnv.hs
@@ -0,0 +1,268 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Data.LensRef.TestEnv where
+
+import Control.Monad.State
+import Control.Monad.Writer hiding (listen, Any)
+import Control.Monad.Operational
+import qualified Data.Sequence as Seq
+import Control.Lens hiding ((|>), view)
+
+import Unsafe.Coerce
+
+import Data.LensRef
+import Data.LensRef.Common
+
+----------------------
+
+
+class MonadRegister tm => MonadRegisterRun tm where
+
+    type AsocT tm :: *
+
+    runReg :: (m ~ EffectM tm)
+        => m (AsocT tm)
+        -> (AsocT tm -> m ())
+        -> tm a
+        -> m (a, m ())
+
+
+
+--------------------------
+
+newtype Id = Id Int deriving Eq
+
+instance Show Id where show (Id i) = "#" ++ show i
+
+newtype Port a = Port { unPort :: Int } deriving (Eq, Num)
+
+instance Show (Port a) where show (Port i) = show i
+
+data Inst t a where
+    Message  :: String -> Inst t ()
+    Listen   :: Show b => Port b -> (b -> Prog t ()) -> Inst t Id
+    SetStatus  :: Id -> RegionStatusChange -> Inst t ()
+
+    ReadI :: Inst t t
+    WriteI :: t -> Inst t ()
+    NewRef :: a -> Inst t (Morph (StateT a (Prog t)) (Prog t))
+
+type Prog t = ProgramT (Inst t) (State (Seq.Seq Any))
+
+
+---------------------------------------------------
+
+instance NewRef (Prog t) where
+    newRef' = singleton . NewRef
+
+message :: (MonadRegister m, EffectM m ~ Prog t) => String -> m ()
+message = liftEffectM . singleton . Message
+
+listen :: (MonadRegister m, EffectM m ~ Prog t, Show a) => Port a -> (a -> Modifier m ()) -> m ()
+listen i m = do
+    f <- registerCallback m
+    id <- liftEffectM . singleton $ Listen i f
+    message $ "listener " ++ show id
+    onRegionStatusChange $ \s -> do
+        liftEffectM . singleton $ SetStatus id s
+        when (s == Kill) $ message $ show s ++ " " ++ show id
+
+
+data Inst' a where
+    Message' :: String -> Inst' ()
+    Error'   :: String -> Inst' ()
+    Send     :: forall a . Show a => Port a -> a -> Inst' ()
+
+type Prog' = Program Inst'
+
+message' = singleton . Message'
+error' = singleton . Error'
+send i s = singleton $ Send i s
+
+--getProg' :: MonadError String m => Prog' b -> m b
+getProg' :: Prog' b
+    -> StateT s Er b
+getProg' p = case runIdentity . viewT $ p of
+    Return x -> return x
+    Send i s :>>= p -> do
+        fail' $ "end expected instead of send " ++ show i ++ " " ++ show s
+        getProg' $ p ()
+    Message' s :>>= p -> do
+        fail' $ "end expected instead of message' " ++ s
+        getProg' $ p ()
+    Error' s :>>= p -> do
+        fail' $ "end expected instead of unfail " ++ s
+        getProg' $ p ()
+  
+
+type Er = Writer [Either (Either String String) String] --ErrorT String (Writer [String])
+
+tell_ s = tell [Right s]
+fail' s = tell [Left $ Right s]
+unfail s = tell [Left $ Left s]
+handEr name = showRes name . runWriter -- . runErrorT
+showRes name ((),l) = case f [] l of
+    [] -> []
+    xs -> ("test " ++ name ++ " failed.") : xs ++ [""]
+  where
+    f acc (Right x: xs) = f (x:acc) xs
+    f acc (Left (Right s): Left (Left s'): xs) | s == s' = f (("unfail " ++ s'): acc) xs
+    f acc (Left e: _) = reverse $ either id id e: acc
+    f _ [] = []
+
+data Any = forall x . Any x
+
+data Listener m = forall a . Show a => Listener
+    { _listenerId :: Id
+    , _listenerPort :: Port a
+    , _listenerStatus :: RegionStatusChange
+    , _listenerCallback :: a -> Prog m ()
+    }
+makeLenses ''Listener
+
+data ST m = ST
+    { _postponed :: [m]
+    , _listeners :: [Listener m]
+    , _idcounter :: Int
+    , _vars :: Seq.Seq Any
+    }
+makeLenses ''ST
+
+
+coeval_ :: forall a b m
+     . (Prog m () -> m)
+    -> Prog m a
+    -> Prog' b
+    -> StateT (ST m) Er (Maybe a, Prog' b)
+coeval_ lift_ q p = do
+    op <- zoom vars $ mapStateT lift $ viewT q
+    coeval__ lift_ op p
+
+coeval__ :: forall a b m
+     . (Prog m () -> m)
+    -> ProgramViewT (Inst m) (State (Seq.Seq Any)) a
+    -> Prog' b
+    -> StateT (ST m) Er (Maybe a, Prog' b)
+coeval__ lift_ op p = do
+  nopostponed <- use $ postponed . to null
+  case (op, view p) of
+
+    (_, Error' s :>>= k) -> do
+        unfail s
+        coeval__ lift_ op $ k ()
+
+    (Message s :>>= k, Return x) -> do
+        fail' $ "the following message expected: " ++ s ++ " instead of return"
+        coeval_ lift_ (k ()) (return x)
+
+    (Message s :>>= k, Message' s' :>>= k')
+        | s == s' -> do
+            tell_ ("message: " ++ s)
+            coeval_ lift_ (k ()) (k' ())
+        | otherwise -> do
+            fail' $ "the following message expected: " ++ s ++ " instead of " ++ s'
+            coeval__ lift_ op $ k' ()
+
+    (Message s :>>= _, Send _i s' :>>= k') -> do
+        fail' $ "the following message expected: " ++ s ++ " instead of send " ++ show s'
+        coeval__ lift_ op (k' ())
+
+    (SetStatus i status :>>= k, _) -> do
+        listeners %= case status of
+            Kill -> filter ((/=i) . (^. listenerId))
+            Block -> map f where
+                f (Listener i' c Unblock x) | i' == i = Listener i c Block x
+                f x = x
+            Unblock -> map f where
+                f (Listener i' c Block x) | i' == i = Listener i c Unblock x
+                f x = x
+        coeval_ lift_ (k ()) p
+
+    (Listen i lr :>>= k, _) -> do
+        co <- use idcounter
+        listeners %= (Listener (Id co) i Unblock lr :)
+        idcounter %= (+1)
+        coeval_ lift_ (k $ Id co) p
+
+    (ReadI :>>= k, _) | not nopostponed -> do
+        x <- use $ postponed . to head
+        postponed %= tail
+        coeval_ lift_ (k x) p
+
+    (WriteI x :>>= k, _) -> do
+        postponed %= (++[x])
+        coeval_ lift_ (k ()) p
+
+    (NewRef a :>>= k, _) -> do
+        n <- use $ vars . to Seq.length
+
+        let ff :: forall aa bb . aa -> StateT aa (Prog m) bb -> Prog m bb
+            ff _ (StateT f) = do
+                v <- gets (`Seq.index` n)
+                modify $ Seq.update n $ error "recursive reference modification"
+                case v of
+                  Any w -> do
+                    (x, w') <- f $ unsafeCoerce w
+                    modify $ Seq.update n $ Any w'
+                    return x
+        vars %= (Seq.|> Any a)
+        coeval_ lift_ (k $ Morph $ ff a) p
+
+    (_, Send i@(Port pi) s :>>= k) -> do
+        tell_ $ "send " ++ show i ++ " " ++ show s
+        if not nopostponed
+          then do
+            fail' $ "early send of " ++ show s
+          else do
+            li' <- use $ listeners . to (\li -> [lift_ $ lr $ unsafeCoerce s | Listener _ (Port pi') Unblock lr <- li, pi == pi'])
+            if (null li')
+              then do
+                fail' $ "message is not received: " ++ show i ++ " " ++ show s
+              else do
+                postponed %= (++ li')
+        coeval__ lift_ op (k ())
+
+    (ReadI :>>= _, _) | nopostponed -> return (Nothing, p)
+
+    (Return x, _) -> return (Just x, p)
+
+
+
+runTest_ :: (Eq a, Show a, m ~ Prog n)
+    => String
+    -> (Prog n () -> n)
+    -> (m n -> (n -> m ()) -> tm a -> m (a, m ()))
+    -> tm a
+    -> Prog' (a, Prog' ())
+    -> IO ()
+runTest_ name lift runRegister_ r p0 = putStr $ unlines $ handEr name $ flip evalStateT (ST [] [] 0 Seq.empty) $ do
+    (Just (a1,c),pe) <- coeval_ lift (runRegister_ (singleton ReadI) (singleton . WriteI) r) p0
+    (a2,p) <- getProg' pe
+    when (a1 /= a2) $ fail' $ "results differ: " ++ show a1 ++ " vs " ++ show a2
+    (_, pr) <- coeval_ lift c p
+    getProg' pr
+
+------------------------------------------------
+
+-- | Check an equality.
+(==?) :: (Eq a, Show a, MonadRegisterRun m, EffectM m ~ Prog (AsocT m)) => a -> a -> m ()
+rv ==? v = when (rv /= v) $ message $ "runTest failed: " ++ show rv ++ " /= " ++ show v
+
+-- | Check the current value of a given reference.
+(==>) :: (Eq a, Show a, MonadRegisterRun m, EffectM m ~ Prog (AsocT m)) => Ref m a -> a -> m ()
+r ==> v = readRef r >>= (==? v)
+
+infix 0 ==>, ==?
+
+
+
+