Commit 2da7d59b authored by Steffen Michels's avatar Steffen Michels

Merge branch '350-parallel-share-combinator-reading-only-one-side' into 'master'

Add sds functions to automatically stamp them

Closes #350

See merge request !338
parents f920475b 699dd5ed
Pipeline #31767 passed with stage
in 6 minutes and 54 seconds
......@@ -57,7 +57,7 @@ from iTasks.Internal.Serialization import generic JSONEncode, generic JSONDecode
from iTasks.Internal.SDSService import sdsServiceTask
from iTasks.Internal.SDS import instance Identifiable SDSSource, instance Readable SDSSource,instance Writeable SDSSource,instance Modifiable SDSSource,instance Registrable SDSSource,instance Identifiable SDSLens,instance Readable SDSLens,instance Writeable SDSLens,instance Modifiable SDSLens,instance Registrable SDSLens,instance Identifiable SDSCache,instance Readable SDSCache,instance Writeable SDSCache,instance Modifiable SDSCache,instance Registrable SDSCache,instance Identifiable SDSSequence,instance Readable SDSSequence,instance Writeable SDSSequence,instance Modifiable SDSSequence,instance Registrable SDSSequence,instance Identifiable SDSSelect,instance Readable SDSSelect,instance Writeable SDSSelect,instance Modifiable SDSSelect,instance Registrable SDSSelect,instance Identifiable SDSParallel,instance Readable SDSParallel,instance Writeable SDSParallel,instance Modifiable SDSParallel,instance Registrable SDSParallel,instance Identifiable SDSRemoteService,instance Readable SDSRemoteService,instance Writeable SDSRemoteService,instance Modifiable SDSRemoteService,instance Registrable SDSRemoteService,instance Identifiable SDSRemoteSource,instance Readable SDSRemoteSource,instance Writeable SDSRemoteSource,instance Modifiable SDSRemoteSource,instance Registrable SDSRemoteSource, instance Identifiable SDSDebug, instance Readable SDSDebug, instance Writeable SDSDebug, instance Registrable SDSDebug, instance Modifiable SDSDebug
from iTasks.Internal.SDS import instance Identifiable SDSSource, instance Readable SDSSource,instance Writeable SDSSource,instance Modifiable SDSSource,instance Registrable SDSSource,instance Identifiable SDSLens,instance Readable SDSLens,instance Writeable SDSLens,instance Modifiable SDSLens,instance Registrable SDSLens,instance Identifiable SDSCache,instance Readable SDSCache,instance Writeable SDSCache,instance Modifiable SDSCache,instance Registrable SDSCache,instance Identifiable SDSSequence,instance Readable SDSSequence,instance Writeable SDSSequence,instance Modifiable SDSSequence,instance Registrable SDSSequence,instance Identifiable SDSSelect,instance Readable SDSSelect,instance Writeable SDSSelect,instance Modifiable SDSSelect,instance Registrable SDSSelect,instance Identifiable SDSParallel,instance Readable SDSParallel,instance Writeable SDSParallel,instance Modifiable SDSParallel,instance Registrable SDSParallel,instance Identifiable SDSRemoteService,instance Readable SDSRemoteService,instance Writeable SDSRemoteService,instance Modifiable SDSRemoteService,instance Registrable SDSRemoteService,instance Identifiable SDSRemoteSource,instance Readable SDSRemoteSource,instance Writeable SDSRemoteSource,instance Modifiable SDSRemoteSource,instance Registrable SDSRemoteSource, instance Identifiable SDSDebug, instance Readable SDSDebug, instance Writeable SDSDebug, instance Registrable SDSDebug, instance Modifiable SDSDebug, instance Identifiable SDSNoNotify, instance Readable SDSNoNotify, instance Writeable SDSNoNotify, instance Registrable SDSNoNotify, instance Modifiable SDSNoNotify
from StdFunc import id, const, o
from Data.List import instance Functor []
......@@ -5,6 +5,7 @@ import iTasks.WF.Tasks.SDS
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Core
import iTasks.WF.Combinators.Common
import iTasks.SDS.Combinators.Common
import iTasks.WF.Combinators.Overloaded
import iTasks.SDS.Sources.System
from iTasks.Internal.Task import mkInstantTask
......@@ -237,3 +238,8 @@ waitForTimer interval =
get currentTimestamp >>- \(Timestamp now) ->
timestampToLocalDateTime (Timestamp (now + interval)) >>- \endTime ->
waitForDateTime endTime
dateTimeStampedShare :: (sds p (DateTime,a) (DateTime,a)) -> SDSLens p (DateTime, a) a | gText{|*|} p & TC p & TC a & RWShared sds
dateTimeStampedShare sds
= sdsTranslate "dateTimeStampedShare" (\p->(p, ()))
(sdsStamp sds currentDateTime (\x y->(x, y)))
......@@ -64,6 +64,12 @@ instance Writeable SDSDebug
instance Modifiable SDSDebug
instance Registrable SDSDebug
instance Identifiable SDSNoNotify
instance Readable SDSNoNotify
instance Writeable SDSNoNotify
instance Modifiable SDSNoNotify
instance Registrable SDSNoNotify
:: DeferredWrite = E. p r w sds: DeferredWrite !p !w !(sds p r w) & gText{|*|}, TC p & TC r & TC w & RWShared sds
//Internal creation functions:
......
......@@ -992,3 +992,39 @@ readAndMbRegisterSDS :: !(sds p r w) !p !TaskContext !(Maybe (!TaskId, !SDSIdent
readAndMbRegisterSDS sds p c mbRegister iworld = case mbRegister of
Just (regTaskId, reqSDSId) = readRegisterSDS sds p c regTaskId reqSDSId iworld
Nothing = readSDS sds p c iworld
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 set sds), iworld)
= (Ok (WriteResult set (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 set r w sds), iworld)
= (Ok (ModifyResult set r w (SDSNoNotify sds)), iworld)
(Ok (AsyncModify sds mf), iworld)
= (Ok (AsyncModify (SDSNoNotify sds) mf), iworld)
......@@ -40,6 +40,25 @@ sdsTranslate :: !String !(p -> ps) !(sds ps r w) -> SDSLens p r w | gText{|*|}
// Introduce a new parameter
sdsSplit :: !String !(p -> (ps,pn)) !(pn rs -> r) !(pn rs w -> (ws,SDSNotifyPred pn)) !(Maybe (SDSReducer p ws w)) !(sds ps rs ws) -> SDSLens p r w | gText{|*|} ps & TC ps & gText{|*|} pn & TC pn & TC rs & TC ws & RWShared sds
/*
* Read the data from the rhs when writing the lhs.
* The resulting share is only notified when the lhs is notified.
*
* @param the sds to read and write from
* @param the sds to only read from when writing
* @param the function with which you combine the values for actually writing
* @return the resulting sds
*/
sdsStamp :: !(sds1 p1 r1 w1) !(sds2 p2 r2 w2) (r2 w -> w1) -> SDSLens (p1, p2) r1 w | gText{|*|}, TC p1 & gText{|*|}, TC p2 & TC r1 & TC r2 & TC w1 & TC w2 & RWShared sds2 & RWShared sds1
/*
* Automatically stamp the share data with the timespec of writing
*
* @param the sds to automatically stamp the data for
* @return the resulting sds
*/
timespecStampedShare :: (sds p (Timespec,a) (Timespec,a)) -> SDSLens p (Timespec, a) a | gText{|*|} p & TC p & TC a & RWShared sds
// Treat symmetric sources with optional values as if they always have a value.
// You can provide a default value, if you don't it will trigger a read error
removeMaybe :: !(Maybe a) !(sds p (Maybe a) (Maybe a)) -> SDSLens p a a | gText{|*|} p & TC p & TC a & RWShared sds
......
......@@ -2,10 +2,12 @@ implementation module iTasks.SDS.Combinators.Common
import StdTuple, StdList
import iTasks.SDS.Definition, iTasks.SDS.Combinators.Core, iTasks.SDS.Sources.Core
import iTasks.SDS.Sources.System
import iTasks.WF.Combinators.Core
from StdFunc import o, const, flip, id
from iTasks.Internal.Task import exception, :: TaskException
import qualified Data.Map as DM
import Data.Func
import qualified Data.IntMap.Strict as DIS
from Data.IntMap.Strict import :: IntMap
from Data.Map import :: Map
......@@ -47,6 +49,23 @@ where
write` p rs w = Ok (Just (fst (write (snd (param p)) rs w)))
notify` p rs w ts pq = (snd (write (snd (param p)) rs w)) ts (snd (param pq))
sdsStamp :: !(sds1 p1 r1 w1) !(sds2 p2 r2 w2) (r2 w -> w1) -> SDSLens (p1, p2) r1 w | gText{|*|}, TC p1 & gText{|*|}, TC p2 & TC r1 & TC r2 & TC w1 & TC w2 & RWShared sds2 & RWShared sds1
sdsStamp source helper writefun = sdsLens "*<" id
(SDSRead \_ (r1, r2)->Ok r1)
(SDSWrite \_ (r1, r2) w->Ok $ Just $ (writefun r2 w, ()))
(SDSNotifyConst \_ _ _ _->True)
Nothing
$ sdsParallel ">**<" id id
(SDSWriteConst $ const $ Ok o Just o fst)
(SDSWriteConst $ const $ Ok o Just o snd)
source
(mapWrite (\_ _->Nothing) Nothing $ SDSNoNotify helper)
timespecStampedShare :: (sds p (Timespec,a) (Timespec,a)) -> SDSLens p (Timespec, a) a | gText{|*|} p & TC p & TC a & RWShared sds
timespecStampedShare sds
= sdsTranslate "timespecStampedShare" (\p->(p, ()))
$ sdsStamp sds currentTimespec \x y->(x, y)
removeMaybe :: !(Maybe a) !(sds p (Maybe a) (Maybe a)) -> SDSLens p a a | gText{|*|} p & TC p & TC a & RWShared sds
removeMaybe defaultValue sds = sdsLens "removeMaybe" id (SDSRead read) (SDSWriteConst write) (SDSNotifyConst (\_ _ _ _ -> True)) (Just reducer) sds
where
......
......@@ -338,3 +338,5 @@ required type w. The reducer has the job to turn this ws into w.
:: SDSRemoteService p r w = SDSRemoteService !(Maybe ConnectionId) !(WebServiceShareOptions p r w)
:: SDSDebug p r w = E. sds: SDSDebug !String !(sds p r w) & RWShared sds
:: SDSNoNotify p r w = E.sds: SDSNoNotify !(sds p r w) & RWShared sds
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment