X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=uds%2Ftest.icl;h=f294e8ec85734853c1fe386821c07ae4d02add8f;hb=HEAD;hp=f2601b955655648f8a473f1a284a0af22848453e;hpb=111565b97002ef709dd5f822d0edee426a03e1a1;p=clean-tests.git

diff --git a/uds/test.icl b/uds/test.icl
index f2601b9..f294e8e 100644
--- a/uds/test.icl
+++ b/uds/test.icl
@@ -1,60 +1,94 @@
 module test
 
 import StdEnv
-import Data.Maybe
-import Data.Functor
+import Data.Either
 import Data.Func
-import Control.Applicative
-import Control.Monad
+import Data.Functor
+import Data.Functor.Identity
+from Data.Map import :: Map(..)
 import qualified Data.Map
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.Fail
+import Control.Monad.Trans
+import System.IO
 
-class get v ~st
-where
-	get :: (v r w) .st -> .(Maybe r, .st) | TC r
-class put v ~st
-where
-	put :: w (v r w) .st -> .(Maybe (), .st) | TC w
+import ASDS
+import ASDS.Source
+import ASDS.Lens
+import ASDS.Select
+import ASDS.Parallel
 
-:: Source r w = Source String
-:: St :== 'Data.Map'.Map String Dynamic
+instance MonadFail (Either String) where fail s = Left s
 
-instance get Source St
-where
-	get (Source n) st = case 'Data.Map'.get n st of
-		Just (a :: a^) = (Just a, st)
-		_ = (Nothing, st)
+readwrite :: r w (sds m () r w) -> PViewT m () | MonadFail m & read sds & write sds & TC r & TC w & == r
+readwrite r w sds = equal r (setShare w sds >>| getShare sds)
+
+equal :: a (PViewT m a) -> PViewT m () | MonadFail m & == a
+equal expected mon = mon >>= \v->if (v == expected) (pure ()) (fail "Not equal")
+
+//Start :: Either String (((), [NRequest Identity)]), Map String Dynamic)
+Start w = /*eval*/execIO (runStateT (observe intsource () "int" (putStrLn "blurp" >>| pure ()) >>| setShare 42 intsource) []) w
+
+import Debug.Trace
 
