Devices/mTaskTCP.icl

   1 implementation module Devices.mTaskTCP
   2
   3 import GenPrint
   4 import StdDebug
   5 import Devices.mTaskDevice
   6 import iTasks
   7 from Data.Tuple import appSnd
   8 from Data.Maybe import fromMaybe
   9 from Text import class Text(indexOf), instance Text String
  10
  11 derive class iTask TCPSettings
  12 derive gPrint MTaskMSGRecv
  13
  14 getmTaskTCPDevice :: Task MTaskResource
  15 getmTaskTCPDevice = TCPDevice <$> enterInformation "Settings" []
  16
  17 :: ChD :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
  18
  19 instance MTaskDuplex TCPSettings where
  20         synFun :: TCPSettings (Shared Channels) -> Task ()
  21         synFun s channels =
  22                 tcpconnect s.host s.port channels {ConnectionHandlers|
  23                                 onConnect=onConnect,
  24                                 onData=onData,
  25                                 onShareChange=onShareChange,
  26                                 onDisconnect=onDisconnect} @! ()
  27                 where
  28                         onConnect :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
  29                         onConnect acc (msgs,send,sendStopped) = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
  30
  31                         onData :: String String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
  32                         onData newdata acc (msgs,send,True) = (Ok acc, Nothing, [], True)
  33                         onData newdata acc (msgs,send,sendStopped)
  34                         # split = indexOf "\n" newdata
  35                         | split == -1 = (Ok acc, Just (msgs, send, True), [], False)
  36                         # newMsg = decode (newdata % (0, split-1))
  37                         // Recurse with smaller data, empty accumulator and new message
  38                         = onData (newdata % (split+1, size newdata - split))
  39                                 "" (msgs ++ [newMsg], send, False)
  40
  41                         onShareChange :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
  42                         // Stop!
  43                          0onShareChange acc (msgs,send,True) = (Ok acc, Nothing, [], True)
  44                         // Nothing to send
  45                         onShareChange acc (msgs,[], _) = (Ok acc, Nothing, [], False)
  46                         // Something to send
  47                         onShareChange acc (msgs,send, ss) = (Ok acc, Just (msgs,[],ss), map encode send, False)
  48
  49                         onDisconnect :: String ChD -> (MaybeErrorString String, Maybe ChD)
  50                         onDisconnect _ (msgs,send,_) = (Ok "", Just ([], [], True))