X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskTCP.icl;h=4ebc1ac223898681f3825acaf209806d8eebde19;hb=a2df77cbda43d5a24eeb8ac7db7452baae9f18aa;hp=bf05e0549485d2899b800a3b0048f8a1ad70fdca;hpb=00fec1dc0792381759d7cfbfb55f17996a11f1a4;p=mTask.git diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl index bf05e05..4ebc1ac 100644 --- a/Devices/mTaskTCP.icl +++ b/Devices/mTaskTCP.icl @@ -1,28 +1,47 @@ implementation module Devices.mTaskTCP +import GenPrint +import StdDebug import Devices.mTaskDevice import iTasks +from Data.Tuple import appSnd +from Data.Maybe import fromMaybe +from Text import class Text(indexOf), instance Text String derive class iTask TCPSettings +derive gPrint MTaskMSGRecv getmTaskTCPDevice :: Task MTaskResource getmTaskTCPDevice = TCPDevice <$> enterInformation "Settings" [] instance MTaskDuplex TCPSettings where synFun :: TCPSettings (Shared Channels) -> Task () - synFun s channels = catchAll ( + synFun s channels = tcpconnect s.host s.port channels {ConnectionHandlers| onConnect=onConnect, whileConnected=whileConnected, - onDisconnect=onDisconnect} @! ()) - (\v->traceValue v @! ()) + onDisconnect=onDisconnect} @! () where onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) - onConnect _ (msgs,send,sendStopped) = (Ok "", Just (msgs,[],sendStopped), map encode send, False) + onConnect acc (msgs,send,sendStopped) = (Ok "", Just (msgs,[],sendStopped), map encode send, False) whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) - whileConnected Nothing acc (msgs,send,sendStopped) = (Ok acc, Nothing, [], False) - whileConnected (Just newData) acc (msgs,send,sendStopped) = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False) + //We stop + whileConnected _ _ (_,_,True) = (Ok "", Nothing, [], True) + //No new data and nothing to send + whileConnected Nothing acc (_,[],_) = (Ok acc, Nothing, [], False) + //New data and possibly something to send + whileConnected newdata acc (msgs,send,sendStopped) + # (acc, nd) = process (acc +++ fromMaybe "" newdata) + | isEmpty nd && isEmpty send = (Ok acc, Nothing, [], False) + = (Ok acc, Just (msgs++map decode nd,[],sendStopped), map encode send, False) + + process :: String -> (String, [String]) + process s + | not (trace_tn ("process: " +++ toString (toJSON s))) = undef + = case indexOf "\n" s of + -1 = (s, []) + i = appSnd (\ss->[s % (0,i-1):ss]) (process (s % (i+1, size s))) onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool)) - onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing) + onDisconnect _ (msgs,send,sendStopped) = (Ok "", Nothing)