things

[clean-tests.git] / stampedShare / test.icl

diff --git a/stampedShare/test.icl b/stampedShare/test.icl
new file mode 100644 (file)
index 0000000..1b2445c
--- /dev/null
+++ b/stampedShare/test.icl
@@ -0,0 +1,73 @@
+module test
+
+import Data.Func
+import iTasks.Extensions.DateTime
+import qualified Data.Map as DM
+import qualified Data.Set as DS
+import iTasks
+
+//:: SDSStamped sds p r w = SDSStamped String (sds p (DateTime, r) (DateTime, w))
+//instance Identifiable (SDSStamped sds) | Identifiable sds
+//where
+//     nameSDS (SDSStamped n sds) acc = ["t$":nameSDS sds ["$t":acc]]
+//instance Readable (SDSStamped sds) | Readable sds
+//where
+//     readSDS (SDSStamped name sds) p c iworld
+//             = case readSDS sds p c iworld of
+//                     (Error e, iworld) = (Error e, iworld)
+//                     (Ok (ReadResult r ssds), iworld)
+//                             = (Ok (ReadResult r (SDSStamped name ssds)), iworld)
+//                     (Ok (AsyncRead sds), iworld)
+//                             = (Ok (AsyncRead (SDSStamped name sds)), iworld)
+//
+
+:: SDSNoNotify p r w = E.sds: SDSNoNotify (sds p r w) & RWShared sds
+instance Identifiable SDSNoNotify where
+       nameSDS (SDSNoNotify sds) c = nameSDS sds c
+instance Readable SDSNoNotify where
+   readSDS (SDSNoNotify sds) p c iworld
+               = case readSDS sds p c iworld of
+                       (Error e, iworld) = (Error e, iworld)
+                       (Ok (ReadResult r sds), iworld)
+                               = (Ok (ReadResult r sds), iworld)
+                       (Ok (AsyncRead sds), iworld)
+                               = (Ok (AsyncRead sds), iworld)
+
+instance Writeable SDSNoNotify where
+       writeSDS (SDSNoNotify sds) p c w iworld
+               = case writeSDS sds p c w iworld of
+                       (Error e, iworld) = (Error e, iworld)
+                       (Ok (WriteResult _ sds), iworld)
+                               = (Ok (WriteResult 'DS'.newSet (SDSNoNotify sds)), iworld)
+                       (Ok (AsyncWrite sds), iworld)
+                               = (Ok (AsyncWrite (SDSNoNotify sds)), iworld)
+instance Registrable SDSNoNotify where
+       readRegisterSDS (SDSNoNotify sds) p c _ _ iworld
+               = case readSDS sds p c iworld of
+                       (Error e, iworld) = (Error e, iworld)
+                       (Ok (ReadResult r sds), iworld)
+                               = (Ok (ReadResult r sds), iworld)
+                       (Ok (AsyncRead sds), iworld)
+                               = (Ok (AsyncRead sds), iworld)
+instance Modifiable SDSNoNotify where
+       modifySDS mf (SDSNoNotify sds) p c iworld
+               = case modifySDS mf sds p c iworld of
+                       (Error e, iworld) = (Error e, iworld)
+                       (Ok (ModifyResult _ r w sds), iworld)
+                               = (Ok (ModifyResult 'DS'.newSet r w (SDSNoNotify sds)), iworld)
+                       (Ok (AsyncModify sds mf), iworld)
+                               = (Ok (AsyncModify (SDSNoNotify sds) mf), iworld)
+
+
+sh = sharedStore "bork" ({DateTime|year=0,mon=0,day=0,hour=0,min=0,sec=0}, 42)
+
+Start w = doTasks t w
+//Start w = nameSDS (SDSStamped "bork" sh) []
+
+stampedShare :: (Shared sds (DateTime, a)) -> SDSLens () (DateTime, a) a | TC a & RWShared sds
+stampedShare sds =
+       mapReadWrite (fst , \a (_, dt)->Just ((dt, a), dt)) Nothing
+       $ sds >*< (mapWrite (\_ _->Nothing) Nothing currentDateTime)
+
+t = viewSharedInformation [] sh
+       -&&- updateSharedInformation [] (stampedShare sh)