bundles/org.simantics.modeling/scl/Simantics/ReverseSynchronization.scl

   1 import "MSet" as MSet
   2 import "Simantics/DB" (Resource)
   3 import "Simantics/Variables" (Variable)
   4 import "Simantics/DB" as DB
   5 import "Simantics/Variables" as VAR
   6 import "Simantics/Model" as MODEL
   7
   8 // ----------------------------------------------------------------------------
   9
  10 data Synchronizable = Synchronizable Variable Variable String String
  11
  12 // ----------------------------------------------------------------------------
  13 // Utility functions and imports
  14
  15 @private
  16 importJava "org.simantics.db.layer0.variable.Variables" where
  17     @JavaName getRVI
  18     rvi :: Variable -> <ReadGraph> String
  19
  20 @private
  21 importJava "org.simantics.databoard.util.URIStringUtils" where
  22     @JavaName escape
  23     escapeUri :: String -> String
  24     @JavaName unescape
  25     unescapeUri :: String -> String
  26
  27 @private
  28 partOfComposites :: MSet.T Resource -> Variable -> Variable -> <Proc,ReadGraph> Boolean
  29 partOfComposites composites context v = let
  30         recurseParent var = match (VAR.possibleParent var) with
  31             Just p -> partOfComposites composites context p
  32             Nothing -> False
  33     in
  34         if (context == v) then False
  35         else match (VAR.possibleRepresents v) with
  36             Nothing -> recurseParent v
  37             Just r -> if (MSet.contains composites r) then True
  38                       else recurseParent v
  39
  40 @private
  41 concatStrings :: [String] -> String
  42 concatStrings strings = foldl (\s1 s2 -> s1 + s2) "" strings
  43
  44 @private
  45 glueFilteredStrings :: String -> (String -> String) -> [String] -> String
  46 glueFilteredStrings glue f strings = foldl (\s1 s2 -> s1 + glue + (f s2)) "" strings
  47
  48 @private
  49 reverseSynchronizable :: (Variable -> <ReadGraph> Maybe Variable) -> Variable -> <ReadGraph> Maybe Synchronizable
  50 reverseSynchronizable experimentPropertyMapper configProp = match (experimentPropertyMapper configProp) with
  51     Nothing -> Nothing
  52     Just activeProp -> let
  53             configValue = (VAR.propertyValue configProp "HasDisplayValue") :: String
  54             activeValue = (VAR.propertyValue activeProp "HasDisplayValue") :: String
  55         in do
  56             if (activeValue == configValue) then Nothing
  57             else Just $ Synchronizable
  58                 configProp
  59                 activeProp
  60                 configValue
  61                 activeValue
  62
  63 @private
  64 resolveComposite :: String -> [String] -> <ReadGraph> Maybe Resource
  65 resolveComposite pathContextUri path = DB.possibleResource (pathContextUri + (glueFilteredStrings "/" escapeUri path))
  66
  67 @private
  68 resolveComposites :: Resource -> [[String]] -> <Proc,ReadGraph> MSet.T Resource
  69 resolveComposites pathContext paths = MSet.fromList (mapMaybe (resolveComposite (DB.uriOf pathContext)) paths)
  70
  71 @private
  72 reverseSynchronizableComponents :: (Resource -> <ReadGraph> [Variable]) -> [[String]] -> <Proc,ReadGraph> [Variable]
  73 reverseSynchronizableComponents componentFinder folderPaths = let
  74         m = DB.currentModel
  75         configurationContext = MODEL.configurationOf m
  76         composites = resolveComposites configurationContext folderPaths
  77         components = componentFinder m
  78     in
  79         if (length folderPaths > 0) then filter (partOfComposites composites (VAR.resourceVariable configurationContext)) components
  80         else components
  81
  82 @private
  83 reverseSynchronizableProperties :: (Variable -> <ReadGraph> Maybe Variable) -> Variable -> <ReadGraph> [Synchronizable]
  84 reverseSynchronizableProperties experimentPropertyMapper componentVar = mapMaybe (reverseSynchronizable experimentPropertyMapper) (VAR.properties componentVar)
  85
  86 @private
  87 formatSynchronizable :: Synchronizable -> <ReadGraph> String
  88 formatSynchronizable (Synchronizable config active configValue activeValue) = let
  89         component = VAR.variableParent config
  90         componentName = VAR.name component
  91         propertyName = VAR.name config
  92         path = unescapeUri (rvi (VAR.variableParent component))
  93     in
  94         path + "\t" + componentName + "\t" + propertyName + "\t" + configValue + "\t" + activeValue + "\n"
  95
  96 @private
  97 showSynchronizable :: Synchronizable -> <ReadGraph> String
  98 showSynchronizable (Synchronizable config active configValue activeValue) = let
  99         component = VAR.variableParent config
 100         componentName = VAR.name component
 101         propertyName = VAR.name config
 102     in
 103         componentName + " " + propertyName + " " + configValue + " -> " + activeValue
 104
 105 """
 106 Resolves all component properties that can be reverse synchronized from
 107 the active model's currently active solver state into the active model's
 108 configuration. The @Synchronizable@s resolved can then be passed on to other
 109 functions in this module for printing and application.
 110
 111 Reverse synchronizability of a component and its properties is left up to
 112 argument functions. The `moduleFinder` function looks for all synchronizable components
 113 within the model specified as argument and the `experimentPropertyFilter`
 114 function filters the properties that are considered reverse-synchronizable.
 115
 116 The @folderPaths@ argument can be used to tell the system which subfolders
 117 of the model configuration to check for reverse-synchronizable properties.
 118 For example, to specify that you want all modules contained by the root
 119 folder @Folder@ to be examined, you should just specify @[["Folder"]]@.
 120 On the other hand if you want to check only specific subfolders/drawings,
 121 you can specify them like this: @[["Folder", "Subfolder","Drawing"], ["Folder", "Subfolder 2", "Another Drawing"]]@.
 122 To examine all modules in the model configuration, the empty list @[]@
 123 can be specified.
 124
 125 Examples:
 126 > findReverseSynchronizables []
 127 > findReverseSynchronizables [["Folder"]]
 128 > findReverseSynchronizables [["Folder", "Subfolder", "Drawing 1"], ["Folder", "Subfolder 2", "Another Drawing"]]
 129 """
 130 findReverseSynchronizables :: (Resource -> <ReadGraph> [Variable]) ->
 131                           (Variable -> <ReadGraph> Maybe Variable) ->
 132                           [[String]] -> <Proc,ReadGraph> [Synchronizable]
 133 findReverseSynchronizables componentFinder experimentPropertyMapper folderPaths =
 134     concatMap (reverseSynchronizableProperties experimentPropertyMapper)
 135               (reverseSynchronizableComponents componentFinder folderPaths)
 136
 137 """
 138 Formats the specified list of synchronizables into a String where each
 139 line of text represents a single synchronizable in the following
 140 tab-separated format that can be directly copy-pasted into e.g. Excel:
 141
 142 <path>\t<componentName>\t<propertyName>\t<configValue>\t<activeValue>
 143
 144 Example:
 145 > print (formatSynchronizables (findReverseSynchronizables []))
 146 """
 147 formatSynchronizables :: [Synchronizable] -> <ReadGraph> String
 148 formatSynchronizables syncs = concatStrings $ map formatSynchronizable syncs
 149
 150 @private
 151 applyReverseSynchronization :: Synchronizable -> <Proc,WriteGraph> ()
 152 applyReverseSynchronization s = do
 153     print ("Reverse synchronizing " + (showSynchronizable s))
 154     match s with
 155         (Synchronizable configVar _ _ activeValue) -> VAR.setPropertyValue configVar "HasDisplayValue" activeValue
 156
 157 """
 158 Applies a list of reverse synchronization operations into the active model's configuration.
 159
 160 Example:
 161 > applyReverseSynchronizations (findReverseSynchronizables [])
 162 """
 163 applyReverseSynchronizations :: [Synchronizable] -> <Proc,WriteGraph> ()
 164 applyReverseSynchronizations syncs = do
 165     DB.disableDependencies ()
 166     for syncs applyReverseSynchronization