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         | not (trace_tn "synFun started") = undef
  23         = tcpconnect s.host s.port channels {ConnectionHandlers|
  24                                 onConnect=onConnect,
  25                                 onData=onData,
  26                                 onShareChange=onShareChange,
  27                                 onDisconnect=onDisconnect} >>= \_->viewInformation "done" [] "done" @! ()
  28                 where
  29                         onConnect :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
  30                         onConnect acc (msgs,send,sendStopped)
  31                         | not (trace_tn "onConnect") = undef
  32                         | isEmpty send = (Ok "", Nothing, [], False)
  33                         = (Ok "", Just (msgs, [], sendStopped), map encode send, False)
  34
  35                         onData :: String String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
  36                         onData newdata acc (msgs,send,True)
  37                         | not (trace_tn "onData: stop") = undef
  38                         = (Ok acc, Nothing, [], True)
  39                         onData newdata acc (msgs,send,sendStopped)
  40                         | not (trace_tn "onData: notstop") = undef
  41                         # split = indexOf "\n" newdata
  42                         | split == -1 = (Ok acc, Just (msgs, send, False), [], False)
  43                         # newMsg = decode (newdata % (0, split-1))
  44                         // Recurse with smaller data, empty accumulator and new message
  45                         = onData (newdata % (split+1, size newdata - split))
  46                                 "" (msgs ++ [newMsg], send, False)
  47
  48                         onShareChange :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
  49                         // Stop!
  50                         onShareChange acc (msgs,send,True)
  51                         | not (trace_tn "onSC: stop") = undef
  52                         = (Ok acc, Nothing, [], True)
  53                         // Nothing to send
  54                         onShareChange acc (msgs,[], _) = (Ok acc, Nothing, [], False)
  55                         // Something to send
  56                         onShareChange acc (msgs,send, ss)
  57                         | not (trace_tn "onSC: send") = undef
  58                         = (Ok acc, Just (msgs,[],ss), map encode send, False)
  59
  60                         onDisconnect :: String ChD -> (MaybeErrorString String, Maybe ChD)
  61                         onDisconnect _ (msgs,send,_)
  62                         | not (trace_tn "ondisconnect") = undef
  63                         = (Ok "", Just ([], [], True))