clean up, move iTasks serial stuff to Cleanserial, add toplevel tasks for syncing

[mTask.git] / miTask.icl

diff --git a/miTask.icl b/miTask.icl
index 11daaa9..a20108c 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -23,7 +23,7 @@ import iTasks._Framework.IWorld
 import iTasks._Framework.Store
 
 
 import iTasks._Framework.Store
 
 

-import TTY
+import TTY, iTasksTTY

 
 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


@@ -33,14 +33,40 @@ derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 
 :: SerTCP = SerialDevice | TCPDevice
 :: MTaskDevice = {
 
 :: SerTCP = SerialDevice | TCPDevice
 :: MTaskDevice = {

+               deviceTask :: Maybe TaskId,

                deviceConnected :: Maybe String,
                deviceConnected :: Maybe String,

-               deviceName :: String
+               deviceName :: String,
+               deviceTasks :: [(String, Int)]
+       }
+:: MTaskShare = {
+               initValue :: Int,
+               withTask :: String,
+               identifier :: Int,
+               realShare :: String

        }
 
 Start :: *World -> *World
 Start world = startEngine (mTaskManager
        >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world
 
        }
 
 Start :: *World -> *World
 Start world = startEngine (mTaskManager
        >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world
 

+memoryShare :: String a -> Shared a | iTask a
+memoryShare s d = sdsFocus s $ memoryStore "" $ Just d
+
+deviceStore :: Shared [MTaskDevice]
+deviceStore = memoryShare "mTaskDevices" []
+
+sdsStore :: Shared [MTaskShare]
+sdsStore = memoryShare "mTaskShares" []
+
+bcStateStore :: Shared BCState
+bcStateStore = memoryShare "mTaskBCState" zero
+
+mTaskTaskStore :: Shared [String]
+mTaskTaskStore = memoryShare "mTaskTasks" ["ledder", "ledon", "ledoff"]
+
+mTaskMap :: Map String (Main (ByteCode () Stmt))
+mTaskMap = 'DM'.fromList [("ledder", bc), ("ledon", bc2 LED1), ("ledoff", bc3 LED3)]
+

 bc :: Main (ByteCode () Stmt)
 bc = sds \x=1 In sds \pinnetje=1 In {main =
                IF (digitalRead D3) (
 bc :: Main (ByteCode () Stmt)
 bc = sds \x=1 In sds \pinnetje=1 In {main =
                IF (digitalRead D3) (


@@ -65,8 +91,8 @@ 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, MTaskDevice
+:: MTaskDeviceStatus = {connected :: Bool, name :: String, tasks :: [(String, Int)]}
+derive class iTask MTaskDeviceStatus, MTaskDevice, MTaskShare, BCState

 
 mTaskManager :: Task ()
 mTaskManager = anyTask 
 
 mTaskManager :: Task ()
 mTaskManager = anyTask 


@@ -75,28 +101,62 @@ mTaskManager = anyTask
                , whileUnchanged deviceStore viewDevices
                ] <<@ ApplyLayout layout
        where
                , whileUnchanged deviceStore viewDevices
                ] <<@ ApplyLayout layout
        where

-               isValue (Value _ _) = True
-               isValue _                       = False
-
-               viewmTasks = enterChoice "Available mTasks" [ChooseFromList id] ["ledder", "ledon", "ledoff"]
-                       >>= viewInformation "" []
-

                layout = sequenceLayouts
                        [ arrangeWithSideBar 0 LeftSide 260 True
                        , arrangeSplit Vertical True
                        ]
 
                layout = sequenceLayouts
                        [ arrangeWithSideBar 0 LeftSide 260 True
                        , arrangeSplit Vertical True
                        ]
 

-               viewShares :: Task ()
-               viewShares = forever (
-                               enterChoiceWithShared "Shares" [ChooseFromList sdsvw] sdsShare
-                       >>* [OnValue $ withValue $ Just o updateShare]
-                       >>* [OnAction (Action "Back") (const $ Just $ treturn ())]
-                       )
+               viewmTasks = listmTasks
+                       >&^ \sh->whileUnchanged sh $ \mi->case mi of
+                               Nothing = viewInformation "No task selected" [] ()
+                               Just mTaskTask = get deviceStore
+                                       >>= \devices->case devices of
+                                               [] = viewInformation "No devices yet" [] ()
+                                               ds = sendmTask mTaskTask ds @! ()

                        where
                        where

-                               sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v]
-                               updateShare (k, v) = (viewInformation "Key" [] k
-                                       ||- updateInformation "Value" [] v)
-                                       >>= \nv->upd
+                               listmTasks :: Task String
+                               listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
+
+                               sendmTask mTaskId ds = 
+                                               (enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
+                                               -&&- enterInformation "Timeout, 0 for one-shot" [])
+                                       >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)]
+
+                               sendToDevice :: String (MTaskDevice, Int) -> Task ()
+                               sendToDevice mTask (device, timeout) =
+                                               get bcStateStore @ createBytecode
+                                       >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
+                                       >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
+                                       >>| makeShares sdss
+                                       >>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device)
+                                       @! ()
+                                       where
+                                               createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) st
+                                               sharename i = fromJust (device.deviceConnected) +++ "-" +++ toString i
+                                               toSDSRecords st = [{MTaskShare |
+                                                       initValue=toInt d1*265 + toInt d2,
+                                                       withTask=mTask,
+                                                       identifier=i,
+                                                       realShare="mTaskSDS-" +++ toString i}
+                                                               \\(i,[d1,d2])<-st.sdss]
+                                               makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
+                                       
+               getSDSStore :: MTaskShare -> Shared Int
+               getSDSStore sh = memoryShare sh.realShare 0
+                                       
+               channels :: MTaskDevice -> Shared Channels
+               channels d = memoryShare (fromJust d.deviceConnected) ([], [], False)
+
+               viewShares :: Task ()
+               viewShares = forever $ viewSharedInformation "Shares" [] sdsStore @! ()
+//                             enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore
+//                     >>* [OnValue $ withValue $ Just o updateShare]
+//                     >>* [OnAction (Action "Back") (const $ Just $ treturn ())]
+//                     where
+//                             sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v]
+//                             updateShare s = viewInformation "" [] ()
+//                             updateShare (k, v) = (viewInformation "Key" [] k
+//                                     ||- updateInformation "Value" [] v)

                                        
 
                viewDevices :: [MTaskDevice] -> Task ()
                                        
 
                viewDevices :: [MTaskDevice] -> Task ()


