- viewDevices :: [MTaskDevice] -> Task ()
- viewDevices ds = anyTask [
- addDevice deviceStore <<@ Title "Add new device" @! ():
- [viewDevice d <<@ Title d.deviceName\\d<-ds]]
- <<@ ArrangeWithTabs @! ()
-
- viewDevice :: MTaskDevice -> Task ()
- viewDevice d = (viewInformation "Device settings" [] d
- ||- viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
- ) <<@ ArrangeHorizontal
- where
- dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
-
- addDevice :: (Shared [MTaskDevice]) -> Task SerTCP
- addDevice devices = enterInformation "Device type" []
- >&^ \sh->whileUnchanged sh $ \mty->case mty of
- Nothing = viewInformation "No type selected yet" [] "" @! ()
- Just ty = case ty of
- TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" [])
- >>= \(name, (host, port))->cont name (syncNetworkChannel host port)
- SerialDevice = (enterInformation "Name" [] -&&- enterTTYSettings)
- >>= \(name, set)->cont name (syncSerialChannel set encode decode)
- where
- cont :: String ((Shared Channels) -> Task ()) -> Task ()
- cont name synfun = get randomInt
- @ (\randint->{MTaskDevice |
- deviceChannels=name +++ toString randint,
- deviceName=name,
- deviceTasks=[],
- deviceTask=Nothing})
- >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch)
- >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
- @! ()
-