X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskDevice.icl;h=c8bee618da1aba157a79c0764e05987796e2b14b;hb=a2df77cbda43d5a24eeb8ac7db7452baae9f18aa;hp=6f6480af1167892e0c03594fdab0187a6b7dcb74;hpb=ee38806680e1706a4aea577d1ed699860f1fb0e8;p=mTask.git diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 6f6480a..c8bee61 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -7,6 +7,7 @@ import iTasks import iTasksTTY import TTY import qualified Data.Map as DM +import qualified Data.List as DL import Utils.SDS import Utils.Devices @@ -29,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 @@ -98,22 +105,6 @@ deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d) // >>| upd (removeShares d) sdsStore @! () -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 st1 - >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare - >>| sendMessages msgs device - >>| makeTask wta -1 - >>= withDevices device o addTask - @! () - where - sharename i = device.deviceChannels +++ "-" +++ toString i - 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]} sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels) sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels @@ -121,9 +112,11 @@ 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 [] = []