From: Mart Lubbers Date: Mon, 27 Feb 2017 10:16:49 +0000 (+0100) Subject: equality for devices, externalize tasks X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=71787cb6678d7a0d2014d373af5e55447796f78d;p=mTask.git equality for devices, externalize tasks --- diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl index bae7af6..0e9f567 100644 --- a/Devices/mTaskDevice.dcl +++ b/Devices/mTaskDevice.dcl @@ -29,6 +29,8 @@ channels :: MTaskDevice -> Shared Channels ,deviceData :: MTaskResource } +instance == MTaskDevice + class MTaskDuplex a where synFun :: a (Shared Channels) -> Task () diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 9a93634..4fff9ae 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -1,5 +1,6 @@ implementation module Devices.mTaskDevice +from StdFunc import flip import Generics.gCons import mTaskInterpret import iTasks @@ -19,6 +20,9 @@ derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings +instance == MTaskDevice where + (==) a b = a.deviceChannels == b.deviceChannels + channels :: MTaskDevice -> Shared Channels channels d = memoryShare d.deviceChannels ([], [], False) @@ -60,7 +64,7 @@ manageDevices processFun ds = anyTask [ <<@ ArrangeWithTabs @! () viewDevice :: MTaskDevice -> Task () -viewDevice d = anyTask +viewDevice d = forever $ anyTask [viewInformation "Device settings" [] d @! () ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! () ,forever $ @@ -68,19 +72,25 @@ viewDevice d = anyTask >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)] @! () ] <<@ ArrangeHorizontal + >>* [OnAction (Action "Delete Device") (always $ deleteDevice d)] where dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) +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 + @! () + sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, Int) -> Task () sendToDevice wta mTask (device, timeout) = - get bcStateStore - >>= \st->treturn (toMessages timeout (toRealByteCode (unMain mTask) st)) + get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask) >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare >>| makeShares sdss >>| sendMessage device msgs >>| makeTask wta -1 - >>= \task->withDevices device (addTask timeout task) + >>= withDevices device o addTask timeout @! () where sharename i = device.deviceChannels +++ "-" +++ toString i @@ -99,8 +109,7 @@ sendMessage :: MTaskDevice [MTaskMSGSend] -> Task () sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! () withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () -withDevices a trans = upd (map withDevice) deviceStore @! () - where withDevice b = if (a.deviceChannels == b.deviceChannels) (trans b) b +withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! () deviceTaskAcked :: MTaskDevice Int -> Task () deviceTaskAcked dev i diff --git a/miTask.icl b/miTask.icl index a2ef345..09fb5dd 100644 --- a/miTask.icl +++ b/miTask.icl @@ -35,13 +35,11 @@ mTaskManager = anyTask [ viewmTasks @! () , whileUnchanged sdsStore viewShares , whileUnchanged deviceStore $ manageDevices process - ] <<@ ApplyLayout layout - where - layout = sequenceLayouts + ] <<@ ApplyLayout (sequenceLayouts [ arrangeWithSideBar 0 LeftSide 260 True , arrangeSplit Vertical True - ] - + ]) + where viewmTasks :: Task String viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of