update to new iTasks system, some error, heap full

diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl
index 4ebc1ac..9d810ef 100644 (file)
--- 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 (file)
--- 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