X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=uds%2Ftest.icl;h=f294e8ec85734853c1fe386821c07ae4d02add8f;hb=HEAD;hp=edb8eeb93cc94be63bbdac1939985f2c43358bec;hpb=27b73130a759ac1fdd20c8f6ab07cb259bc96419;p=clean-tests.git diff --git a/uds/test.icl b/uds/test.icl index edb8eeb..f294e8e 100644 --- a/uds/test.icl +++ b/uds/test.icl @@ -3,12 +3,15 @@ module test import StdEnv import Data.Either import Data.Func +import Data.Functor +import Data.Functor.Identity from Data.Map import :: Map(..) import qualified Data.Map import Control.Monad import Control.Monad.State import Control.Monad.Fail import Control.Monad.Trans +import System.IO import ASDS import ASDS.Source @@ -24,6 +27,15 @@ readwrite r w sds = equal r (setShare w sds >>| getShare sds) equal :: a (PViewT m a) -> PViewT m () | MonadFail m & == a equal expected mon = mon >>= \v->if (v == expected) (pure ()) (fail "Not equal") +//Start :: Either String (((), [NRequest Identity)]), Map String Dynamic) +Start w = /*eval*/execIO (runStateT (observe intsource () "int" (putStrLn "blurp" >>| pure ()) >>| setShare 42 intsource) []) w + +import Debug.Trace + +intsource :: Source m () Int Int | pure m +intsource = source "int" (\_->pure 42) (\_ _->pure (\_->True)) + +/* //Start :: Either String ((), Map String Dynamic) Start = runStateT (runStateT (sequence_ $ map test tests) []) 'Data.Map'.newMap where @@ -47,6 +59,7 @@ where sh :: Lens (Lens (Lens (Lens (RWPair ReadSource WriteSource)))) (StateT (Map String Dynamic) m) () a a | MonadFail m & TC a sh = focus "foo" astore +*/ 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 testpar l r = @@ -78,4 +91,4 @@ dstore :: Lens (Lens (RWPair ReadSource WriteSource)) (StateT (Map String Dynami dstore = translate (\i->((), i)) $ keyedStore store store :: Source (StateT (Map String Dynamic) m) () (Map String Dynamic) (Map String Dynamic) | Monad m -store = source (\_->getState) \_->put +store = source "store" (\p->getState) \p w->(\p->True) <$ put w