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 import GenPrint, TTY
  22 derive gPrint MTaskDevice, Maybe, MTaskShare, MTaskResource, TaskId, MTaskTask, (,), TTYSettings, TCPSettings, DateTime, Parity, BaudRate, ByteSize, MaybeError, ()
  23 gPrint{|Dynamic|} _ st = gPrint{|*|} "**Dynamic**" st
  24
  25 deviceStore :: RWShared (Maybe (MTaskDevice, Int)) [MTaskDevice] [MTaskDevice]
  26 deviceStore = SDSSource {SDSSource
  27         | name = "deviceStore"
  28         , read = \_->read realDeviceStore
  29         , write= realWrite
  30         }
  31 where
  32         realRead p iw
  33         | not (trace_tn $ "read called with: " +++ printToString p) = undef
  34         = read realDeviceStore iw
  35
  36         realWrite mi w iw
  37         | not (trace_tn $ "write called with: " +++ printToString mi +++ " w " +++ printToString w) = undef
  38         # (merr, iw) = write w realDeviceStore iw
  39         | not (trace_tn $ "written to real store: " +++ printToString merr) = undef
  40         | isError merr || isNothing mi = (merr $> notifyPred mi, iw)
  41         # (Just (dev, ident)) = mi
  42         | ident == -1 = (merr $> notifyPred mi, iw)
  43         = case find ((==)dev) w of
  44                 Nothing = (Error $ exception "Device doesn't exist anymore", iw)
  45                 Just {deviceShares} = case find (\d->d.identifier == ident) deviceShares of
  46                         Nothing = (Error $ exception $ "deviceStore: Share doesn't exist: " +++ toString ident, iw)
  47                         Just s
  48                         | not $ trace_tn "Really sending a message from a share update" = undef
  49                         = case sendMessagesIW [MTUpd ident s.MTaskShare.value] dev iw of
  50                                 (Error e, iw) = (Error e, iw)
  51                                 (Ok _, iw) = (Ok $ notifyPred mi, iw)
  52
  53         notifyPred :: (Maybe (MTaskDevice, Int)) (Maybe (MTaskDevice, Int)) -> Bool
  54         // Global watcher looking at a global event
  55         notifyPred Nothing Nothing = True
  56         // Global watcher looking at a local event
  57         notifyPred Nothing (Just _) = False
  58         // Local watcher looking at a global event
  59         notifyPred (Just _) Nothing = False
  60         // Local device watcher looking at a local event
  61         notifyPred (Just (d1, -1)) (Just (d2, _)) = d1 == d2
  62         // Local share watcher looking at a local share event
  63         notifyPred (Just (d1, i1)) (Just (d2, i2)) = d1 == d2 && i1 == i2
  64
  65 realDeviceStore :: Shared [MTaskDevice]
  66 realDeviceStore = memoryShare "mTaskDevices" []
  67
  68 bcStateStore :: Shared BCState
  69 bcStateStore = memoryShare "mTaskBCState" zero
  70
  71 mTaskTaskStore :: Shared [String]
  72 mTaskTaskStore = memoryShare "mTaskTasks" $ 'DM'.keys allmTasks