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
repositories / clean-tests.git / blobdiff