X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskTCP.icl;h=48dc193f875adc420a252b9eba83fa6ab40073a2;hb=17aaf6797b3dd4e820b186a55335a36a89ea92cb;hp=bf05e0549485d2899b800a3b0048f8a1ad70fdca;hpb=00fec1dc0792381759d7cfbfb55f17996a11f1a4;p=mTask.git diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl index bf05e05..48dc193 100644 --- a/Devices/mTaskTCP.icl +++ b/Devices/mTaskTCP.icl @@ -1,28 +1,64 @@ 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" [] +:: ChD :== ([MTaskMSGRecv], [MTaskMSGSend], Bool) + instance MTaskDuplex TCPSettings where synFun :: TCPSettings (Shared Channels) -> Task () - synFun s channels = catchAll ( - tcpconnect s.host s.port channels {ConnectionHandlers| + synFun s channels + | not (trace_tn "synFun started") = undef + = tcpconnect s.host s.port channels {ConnectionHandlers| onConnect=onConnect, - whileConnected=whileConnected, - onDisconnect=onDisconnect} @! ()) - (\v->traceValue v @! ()) + onData=onData, + onShareChange=onShareChange, + onDisconnect=onDisconnect} >>= \_->viewInformation "done" [] "done" @! () 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 :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool) + onConnect acc (msgs,send,sendStopped) + | not (trace_tn "onConnect") = undef + = (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) + onData :: String String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool) + onData newdata acc (msgs,send,True) + | not (trace_tn "onData: stop") = undef + = (Ok acc, Nothing, [], True) + onData newdata acc (msgs,send,sendStopped) + | not (trace_tn "onData: notstop") = undef + # split = indexOf "\n" newdata + | split == -1 = (Ok acc, Just (msgs, send, True), [], False) + # newMsg = decode (newdata % (0, split-1)) + // Recurse with smaller data, empty accumulator and new message + = onData (newdata % (split+1, size newdata - split)) + "" (msgs ++ [newMsg], send, False) - onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool)) - onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing) + onShareChange :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool) + // Stop! + onShareChange acc (msgs,send,True) + | not (trace_tn "onSC: stop") = undef + = (Ok acc, Nothing, [], True) + // Nothing to send + onShareChange acc (msgs,[], _) + | not (trace_tn "onSC: nothing") = undef + = (Ok acc, Nothing, [], False) + // Something to send + onShareChange acc (msgs,send, ss) + | not (trace_tn "onSC: send") = undef + = (Ok acc, Just (msgs,[],ss), map encode send, False) + + onDisconnect :: String ChD -> (MaybeErrorString String, Maybe ChD) + onDisconnect _ (msgs,send,_) + | not (trace_tn "ondisconnect") = undef + = (Ok "", Just ([], [], True))