uds/test.icl

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