1 implementation module Devices.mTaskTCP
5 import Devices.mTaskDevice
7 from Data.Tuple import appSnd
8 from Text import class Text(indexOf), instance Text String
10 derive class iTask TCPSettings
11 derive gPrint MTaskMSGRecv
13 getmTaskTCPDevice :: Task MTaskResource
14 getmTaskTCPDevice = TCPDevice <$> enterInformation "Settings" []
16 instance MTaskDuplex TCPSettings where
17 synFun :: TCPSettings (Shared Channels) -> Task ()
19 tcpconnect s.host s.port channels {ConnectionHandlers|
21 whileConnected=whileConnected,
22 onDisconnect=onDisconnect} @! ()
24 onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
25 onConnect acc (msgs,send,sendStopped) = (Ok acc, Just (msgs,[],sendStopped), map encode send, False)
27 whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
29 whileConnected _ _ (_,_,True) = (Ok "", Nothing, [], True)
31 //No new data and nothing to send
32 whileConnected Nothing acc (_,[],_) = (Ok acc, Nothing, [], False)
34 //New data and possibly something to send
35 whileConnected (Just newdata) acc (msgs,send,sendStopped)
36 # (acc, nd) = process (acc +++ newdata)
37 | isEmpty nd && isEmpty send = (Ok acc, Nothing, [], False)
38 = (Ok acc, Just (msgs++map decode nd,[],sendStopped), map encode send, False)
40 process :: String -> (String, [String])
41 process s = case indexOf "\n" s of
43 i = appSnd (\ss->[s % (0,i):ss]) (process (s % (i, size s)))
45 onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
46 onDisconnect _ (msgs,send,sendStopped) = (Ok "", Nothing)