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 instance MTaskDuplex TCPSettings where
  18         synFun :: TCPSettings (Shared Channels) -> Task ()
  19         synFun s channels =
  20                 tcpconnect s.host s.port channels {ConnectionHandlers|
  21                                 onConnect=onConnect,
  22                                 whileConnected=whileConnected,
  23                                 onDisconnect=onDisconnect} @! ()
  24                 where
  25                         onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
  26                         onConnect acc (msgs,send,sendStopped) = (Ok acc, Just (msgs,[],sendStopped), map encode send, False)
  27
  28                         whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
  29                         //We stop
  30                         whileConnected _ _ (_,_,True) = (Ok "", Nothing, [], True)
  31                         //No new data and nothing to send
  32                         whileConnected Nothing acc (_,[],_) = (Ok acc, Nothing, [], False)
  33                         //New data and possibly something to send
  34                         whileConnected newdata acc (msgs,send,sendStopped)
  35                         # (acc, nd) = process (acc +++ fromMaybe "" newdata)
  36                         | isEmpty nd && isEmpty send = (Ok acc, Nothing, [], False)
  37                         = (Ok acc, Just (msgs++map decode nd,[],sendStopped), map encode send, False)
  38
  39                         process :: String -> (String, [String])
  40                         process s = case indexOf "\n" s of
  41                                 -1 = (s, [])
  42                                 i = appSnd (\ss->[s % (0,i):ss]) (process (s % (i+1, size s)))
  43
  44                         onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
  45                         onDisconnect _ (msgs,send,sendStopped) = (Ok "", Nothing)