From 5eea2c72f8347401784746b5ca3aee99799e49fb Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 15 Jun 2017 16:53:13 +0200 Subject: [PATCH] update to new iTasks system, some error, heap full --- Devices/mTaskTCP.icl | 45 +++++++++++++++++++++++--------------------- miTask.icl | 3 ++- 2 files changed, 26 insertions(+), 22 deletions(-) diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl index 4ebc1ac..9d810ef 100644 --- a/Devices/mTaskTCP.icl +++ b/Devices/mTaskTCP.icl @@ -14,34 +14,37 @@ 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 = tcpconnect s.host s.port channels {ConnectionHandlers| onConnect=onConnect, - whileConnected=whileConnected, + onData=onData, + onShareChange=onShareChange, onDisconnect=onDisconnect} @! () where - onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) + onConnect :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool) 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) - //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))) + onData :: String String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool) + onData newdata acc (msgs,send,True) = (Ok acc, Nothing, [], True) + onData newdata acc (msgs,send,sendStopped) + # 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 _ (msgs,send,sendStopped) = (Ok "", Nothing) + onShareChange :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool) + // Stop! + 0onShareChange acc (msgs,send,True) = (Ok acc, Nothing, [], True) + // Nothing to send + onShareChange acc (msgs,[], _) = (Ok acc, Nothing, [], False) + // Something to send + onShareChange acc (msgs,send, ss) = (Ok acc, Just (msgs,[],ss), map encode send, False) + + onDisconnect :: String ChD -> (MaybeErrorString String, Maybe ChD) + onDisconnect _ (msgs,send,_) = (Ok "", Just ([], [], True)) diff --git a/miTask.icl b/miTask.icl index 2a80f5c..918b414 100644 --- a/miTask.icl +++ b/miTask.icl @@ -26,10 +26,11 @@ import TTY, iTasksTTY Start world = startEngine [ publish "/manage" $ const $ mTaskManager - >>* [OnAction (Action "Shutdown") (always $ shutDown)], + >>* [OnAction (Action "Shutdown") (always $ shutDown 0)], publish "/" $ const demo ] world +demo :: Task () demo = viewSharedInformation "Devices" [] deviceStoreNP >>* [OnValue $ ifValue pred (cont o hd)] where -- 2.20.1