@@ -108,36 +168,39 @@ mTaskManager = anyTask
                viewDevice :: MTaskDevice -> Task ()
                viewDevice d = (viewInformation "Device settings" [] d 
                                ||- (case d.deviceConnected of
                viewDevice :: MTaskDevice -> Task ()
                viewDevice d = (viewInformation "Device settings" [] d 
                                ||- (case d.deviceConnected of

-                                       Just s = viewSharedInformation "Channels" [] (channels d.deviceName) @! ()
+                                       Just s = viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()

                                        Nothing = viewInformation "No channels yet" [] "" @! ()
                                )) <<@ ArrangeHorizontal
                                        Nothing = viewInformation "No channels yet" [] "" @! ()
                                )) <<@ ArrangeHorizontal

-
-               channels :: String -> Shared Channels
-               channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False)
-
-               sdsShare :: Shared [(Int, Int)]
-               sdsShare = sdsFocus "mTaskSDSs" $ memoryStore "" $ Just [(1, 1)]
-
-               addDevice :: (Shared [MTaskDevice]) -> Task ()
-               addDevice devices = enterInformation "Device type and name" []
-                       >>= \(name, ty)->get randomInt @ ((+++) name o toString)
-                       >>= \realname->let ch = channels realname in case ty of
-                               TCPDevice = enterInformation "Hostname and port" []
-                                       >>= \(host, port)->cont realname name ||- syncNetworkChannel host port ch
-                               SerialDevice = accWorld getDevices
-                                       >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
-                                       >>= \(device, settings)->cont realname name ||- syncSerialChannel device settings ch

                        where
                        where

