uds/test.icl

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