tests

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

diff --git a/uds/ASDS.icl b/uds/ASDS.icl
index 4da3be4..77dd23f 100644 (file)
--- a/uds/ASDS.icl
+++ b/uds/ASDS.icl
@@ -6,21 +6,20 @@ import Data.Functor
 import Control.Monad
 import Control.Monad.State
 import Control.Monad.Trans
+from Text import class Text(concat), instance Text String
 
 import ASDS.Source
 import ASDS.Lens
 import ASDS.Select
 import ASDS.Parallel
 
-sds :: (sds m p r w) -> SDS m p r w | read, write, observe sds & Monad m
-sds s = SDS s (pure ())
+sds :: (sds m p r w) -> SDS m p r w | read, write, identity, observe sds & Monad m
+sds s = SDS s
 
-instance read SDS where read (SDS s _) p = read s p
-instance write SDS where write (SDS sds _) p w = write sds p w
-instance observe SDS
-where
-       identity (SDS sds _) c = identity sds c
-       observe (SDS sds _) p oid handle = observe sds p oid handle
+instance read SDS where read (SDS s) p = read s p
+instance write SDS where write (SDS sds) p w = write sds p w
+instance identity SDS where identity (SDS sds) c = identity sds c
+instance observe SDS where observe (SDS sds) p oid handle = observe sds p oid handle
 
 getShare :: (sds m () r w) -> PViewT m r | Monad m & read sds & TC r & TC w
 getShare s = read s () >>= \v->case v of
@@ -35,12 +34,12 @@ setShare w s = write s () w >>= \v->case v of
 updShare :: (r -> w) (sds m () r w) -> PViewT m w | Monad m & read sds & write sds & TC r & TC w
 updShare f s = f <$> getShare s >>= \v->setShare v s >>| liftT (pure v)
 
-trigger :: (p -> Bool) -> PViewT m () | TC p & Monad m
-trigger inv = gets (filter (match inv)) >>= mapM_ run
+trigger :: (v m p r w) (p -> Bool) -> PViewT m () | identity v & TC p & Monad m
+trigger sds inv = gets (filter (match (concat (identity sds [])) inv)) >>= mapM_ run
 where
-       match :: (p -> Bool) (NRequest m) -> Bool | TC p
-       match inv (NRequest oid ohnd (a :: p^)) = inv a
-       match _ _ = False
+       match :: String (p -> Bool) (NRequest m) -> Bool | TC p
+       match id inv (NRequest oid ohnd (a :: p^)) = id == oid && inv a
+       match _ _ _ = False
 
        run :: (NRequest m) -> PViewT m () | Monad m
        run (NRequest oid ohnd _) = liftT ohnd