stampedShare/test.icl

   1 module test
   2
   3 import Data.Func
   4 import iTasks.Extensions.DateTime
   5 import qualified Data.Map as DM
   6 import qualified Data.Set as DS
   7 import iTasks
   8
   9 //:: SDSStamped sds p r w = SDSStamped String (sds p (DateTime, r) (DateTime, w))
  10 //instance Identifiable (SDSStamped sds) | Identifiable sds
  11 //where
  12 //      nameSDS (SDSStamped n sds) acc = ["t$":nameSDS sds ["$t":acc]]
  13 //instance Readable (SDSStamped sds) | Readable sds
  14 //where
  15 //      readSDS (SDSStamped name sds) p c iworld
  16 //              = case readSDS sds p c iworld of
  17 //                      (Error e, iworld) = (Error e, iworld)
  18 //                      (Ok (ReadResult r ssds), iworld)
  19 //                              = (Ok (ReadResult r (SDSStamped name ssds)), iworld)
  20 //                      (Ok (AsyncRead sds), iworld)
  21 //                              = (Ok (AsyncRead (SDSStamped name sds)), iworld)
  22 //
  23
  24 :: SDSNoNotify p r w = E.sds: SDSNoNotify (sds p r w) & RWShared sds
  25 instance Identifiable SDSNoNotify where
  26         nameSDS (SDSNoNotify sds) c = nameSDS sds c
  27 instance Readable SDSNoNotify where
  28    readSDS (SDSNoNotify sds) p c iworld
  29                 = case readSDS sds p c iworld of
  30                         (Error e, iworld) = (Error e, iworld)
  31                         (Ok (ReadResult r sds), iworld)
  32                                 = (Ok (ReadResult r sds), iworld)
  33                         (Ok (AsyncRead sds), iworld)
  34                                 = (Ok (AsyncRead sds), iworld)
  35
  36 instance Writeable SDSNoNotify where
  37         writeSDS (SDSNoNotify sds) p c w iworld
  38                 = case writeSDS sds p c w iworld of
  39                         (Error e, iworld) = (Error e, iworld)
  40                         (Ok (WriteResult _ sds), iworld)
  41                                 = (Ok (WriteResult 'DS'.newSet (SDSNoNotify sds)), iworld)
  42                         (Ok (AsyncWrite sds), iworld)
  43                                 = (Ok (AsyncWrite (SDSNoNotify sds)), iworld)
  44 instance Registrable SDSNoNotify where
  45         readRegisterSDS (SDSNoNotify sds) p c _ _ iworld
  46                 = case readSDS sds p c iworld of
  47                         (Error e, iworld) = (Error e, iworld)
  48                         (Ok (ReadResult r sds), iworld)
  49                                 = (Ok (ReadResult r sds), iworld)
  50                         (Ok (AsyncRead sds), iworld)
  51                                 = (Ok (AsyncRead sds), iworld)
  52 instance Modifiable SDSNoNotify where
  53         modifySDS mf (SDSNoNotify sds) p c iworld
  54                 = case modifySDS mf sds p c iworld of
  55                         (Error e, iworld) = (Error e, iworld)
  56                         (Ok (ModifyResult _ r w sds), iworld)
  57                                 = (Ok (ModifyResult 'DS'.newSet r w (SDSNoNotify sds)), iworld)
  58                         (Ok (AsyncModify sds mf), iworld)
  59                                 = (Ok (AsyncModify (SDSNoNotify sds) mf), iworld)
  60
  61
  62 sh = sharedStore "bork" ({DateTime|year=0,mon=0,day=0,hour=0,min=0,sec=0}, 42)
  63
  64 Start w = doTasks t w
  65 //Start w = nameSDS (SDSStamped "bork" sh) []
  66
  67 stampedShare :: (Shared sds (DateTime, a)) -> SDSLens () (DateTime, a) a | TC a & RWShared sds
  68 stampedShare sds =
  69         mapReadWrite (fst , \a (_, dt)->Just ((dt, a), dt)) Nothing
  70         $ sds >*< (mapWrite (\_ _->Nothing) Nothing currentDateTime)
  71
  72 t = viewSharedInformation [] sh
  73         -&&- updateSharedInformation [] (stampedShare sh)