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