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                         = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
  33
  34                         onData :: String String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
  35                         onData newdata acc (msgs,send,True)
  36                         | not (trace_tn "onData: stop") = undef
  37                         = (Ok acc, Nothing, [], True)
  38                         onData newdata acc (msgs,send,sendStopped)
  39                         | not (trace_tn "onData: notstop") = undef
  40                         # split = indexOf "\n" newdata
  41                         | split == -1 = (Ok acc, Just (msgs, send, True), [], False)
  42                         # newMsg = decode (newdata % (0, split-1))
  43                         // Recurse with smaller data, empty accumulator and new message
  44                         = onData (newdata % (split+1, size newdata - split))
  45                                 "" (msgs ++ [newMsg], send, False)
  46
  47                         onShareChange :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
  48                         // Stop!
  49                         onShareChange acc (msgs,send,True)
  50                         | not (trace_tn "onSC: stop") = undef
  51                         = (Ok acc, Nothing, [], True)
  52                         // Nothing to send
  53                         onShareChange acc (msgs,[], _)
  54                         | not (trace_tn "onSC: nothing") = undef
  55                         = (Ok acc, Nothing, [], False)
  56                         // Something to send
  57                         onShareChange acc (msgs,send, ss)
  58                         | not (trace_tn "onSC: send") = undef
  59                         = (Ok acc, Just (msgs,[],ss), map encode send, False)
  60
  61                         onDisconnect :: String ChD -> (MaybeErrorString String, Maybe ChD)
  62                         onDisconnect _ (msgs,send,_)
  63                         | not (trace_tn "ondisconnect") = undef
  64                         = (Ok "", Just ([], [], True))