implementation module ASDS

import StdEnv

import Data.Functor
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
from Text import class Text(concat), instance Text String

import ASDS.Source
import ASDS.Lens
import ASDS.Select
import ASDS.Parallel

sds :: (sds m p r w) -> SDS m p r w | read, write, identity, observe sds & Monad m
sds s = SDS s

instance read SDS where read (SDS s) p = read s p
instance write SDS where write (SDS sds) p w = write sds p w
instance identity SDS where identity (SDS sds) c = identity sds c
instance observe SDS where observe (SDS sds) p oid handle = observe sds p oid handle

getShare :: (sds m () r w) -> PViewT m r | Monad m & read sds & TC r & TC w
getShare s = read s () >>= \v->case v of
	Reading s = getShare s
	Read r = liftT (pure r)

setShare :: w (sds m () r w) -> PViewT m () | Monad m & write sds & TC r & TC w
setShare w s = write s () w >>= \v->case v of
	Writing s = setShare w s
	Written _ = liftT (pure ())

updShare :: (r -> w) (sds m () r w) -> PViewT m w | Monad m & read sds & write sds & TC r & TC w
updShare f s = f <$> getShare s >>= \v->setShare v s >>| liftT (pure v)

trigger :: (v m p r w) (p -> Bool) -> PViewT m () | identity v & TC p & Monad m
trigger sds inv = gets (filter (match (concat (identity sds [])) inv)) >>= mapM_ run
where
	match :: String (p -> Bool) (NRequest m) -> Bool | TC p
	match id inv (NRequest oid ohnd (a :: p^)) = id == oid && inv a
	match _ _ _ = False

	run :: (NRequest m) -> PViewT m () | Monad m
	run (NRequest oid ohnd _) = liftT ohnd