Shares/mTaskShare.icl

   1 implementation module Shares.mTaskShare
   2
   3 import dynamic_string
   4 import Utils.SDS
   5 import Utils.Devices
   6 import iTasks
   7 import mTask
   8 import Data.List
   9 from Data.Func import $
  10 from StdFunc import flip
  11
  12 derive class iTask MTaskShare
  13
  14 manageShares :: [MTaskShare] -> Task MTaskShare
  15 manageShares x = enterChoice "" [ChooseFromGrid id] x
  16         >>| manageShares x
  17 //manageShares shares = withShared Nothing $ \cs->forever $
  18 //      (viewSharesGrid cs shares -|| updateShares shares <<@ ArrangeVertical)
  19 //      @! ()
  20
  21 //updateShares :: [MTaskShare] -> Task BCValue
  22 //updateShares shares = anyTask (map updateS shares) <<@ ArrangeWithTabs
  23
  24 //updateS :: MTaskShare -> Task BCValue
  25 //updateS sh = flip (<<@) (Title $ toString sh.identifier) $ forever $
  26 //              viewSharedInformation "Current value" [] (getSDSShare sh)
  27 //      ||- (
  28 //                      updateSharedInformation "New value" [] (getSDSShare sh)
  29 //              >>= \nv->allTasks (map (withDevice treturn) sh.withDevice)
  30 //              >>= \devs->allTasks (map (sendMessages [MTUpd sh.identifier nv]) devs)
  31 //              >>| treturn nv
  32 //              )
  33 //      <<@ ArrangeHorizontal
  34
  35 //viewSharesGrid :: (Shared (Maybe MTaskShare)) [MTaskShare] -> Task [BCValue]
  36 //viewSharesGrid _ [] = viewInformation "No shares yet" [] []
  37 //viewSharesGrid cs sh = (allTasks [watch (getSDSShare m)\\m<-sh] <<@ NoUserInterface)
  38 //      >&^ \st->flip (<<@) NoUserInterface $ whileUnchanged st $ \mshs->enterChoice "" [ChooseFromGrid id]
  39 //              [{MTaskShare|ss&value=s}\\s<-fromJust mshs & ss<-sh]
  40 //              >>* [OnValue (withValue $ \s->Just (set (Just s) cs))]
  41 //              @! fromJust mshs
  42
  43 //viewShare :: MTaskShare -> Task BCValue
  44 //viewShare m = viewSharedInformation "" [] (getSDSShare m)
  45 //      <<@ Title ("SDS: " +++ toString m.identifier)
  46
  47 makeShare :: String String Int BCValue -> MTaskShare
  48 makeShare withTask withDevice identifier value = {MTaskShare
  49                 |withTask=[withTask]
  50                 ,withDevice=[withDevice]
  51                 ,identifier=identifier
  52                 ,value=value
  53 //              ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier
  54                 }
  55
  56 updateShare :: Int BCValue -> Task [MTaskShare]
  57 updateShare ident val = upd (map $ up ident val) sdsStore
  58         where
  59                 up :: Int BCValue MTaskShare -> MTaskShare
  60                 up i v s = if (s.identifier == i) {MTaskShare | s & value=val} s
  61
  62 import GenPrint, StdMisc, StdDebug, TTY
  63 derive gPrint MTaskDevice, MTaskShare, Maybe, MTaskResource, MTaskTask, TaskId, TTYSettings, TCPSettings, DateTime
  64 derive gPrint Parity, BaudRate, ByteSize
  65
  66 cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare]
  67 cleanSharesTask taskid d
  68 | not (trace_tn $ printToString taskid) = undef
  69 | not (trace_tn $ printToString d.deviceTasks) = undef
  70 | not (trace_tn $ printToString $ getNames taskid d) = undef
  71 = upd (map $ up $ getNames taskid d) sdsStore
  72         where
  73                 getNames :: Int MTaskDevice -> [String]
  74                 getNames i d = [t.MTaskTask.name\\t<-d.deviceTasks|t.ident==i]
  75
  76                 up :: [String] MTaskShare -> MTaskShare
  77                 up ns s = {MTaskShare | s & withTask=[t\\t<-s.withTask|not (isMember t ns)]}
  78
  79 cleanSharesDevice :: String -> Task [MTaskShare]
  80 cleanSharesDevice did = upd (map (up did)) sdsStore
  81         where
  82                 up :: String MTaskShare -> MTaskShare
  83                 up i s = {MTaskShare | s & withDevice = [wt\\wt<-s.withDevice|wt <> i]}