X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskDevice.icl;fp=Devices%2FmTaskDevice.icl;h=2a0f17ee56d75ffe2f2520281c1d80258d398b41;hb=17aaf6797b3dd4e820b186a55335a36a89ea92cb;hp=f4789ccd160065ee09ca63c45e078225953e19ca;hpb=5eea2c72f8347401784746b5ca3aee99799e49fb;p=mTask.git

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index f4789cc..2a0f17e 100644
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -53,15 +53,18 @@ getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
 getSynFun (TCPDevice t) = synFun t
 getSynFun (SerialDevice t) = synFun t
 
-addDevice :: (Shared [MTaskDevice]) (MTaskDevice (Shared Channels) -> Task ()) -> Task String
-addDevice devices processFun
+addDevice :: (MTaskDevice (Shared Channels) -> Task ()) -> Task String
+addDevice processFun
 	=   enterChoice "Device type" [] (map consName{|*|} deviceTypes)
 	>&^ \sh->whileUnchanged sh $ \mty->case mty of
 		Nothing = viewInformation "No type selected yet" [] ""
 		Just ty = enterInformation "Name" [] -&&- deviceSettings ty
 			>>= \(name, settings)->makeDevice name settings
-			>>= \dev->upd (\l->[dev:l]) devices
+			>>= \dev->traceValue "make device done"
+			>>| upd (\l->[dev:l]) deviceStoreNP
+			>>| traceValue "update deviceslist"
 			>>| connectDevice processFun dev
+			>>| traceValue "device connected"
 			@! ""
 	where
 		deviceSettings "SerialDevice" = getmTaskSerialDevice
@@ -80,7 +83,7 @@ addDevice devices processFun
 //		errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e}) @! ()
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels
 connectDevice procFun device = let ch = channels device
-	in appendTopLevelTask 'DM'.newMap True
+	in traceValue "connectDevice" >>| appendTopLevelTask 'DM'.newMap True
 		(	procFun device ch 
 		-||- catchAll (getSynFun device.deviceData ch) errHdl)
 		>>= \tid->withDevices device (\d->{d&deviceTask=Just tid,deviceError=Nothing})
@@ -88,12 +91,12 @@ connectDevice procFun device = let ch = channels device
 	where
 		errHdl e = withDevices device (\d->{d & deviceTask=Nothing, deviceError=Just e}) @! ()
 
-manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
-manageDevices processFun ds = anyTask [
-		addDevice deviceStoreNP processFun <<@ Title "Add new device" @! ():
-			[viewDevice processFun d 
-				<<@ Title d.deviceName\\d<-ds]]
-	<<@ ArrangeWithTabs @! ()
+manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) -> Task ()
+manageDevices processFun = get deviceStoreNP >>= \ds->anyTask [
+		addDevice processFun <<@ Title "Add new device" @! ():
+			[viewDevice processFun d <<@ Title d.deviceName\\d<-ds]]
+	<<@ ArrangeWithTabs
+	@! ()
 
 viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
 viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask