clean up, move iTasks serial stuff to Cleanserial, add toplevel tasks for syncing
[mTask.git] / miTask.icl
index 1e62ea7..a20108c 100644 (file)
@@ -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,11 +33,14 @@ derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 
 :: SerTCP = SerialDevice | TCPDevice
 :: MTaskDevice = {
 
 :: SerTCP = SerialDevice | TCPDevice
 :: MTaskDevice = {
+               deviceTask :: Maybe TaskId,
                deviceConnected :: Maybe String,
                deviceName :: String,
                deviceTasks :: [(String, Int)]
        }
 :: MTaskShare = {
                deviceConnected :: Maybe String,
                deviceName :: String,
                deviceTasks :: [(String, Int)]
        }
 :: MTaskShare = {
+               initValue :: Int,
+               withTask :: String,
                identifier :: Int,
                realShare :: String
        }
                identifier :: Int,
                realShare :: String
        }
@@ -98,8 +101,10 @@ mTaskManager = anyTask
                , whileUnchanged deviceStore viewDevices
                ] <<@ ApplyLayout layout
        where
                , whileUnchanged deviceStore viewDevices
                ] <<@ ApplyLayout layout
        where
-               isValue (Value _ _) = True
-               isValue _                       = False
+               layout = sequenceLayouts
+                       [ arrangeWithSideBar 0 LeftSide 260 True
+                       , arrangeSplit Vertical True
+                       ]
 
                viewmTasks = listmTasks
                        >&^ \sh->whileUnchanged sh $ \mi->case mi of
 
                viewmTasks = listmTasks
                        >&^ \sh->whileUnchanged sh $ \mi->case mi of
@@ -118,45 +123,38 @@ mTaskManager = anyTask
                                        >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)]
 
                                sendToDevice :: String (MTaskDevice, Int) -> Task ()
                                        >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)]
 
                                sendToDevice :: String (MTaskDevice, Int) -> Task ()
-                               sendToDevice mTask (device, timeout) = get bcStateStore
-                                       @ toMessages timeout o toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap))
-                                       >>= \(msgs, st1)->set st1 bcStateStore 
-                                       //@ map f
+                               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
                                        >>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device)
                                        @! ()
                                        where
-                                               f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d))
-                                               dd [x,y] = toInt x*265 + toInt y
-                                               
-//             = (msgs, map f st.sdss)
-//                     where 
-//                                     upd (\(r,s,ss)->(r,s++[],ss)) (channels device) @! ()
-//                             # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
-//                             = Just $ viewInformation "" [] device
-//                             = (msgs, map f st.sdss)
-//                                     where 
-//                                             f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d))
-//                                             dd [x,y] = toInt x*265 + toInt y
-//                                     # 
-//                             = Just $ viewInformation "" [] device
+                                               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)
 
                                        
                channels :: MTaskDevice -> Shared Channels
                channels d = memoryShare (fromJust d.deviceConnected) ([], [], False)
 
-               layout = sequenceLayouts
-                       [ arrangeWithSideBar 0 LeftSide 260 True
-                       , arrangeSplit Vertical True
-                       ]
-
                viewShares :: Task ()
                viewShares :: Task ()
-               viewShares = forever $
-                               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 "" [] ()
+               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)
                                        
 //                             updateShare (k, v) = (viewInformation "Key" [] k
 //                                     ||- updateInformation "Value" [] v)
                                        
@@ -176,25 +174,33 @@ mTaskManager = anyTask
                        where
                                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 
                        where
                                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 
-               addDevice :: (Shared [MTaskDevice]) -> Task ()
-               addDevice devices = enterInformation "Device type and name" []
-                       >>= \(name, 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
+               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
                        where
-                               cont d = (upd (\l->[d:l]) devices >>| addDevice devices)
-
-                               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"]
+                               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 ()
@@ -245,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))