X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Tasks%2FmTaskTask.icl;h=d586f4f7e592b46bca4de6a3bdab560bd317d43b;hb=HEAD;hp=845c07724610f11840b731cad199f89b4f84b77b;hpb=c518754bec4758cce7d899463f9c68612c3bf4e4;p=mTask.git diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl index 845c077..d586f4f 100644 --- a/Tasks/mTaskTask.icl +++ b/Tasks/mTaskTask.icl @@ -3,37 +3,40 @@ implementation module Tasks.mTaskTask import mTask import iTasks import Devices.mTaskDevice - +import Data.List +from Data.Func import $ import iTasks._Framework.Serialization derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, RWST, Identity makeTask :: String Int -> Task MTaskTask -makeTask name ident = get currentDateTime +makeTask name ident = get currentDateTime @ \dt->{MTaskTask | name=name,ident=ident,dateAdded=dt} -sendTaskToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () -sendTaskToDevice wta mTask (device, timeout) = - get bcStateStore @ toMessages timeout mTask - >>= \(msgs, st1)->set st1 bcStateStore - >>| toSDSRecords msgs st1 device - >>= \sdss->upd (mergeShares sdss) sdsStore +import StdDebug +import StdMisc +sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task MTaskTask +sendTaskToDevice wta mTask (device, timeout) +# (msgs, newState=:{sdss}) = toMessages timeout mTask device.deviceState +# shares = [makeShare wta "" sdsi sdsval\\{sdsi,sdsval}<-sdss, (MTSds sdsi` _)<-msgs | sdsi == sdsi`] += updateShares device ((++) shares) >>| sendMessages msgs device >>| makeTask wta -1 - >>= withDevices device o addTask - @! () + >>= \t->upd (addTaskUpState newState t) (deviceShare device) + >>| wait "Waiting for task to be acked" (taskAcked t) (deviceShare device) + >>| treturn t where - sharename i = device.deviceChannels +++ "-" +++ toString i - - toSDSRecords :: [MTaskMSGSend] BCState MTaskDevice -> Task [MTaskShare] - toSDSRecords s st device = sequence "" - [makeShare wta device.deviceName sdsi sdsval - \\{sdsi,sdspub,sdsval}<-st.sdss - , (MTSds sdsi` _)<-s - | sdsi == sdsi`] - - mergeShares a b = a ++ b - - addTask :: MTaskTask MTaskDevice -> MTaskDevice - addTask task device = {device & deviceTasks=[task:device.deviceTasks]} + addTaskUpState :: BCState MTaskTask MTaskDevice -> MTaskDevice + addTaskUpState st task device = { MTaskDevice | device & + deviceState=st, deviceTasks=[task:device.deviceTasks]} + taskAcked t d = maybe True (\t->t.ident <> -1) $ find (eq t) d.deviceTasks + eq t1 t2 = t1.dateAdded == t2.dateAdded && + t1.MTaskTask.name == t2.MTaskTask.name + +liftmTask :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () +liftmTask wta mTask c=:(dev, _)= sendTaskToDevice wta mTask c + >>= \t->wait "Waiting for mTask to return" (taskRemoved t) (deviceShare dev) + >>| viewInformation "Done!" [] () +where + taskRemoved t d = isNothing $ find (\t1->t1.ident==t.ident) d.deviceTasks