add some task control

[mTask.git] / miTask.icl

diff --git a/miTask.icl b/miTask.icl
index 5436ffe..d84121a 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -10,6 +10,7 @@ from Text import class Text(startsWith,concat,split,join), instance Text String
 
 from Data.Func import $
 import Data.Tuple
 
 from Data.Func import $
 import Data.Tuple

+import Data.List

 import System.Directory
 
 import iTasks.UI.Definition
 import System.Directory
 
 import iTasks.UI.Definition


@@ -24,11 +25,19 @@ import TTY
 derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
 derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 
 derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
 derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 

+derive class iTask MTaskDevice
+

 :: SerTCP = Serial | TCP
 :: *Resource | TTYd !*TTY
 :: SerTCP = Serial | TCP
 :: *Resource | TTYd !*TTY

+:: MTaskDevice = {
+               deviceConnected :: Maybe (Shared ([String], [String], Bool)),
+               deviceName :: String,
+               deviceSettings :: Either (String, Int) (String, TTYSettings)
+       }

 
 Start :: *World -> *World
 
 Start :: *World -> *World

-Start world = startEngine mTaskTask world
+Start world = startEngine (mTaskManager
+       >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world

 //Start world = startEngine mTaskTask world
 
 bc :: Main (ByteCode () Stmt)
 //Start world = startEngine mTaskTask world
 
 bc :: Main (ByteCode () Stmt)


@@ -55,16 +64,69 @@ bc2 d = {main = ledOn d}
 bc3 :: UserLED -> Main (ByteCode () Stmt)
 bc3 d = {main = ledOff d}
 
 bc3 :: UserLED -> Main (ByteCode () Stmt)
 bc3 d = {main = ledOff d}
 

+:: MTaskDeviceStatus = {connected :: Bool, name :: String}
+derive class iTask MTaskDeviceStatus
+
+mTaskManager :: Task ()
+mTaskManager = forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore)
+       ||- viewSharedInformation "Devices" [ViewAs deviceviewer] deviceStore
+       ||- whileUnchanged deviceStore (\m->if (isEmpty m)
+                       (viewInformation "No devices yet" [] "" @! ()) (connectDevice m)) @! ()
+//             )
+       where
+               connectDevice :: [MTaskDevice] -> Task ()
+               connectDevice [] = treturn ()
+               connectDevice [d:ds] = (case d.deviceConnected of
+                       (Just sh) = viewSharedInformation "Buffers" [] sh @! ()
+                       Nothing = viewInformation ("Connect " +++ d.deviceName) [] "" >>* [
+                               OnAction (Action "connect") (const $ Just $ connect d)]
+                       ) -|| connectDevice ds
+
+               connect :: MTaskDevice -> Task ()
+               connect d=:{deviceSettings} = withShared ([], [], False) $ \ch->
+                       case deviceSettings of
+                               Left (host, port) = syncNetworkChannel host port ch
+                               Right (dev, sett) = syncSerialChannel dev sett ch
+                       ||- viewSharedInformation "Buffers" [] ch @! ()
+
+               deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
+               deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
+                       connected = if (isNothing d.deviceConnected) False True}\\d<-ds]
+       
+               deviceStore :: Shared [MTaskDevice]
+               deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just [])

 
 

-withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a
-withDevice t = withShared ([], [], False) \ch->
-               enterInformation "Type" []
-       >>= \ty->case ty of
+//             showTabbed :: [MTaskDevice] -> Task ()
+//             showTabbed [] = viewInformation "" [] "No devices yet" @! ()
+//             showTabbed [l:ls] = foldr (\e es->manageDevice e ||- es) (manageDevice l) ls
+//
+//             manageDevice :: MTaskDevice -> Task ()
+//             manageDevice md = 
+//                             either viewTCP viewSer md.deviceSettings
+//                     ||- maybe
+//                             (treturn () >>* [OnAction (Action "Connect") (always shutDown)] @! ())
+//                             (\b->viewSharedInformation "Buffers" [] b @! ())
+//                             md.deviceConnected
+//                     <<@ ArrangeVertical
+
+               mapPar :: (a -> Task a) [a] -> Task ()
+               mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
+               allAtOnce t = foldr1 (||-) t @! ()
+               //allAtOnce = (flip (@!) ()) o foldr1 (||-)
+
+addDevice :: Task MTaskDevice
+addDevice = enterInformation "Device name" []
+       -&&- enterInformation "Device type" []
+       >>= \(name, ty)->(case ty of

                TCP = (enterInformation "Host" [] -&&- enterInformation "Port" [])
                TCP = (enterInformation "Host" [] -&&- enterInformation "Port" [])

-                       >>= \(port,host)->t ch -|| syncNetworkChannel host port ch
+                       >>= treturn o Left

                Serial = accWorld getDevices
                        >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
                Serial = accWorld getDevices
                        >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)

-                       >>= \(dev,set)->t ch -|| syncSerialChannel dev set ch
+                       >>= treturn o Right
+       ) >>= \set->treturn {MTaskDevice |
+               deviceConnected=Nothing,
+               deviceName=name,
+               deviceSettings=set}

        where
                getDevices :: !*World -> *(![String], !*World)
                getDevices w = case readDirectory "/dev" w of
        where
                getDevices :: !*World -> *(![String], !*World)
                getDevices w = case readDirectory "/dev" w of


