start with management tasks

[mTask.git] / miTask.icl

diff --git a/miTask.icl b/miTask.icl
index 2757450..e81f47d 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -8,6 +8,7 @@ import mTask
 
 from Text import class Text(startsWith,concat,split,join), instance Text String
 
 
 from Text import class Text(startsWith,concat,split,join), instance Text String
 

+from Data.Func import $

 import Data.Tuple
 import System.Directory
 
 import Data.Tuple
 import System.Directory
 


@@ -23,11 +24,15 @@ 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 = SerialDevice String TTYSettings | TCPDevice String Int

 
 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)


@@ -54,7 +59,6 @@ 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}
 

-

 withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a
 withDevice t = withShared ([], [], False) \ch->
                enterInformation "Type" []
 withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a
 withDevice t = withShared ([], [], False) \ch->
                enterInformation "Type" []


@@ -73,6 +77,30 @@ 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"]
 

+mTaskManager :: Task ()
+mTaskManager = viewSharedInformation "Devices" [] deviceStore
+       ||- forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) @! ()
+       where
+               deviceStore :: Shared [MTaskDevice]
+               deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just [])
+
+addDevice :: Task MTaskDevice
+addDevice = enterInformation "Enter device type" []
+       >>= \ty->case ty of
+               TCP = (enterInformation "Host" [] -&&- enterInformation "Port" [])
+                       >>= return o uncurry TCPDevice
+               Serial = accWorld getDevices
+                       >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
+                       >>= return o uncurry SerialDevice
+       where
+               getDevices :: !*World -> *(![String], !*World)
+               getDevices w = case readDirectory "/dev" w of
+                       (Error (errcode, errmsg), w) = abort errmsg
+                       (Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w)
+                       where
+                               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->
 mTaskTask :: Task ()
 mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
        withDevice \ch->


@@ -82,7 +110,7 @@ mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
                                >>= \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)
                                >>= \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" [ViewWith lens] ch
+               ||- viewSharedInformation "channels" [ViewAs lens] ch

                ||- viewSharedInformation "messages" [] messageShare
                ||- viewSh sdsShares ch
                >>* [OnAction ActionFinish (always shutDown)]
                ||- viewSharedInformation "messages" [] messageShare
                ||- viewSh sdsShares ch
                >>* [OnAction ActionFinish (always shutDown)]


@@ -112,7 +140,8 @@ mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
                = updateSDSs xs m n
                updateSDSs _ m mtm = case mtm of
                        MTMessage s = upd (\l->take 5 [s:l]) m @! ()
                = 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 @! ()
+                       mta=:(MTTaskAck _) = upd (\l->take 5 [toString mta:l]) m @! ()
+                       //TODO other recv msgs

                        _ = return ()
 
                lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])
                        _ = return ()
 
                lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])


@@ -151,10 +180,10 @@ syncSerialChannel dev opts rw = Task eval
                        # iworld = {iworld & world=world, resources=Just (TTYd tty)}
                        = case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw)) iworld of
                                (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
                        # iworld = {iworld & world=world, resources=Just (TTYd tty)}
                        = case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw)) iworld of
                                (Error e, iworld) = (ExceptionResult (exception "h"), iworld)

-                               (Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoRep (TCBasic taskId ts JSONNull False), iworld)
+                               (Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoChange (TCBasic taskId ts JSONNull False), iworld)

 
                eval _ _ tree=:(TCBasic _ ts _ _) iworld
 
                eval _ _ tree=:(TCBasic _ ts _ _) iworld

-               = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoRep tree, iworld)
+               = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoChange tree, iworld)

 
                eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
                # (TTYd tty) = fromJust resources
 
                eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
                # (TTYd tty) = fromJust resources


@@ -164,10 +193,10 @@ syncSerialChannel dev opts rw = Task eval
                        (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
                        (Ok _, iworld) = (DestroyedResult, iworld)
 
                        (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
                        (Ok _, iworld) = (DestroyedResult, iworld)
 

-serialDeviceBackgroundTask :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) !*IWorld -> *IWorld
+serialDeviceBackgroundTask :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) !*IWorld -> (MaybeError TaskException (), *IWorld)

 serialDeviceBackgroundTask rw iworld
        = case read rw iworld of
 serialDeviceBackgroundTask rw iworld
        = case read rw iworld of

-               (Error e, iworld) = abort "share couldn't be read"
+               (Error e, iworld) = (Error $ exception "share couldn't be read", iworld)

                (Ok (r,s,ss), iworld)
                # (Just (TTYd tty)) = iworld.resources
                # tty = writet (map encode s) tty
                (Ok (r,s,ss), iworld)
                # (Just (TTYd tty)) = iworld.resources
                # tty = writet (map encode s) tty


@@ -178,10 +207,10 @@ serialDeviceBackgroundTask rw iworld
                        = ([decode l], tty)
                # iworld = {iworld & resources=Just (TTYd tty)}
                = case write (r++ml,[],False) rw iworld of
                        = ([decode l], tty)
                # iworld = {iworld & resources=Just (TTYd tty)}
                = case write (r++ml,[],False) rw iworld of

-                       (Error e, iworld) = abort "share couldn't be written"
+                       (Error e, iworld) = (Error $ exception "share couldn't be written", iworld)

                        (Ok _, iworld) = case notify rw iworld of
                        (Ok _, iworld) = case notify rw iworld of

-                               (Error e, iworld) = abort "share couldn't be notified"
-                               (Ok _, iworld) = iworld
+                               (Error e, iworld) = (Error $ exception "share couldn't be notified", iworld)
+                               (Ok _, iworld) = (Ok (), iworld)

        where
                writet :: [String] -> (*TTY -> *TTY)
                writet [] = id
        where
                writet :: [String] -> (*TTY -> *TTY)
                writet [] = id