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 :: Task [MTaskDevice]
  15 manageShares = whileUnchanged deviceStore
  16         $ \devs->case devs of
  17                 [] = viewInformation "No devices yet" [] []
  18                 _ = allTasks (map manageSharesOnDevice devs)
  19
  20 manageSharesOnDevice :: MTaskDevice -> Task MTaskDevice
  21 manageSharesOnDevice dev = (case dev.deviceShares of
  22                 [] = viewInformation dev.deviceName [] "No shares yet"
  23                 shs = enterChoice dev.deviceName [ChooseFromGrid id] shs @ const ""
  24         ) >>| treturn dev
  25
  26 updateShares :: MTaskDevice ([MTaskShare] -> [MTaskShare]) -> Task [MTaskShare]
  27 updateShares dev tfun = upd (map upFun) deviceStore
  28                 @ (\d->d.deviceShares) o fromJust o find ((==)dev)
  29         where
  30                 upFun d = if (dev == d) ({d&deviceShares=tfun d.deviceShares}) d
  31
  32 //manageShares shares = withShared Nothing $ \cs->forever $
  33 //      (viewSharesGrid cs shares -|| updateShares shares <<@ ArrangeVertical)
  34 //      @! ()
  35
  36 //updateShares :: [MTaskShare] -> Task BCValue
  37 //updateShares shares = anyTask (map updateS shares) <<@ ArrangeWithTabs
  38
  39 //updateS :: MTaskShare -> Task BCValue
  40 //updateS sh = flip (<<@) (Title $ toString sh.identifier) $ forever $
  41 //              viewSharedInformation "Current value" [] (getSDSShare sh)
  42 //      ||- (
  43 //                      updateSharedInformation "New value" [] (getSDSShare sh)
  44 //              >>= \nv->allTasks (map (withDevice treturn) sh.withDevice)
  45 //              >>= \devs->allTasks (map (sendMessages [MTUpd sh.identifier nv]) devs)
  46 //              >>| treturn nv
  47 //              )
  48 //      <<@ ArrangeHorizontal
  49
  50 //viewSharesGrid :: (Shared (Maybe MTaskShare)) [MTaskShare] -> Task [BCValue]
  51 //viewSharesGrid _ [] = viewInformation "No shares yet" [] []
  52 //viewSharesGrid cs sh = (allTasks [watch (getSDSShare m)\\m<-sh] <<@ NoUserInterface)
  53 //      >&^ \st->flip (<<@) NoUserInterface $ whileUnchanged st $ \mshs->enterChoice "" [ChooseFromGrid id]
  54 //              [{MTaskShare|ss&value=s}\\s<-fromJust mshs & ss<-sh]
  55 //              >>* [OnValue (withValue $ \s->Just (set (Just s) cs))]
  56 //              @! fromJust mshs
  57
  58 //viewShare :: MTaskShare -> Task BCValue
  59 //viewShare m = viewSharedInformation "" [] (getSDSShare m)
  60 //      <<@ Title ("SDS: " +++ toString m.identifier)
  61
  62 makeShare :: String Int BCValue -> MTaskShare
  63 makeShare withTask identifier value = {MTaskShare
  64                 |withTask=[withTask]
  65                 ,identifier=identifier
  66                 ,value=value
  67                 }
  68
  69 updateShareFromPublish :: MTaskDevice Int BCValue -> Task [MTaskShare]
  70 updateShareFromPublish dev ident val = updateShares dev $ map $ up ident val
  71         where
  72                 up :: Int BCValue MTaskShare -> MTaskShare
  73                 up i v s = if (s.identifier == i) {MTaskShare | s & value=val} s
  74
  75 import GenPrint, StdMisc, StdDebug, TTY
  76 derive gPrint MTaskDevice, MTaskShare, Maybe, MTaskResource, MTaskTask, TaskId, TTYSettings, TCPSettings, DateTime
  77 derive gPrint Parity, BaudRate, ByteSize
  78
  79 cleanSharesTask :: Int MTaskDevice -> Task [MTaskShare]
  80 cleanSharesTask taskid d = updateShares d id //TODO
  81 //# shares = d.deviceShares
  82 //| not (trace_tn $ printToString taskid) = undef
  83 //| not (trace_tn $ printToString d.deviceTasks) = undef
  84 //| not (trace_tn $ printToString $ getNames taskid d) = undef
  85 //= upd (map $ up $ getNames taskid d) sdsStore
  86 //      where
  87 //              getNames :: Int MTaskDevice -> [String]
  88 //              getNames i d = [t.MTaskTask.name\\t<-d.deviceTasks|t.ident==i]
  89 //
  90 //              up :: [String] MTaskShare -> MTaskShare
  91 //              up ns s = {MTaskShare | s & withTask=[t\\t<-s.withTask|not (isMember t ns)]}
  92
  93 getRealShare :: MTaskDevice BCShare -> Shared BCValue
  94 getRealShare dev {sdsi} = SDSSource {SDSSource
  95         | name = "mTaskShareMap-" +++ toString sdsi, read=rr, write=ww}
  96         where
  97                 rr name iworld = case read deviceStore iworld of
  98                         (Error e, iworld) = (Error e, iworld)
  99                         (Ok devices, iworld) = case find ((==)dev) devices of
 100                                 Nothing = (Error $ exception "Device doesn't exist anymore", iworld)
 101                                 Just {deviceShares} = case find (\s->s.identifier == sdsi) deviceShares of
 102                                         Nothing = (Error $ exception "Share doesn't exist", iworld)
 103                                         Just share = (Ok share.MTaskShare.value, iworld)
 104
 105                 // Also send messages
 106                 ww name value iworld = undef//case modify (modFun name value) sdsStore of
 107 //                      (Error e, iworld) = (Error e, iworld)
 108 //                      (Ok shares, iworld) = (Ok $ const True, iworld)