clean up, move iTasks serial stuff to Cleanserial, add toplevel tasks for syncing
authorMart Lubbers <mart@martlubbers.net>
Sun, 19 Feb 2017 17:12:57 +0000 (18:12 +0100)
committerMart Lubbers <mart@martlubbers.net>
Sun, 19 Feb 2017 17:12:57 +0000 (18:12 +0100)
CleanSerial
miTask.icl

index 96af278..9ea6c24 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 96af2783c31759b6c07a5514f9fd52060c9fcff6
+Subproject commit 9ea6c24060fbe14dd26e8efc62a4c004a3ba395b
index 1e62ea7..a20108c 100644 (file)
@@ -23,7 +23,7 @@ import iTasks._Framework.IWorld
 import iTasks._Framework.Store
 
 
-import TTY
+import TTY, iTasksTTY
 
 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 = {
+               deviceTask :: Maybe TaskId,
                deviceConnected :: Maybe String,
                deviceName :: String,
                deviceTasks :: [(String, Int)]
        }
 :: MTaskShare = {
+               initValue :: Int,
+               withTask :: String,
                identifier :: Int,
                realShare :: String
        }
@@ -98,8 +101,10 @@ mTaskManager = anyTask
                , 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
@@ -118,45 +123,38 @@ mTaskManager = anyTask
                                        >>* [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
-                                               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)
 
-               layout = sequenceLayouts
-                       [ arrangeWithSideBar 0 LeftSide 260 True
-                       , arrangeSplit Vertical True
-                       ]
-
                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)
                                        
@@ -176,25 +174,33 @@ mTaskManager = anyTask
                        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
-                               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 ()
@@ -245,14 +251,6 @@ mTaskManager = anyTask
 //             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))