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
  11 derive class iTask MTaskShareType, MTaskShare
  12
  13 manageShares :: [MTaskShare] -> Task ()
  14 manageShares shares = withShared Nothing $ \cs->forever $
  15         (viewSharesGrid cs shares -|| updateShares shares <<@ ArrangeVertical)
  16         @! ()
  17 updateShares :: [MTaskShare] -> Task BCValue
  18 updateShares shares = anyTask (map updateS shares) <<@ ArrangeWithTabs
  19
  20 updateS :: MTaskShare -> Task BCValue
  21 updateS sh = flip (<<@) (Title $ toString sh.identifier) $ forever $
  22                 viewSharedInformation "Current value" [] (getSDSShare sh)
  23         ||- (
  24                         updateSharedInformation "New value" [] (getSDSShare sh)
  25                 >>= \nv->allTasks (map (sendMessages [MTUpd sh.identifier nv]) sh.withDevice)
  26                 >>| treturn nv
  27                 )
  28         <<@ ArrangeHorizontal
  29
  30 //      >&^ \st->whileUnchanged st $ \msh->case msh of
  31 //              Nothing = viewShares shares
  32 //              Just sh = forever (
  33 //                              viewSharedInformation "View value" [] (getSDSShare sh) >>| treturn sh
  34 //                      >>* [OnAction (Action "Update") (withValue (Just o updateInformation "New value" []))]
  35 //                      >>= updateShare sh
  36 //                      )
  37 //
  38 //      ) @! ()
  39
  40
  41 //viewShares :: [MTaskShare] -> Task BCValue
  42 //viewShares shares = anyTask (map viewShare shares)
  43 //
  44 //viewAndDelete :: [MTaskShare] -> Task ()
  45 //viewAndDelete shares
  46 //      = enterChoice "Choose share to update" [ChooseFromGrid id] shares @! ()
  47
  48 //updateShare :: MTaskShare a -> Task MTaskShare | toByteCode, iTask a
  49 //updateShare sh=:{withTask,identifier} a = getDeviceByName withTask
  50 //      >>= sendMessages [MTUpd identifier $ toString $ toByteCode a]
  51 //      >>| treturn sh
  52 //
  53 from StdFunc import flip
  54
  55 viewSharesGrid :: (Shared (Maybe MTaskShare)) [MTaskShare] -> Task [BCValue]
  56 viewSharesGrid _ [] = viewInformation "No shares yet" [] []
  57 viewSharesGrid cs sh = (allTasks [watch (getSDSShare m)\\m<-sh] <<@ NoUserInterface)
  58         >&^ \st->flip (<<@) NoUserInterface $ whileUnchanged st $ \mshs->enterChoice "" [ChooseFromGrid id]
  59                 [{MTaskShare|ss&value=s}\\s<-fromJust mshs & ss<-sh]
  60 //              >>* [OnValue (withValue $ \s->Just (set (Just s) cs))]
  61                 @! fromJust mshs
  62
  63 viewShare :: MTaskShare -> Task BCValue
  64 viewShare m = viewSharedInformation "" [] (getSDSShare m)
  65         <<@ Title ("SDS: " +++ toString m.identifier)
  66
  67 getSDSShare :: MTaskShare -> Shared BCValue
  68 getSDSShare s=:{realShare=(MTaskWithShare id),value} = memoryShare id value
  69
  70 makeShare :: String MTaskDevice Int BCValue -> Task MTaskShare
  71 makeShare withTask withDevice identifier value = treturn
  72                 {MTaskShare
  73                 |withTask=[withTask]
  74                 ,withDevice=[withDevice]
  75                 ,identifier=identifier
  76                 ,value=value
  77                 ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier
  78                 } >>= \sh->set value (getSDSShare sh) >>| treturn sh
  79
  80 updateShare :: Int BCValue -> Task ()
  81 updateShare ident val = get sdsStore
  82         >>= \sh->(case find (\s->s.identifier==ident) sh of
  83                 Nothing = abort "Help, no share found with this ident"
  84                 Just mts = set val (getSDSShare mts))
  85         >>| traceValue "Updated" @! ()