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 memoryShare :: String a -> Shared a | iTask a
  14 memoryShare s d = sdsFocus s $ memoryStore s $ Just d
  15
  16 deviceStoreNP :: Shared [MTaskDevice]
  17 deviceStoreNP = sdsFocus Nothing $ deviceStore
  18
  19 deviceStore :: RWShared (Maybe (MTaskDevice, Int)) [MTaskDevice] [MTaskDevice]
  20 deviceStore = SDSSource {SDSSource
  21         | name = "deviceStore"
  22         , read = \_->read realDeviceStore
  23         , write= realWrite
  24         }
  25 where
  26         realWrite mi w iw
  27         # (merr, iw) = write w realDeviceStore iw
  28         | isError merr || isNothing mi = (merr $> const True, iw)
  29         # (Just (dev, ident)) = mi
  30         | ident == -1 = (merr $> const True, iw)
  31         = case find ((==)dev) w of
  32                 Nothing = (Error $ exception "Device doesn't exist anymore", iw)
  33                 Just {deviceShares} = case find (\{identifier}->identifier == ident) deviceShares of
  34                         Nothing = (Error $ exception $ "deviceStore: Share doesn't exist: " +++ toString ident, iw)
  35                         Just s = case sendMessagesIW [MTUpd ident s.MTaskShare.value] dev iw of
  36                                 (Error e, iw) = (Error e, iw)
  37                                 (Ok _, iw) = (Ok $ lens mi, iw)
  38
  39         lens Nothing (Just p) = False
  40         lens Nothing Nothing = True
  41         lens (Just (d1, i1)) (Just (d2, i2)) = d1 == d2 && (i2 == -1 || i1 == i2)
  42
  43 realDeviceStore :: Shared [MTaskDevice]
  44 realDeviceStore = sharedStore "mTaskDevices" []
  45
  46 bcStateStore :: Shared BCState
  47 bcStateStore = memoryShare "mTaskBCState" zero
  48
  49 mTaskTaskStore :: Shared [String]
  50 mTaskTaskStore = memoryShare "mTaskTasks" $ 'DM'.keys allmTasks