X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskDevice.icl;h=9b26455a6d0cc2055cf1074e1a27c8d687225217;hb=be3f747f775c05facb8a34cf0baba523401b88fb;hp=71c6ee21e809d0c7e23c086d3114e88600b01278;hpb=28f4e19f893889e6d19d8c0653a643ae1580fd6d;p=mTask.git diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 71c6ee2..9b26455 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -36,7 +36,8 @@ makeDevice name res = get randomInt @ \rand->{MTaskDevice ,deviceTasks=[] ,deviceTask=Nothing ,deviceError=Nothing - ,deviceData=res} + ,deviceData=res + ,deviceSpec=Nothing} getSynFun :: MTaskResource -> ((Shared Channels) -> Task ()) getSynFun (TCPDevice t) = synFun t @@ -74,7 +75,7 @@ manageDevices processFun ds = anyTask [ <<@ ArrangeWithTabs @! () viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task () -viewDevice pf d = forever $ anyTask +viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask [viewInformation "Device settings" [] d @! () ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! () ,forever $ @@ -91,31 +92,30 @@ viewDevice pf d = forever $ anyTask deleteDevice :: MTaskDevice -> Task () deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d) >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask - >>| upd (filter ((==)d)) deviceStore + >>| upd (filter ((<>)d)) deviceStore @! () sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () sendToDevice wta mTask (device, timeout) = - get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask) - >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords - >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare - >>| makeShares sdss + traceValue "starting to send" + >>| get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask) + >>= \(msgs, st1)->traceValue "messages generated" + >>| set st1 bcStateStore + >>| traceValue "bcstate store updated" + >>| toSDSRecords st1 + >>= \sdss->traceValue "Shares created" + >>| set sdss sdsStore//MTaskShareaddToSDSShare + >>| traceValue "Shares store updated" >>| sendMessages msgs device + >>| traceValue "Messages sent" >>| makeTask wta -1 - >>= withDevices device o addTask + >>= \t->traceValue "Task made" + >>| withDevices device (addTask t) + >>| traceValue "Tasks share updated" @! () where sharename i = device.deviceChannels +++ "-" +++ toString i - toSDSRecords st = [{MTaskShare | - withTask=wta, - identifier=sdsi, - initVal=sdsval, - //We skip the only/local shares - realShare="mTaskSDS-" +++ toString sdsi} - \\{sdsi,sdspub,sdsval}<-st.sdss | sdspub] - - makeShares :: [MTaskShare] -> Task () - makeShares shs = treturn () //foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ()) + toSDSRecords st = sequence "" [makeShare wta sdsi sdsval\\{sdsi,sdspub,sdsval}<-st.sdss]// | sdspub] addTask :: MTaskTask MTaskDevice -> MTaskDevice addTask task device = {device & deviceTasks=[task:device.deviceTasks]} @@ -141,3 +141,6 @@ deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! () deviceTaskDeleteAcked :: MTaskDevice Int -> Task () deviceTaskDeleteAcked d i = withDevices d $ deleteTask where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]} + +deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task () +deviceAddSpec d s = withDevices d $ \r->{MTaskDevice | r & deviceSpec=Just s}