-instance put Source St
+intsource :: Source m () Int Int | pure m
+intsource = source "int" (\_->pure 42) (\_ _->pure (\_->True))
+
+/*
+//Start :: Either String ((), Map String Dynamic)
+Start = runStateT (runStateT (sequence_ $ map test tests) []) 'Data.Map'.newMap
 where
-	put w (Source n) st = (Just (), 'Data.Map'.put n (dynamic w) st)
-
-:: Par sdsl sdsr r w = E.r1 r2 w1 w2: Par (ParOpts sdsl sdsr r1 r2 w1 w2 r w)
-	& TC r1 & TC r2 & TC w1 & TC w2
-:: ParOpts sdsl sdsr r1 r2 w1 w2 r w =
-	{ read  :: r1 r2 -> Maybe r
-	, write :: w -> Maybe (w1, w2)
-	, left  :: (sdsl r1 w1)
-	, right :: (sdsr r2 w2)
-	}
-
-instance get (Par sdsl sdsr) St | get sdsl St & get sdsr St
+	test t = liftT (put 'Data.Map'.newMap) >>| t
+
+//	tests :: [StateT [NRequest (StateT (Map String Dynamic) (Either String))] (StateT (Map String Dynamic) (Either String)) ()]
+	tests :: [PViewT (StateT (Map String Dynamic) (Either String)) ()]
+	tests = flatten
+		[ [readwrite i i sh \\ i<-[-1, 0, -100, 100]]
+		, [setShare [0..10] sh >>| equal i (getShare (focus ((), i) (indexedStore sh)))\\i<-[0..10]]
+		, [setShare [0..10] sh >>| setShare 42 (focus ((), i) (indexedStore sh)) >>| equal 42 (getShare (focus ((), i) (indexedStore sh)))\\i<-[0..10]]
+		, [setShare [(i, i)\\i<-[0..10]] sh >>| equal i (getShare (focus ((), i) (assocStore sh)))\\i<-[0..10]]
+		, [setShare ('Data.Map'.fromList [(i, i)\\i<-[0..10]]) sh >>| equal i (getShare (focus ((), i) (keyedStore sh)))\\i<-[0..10]]
+		, [setShare [0..10] sh >>| setShare 4 (focus "idx" astore) >>| equal 4 (getShare $ focus ((), ()) $ selectList (focus "idx" astore) sh)]
+		, [setShare 38 sh >>| equal 38 (getShare (After 100 sh (pure ())))]
+		, [testpar (focus "foo" astore) (focus "bar" astore)]
+		, [testpar (after 100 $ focus "foo" astore) (after 100 $ focus "bar" astore)]
+		, [testpar (after 100 $ focus "foo" astore) (focus "bar" astore)]
+		, [testpar (focus "foo" astore) (after 100 $ focus "bar" astore)]
+		]
+
+	sh :: Lens (Lens (Lens (Lens (RWPair ReadSource WriteSource)))) (StateT (Map String Dynamic) m) () a a | MonadFail m & TC a
+	sh = focus "foo" astore
+*/
+
+testpar :: (A.a: sds1 m () a a | TC, == a) (A.a: sds2 m () a a | TC, == a) -> PViewT m () | MonadFail m & read, write sds1 & read, write sds2
+testpar l r =
+	    setShare (42, 'a') (l >+< r)
+	>>| equal (42, 'a') (getShare $ l >+< r) >>| equal 42 (getShare l) >>| equal 'a' (getShare r)
+	>>| setShare 38 l
+	>>| equal (38, 'a') (getShare $ l >+< r) >>| equal 38 (getShare l) >>| equal 'a' (getShare r)
+	>>| setShare 'b' r
+	>>| equal (38, 'b') (getShare $ l >+< r) >>| equal 38 (getShare l) >>| equal 'b' (getShare r)
+
+:: After sds m p r w = After Int (sds m p r w) (m ())
+after :: Int (sds m p r w) -> After sds m p r w | pure m
+after i sds = After i sds $ pure ()
+
+instance read (After sds) | read sds
 where
-	get (Par {read,left,right}) st
-		# (ml, st) = get left st
-		# (mr, st) = get right st
-		= (join $ read <$> ml <*> mr, st)
-instance put (Par sdsl sdsr) St | put sdsl St & put sdsr St
+	read (After 0 sds _) p = read sds p
+	read (After n sds m) p = pure (Reading (After (n-1) sds m))
+
+instance write (After sds) | write sds
 where
-	put w (Par {write,left,right}) st
-		= case write w of
-			Nothing = (Nothing, st)
-			Just (w1, w2)
-				# (ml, st) = put w1 left st
-				# (mr, st) = put w2 right st
-				= (ml *> mr, st)
-
-Start :: (Maybe Int, .St)
-Start
-	# st = 'Data.Map'.newMap
-	# (Just _, st) = put 42 (Source "blurp") st
-	= get (Source "blurp") st
+	write (After 0 sds _) p w = write sds p w
+	write (After n sds m) p w = pure (Writing (After (n-1) sds m))
+
+astore :: Lens (Lens (Lens (RWPair ReadSource WriteSource))) (StateT (Map String Dynamic) m) String a a | MonadFail m & TC a
+astore = fromDynStore dstore
+
+dstore :: Lens (Lens (RWPair ReadSource WriteSource)) (StateT (Map String Dynamic) m) String Dynamic Dynamic | MonadFail m
+dstore = translate (\i->((), i)) $ keyedStore store
+
+store :: Source (StateT (Map String Dynamic) m) () (Map String Dynamic) (Map String Dynamic) | Monad m
+store = source "store" (\p->getState) \p w->(\p->True) <$ put w