X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=miTask.icl;h=8c17f09423768eebe75f71d318dd96818a4f1379;hb=6420aa92a3b4b341f8f86654df79adc1ef610741;hp=84b25633289174f4a0fa15d88c6ef9d3d2ee4b32;hpb=c667554eb5dc359481a5f84b60649169f31e0f3d;p=mTask.git diff --git a/miTask.icl b/miTask.icl index 84b2563..8c17f09 100644 --- a/miTask.icl +++ b/miTask.icl @@ -1,49 +1,92 @@ module miTask import StdDebug, StdMisc - -from Text import class Text(concat,join,split), instance Text String +from StdFunc import flip import iTasks import mTask +import Devices.mTaskDevice +import Shares.mTaskShare +import Tasks.Examples +import Utils.SDS + +from Text import class Text(startsWith,concat,split,join), instance Text String + +import qualified Data.Map as DM + +from Data.Func import $ +import Data.Tuple +import Data.List +import System.Directory + +import iTasks._Framework.Store +import iTasks._Framework.Serialization -Start :: *World -> *World -Start world = startEngine mTaskTask world +import TTY, iTasksTTY -mTaskTask :: Task () -mTaskTask = withShared ([],False,[],False) (\ch-> - syncNetworkChannel "localhost" 8123 "\n" id id ch ||- - updateSharedInformation "channels" [] ch @! ()) +Start world = startEngine [ + publish "/manage" $ const $ mTaskManager + >>* [OnAction (Action "Shutdown") (always $ shutDown 0)], + publish "/" $ const demo + ] world -syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m -syncNetworkChannel server port msgSeparator decodeFun encodeFun channel - = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! () +demo :: Task () +demo = viewSharedInformation "Devices" [] deviceStoreNP + >>* [OnValue $ ifValue pred (cont o hd)] where - onConnect _ (received,receiveStopped,send,sendStopped) - = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False) - whileConnected Nothing acc (received,receiveStopped,send,sendStopped) - = (Ok acc, Nothing, [], False) - whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped) - # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData])) - # write = if (not (isEmpty msgs && isEmpty send)) - (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped)) - Nothing - = (Ok acc,write,map encodeFun send,False) - - onDisconnect l (received,receiveStopped,send,sendStopped) - = (Ok l,Just (received,True,send,sendStopped)) - -consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m -consumeNetworkStream processTask channel - = ((watch channel >>* [OnValue (ifValue ifProcess process)]) Task () + cont dev + # rs = getRealShare dev (hd dev.deviceShares) + = get rs >>= \oldvalue-> + forever (updateSharedInformation "Blinkyblink" [] (getRealShare dev (hd dev.deviceShares)) + >>* [OnAction ActionContinue (const $ Just $ treturn ())]) + -|| (wait "bigger than 10" (\x->x == oldvalue) rs + >>= viewInformation "Bigger:)" []) + + toInt :: BCValue -> Int + toInt (BCValue e) = dynToInt (dynamic e) + + dynToInt :: Dynamic -> Int + dynToInt (a :: Int) = a + dynToInt x = abort "Not an int" + +mTaskManager :: Task () +mTaskManager = (>>|) startupDevices $ + forever viewmTasks ||- + ((manageShares ||- forever (manageDevices process)) <<@ ArrangeSplit Vertical True) + <<@ ArrangeWithSideBar 0 LeftSide 260 True where - ifProcess (received,receiveStopped,_,_) - = receiveStopped || (not (isEmpty received)) - - process (received,receiveStopped,_,_) - = upd empty channel - >>| if (isEmpty received) (return ()) (processTask received) - @! receiveStopped - - empty :: ([m],Bool,[m],Bool) -> ([m],Bool,[m],Bool) - empty (_,rs,s,ss) = ([],rs,s,ss) + viewmTasks :: Task [MTaskDevice] + viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore + >>= \task->get deviceStoreNP + >>* [OnValue $ (ifValue isEmpty) $ \_-> + viewInformation "No devices yet" [] [] >>= treturn + ,OnValue $ (ifValue $ not o isEmpty) $ \d-> + fromJust ('DM'.get task allmTasks) + >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] d + -&&- enterInformation "Timeout" [] + ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice task bc)] + ] + + process :: MTaskDevice (Shared Channels) -> Task () + process device ch = forever + $ traceValue "Waiting for channel change" + >>| wait "process" (not o isEmpty o fst3) ch + >>= \(r,s,ss)->upd (appFst3 (const [])) ch + >>| proc r + where + proc :: [MTaskMSGRecv] -> Task () + proc [] = treturn () + proc [MTEmpty:ms] = proc ms + proc [m:ms] = traceValue (toString m) >>| (case m of +// MTSDSAck i = traceValue (toString m) @! () +// MTSDSDelAck i = traceValue (toString m) @! () + MTPub i val = updateShareFromPublish device i val @! () + MTTaskAck i mem = deviceTaskAcked device i mem @! () + MTTaskDelAck i = deviceTaskDeleteAcked device i @! () + MTDevSpec s = deviceAddSpec device s @! () + _ = treturn () + ) >>| proc ms