miTaskDevices.icl

   1 implementation module miTaskDevices
   2
   3 import mTask
   4 import iTasks
   5
   6 :: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
   7 :: TCPDevice = {hostname :: String, port :: Int}
   8 :: SerialDevice = {settings :: TTYSettings}
   9
  10 :: DeviceType = SerialDevice | TCPDevice
  11
  12 derive class iTask TCPDevice, SerialDevice, DeviceType
  13
  14 getmTaskDevice :: Task a | mTaskDevice a
  15 getmTaskDevice = enterInformation "Device type" []
  16         >&^ \st->whileUnchanged st $ \dt->case dt of
  17                 Nothing = viewInformation "No type selected yet" [] Nothing
  18                 Just SerialDevice = getSerialDevice @ pure
  19                 Just TCPDevice = getTDevice @ pure
  20         >>* [OnValue (ifValue isJust fromJust)]
  21         where
  22                 getSD :: Task SerialDevice
  23                 getSD = entermTaskDevice
  24                 getTD :: Task TCPDevice
  25                 getTD = entermTaskDevice
  26
  27 instance mTaskDevice TCPDevice where
  28         entermTaskDevice = enterInformation "" []
  29         viewmTaskDevice = viewInformation "" []
  30         syncTask d ch = catchAll (
  31                         tcpconnect d.host d.port ch {ConnectionHandlers|
  32                                 onConnect=onConnect,
  33                                 whileConnected=whileConnected,
  34                                 onDisconnect=onDisconnect} @! ())
  35                 (\v->traceValue v @! ())
  36                 where
  37                         onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
  38                         onConnect _ (msgs,send,sendStopped) = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
  39
  40                         whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
  41                         whileConnected Nothing acc (msgs,send,sendStopped) = (Ok acc, Nothing, [], False)
  42                         whileConnected (Just newData) acc (msgs,send,sendStopped) = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
  43
  44                         onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
  45                         onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)
  46
  47 instance mTaskDevice SerialDevice where
  48         entermTaskDevice = enterTTYSettings >>= \s->{SerialDevice|settings=s}
  49         viewmTaskDevice = viewInformation "" []
  50         syncTask d ch = syncSerialSettings d.settings encode decode ch