From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 15 Jun 2017 14:53:13 +0000 (+0200)
Subject: update to new iTasks system, some error, heap full
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=5eea2c72f8347401784746b5ca3aee99799e49fb;p=mTask.git

update to new iTasks system, some error, heap full
---

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