X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskDevice.icl;h=95c549e32508c456e7139f8cba2d2b2f058a8ba4;hb=fcb4abeb34dc3302f15b10c3b916bc14e3047707;hp=a99097ddea029cadf935362c6e853397e392aa1f;hpb=c518754bec4758cce7d899463f9c68612c3bf4e4;p=mTask.git diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index a99097d..95c549e 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -30,6 +30,12 @@ startupDevices :: Task [MTaskDevice] startupDevices = upd (map reset) deviceStore where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing} +withDevice :: (MTaskDevice -> Task a) String -> Task a | iTask a +withDevice f s = get deviceStore + >>= \ds->case 'DL'.find (\d->d.deviceName == s) ds of + Nothing = throw "Device not available" + Just d = f d + makeDevice :: String MTaskResource -> Task MTaskDevice makeDevice name res = get randomInt @ \rand->{MTaskDevice |deviceChannels=name +++ toString rand @@ -96,33 +102,32 @@ 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 (removeShares d) sdsStore + >>| cleanSharesDevice d.deviceName @! () - sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels) sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! () -deviceTaskAcked :: MTaskDevice Int -> Task () -deviceTaskAcked dev i - = withDevices dev (\d->{d&deviceTasks=ackFirst d.deviceTasks}) +deviceTaskAcked :: MTaskDevice Int Int -> Task () +deviceTaskAcked dev i mem + = withDevices dev (\d->{d + &deviceTasks=ackFirst d.deviceTasks + ,deviceSpec=Just {fromJust d.deviceSpec & bytesMemory=mem}}) where ackFirst :: [MTaskTask] -> [MTaskTask] ackFirst [] = [] ackFirst [t:ts] = if (t.ident == -1) [{t & ident=i}:ts] [t:ackFirst ts] -getDevice :: String -> Task MTaskDevice -getDevice n = get deviceStore @ fromJust o 'DL'.find (\s->s.deviceName == n) - deviceTaskDelete :: MTaskDevice MTaskTask -> Task () deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! () deviceTaskDeleteAcked :: MTaskDevice Int -> Task () -deviceTaskDeleteAcked d i = withDevices d $ deleteTask +deviceTaskDeleteAcked d i = cleanSharesTask i d + >>| withDevices d deleteTask where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]} deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task ()