uds
[clean-tests.git] / uds / ASDS / Lens.icl
index 351e759..a5f4889 100644 (file)
@@ -6,6 +6,8 @@ import Data.Functor
 import Data.List
 import Data.Maybe
 import Control.Monad
+from Control.Monad.State import instance Monad (StateT st m), instance Functor (StateT st m), instance pure (StateT st m), instance <*> (StateT st m), instance MonadTrans (StateT st)
+import Control.Monad.Trans
 import Control.Monad.Fail
 from Data.Map import :: Map(..), get, put
 
@@ -16,10 +18,10 @@ lens param mapr mapw lens = Lens {param=param,mapr=mapr,mapw=mapw,lens=lens}
 
 instance read (Lens sds) | read sds
 where
-       read (Lens t=:{mapr=LensReadConst f}) p = Read <$> f p
+       read (Lens t=:{mapr=LensReadConst f}) p = Read <$> liftT (f p)
        read (Lens t=:{param,mapr=LensRead mapr,lens}) p = read lens (param p) >>= \v->case v of
                Reading s = pure $ Reading $ Lens {t & lens=s}
-               Read r = Read <$> mapr p r
+               Read r = Read <$> liftT (mapr p r)
 
 instance write (Lens sds) | read sds & write sds
 where
@@ -28,7 +30,7 @@ where
                Reading s = pure $ Writing $ Lens {t & lens=rwpair s lens}
                Read r = write (Lens {t & mapw=LensWriteConst \p w->mapw p w r}) p w
        //Then do the actual writing
-       write (Lens t=:{param,mapw=LensWriteConst mapw,lens}) p w = mapw p w >>= \v->case v of
+       write (Lens t=:{param,mapw=LensWriteConst mapw,lens}) p w = liftT (mapw p w) >>= \v->case v of
                ?None = pure $ Written ()
                ?Just w = write lens (param p) w >>= \v->case v of
                        Writing s = pure $ Writing $ Lens {t & lens=rwpair lens s}