better background instance handling

TTY.dcl

@@ -21,6 +21,8 @@ from StdClass import class zero
 
 instance zero TTYSettings
 
+makeTTYSettings :: String BaudRate ByteSize Parity Bool Bool -> TTYSettings
+
 TTYclose :: !*TTY !*env -> (!Bool, !*env)
 TTYerror :: !*env -> (!String, !*env)
 TTYopen :: !TTYSettings !*env -> (!Bool,!*TTY,!*env)

TTY.icl

@@ -34,6 +34,10 @@ instance toInt Parity where
 		ParityNone = 0; ParityOdd = 1; ParityEven = 2; ParitySpace = 3;
 		ParityMark = 4
 
+makeTTYSettings :: String BaudRate ByteSize Parity Bool Bool -> TTYSettings
+makeTTYSettings dp br bs pr sb xx = {TTYSettings | devicePath=dp, baudrate=br,
+	bytesize=bs, parity=pr, stop2bits=sb, xonxoff=xx}
+
 TTYopen :: !TTYSettings !*env -> (!Bool, !*TTY, !*env)
 TTYopen ts w = TTYopen2
 	ts.devicePath

iTasksTTY.dcl

@@ -7,4 +7,6 @@ derive class iTask TTYSettings
 
 getTTYDevices :: !*env -> *(![String], !*env)
 
+enterTTYSettings :: Task TTYSettings
+
 syncSerialChannel :: TTYSettings (b -> String) (String -> a) (Shared ([a],[b],Bool)) -> Task () | iTask a & iTask b

iTasksTTY.icl

@@ -6,9 +6,12 @@ import StdList
 from StdFunc import o, flip
 import StdMisc
 import StdString
+import Data.List
 
 import System.Directory
 import iTasks
+import Data.Tuple
+import Control.Applicative
 from Data.Func import $
 from Text import class Text(startsWith), instance Text String
 
@@ -19,7 +22,7 @@ import iTasks._Framework.TaskServer
 import iTasks._Framework.IWorld
 import iTasks._Framework.Store
 
-:: *Resource | TTYd !*TTY
+:: *Resource | TTYd !*TTY Int
 
 derive class iTask TTYSettings, Parity, BaudRate, ByteSize
 
@@ -31,50 +34,60 @@ getTTYDevices w = case readDirectory "/dev" w of
 		isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
 		prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
 
+enterTTYSettings :: Task TTYSettings
+enterTTYSettings = accWorld getTTYDevices
+	>>= \ds->(((((enterChoice "Device" [] ds
+	-&&- updateInformation "Baudrate" [] B9600)
+	-&&- updateInformation "Bytesize" [] BytesizeEight)
+	-&&- updateInformation "Parity" [] ParityNone)
+	-&&- updateInformation "Stop2bits" [] False)
+	-&&- updateInformation "Xonoff" [] False)
+	@ (uncurry o uncurry o uncurry o uncurry o uncurry) makeTTYSettings
+
 syncSerialChannel :: TTYSettings (b -> String) (String -> a) (Shared ([a],[b],Bool)) -> Task () | iTask a & iTask b
 syncSerialChannel opts enc dec rw = Task eval
 	where
-		eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world}
+		eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world,ioTasks={todo}}
 		= case TTYopen opts world of
 			(False, _, world)
 			# (err, world) = TTYerror world
 			= (ExceptionResult (exception err), {iworld & world=world})
 			(True, tty, world)
-			# iworld = {iworld & world=world, resources=Just (TTYd tty)}
-			= case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw)) iworld of
+			# iworld = {iworld & world=world}
+			= case addBackgroundTask (BackgroundTask (serialDeviceBackgroundTask enc dec rw)) iworld of
 				(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
-				(Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoChange (TCBasic taskId ts JSONNull False), iworld)
+				(Ok bgid, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} rep (TCBasic taskId ts JSONNull False), {iworld & resources=Just (TTYd tty bgid)})
 
 		eval _ _ tree=:(TCBasic _ ts _ _) iworld
-		= (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoChange tree, iworld)
+		= (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} rep tree, iworld)
 
 		eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
-		# (TTYd tty) = fromJust resources
+		# (TTYd tty bgid) = fromJust resources
 		# (ok, world) = TTYclose tty world
 		# iworld = {iworld & world=world,resources=Nothing}
-		= case removeBackgroundTask 42 iworld of
+		= case removeBackgroundTask bgid iworld of
 			(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
 			(Ok _, iworld) = (DestroyedResult, iworld)
 
-//		serialDeviceBackgroundTask :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) !*IWorld -> (MaybeError TaskException (), *IWorld)
-		serialDeviceBackgroundTask rw iworld
-			= case read rw iworld of
-				(Error e, iworld) = (Error $ exception "share couldn't be read", iworld)
-				(Ok (r,s,ss), iworld)
-				# (Just (TTYd tty)) = iworld.resources
-				# tty = writet (map enc s) tty
-				# (ml, tty) = case TTYavailable tty of
-					(False, tty) = ([], tty)
-					(_, tty)
-					# (l, tty) = TTYreadline tty
-					= ([dec l], tty)
-				# iworld = {iworld & resources=Just (TTYd tty)}
-				= case write (r++ml,[],False) rw iworld of
-					(Error e, iworld) = (Error $ exception "share couldn't be written", iworld)
-					(Ok _, iworld) = case notify rw iworld of
-						(Error e, iworld) = (Error $ exception "share couldn't be notified", iworld)
-						(Ok _, iworld) = (Ok (), iworld)
-			where
-				writet :: [String] -> (*TTY -> *TTY)
-				writet [] = id
-				writet [x:xs] = writet xs o TTYwrite x
+		rep = ReplaceUI $ stringDisplay $ "Serial client " <+++ opts.devicePath
+
+serialDeviceBackgroundTask :: (b -> String) (String -> a) (Shared ([a],[b],Bool)) !*IWorld -> (MaybeError TaskException (), *IWorld) | iTask a & iTask b
+serialDeviceBackgroundTask enc dec rw iworld
+	= case read rw iworld of
+		(Error e, iworld) = (Error $ exception "share couldn't be read", iworld)
+		(Ok (r,s,ss), iworld)
+		# (Just (TTYd tty bgid)) = iworld.resources
+		# tty = writet (map enc s) tty
+		# (ml, tty) = case TTYavailable tty of
+			(False, tty) = ([], tty)
+			(_, tty) = appFst (pure o dec) $ TTYreadline tty
+		# iworld = {iworld & resources=Just (TTYd tty bgid)}
+		= case write (r++ml,[],False) rw iworld of
+			(Error e, iworld) = (Error $ exception "share couldn't be written", iworld)
+			(Ok _, iworld) = case notify rw iworld of
+				(Error e, iworld) = (Error $ exception "share couldn't be notified", iworld)
+				(Ok _, iworld) = (Ok (), iworld)
+	where
+		writet :: [String] -> (*TTY -> *TTY)
+		writet [] = id
+		writet [x:xs] = writet xs o TTYwrite x