uds/test.icl

   1 module test
   2
   3 import StdEnv
   4 import Data.Either
   5 import Data.Func
   6 from Data.Map import :: Map(..)
   7 import qualified Data.Map
   8 import Control.Monad
   9 import Control.Monad.State
  10 import Control.Monad.Fail
  11 import Control.Monad.Trans
  12
  13 import ASDS
  14 import ASDS.Source
  15 import ASDS.Lens
  16 import ASDS.Select
  17 import ASDS.Parallel
  18
  19 instance MonadFail (Either String) where fail s = Left s
  20
  21 readwrite :: r w (sds m () r w) -> PViewT m () | MonadFail m & read sds & write sds & TC r & TC w & == r
  22 readwrite r w sds = equal r (setShare w sds >>| getShare sds)
  23
  24 equal :: a (PViewT m a) -> PViewT m () | MonadFail m & == a
  25 equal expected mon = mon >>= \v->if (v == expected) (pure ()) (fail "Not equal")
  26
  27 //Start :: Either String ((), Map String Dynamic)
  28 Start = runStateT (runStateT (sequence_ $ map test tests) []) 'Data.Map'.newMap
  29 where
  30         test t = liftT (put 'Data.Map'.newMap) >>| t
  31
  32 //      tests :: [StateT [NRequest (StateT (Map String Dynamic) (Either String))] (StateT (Map String Dynamic) (Either String)) ()]
  33         tests :: [PViewT (StateT (Map String Dynamic) (Either String)) ()]
  34         tests = flatten
  35                 [ [readwrite i i sh \\ i<-[-1, 0, -100, 100]]
  36                 , [setShare [0..10] sh >>| equal i (getShare (focus ((), i) (indexedStore sh)))\\i<-[0..10]]
  37                 , [setShare [0..10] sh >>| setShare 42 (focus ((), i) (indexedStore sh)) >>| equal 42 (getShare (focus ((), i) (indexedStore sh)))\\i<-[0..10]]
  38                 , [setShare [(i, i)\\i<-[0..10]] sh >>| equal i (getShare (focus ((), i) (assocStore sh)))\\i<-[0..10]]
  39                 , [setShare ('Data.Map'.fromList [(i, i)\\i<-[0..10]]) sh >>| equal i (getShare (focus ((), i) (keyedStore sh)))\\i<-[0..10]]
  40                 , [setShare [0..10] sh >>| setShare 4 (focus "idx" astore) >>| equal 4 (getShare $ focus ((), ()) $ selectList (focus "idx" astore) sh)]
  41                 , [setShare 38 sh >>| equal 38 (getShare (After 100 sh (pure ())))]
  42                 , [testpar (focus "foo" astore) (focus "bar" astore)]
  43                 , [testpar (after 100 $ focus "foo" astore) (after 100 $ focus "bar" astore)]
  44                 , [testpar (after 100 $ focus "foo" astore) (focus "bar" astore)]
  45                 , [testpar (focus "foo" astore) (after 100 $ focus "bar" astore)]
  46                 ]
  47
  48         sh :: Lens (Lens (Lens (Lens (RWPair ReadSource WriteSource)))) (StateT (Map String Dynamic) m) () a a | MonadFail m & TC a
  49         sh = focus "foo" astore
  50
  51 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
  52 testpar l r =
  53             setShare (42, 'a') (l >+< r)
  54         >>| equal (42, 'a') (getShare $ l >+< r) >>| equal 42 (getShare l) >>| equal 'a' (getShare r)
  55         >>| setShare 38 l
  56         >>| equal (38, 'a') (getShare $ l >+< r) >>| equal 38 (getShare l) >>| equal 'a' (getShare r)
  57         >>| setShare 'b' r
  58         >>| equal (38, 'b') (getShare $ l >+< r) >>| equal 38 (getShare l) >>| equal 'b' (getShare r)
  59
  60 :: After sds m p r w = After Int (sds m p r w) (m ())
  61 after :: Int (sds m p r w) -> After sds m p r w | pure m
  62 after i sds = After i sds $ pure ()
  63
  64 instance read (After sds) | read sds
  65 where
  66         read (After 0 sds _) p = read sds p
  67         read (After n sds m) p = pure (Reading (After (n-1) sds m))
  68
  69 instance write (After sds) | write sds
  70 where
  71         write (After 0 sds _) p w = write sds p w
  72         write (After n sds m) p w = pure (Writing (After (n-1) sds m))
  73
  74 astore :: Lens (Lens (Lens (RWPair ReadSource WriteSource))) (StateT (Map String Dynamic) m) String a a | MonadFail m & TC a
  75 astore = fromDynStore dstore
  76
  77 dstore :: Lens (Lens (RWPair ReadSource WriteSource)) (StateT (Map String Dynamic) m) String Dynamic Dynamic | MonadFail m
  78 dstore = translate (\i->((), i)) $ keyedStore store
  79
  80 store :: Source (StateT (Map String Dynamic) m) () (Map String Dynamic) (Map String Dynamic) | Monad m
  81 store = source (\_->getState) \_->put