-                               cont rn nm = (upd (\l->[dev rn nm:l]) devices >>| addDevice devices)
-                               dev rn nm = {deviceConnected=Just rn,deviceName=nm}
-
-                               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)
-
-                               isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
-                               prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
+                               dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
+
+               addDevice :: (Shared [MTaskDevice]) -> Task SerTCP
+               addDevice devices = enterInformation "Device type" []
+                       >&^ \sh->whileUnchanged sh $ \mty->case mty of
+                               Nothing = viewInformation "No type selected yet" [] "" @! ()
+                               Just ty = case ty of
+                                       TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" [])
+                                               >>= \(name, (host, port))->cont name (syncNetworkChannel host port)
+                                       SerialDevice = accWorld getTTYDevices
+                                               >>= \dl->(enterInformation "Name" [] -&&- enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
+                                               >>= \(name, (dev, set))->cont name (syncSerialChannel dev set)
+                       where
+                               cont :: String ((Shared Channels) -> Task ()) -> Task ()
+                               cont name synfun = get randomInt 
+                                       @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[], deviceTask=Nothing})
+                                       >>= \dev->appendTopLevelTask 'DM'.newMap True (synfun $ channels dev)
+                                       >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
+                                       @! ()
+                                               
+//                             >= \ty->get randomInt @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[]})
+//                     >>= \dev->let ch = channels dev in case ty of
+//                             TCPDevice = enterInformation "Hostname and port" []
+//                                     >>= \(host, port)->cont dev ||- syncNetworkChannel host port ch
+//                             SerialDevice = accWorld getDevices
+//                                     >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
+//                                     >>= \(device, settings)->cont dev ||- syncSerialChannel device settings ch
+//                     where
+//                             cont d = (upd (\l->[d:l]) devices >>| addDevice devices)

 
 //             connectDevice :: [MTaskDevice] -> Task ()
 //             connectDevice [] = treturn ()
 
 //             connectDevice :: [MTaskDevice] -> Task ()
 //             connectDevice [] = treturn ()


@@ -149,11 +212,9 @@ mTaskManager = anyTask
 
                deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
                deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
 
                deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
                deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,

-                       connected = if (isNothing d.deviceConnected) False True}\\d<-ds]
+                       connected = if (isNothing d.deviceConnected) False True,
+                       tasks = d.deviceTasks}\\d<-ds]

        
        

-               deviceStore :: Shared [MTaskDevice]
-               deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just [])
-

 //             showTabbed :: [MTaskDevice] -> Task ()
 //             showTabbed [] = viewInformation "" [] "No devices yet" @! ()
 //             showTabbed [l:ls] = foldr (\e es->manageDevice e ||- es) (manageDevice l) ls
 //             showTabbed :: [MTaskDevice] -> Task ()
 //             showTabbed [] = viewInformation "" [] "No devices yet" @! ()
 //             showTabbed [l:ls] = foldr (\e es->manageDevice e ||- es) (manageDevice l) ls


@@ -190,14 +251,6 @@ mTaskManager = anyTask
 //             messageShare :: Shared [String]
 //             messageShare = sharedStore "mTaskMessagesRecv" []
 //
 //             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))
 //             makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
 //             makeMsgs timeout bc
 //             # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))


@@ -290,8 +343,9 @@ serialDeviceBackgroundTask rw iworld
 
 
 syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
 
 
 syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()

-syncNetworkChannel server port channel
-       = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
+syncNetworkChannel server port channel = catchAll
+               (tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ())
+               (\v->traceValue v @! ())

        where
                onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
                onConnect _ (msgs,send,sendStopped)
        where
                onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
                onConnect _ (msgs,send,sendStopped)


@@ -302,8 +356,9 @@ syncNetworkChannel server port channel
                = (Ok acc, Nothing, [], False)
 
                whileConnected (Just newData) acc (msgs,send,sendStopped)
                = (Ok acc, Nothing, [], False)
 
                whileConnected (Just newData) acc (msgs,send,sendStopped)

-               | sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
-               = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
+               = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
+               //| sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
+//             = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)

                
                onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
                onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)
                
                onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
                onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)