uds/ASDS/Source.icl

   1 implementation module ASDS.Source
   2
   3 import StdEnv
   4 import Data.Func
   5 import Data.Functor
   6 import Control.Monad
   7 import Control.Monad.State
   8 import Control.Monad.Trans
   9 import ASDS
  10
  11 rwpair :: (sdsr m p r w) (sdsw m p r w) -> RWPair sdsr sdsw m p r w | pure m
  12 rwpair l r = RWPair l r (pure ())
  13
  14 source :: (p -> m r) (p w -> m ()) -> Source m p r w | pure m
  15 source read write = rwpair (ReadSource read) (WriteSource write)
  16
  17 instance read ReadSource
  18 where
  19         read (ReadSource read) p = Read <$> liftT (read p)
  20
  21 instance write WriteSource
  22 where
  23         write (WriteSource write) p w = Written <$> liftT (write p w)
  24
  25 instance observe WriteSource
  26 where
  27         observe sds p oid hnd = modify \s->[NRequest oid hnd (dynamic p):s]
  28
  29 instance read (RWPair sdsr sdsw) | read sdsr
  30 where
  31         read (RWPair s w _) p = read s p >>= \v->case v of
  32                 Reading s = pure $ Reading (rwpair s w)
  33                 Read r = pure $ Read r
  34
  35 instance write (RWPair sdsr sdsw) | write sdsw
  36 where
  37         write (RWPair r s _) p w = write s p w >>= \v->case v of
  38                 Writing s = pure $ Writing $ rwpair r s
  39                 Written _ = pure $ Written ()
  40
  41 instance observe (RWPair sdsr sdsw) | observe sdsw
  42 where
  43         observe (RWPair r s _) p oid hnd = observe s p oid hnd
  44
  45 constShare :: a -> ReadSource m p a b | pure m
  46 constShare a = ReadSource \_->pure a
  47
  48 nullShare :: WriteSource m p a b | pure m
  49 nullShare = WriteSource \_ _->pure ()