Devices/mTaskDevice.icl

   1 implementation module Devices.mTaskDevice
   2
   3 import Generics.gCons
   4 import mTaskInterpret
   5 import iTasks
   6 import iTasksTTY
   7 import TTY
   8 import qualified Data.Map as DM
   9 import Utils.SDS
  10
  11 import GenBimap
  12 import Devices.mTaskSerial
  13 import Devices.mTaskTCP
  14 import iTasks._Framework.Store
  15
  16 from Data.Func import $
  17
  18 derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
  19 derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
  20 derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
  21
  22 channels :: MTaskDevice -> Shared Channels
  23 channels d = memoryShare d.deviceChannels ([], [], False)
  24
  25 makeDevice :: String MTaskResource -> Task MTaskDevice
  26 makeDevice name res = get randomInt @ \rand->{MTaskDevice
  27                 |deviceChannels=name +++ toString rand
  28                 ,deviceName=name
  29                 ,deviceTasks=[]
  30                 ,deviceTask=Nothing
  31                 ,deviceData=res}
  32
  33 getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
  34 getSynFun (TCPDevice t) = synFun t
  35 getSynFun (SerialDevice t) = synFun t
  36
  37 addDevice :: (Shared [MTaskDevice]) -> Task String
  38 addDevice devices = enterChoice "Device type" [] (map consName{|*|} deviceTypes)
  39         >&^ \sh->whileUnchanged sh $ \mty->case mty of
  40                 Nothing = viewInformation "No type selected yet" [] ""
  41                 Just ty = enterInformation "Name" [] -&&- deviceSettings ty
  42                         >>= \(name, settings)->makeDevice name settings
  43                         >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch=channels dev in getSynFun dev.deviceData ch)
  44                         >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
  45                         @! ""
  46         where
  47                 deviceSettings "SerialDevice" = getmTaskSerialDevice
  48                 deviceSettings "TCPDevice" = getmTaskTCPDevice
  49
  50                 deviceTypes :: [MTaskResource]
  51                 deviceTypes = conses{|*|}
  52
  53 viewDevices :: [MTaskDevice] -> Task ()
  54 viewDevices ds = anyTask [
  55                 addDevice deviceStore <<@ Title "Add new device" @! ():
  56                         [viewDevice d <<@ Title d.deviceName\\d<-ds]]
  57         <<@ ArrangeWithTabs @! ()
  58
  59 viewDevice :: MTaskDevice -> Task ()
  60 viewDevice d = (viewInformation "Device settings" [] d
  61                 ||- viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
  62                 ) <<@ ArrangeHorizontal
  63         where
  64                 dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)