Commit 916b5246 authored by Haye Böhm's avatar Haye Böhm

Implement fully asynchronous reading/writing/modifying of arbitrary SDS

trees

This commit enables:
- Asynchronous reading from any kind of SDS
- Asynchronous writing from any kind of SDS
- Asynchronous modifying of SDSLens, SDSSelect, SDSRemoteSource,
SDSSource. For all other SDS definition the modify is implemented as
read --> write.
parent 29d78d8a
......@@ -66,7 +66,7 @@ citizenFromSSN :: SSN [Citizen] -> Maybe Citizen
/** nameHomeAddressFromCitizen citizen=:{home_address=Just address} = nha:
@nha contains the @citizen.name and @address.
nameHomeAddressFromCitizen citizen=:{home_address=Nothing}:
is undefined.
is abort undefined.
*/
nameHomeAddressFromCitizen :: Citizen -> NameHomeAddress
......
......@@ -51,9 +51,7 @@ where
weatherService = remoteService (weatherOptions {apiKey = "1160ac287072c67ae44708dee89f9a8b" , type = ByCityName "Nijmegen"})
Start :: *World -> *World
Start world
= startEngineWithOptions opts maintask world
Start world = startEngineWithOptions opts maintask world
where
opts [] = \op->(Just {op&distributed=True}, ["Started server on port: " +++ toString op.serverPort])
opts ["-p",p:as] = appFst (fmap (\o->{o & serverPort=toInt p})) o opts as
......
SHELL = /bin/zsh
INSTANCES = 5
INSTANCES?=5
build:
cpm make;
rm -rf instances;
for n in {0..${INSTANCES}} ; do \
mkdir -p instances/$$n;\
cp AsyncShareTest instances/$$n/;\
cp -r AsyncShareTest-www instances/$$n/;\
done
.SECONDARY: AsyncShareTest.prj
build: AsyncShareTest $(foreach v,$(shell seq $(INSTANCES)),instances/$v/AsyncShareTest)
%: %.prj %.icl
cpm make
%.prj:
cpm project $(basename $@) create
cpm project $@ target iTasks-git
cpm project $@ set -h 2000M -s 20M -dynamics
%/AsyncShareTest: AsyncShareTest
mkdir -p $(dir $@)
cp $< $@
cp -r $<-www $@-www
clean:
rm -rf instances;
rm -rf Clean\ System\ Files;
rm AsyncShareTest;
rm -rf AsyncShareTest-www;
\ No newline at end of file
$(RM) -r instances Clean\ System\ Files AsyncShareTest $(addprefix AsyncShareTest,-www -sapl -data)
clobber:
$(RM) AsyncShareTest.prj
module RemoteServiceExamples
import iTasks
import Internet.HTTP
:: OpenWeatherRequest =
{ apiKey :: String
, type :: OpenWeatherRequestType
}
:: OpenWeatherRequestType = ByCityName String | ByCoordinates Real Real
:: OpenWeatherResponse =
{ id :: Int
, main :: String
, description :: String
, icon :: String }
derive class iTask OpenWeatherResponse
Start world = startEngine serviceTask world
where
serviceTask = get weatherService >>= viewInformation "Current weather" []
// api.openweathermap.org/data/2.5/weather?q=London,uk
weatherOptions :: OpenWeatherRequest -> WebServiceShareOptions OpenWeatherResponse
weatherOptions owr = HttpShareOptions (toRequest owr) fromResp
where
toRequest {OpenWeatherRequest|apiKey, type}
# r = newHTTPRequest
= {HTTPRequest|r & server_name = "api.openweathermap.org", server_port = 80, req_path = "/data/2.5/weather", req_query = query type +++ "&APPID=" +++ apiKey}
fromResp response = case jsonQuery "weather/0" (fromString response.rsp_data) of
Nothing = Left "Could not select JSON"
(Just selected) = case fromJSON selected of
Nothing = Left "Could not transform JSON"
(Just v) = Right v
query (ByCityName name) = "?q=" +++ name
query (ByCoordinates lat long) = "?lat=" +++ toString lat +++ "&lon=" +++ toString long
weatherService = remoteService (weatherOptions {apiKey = "1160ac287072c67ae44708dee89f9a8b" , type = ByCityName "Nijmegen"})
\ No newline at end of file
instances/
RemoteServiceExamples
RemoteShareExamples
INSTANCES?=5
.SECONDARY: RemoteShareExamples.prj
build: RemoteShareExamples $(foreach v,$(shell seq $(INSTANCES)),instances/$v/RemoteShareExamples)
%: %.prj %.icl
cpm make
%.prj:
cpm project $(basename $@) create
cpm project $@ target iTasks-git
cpm project $@ set -h 2000M -s 20M -dynamics
%/RemoteShareExamples: RemoteShareExamples
mkdir -p $(dir $@)
cp $< $@
cp -r $<-www $@-www
clean:
$(RM) -r instances Clean\ System\ Files RemoteShareExamples $(addprefix RemoteShareExamples,-www -sapl -data)
clobber:
$(RM) RemoteShareExamples.prj
module RemoteShareExamples
import iTasks
import iTasks.Internal.Distributed.Instance
import Data.Func
import Data.Tuple
import Data.Maybe
import Data.Functor
import Data.Either
derive class iTask TestRecord
:: TestRecord = {number :: Int, numbers :: [Int], text :: String, texts :: [String]}
testShare = sharedStore "sharedStoreNamebla" {number = 37, numbers = [1, 2, 3], text = "Test", texts = ["een", "twee", "drie", "vier"]}
remoteTestShare = remoteShare testShare {domain = "TEST", port = 8080}
leftShare = sharedStore "leftShare" (1, 2, 3)
rightShare = sharedStore "rightShare" (10, 20, 30)
parallelShare = leftShare >*< rightShare
remoteParallelShare = remoteShare parallelShare {domain = "TEST", port = 8080}
parallelWithLeftRemote = (remoteShare leftShare {domain = "TEST", port = 8080}) >*< rightShare
parallelWithRightRemote = leftShare >*< (remoteShare rightShare {domain = "TEST", port = 8080})
intShare = sharedStore "intShare" 15
simpleShare = remoteShare intShare {domain="TEST", port=8080}
projectedRemote = sdsProject (SDSLensRead (\r. Ok (r + 2))) (SDSLensWrite (\_ r. Ok (DoWrite (r - 2)))) (\_ ws. Ok (ws + 2)) simpleShare
Start world = startEngine [publish "/" (\_ -> loginAndManageWorkList "Hello!" flows)] world
where
title = "Remote share test"
flows = [ workflow "Tests/1" "Test 1" case1
, workflow "Tests/2" "Test 2" case2
, workflow "Tests/3" "Test 3" case3
, workflow "Tests/4" "Test 4" case4
, workflow "Tests/5" "Test 5" case5
, workflow "Tests/6" "Test 6" case6
, workflow "Tests/7" "Test 7" case7]
// 1. We can read from a remote share
localSdss = (viewSharedInformation "sharedStoreNamebla" [] testShare
-&&- viewSharedInformation "leftShare" [] leftShare
-&&- viewSharedInformation "rightShare" [] rightShare
-&&- viewSharedInformation "intShare" [] intShare) >>| return ()
case1 = get simpleShare
>>= viewInformation "Remote int share" []
>>| return ()
// 2. We can write to a remote share and retrieve the result, which should be the same
case2 = enterInformation "Enter the new remote state" []
>>= \i. set i remoteTestShare
>>| get remoteTestShare
>>= viewInformation "Retrieved remote state" []
>>| return ()
// 3. We can update a remote share
case3 = updateSharedInformation "Updating remote state" [] remoteTestShare >>| return ()
// 4. We can update a parallel share with a left remote part
case4 = updateSharedInformation "Update share with left remote part" [] parallelWithLeftRemote >>| return ()
// 5. We can update a parallel share with a right remote part
case5 = updateSharedInformation "Update share with right remote part" [] parallelWithRightRemote >>| return ()
// 6. We can update the share at the same time and see the changes
case6 = (updateSharedInformation "Update share with left remote part" [] parallelWithLeftRemote -||- updateSharedInformation "Update share with left remote part" [] parallelWithLeftRemote)
>>| return ()
// 7. We can translate a remote share
case7 = updateSharedInformation "Update a translated remote share" [] projectedRemote >>| return ()
......@@ -47,21 +47,13 @@ defaultEngineOptions world
, appPath = appPath
, appVersion = appVersion
, serverPort = IF_POSIX_OR_WINDOWS 8080 80
<<<<<<< HEAD
, serverUrl = "http://localhost/"
, keepaliveTime = {tv_sec=300,tv_nsec=0} // 5 minutes
, sessionTime = {tv_sec=60,tv_nsec=0} // 1 minute, (the client pings every 10 seconds by default)
, persistTasks = False
, autoLayout = True
, timeout = Just 500
=======
, serverUrl = "http://localhost/"
, keepaliveTime = 300 // 5 minutes
, sessionTime = 60 // 1 minute, (the client pings every 10 seconds by default)
, persistTasks = False
, autoLayout = True
, distributed = False
>>>>>>> Add storing symbols to the engine
, timeout = Just 500
, webDirPath = appDir </> appName +++ "-www"
, storeDirPath = appDir </> appName +++ "-data" </> "stores"
, tempDirPath = appDir </> appName +++ "-data" </> "tmp"
......
......@@ -285,13 +285,13 @@ tonicDynamicBrowser rs
tonicDynamicBrowser` :: [TaskAppRenderer] (sds () NavStack NavStack) -> Task () | RWShared sds
tonicDynamicBrowser` rs navstack =
((activeBlueprintInstances -&&- blueprintViewer) /* <<@ ArrangeVertical */) @! ()
where
where
activeBlueprintInstances = editSharedChoiceWithSharedAs
(Title "Active blueprint instances")
[ChooseFromGrid customView]
(mapRead (\(trt, q) -> filterActiveTasks q (flattenRTMap trt)) (tonicSharedRT |*| queryShare))
setTaskId selectedBlueprint <<@ ArrangeWithSideBar 0 TopSide 175 True
where
(mapRead (\(trt, q) -> filterActiveTasks q (flattenRTMap trt)) ((tonicSharedRT |*| queryShare) f))
setTaskId selectedBlueprint f <<@ ArrangeWithSideBar 0 TopSide 175 True
where
setTaskId x = { click_origin_mbbpident = Nothing
, click_origin_mbnodeId = Nothing
, click_target_bpident = { bpident_moduleName = x.bpi_bpref.bpr_moduleName
......@@ -300,6 +300,9 @@ tonicDynamicBrowser` rs navstack =
}
}
// TODO: Fix!!
f p = undef
flattenRTMap :: TonicRTMap -> [BlueprintInstance]
flattenRTMap trt = 'DM'.elems ('DM'.foldrWithKey f 'DM'.newMap trt)
where
......@@ -309,13 +312,13 @@ tonicDynamicBrowser` rs navstack =
g tid ((mn, fn), bpi) acc = 'DM'.put (tid, mn, fn) bpi acc
blueprintViewer
= whileUnchanged (selectedBlueprint |*| navstack) (
= whileUnchanged ((selectedBlueprint |*| navstack) id) (
\(bpmeta, ns) -> case bpmeta of
Just meta=:{click_target_bpident = {bpident_compId = Just tid, bpident_moduleName, bpident_compName}}
# focus = (sdsFocus (comp2TaskId tid, bpident_moduleName, bpident_compName) tonicInstances)
= get focus
>>~ \mbprnt -> get selectedDetail
>>~ \selDetail -> whileUnchanged (focus |*| dynamicDisplaySettings) (
>>~ \selDetail -> whileUnchanged ((focus |*| dynamicDisplaySettings) f) (
\shareData ->
case shareData of
(Just bpinst, dynSett) -> viewInstance rs navstack dynSett bpinst selDetail meta
......@@ -328,23 +331,9 @@ tonicDynamicBrowser` rs navstack =
_ = viewInformation () [] "Please select a blueprint" @! ()
)<<@ ApplyLayout (layoutSubUIs (SelectByType UIAction) (setActionIcon ('DM'.fromList [("Back","previous"),("Parent task","open")])))
where
//navToParent currinst=:{bpi_bpref = currbpref} dynSett selDetail tid rs (Just inst=:{bpi_bpref = bpref}) // TODO Check
//= Just ( upd (\xs -> [mkMeta tid : xs]) navstack
//>>| set (Just (mkMeta inst.bpi_taskId)) selectedBlueprint
//>>| viewInstance rs navstack dynSett inst selDetail (mkMeta inst.bpi_taskId) @! ())
//where
//mkMeta tid =
//{ click_origin_mbbpident = Just { bpident_moduleName = currbpref.bpr_moduleName
//, bpident_compName = currbpref.bpr_taskName
//, bpident_compId = Just (toComp currinst.bpi_taskId)
//}
//, click_origin_mbnodeId = Nothing
//, click_target_bpident = { bpident_moduleName = bpref.bpr_moduleName
//, bpident_compName = bpref.bpr_taskName
//, bpident_compId = Just (toComp tid)
//}
//}
//navToParent _ _ _ _ _ _ = Nothing
// TODO: Fix!
f _ = undef
navigateBackwards :: !DynamicDisplaySettings !(Maybe (Either ClickMeta (ModuleName, FuncName, ComputationId, Int))) NavStack a -> Maybe (Task ())
navigateBackwards _ _ [] _ = Nothing
......
......@@ -16,7 +16,7 @@ userAccounts = sharedStore "UserAccounts" [ROOT_USER]
users :: SDSLens () [User] ()
users = mapReadWrite (\accounts -> [AuthenticatedUser (toString a.UserAccount.credentials.Credentials.username) a.UserAccount.roles a.UserAccount.title
\\ a <- accounts]
, \() accounts -> Nothing) userAccounts
, \() accounts -> DoNotWrite accounts) (\_ _ -> Ok ()) userAccounts
usersWithRole :: !Role -> SDSLens () [User] ()
usersWithRole role = mapRead (filter (hasRole role)) users
......@@ -25,7 +25,7 @@ where
hasRole _ _ = False
userAccount :: UserId -> SDSLens () (Maybe UserAccount) (Maybe UserAccount)
userAccount userId = mapReadWrite (getAccount userId, \w r -> Just (setAccount w r)) userAccounts
userAccount userId = mapReadWrite (getAccount userId, \w r -> DoWrite (setAccount w r)) (\_ accounts -> Ok (getAccount userId accounts)) userAccounts
where
getAccount :: UserId [UserAccount] -> Maybe UserAccount
getAccount userId accounts = case [a \\ a <- accounts | identifyUserAccount a == userId] of
......
......@@ -43,7 +43,7 @@ myWork = workList taskInstancesForCurrentUser
allWork :: SDSLens () [(TaskId,WorklistRow)] ()
allWork = workList allTaskInstances
workList instances = mapRead projection (instances |*| currentTopTask)
workList instances = mapRead projection ((instances |*| currentTopTask) f)
where
projection (instances,ownPid)
= [(TaskId i.TaskInstance.instanceNo 0, mkRow i) \\ i <- instances | notSelf ownPid i && isActive i]
......@@ -65,7 +65,7 @@ where
,parentTask = if (listId == TaskId 0 0) Nothing (Just (toString listId))
}
f (l, r) = ((), ())
// SHARES
// Available workflows
......@@ -73,17 +73,17 @@ workflows :: SDSLens () [Workflow] [Workflow]
workflows = sharedStore "Workflows" []
workflowByPath :: !String -> SDSLens () Workflow Workflow
workflowByPath path = mapReadWriteError (toPrj,fromPrj) workflows
workflowByPath path = mapReadWriteError (toPrj,fromPrj) (\_ flows -> toPrj flows) workflows
where
toPrj wfs = case [wf \\ wf <- wfs | wf.Workflow.path == path] of
[wf:_] = Ok wf
_ = Error (exception ("Workflow " +++ path +++ " could not be found"))
fromPrj nwf wfs
= Ok (Just [if (wf.path == path) nwf wf \\ wf <- wfs])
= Ok (DoWrite [if (wf.path == path) nwf wf \\ wf <- wfs])
allowedWorkflows :: SDSLens () [Workflow] ()
allowedWorkflows = mapRead filterAllowed (workflows |*| currentUser)
allowedWorkflows = mapRead filterAllowed ((workflows |*| currentUser) id)
where
filterAllowed (workflows,user) = filter (isAllowedWorkflow user) workflows
......@@ -107,12 +107,13 @@ manageWorklist iflows
= installInitialWorkflows iflows
>>| manageWorkInSession
import StdDebug
installInitialWorkflows ::[Workflow] -> Task ()
installInitialWorkflows [] = return ()
installInitialWorkflows iflows
= try (get workflows) (\(StoreReadBuildVersionError _) -> return [])
= try (get workflows) (\(StoreReadBuildVersionError _) -> trace_n "Error installing flows" (return []))
>>= \flows -> case flows of
[] = set iflows workflows @! ()
[] = trace_n ("Setting flows: " +++ toString (length iflows)) (set iflows workflows @! ())
_ = return ()
loginAndManageWorkList :: !String ![Workflow] -> Task ()
......@@ -312,12 +313,14 @@ where
//Look in the catalog for an entry that has the same path as
//the 'catalogId' that is stored in the incompatible task instance's properties
findReplacement taskId
= get (sdsFocus taskId (taskListEntryMeta topLevelTasks) |*| workflows)
= get (((sdsFocus taskId (taskListEntryMeta topLevelTasks)) |*| workflows) f)
@ \(taskListEntry,catalog) -> maybe Nothing (lookup catalog) ('DM'.get "catalogId" taskListEntry.TaskListItem.attributes)
where
lookup [wf=:{Workflow|path}:wfs] cid = if (path == cid) (Just wf) (lookup wfs cid)
lookup [] _ = Nothing
f ({TaskListItem|attributes}, r) = (attributes, r)
appendOnce :: TaskId (Task a) (SharedTaskList a) -> Task () | iTask a
appendOnce identity task slist
= get (taskListMeta slist)
......
......@@ -188,15 +188,16 @@ authServerInfoShare :: SDSLens () String String
authServerInfoShare = sharedStore "authServer" ""
currentDistributedUser :: SDSParallel () (User,Domain) (User,Domain)
currentDistributedUser = sdsParallel "communicationDetailsByNo" param read (SDSWriteConst writel) (SDSWriteConst writer) currentUser authServerInfoShare
currentDistributedUser = sdsParallel "communicationDetailsByNo" param read (SDSWriteConst writel) (SDSWriteConst writer) reducer currentUser authServerInfoShare
where
param p = (p,p)
read (user,domain) = (user,Domain domain)
writel _ (x,_) = Ok (Just x)
writer _ (_, Domain y) = Ok (Just y)
writel _ (x,_) = Ok (DoWrite x)
writer _ (_, Domain y) = Ok (DoWrite y)
reducer p (u, d) = Ok (u, Domain d)
currentDomain :: SDSLens () Domain ()
currentDomain = toReadOnly (mapRead (\domain -> Domain domain) authServerInfoShare)
currentDomain = toReadOnly (mapRead (\domain -> Domain domain) authServerInfoShare) (\(Domain d). d)
enterDomain :: Task Domain
enterDomain
......
......@@ -49,7 +49,7 @@ proxyTask value_share onDestroy = Task eval
eval event evalOpts tree=:(TCInit taskId ts) iworld
# (val,iworld) = readRegister taskId value_share iworld
= case val of
Ok (Result val) = (ValueResult val {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} (rep event) tree, iworld)
Ok (ReadResult val) = (ValueResult val {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} (rep event) tree, iworld)
Error e = (ExceptionResult e,iworld)
eval event repAs (TCDestroy _) iworld
# iworld = onDestroy iworld
......
definition module iTasks.Extensions.Distributed._Formatter
import StdMaybe
import symbols_in_program
deserializeFromBase64 :: String !{#Symbol} -> a
......
......@@ -5,12 +5,17 @@ import symbols_in_program
import _SystemArray
import Text.Encodings.Base64
import iTasks
import StdMisc
deserializeFromBase64 :: String !{#Symbol} -> a
deserializeFromBase64 input symbols
= case json (toString (base64Decode input)) of
(Just data) # (x, y, z) = deserializeFromString data
= fst (copy_from_string_with_names x y z symbols)
# decoded = base64Decode input
# string = toString decoded
# json = json string
= case json of
(Just data) # (x, y, z) = deserializeFromString data
= fst (copy_from_string_with_names x y z symbols)
Nothing = abort ("Could not deserialize.\nInput:\n" +++ input +++ "\n\nString:\n" +++ string)
// We evaluate the argument to normal form due to some unknown laziness which creates dependency on the whole iTasks library.
eval :: !a -> Bool
......
......@@ -124,15 +124,17 @@ where
derive class iTask Credentials
currentUser :: SDSLens () User User
currentUser = sdsLens "currentUser" id (SDSRead userFromAttr) (SDSWrite userToAttr) (SDSNotify notify) currentTaskInstanceAttributes
currentUser = sdsLens "currentUser" id (SDSRead userFromAttr) (SDSWrite userToAttr) (SDSNotify notify) reducer currentTaskInstanceAttributes
where
notify _ _ _ = const (const True)
taskInstanceUser :: SDSLens InstanceNo User User
taskInstanceUser = sdsLens "taskInstanceUser" id (SDSRead userFromAttr) (SDSWrite userToAttr) (SDSNotify notify) taskInstanceAttributesByNo
taskInstanceUser = sdsLens "taskInstanceUser" id (SDSRead userFromAttr) (SDSWrite userToAttr) (SDSNotify notify) reducer taskInstanceAttributesByNo
where
notify _ _ _ = const (const True)
reducer p ws = userFromAttr () ws
userFromAttr :: a TaskAttributes -> MaybeError TaskException User
userFromAttr _ attr = case 'DM'.get "auth-user" attr of
Just userId = Ok (AuthenticatedUser userId (maybe [] (split ",") ('DM'.get "auth-roles" attr)) ('DM'.get "auth-title" attr))
......@@ -140,25 +142,25 @@ userFromAttr _ attr = case 'DM'.get "auth-user" attr of
Just session = Ok (AnonymousUser session)
_ = Ok SystemUser
userToAttr :: a TaskAttributes User -> MaybeError TaskException (Maybe TaskAttributes)
userToAttr :: a TaskAttributes User -> MaybeError TaskException (MaybeSDSWrite TaskAttributes)
userToAttr _ attr (AuthenticatedUser userId userRoles userTitle)
//Update user properties
# attr = 'DM'.put "auth-user" userId attr
# attr = if (isEmpty userRoles) ('DM'.del "auth-roles" attr) ('DM'.put "auth-roles" (join "," userRoles) attr)
# attr = maybe ('DM'.del "auth-title" attr) (\title -> 'DM'.put "auth-title" title attr) userTitle
= Ok (Just attr)
= Ok (DoWrite attr)
userToAttr _ attr _
//Remove user properties
# attr = 'DM'.del "auth-user" attr
# attr = 'DM'.del "auth-roles" attr
# attr = 'DM'.del "auth-title" attr
= Ok (Just attr)
= Ok (DoWrite attr)
processesForUser :: User -> SDSLens () [TaskListItem ()] ()
processesForUser user = mapRead (filter (forWorker user)) currentProcesses
processesForCurrentUser :: SDSLens () [TaskListItem ()] ()
processesForCurrentUser = mapRead readPrj (currentProcesses >*| currentUser)
processesForCurrentUser = mapRead readPrj ((currentProcesses >*| currentUser) id)
where
readPrj (items,user) = filter (forWorker user) items
......@@ -173,10 +175,10 @@ forWorker user {TaskListItem|attributes} = case 'DM'.get "user" attributes of
Nothing = True
taskInstancesForUser :: SDSLens User [TaskInstance] ()
taskInstancesForUser = sdsLens "taskInstancesForUser" (const ()) (SDSRead read) (SDSWriteConst write) (SDSNotify notify) detachedTaskInstances
taskInstancesForUser = sdsLens "taskInstancesForUser" (const ()) (SDSRead read) (SDSWriteConst write) (SDSNotify notify) (\_ _ -> Ok ()) detachedTaskInstances
where
read u instances = Ok (filter (forUser u) instances)
write _ () = Ok Nothing
write _ () = Ok (DoNotWrite ())
notify _ _ _ = const (const False)
forUser user {TaskInstance|attributes} = case 'DM'.get "user" attributes of
......@@ -196,7 +198,7 @@ taskInstancesForCurrentUser
id
(\() u -> u)
(\_ _ -> Right snd)
(SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ _ -> Ok Nothing)) currentUser taskInstancesForUser
(SDSWrite (\_ u _ -> Ok (DoNotWrite u))) (SDSWriteConst (\_ _ -> Ok (DoNotWrite ()))) (\_ _ -> Ok ()) currentUser taskInstancesForUser
workOn :: !t -> Task AttachmentStatus | toInstanceNo t
workOn t
......
......@@ -60,9 +60,9 @@ serveWebService port handler
@! ()
where
manageConnections io
= tcplisten port False (currentTimestamp |*< io)
= tcplisten port False ((currentTimespec |*< io) (const ()))
{ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect}
onConnect client_name (now,io)
= (Ok (Idle client_name now), Nothing, [], False)
......
......@@ -5,21 +5,22 @@ from iTasks.WF.Definition import :: TaskId
from iTasks.Internal.IWorld import :: IOState, :: IOStates
from iTasks.Internal.SDS import :: SDSIdentity, :: SDSNotifyRequest
:: SDSRequest p r w sds = SDSReadRequest (sds p r w) (Maybe (TaskId, Int)) & TC r & Readable sds
| SDSWriteRequest (sds p r w) w & TC r & TC w & Writable sds
| SDSModifyRequest (sds p r w) (r -> w) & TC r & TC w & Readable, Writable sds
:: SDSRequest p r w = E. sds: SDSReadRequest (sds p r w) p & gText{|*|} p & TC p & TC r & TC w & Readable sds
| E. sds: SDSRegisterRequest (sds p r w) p SDSIdentity TaskId Int & gText{|*|} p & TC p & TC r & TC w & Registrable sds & Readable sds