asynchronous parametric lenses

[clean-tests.git] / uds / auds.icl

diff --git a/uds/auds.icl b/uds/auds.icl
index a94b077..adb7c32 100644 (file)
--- a/uds/auds.icl
+++ b/uds/auds.icl
@@ -26,7 +26,7 @@ instance MonadFail (StateT s m) | MonadFail m where fail s = liftT $ fail s
 sds :: (sds m r w) -> SDS m r w | read sds & write sds & Monad m
 sds s = SDS s (pure ())
 instance read SDS where read (SDS s _) = read s
-instance write SDS where write w (SDS sds _) = write w sds
+instance write SDS where write (SDS sds _) w = write sds w
 
 source :: (m r) (w -> m ()) -> Source m r w
 source read write = RWPair (ReadSource read) (WriteSource write)
@@ -38,13 +38,8 @@ nullShare :: WriteSource m a b | Monad m
 nullShare = WriteSource (\_->pure ())
 
 instance read ReadSource where read (ReadSource read) = Read <$> read
-instance write WriteSource where write w (WriteSource write) = Written <$> write w
+instance write WriteSource where write (WriteSource write) w = Written <$> write w
 
-//upd :: (r -> w) (v m r w) -> m w | TC r & TC w & read, write v & Monad m
-//upd fun sds = read sds >>= \r
-//     # w = fun r
-//     = write w sds >>| pure w
-//
 timeStamp :: ReadSource IO Timestamp ()
 timeStamp = ReadSource $ withWorld time
 
@@ -63,9 +58,9 @@ where
                Reading s = pure $ Reading $ Par {t & left=s}
 instance write (Par sdsl sdsr) | write sdsl & write sdsr
 where
-       write w (Par t=:{writel,left,right})
-               = writel w >>= \(w1, w2)->write w1 left >>= \v->case v of
-                       Written _ = write w2 right >>= \v->case v of
+       write (Par t=:{writel,left,right}) w
+               = writel w >>= \(w1, w2)->write left w1 >>= \v->case v of
+                       Written _ = write right w2 >>= \v->case v of
                                Written _ = pure $ Written ()
                                Writing s = pure $ Writing $ Par {t & writel= \_->pure (w1, w2), left=nullShare, right=s}
                        Writing s = pure $ Writing $ Par {t & writel= \_->pure (w1, w2), left=s}
@@ -86,16 +81,16 @@ where
                Reading s = pure $ Reading (RWPair s w)
 instance write (RWPair sdsr sdsw) | write sdsw
 where
-       write w (RWPair r s) = write w s >>= \v->case v of
+       write (RWPair r s) w = write s w >>= \v->case v of
                Written _ = pure $ Written ()
                Writing s = pure $ Writing $ RWPair r s
 
 instance write (Lens sds) | read sds & write sds
 where
-       write w (Lens t=:{mapw,lens}) = read lens >>= \v->case v of
+       write (Lens t=:{mapw,lens}) w = read lens >>= \v->case v of
                Read r = mapw w r >>= \w->case w of
                        Nothing = pure $ Written ()
-                       Just w = write w lens >>= \v->case v of
+                       Just w = write lens w >>= \v->case v of
                                Written _ = pure $ Written ()
                                Writing s = pure $ Writing $ Lens {t & mapw= \_ _->pure $ Just w, lens=RWPair (constShare r) s}
                Reading s = pure $ Writing $ Lens {t & lens=RWPair s lens}
@@ -144,8 +139,8 @@ where
                Reading s = pure $ Reading $ Select {t & select=s}
 instance write (Select sdsl sdsr) | read sdsl & write sdsr
 where
-       write w (Select t=:{select,bind}) = read select >>= \v->case v of
-               Read r = bind r >>= write w
+       write (Select t=:{select,bind}) w = read select >>= \v->case v of
+               Read r = bind r >>= flip write w
                Reading s = pure $ Writing $ Select {t & select=s}
 
 indexedSelect :: (sdsl m Int z) (sdsr m [a] [a]) -> Select sdsl (Lens sdsr) m a a | TC a & TC z & MonadFail m
@@ -161,7 +156,7 @@ getShare s = read s >>= \v->case v of
        Reading s = getShare s
 
 setShare :: w (sds m r w) -> m () | Monad m & write sds & TC r & TC w
-setShare w s = write w s >>= \v->case v of
+setShare w s = write s w >>= \v->case v of
        Written _ = pure ()
        Writing s = setShare w s