@@ -74,68 +136,69 @@ withDevice t = withShared ([], [], False) \ch->
                                isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
                                prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
 
                                isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
                                prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
 

-mTaskTask :: Task ()
-mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
-       withDevice \ch->
-                       sendMsg msgs ch
-               ||- processMessages ch messageShare sdsShares
-               ||- forever (enterChoice "Choose led to enable" [] [LED1, LED2, LED3]
-                               >>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch)
-               ||- forever (enterChoice "Choose led to disable" [] [LED1, LED2, LED3]
-                               >>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch)
-               ||- viewSharedInformation "channels" [ViewAs lens] ch
-               ||- viewSharedInformation "messages" [] messageShare
-               ||- viewSh sdsShares ch
-               >>* [OnAction ActionFinish (always shutDown)]
-       where
-               messageShare :: Shared [String]
-               messageShare = sharedStore "mTaskMessagesRecv" []
-
-               processMessages ch msgs sdss = forever (watch ch
-                       >>* [OnValue (ifValue (not o isEmpty o fst3) (process ch))])
-                       where
-                               process :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> Task ()
-                               process ch (r,_,_) = upd (appFst3 (const [])) ch >>| process` r
-                                       where
-                                               process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ())
-
-               makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
-               makeMsgs timeout bc
-               # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
-               = (msgs, map f st.sdss)
-                       where 
-                               f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d))
-                               dd [x,y] = toInt x*265 + toInt y
-
-               updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
-               updateSDSs [(id, sh):xs] m n=:(MTPub i d)
-               | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
-               = updateSDSs xs m n
-               updateSDSs _ m mtm = case mtm of
-                       MTMessage s = upd (\l->take 5 [s:l]) m @! ()
-                       mta=:(MTTaskAdded _) = upd (\l->take 5 [toString mta:l]) m @! ()
-                       _ = return ()
-
-               lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])
-               lens (r,s,_) = (map toString r, map toString s)
-
-               viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
-               viewSh [] ch = return ()
-               viewSh [(i, sh):xs] ch
-               # sharename = "SDS-" +++ toString i
-               = (
-                               viewSharedInformation ("SDS-" +++ toString i) [] sh ||-
-                               forever (
-                                       enterInformation sharename []
-                                       >>* [OnAction ActionOk 
-                                                       (ifValue (\j->j>=1 && j <= 3) 
-                                                       (\c->set c sh
-                                                               >>= \_->sendMsg (toSDSUpdate i c) ch
-                                                               @! ()
-                                                       )
-                                               )]
-                               )
-                       ) ||- viewSh xs ch
+//mTaskTask :: Task ()
+//mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
+//     withDevice \ch->
+//                     sendMsg msgs ch
+//             ||- processMessages ch messageShare sdsShares
+//             ||- forever (enterChoice "Choose led to enable" [] [LED1, LED2, LED3]
+//                             >>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch)
+//             ||- forever (enterChoice "Choose led to disable" [] [LED1, LED2, LED3]
+//                             >>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch)
+//             ||- viewSharedInformation "channels" [ViewAs lens] ch
+//             ||- viewSharedInformation "messages" [] messageShare
+//             ||- viewSh sdsShares ch
+//             >>* [OnAction ActionFinish (always shutDown)]
+//     where
+//             messageShare :: Shared [String]
+//             messageShare = sharedStore "mTaskMessagesRecv" []
+//
+//             processMessages ch msgs sdss = forever (watch ch
+//                     >>* [OnValue (ifValue (not o isEmpty o fst3) (process ch))])
+//                     where
+//                             process :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> Task ()
+//                             process ch (r,_,_) = upd (appFst3 (const [])) ch >>| process` r
+//                                     where
+//                                             process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ())
+//
+//             makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
+//             makeMsgs timeout bc
+//             # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
+//             = (msgs, map f st.sdss)
+//                     where 
+//                             f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d))
+//                             dd [x,y] = toInt x*265 + toInt y
+//
+//             updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
+//             updateSDSs [(id, sh):xs] m n=:(MTPub i d)
+//             | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
+//             = updateSDSs xs m n
+//             updateSDSs _ m mtm = case mtm of
+//                     MTMessage s = upd (\l->take 5 [s:l]) m @! ()
+//                     mta=:(MTTaskAck _) = upd (\l->take 5 [toString mta:l]) m @! ()
+//                     //TODO other recv msgs
+//                     _ = return ()
+//
+//             lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])
+//             lens (r,s,_) = (map toString r, map toString s)
+//
+//             viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
+//             viewSh [] ch = return ()
+//             viewSh [(i, sh):xs] ch
+//             # sharename = "SDS-" +++ toString i
+//             = (
+//                             viewSharedInformation ("SDS-" +++ toString i) [] sh ||-
+//                             forever (
+//                                     enterInformation sharename []
+//                                     >>* [OnAction ActionOk 
+//                                                     (ifValue (\j->j>=1 && j <= 3) 
+//                                                     (\c->set c sh
+//                                                             >>= \_->sendMsg (toSDSUpdate i c) ch
+//                                                             @! ()
+//                                                     )
+//                                             )]
+//                             )
+//                     ) ||- viewSh xs ch

 
 sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
 sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! ()
 
 sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
 sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! ()