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 MTaskShareType, MTaskShare
  13
  14 manageShares :: [MTaskShare] -> Task ()
  15 manageShares shares = withShared Nothing $ \cs->forever $
  16         (viewSharesGrid cs shares -|| updateShares shares <<@ ArrangeVertical)
  17         @! ()
  18
  19 updateShares :: [MTaskShare] -> Task BCValue
  20 updateShares shares = anyTask (map updateS shares) <<@ ArrangeWithTabs
  21
  22 updateS :: MTaskShare -> Task BCValue
  23 updateS sh = flip (<<@) (Title $ toString sh.identifier) $ forever $
  24                 viewSharedInformation "Current value" [] (getSDSShare sh)
  25         ||- (
  26                         updateSharedInformation "New value" [] (getSDSShare sh)
  27                 >>= \nv->allTasks (map getDevice sh.withDevice)
  28                 >>= \devs->allTasks (map (sendMessages [MTUpd sh.identifier nv]) devs)
  29                 >>| treturn nv
  30                 )
  31         <<@ ArrangeHorizontal
  32
  33 viewSharesGrid :: (Shared (Maybe MTaskShare)) [MTaskShare] -> Task [BCValue]
  34 viewSharesGrid _ [] = viewInformation "No shares yet" [] []
  35 viewSharesGrid cs sh = (allTasks [watch (getSDSShare m)\\m<-sh] <<@ NoUserInterface)
  36         >&^ \st->flip (<<@) NoUserInterface $ whileUnchanged st $ \mshs->enterChoice "" [ChooseFromGrid id]
  37                 [{MTaskShare|ss&value=s}\\s<-fromJust mshs & ss<-sh]
  38                 >>* [OnValue (withValue $ \s->Just (set (Just s) cs))]
  39                 @! fromJust mshs
  40
  41 viewShare :: MTaskShare -> Task BCValue
  42 viewShare m = viewSharedInformation "" [] (getSDSShare m)
  43         <<@ Title ("SDS: " +++ toString m.identifier)
  44
  45 getSDSShare :: MTaskShare -> Shared BCValue
  46 getSDSShare s=:{realShare=(MTaskWithShare id),value} = memoryShare id value
  47
  48 makeShare :: String String Int BCValue -> Task MTaskShare
  49 makeShare withTask withDevice identifier value = treturn
  50                 {MTaskShare
  51                 |withTask=[withTask]
  52                 ,withDevice=[withDevice]
  53                 ,identifier=identifier
  54                 ,value=value
  55                 ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier
  56                 } >>= \sh->set value (getSDSShare sh) >>| treturn sh
  57
  58 updateShare :: Int BCValue -> Task ()
  59 updateShare ident val = get sdsStore
  60         >>= \sh->(case find (\s->s.identifier==ident) sh of
  61                 Nothing = abort "Help, no share found with this ident"
  62                 Just mts = set val (getSDSShare mts))
  63         >>| traceValue "Updated" @! ()