1 implementation module Devices.mTaskTCP
5 import Devices.mTaskDevice
7 from Data.Tuple import appSnd
8 from Data.Maybe import fromMaybe
9 from Text import class Text(indexOf), instance Text String
11 derive class iTask TCPSettings
12 derive gPrint MTaskMSGRecv
14 getmTaskTCPDevice :: Task MTaskResource
15 getmTaskTCPDevice = TCPDevice <$> enterInformation "Settings" []
17 instance MTaskDuplex TCPSettings where
18 synFun :: TCPSettings (Shared Channels) -> Task ()
20 tcpconnect s.host s.port channels {ConnectionHandlers|
22 whileConnected=whileConnected,
23 onDisconnect=onDisconnect} @! ()
25 onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
26 onConnect acc (msgs,send,sendStopped) = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
28 whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
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)
39 process :: String -> (String, [String])
41 | not (trace_tn ("process: " +++ toString (toJSON s))) = undef
42 = case indexOf "\n" s of
44 i = appSnd (\ss->[s % (0,i-1):ss]) (process (s % (i+1, size s)))
46 onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
47 onDisconnect _ (msgs,send,sendStopped) = (Ok "", Nothing)