Utils/SDS.icl

   1 implementation module Utils.SDS
   2
   3 import iTasks
   4 import iTasks._Framework.Store
   5 import Devices.mTaskDevice
   6 import Shares.mTaskShare
   7 import Tasks.Examples
   8 import Data.List
   9 import qualified Data.Map as DM
  10 from Data.Func import $
  11 import Data.Tuple
  12
  13 import StdDebug
  14
  15 memoryShare :: String a -> Shared a | iTask a
  16 memoryShare s d = sdsFocus s $ memoryStore s $ Just d
  17
  18 deviceStoreNP :: Shared [MTaskDevice]
  19 deviceStoreNP = sdsFocus Nothing $ deviceStore
  20
  21 deviceStore :: RWShared (Maybe (MTaskDevice, Int)) [MTaskDevice] [MTaskDevice]
  22 deviceStore = SDSSource {SDSSource
  23         | name = "deviceStore"
  24         , read = \_->read realDeviceStore
  25         , write= realWrite
  26         }
  27 where
  28         realWrite mi w iw
  29         # (merr, iw) = write w realDeviceStore iw
  30         | isError merr || isNothing mi = (merr $> const True, iw)
  31         # (Just (dev, ident)) = mi
  32         | ident == -1 = (merr $> const True, iw)
  33         = case find ((==)dev) w of
  34                 Nothing = (Error $ exception "Device doesn't exist anymore", iw)
  35                 Just {deviceShares} = case find (\d->d.identifier == ident) deviceShares of
  36                         Nothing = (Error $ exception $ "deviceStore: Share doesn't exist: " +++ toString ident, iw)
  37                         Just s
  38                         | not $ trace_tn "Really sending a message from a share update" = undef
  39                         = case sendMessagesIW [MTUpd ident s.MTaskShare.value] dev iw of
  40                                 (Error e, iw) = (Error e, iw)
  41                                 (Ok _, iw) = (Ok $ lens mi, iw)
  42
  43         lens Nothing (Just p) = False
  44         lens Nothing Nothing = True
  45         lens (Just (d1, i1)) (Just (d2, i2)) = d1 == d2 && (i2 == -1 || i1 == i2)
  46
  47 realDeviceStore :: Shared [MTaskDevice]
  48 realDeviceStore = sharedStore "mTaskDevices" []
  49
  50 bcStateStore :: Shared BCState
  51 bcStateStore = memoryShare "mTaskBCState" zero
  52
  53 mTaskTaskStore :: Shared [String]
  54 mTaskTaskStore = memoryShare "mTaskTasks" $ 'DM'.keys allmTasks