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
  12 import ASDS
  13 import ASDS.Source
  14 import ASDS.Lens
  15 import ASDS.Select
  16 import ASDS.Parallel
  17
  18 instance MonadFail (Either String) where fail s = Left s
  19
  20
  21 readwrite :: r w (sds m () r w) -> 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 (m a) -> 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 (sequence_ $ map test tests) 'Data.Map'.newMap
  29 where
  30         test t = put 'Data.Map'.newMap >>| t
  31
  32         tests = flatten
  33                 [ [readwrite i i sh \\ i<-[-1, 0, -100, 100]]
  34                 , [setShare [0..10] sh >>| equal i (getShare (focus ((), i) (indexedStore sh)))\\i<-[0..10]]
  35                 , [setShare [0..10] sh >>| setShare 42 (focus ((), i) (indexedStore sh)) >>| equal 42 (getShare (focus ((), i) (indexedStore sh)))\\i<-[0..10]]
  36                 , [setShare [(i, i)\\i<-[0..10]] sh >>| equal i (getShare (focus ((), i) (assocStore sh)))\\i<-[0..10]]
  37                 , [setShare ('Data.Map'.fromList [(i, i)\\i<-[0..10]]) sh >>| equal i (getShare (focus ((), i) (keyedStore sh)))\\i<-[0..10]]
  38                 , [setShare (42, 'a') $ focus "foo" astore >+< focus "bar" astore]
  39                 ]
  40
  41         sh :: Lens (Lens (Lens (Lens (RWPair ReadSource WriteSource)))) (StateT (Map String Dynamic) m) () a a | MonadFail m & TC a
  42         sh = focus "foo" astore
  43
  44
  45 //      t = setShare (42, "blurp") (focus "foo" astore >+< focus "bar" astore)
  46 //      t = write 42 (astore "blurp")
  47 //              >>| read (astore "blurp")
  48 //      t = setShare 42 (focus "blurp" astore)
  49 //              >>| getShare (focus "blurp" astore)
  50
  51 //Start world = evalIO t world
  52 //where
  53 //      t = getShare (focus "auds.icl" file)
  54
  55 astore :: Lens (Lens (Lens (RWPair ReadSource WriteSource))) (StateT (Map String Dynamic) m) String a a | MonadFail m & TC a
  56 astore = fromDynStore dstore
  57
  58 dstore :: Lens (Lens (RWPair ReadSource WriteSource)) (StateT (Map String Dynamic) m) String Dynamic Dynamic | MonadFail m
  59 dstore = translate (\i->((), i)) $ keyedStore store
  60
  61 store :: Source (StateT (Map String Dynamic) m) () (Map String Dynamic) (Map String Dynamic) | Monad m
  62 store = source (\_->getState) \_->put