X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=stampedShare%2Ftest.icl;fp=stampedShare%2Ftest.icl;h=1b2445c24b4f46b3efac91a349ea3810f89a9b65;hb=e1f8e1ebd0c95e7bfefb6618a5996fe9b3accc04;hp=0000000000000000000000000000000000000000;hpb=d039e976dcfebdd914caaa64e0f83143a65644ca;p=clean-tests.git

diff --git a/stampedShare/test.icl b/stampedShare/test.icl
new file mode 100644
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)