--- /dev/null
+import "MSet" as MSet\r
+import "Simantics/DB" (Resource)\r
+import "Simantics/Variables" (Variable)\r
+import "Simantics/DB" as DB\r
+import "Simantics/Variables" as VAR\r
+import "Simantics/Model" as MODEL\r
+\r
+// ----------------------------------------------------------------------------\r
+\r
+data Synchronizable = Synchronizable Variable Variable String String\r
+\r
+// ----------------------------------------------------------------------------\r
+// Utility functions and imports\r
+\r
+@private\r
+importJava "org.simantics.db.layer0.variable.Variables" where\r
+ @JavaName getRVI\r
+ rvi :: Variable -> <ReadGraph> String\r
+\r
+@private\r
+importJava "org.simantics.databoard.util.URIStringUtils" where\r
+ @JavaName escape\r
+ escapeUri :: String -> String\r
+ @JavaName unescape\r
+ unescapeUri :: String -> String\r
+\r
+@private\r
+partOfComposites :: MSet.T Resource -> Variable -> Variable -> <Proc,ReadGraph> Boolean\r
+partOfComposites composites context v = let\r
+ recurseParent var = match (VAR.possibleParent var) with\r
+ Just p -> partOfComposites composites context p\r
+ Nothing -> False\r
+ in\r
+ if (context == v) then False\r
+ else match (VAR.possibleRepresents v) with\r
+ Nothing -> recurseParent v\r
+ Just r -> if (MSet.contains composites r) then True\r
+ else recurseParent v\r
+\r
+@private\r
+concatStrings :: [String] -> String\r
+concatStrings strings = foldl (\s1 s2 -> s1 + s2) "" strings\r
+\r
+@private\r
+glueFilteredStrings :: String -> (String -> String) -> [String] -> String\r
+glueFilteredStrings glue f strings = foldl (\s1 s2 -> s1 + glue + (f s2)) "" strings\r
+\r
+@private\r
+reverseSynchronizable :: (Variable -> <ReadGraph> Maybe Variable) -> Variable -> <ReadGraph> Maybe Synchronizable\r
+reverseSynchronizable experimentPropertyMapper configProp = match (experimentPropertyMapper configProp) with \r
+ Nothing -> Nothing\r
+ Just activeProp -> let\r
+ configValue = (VAR.propertyValue configProp "HasDisplayValue") :: String\r
+ activeValue = (VAR.propertyValue activeProp "HasDisplayValue") :: String\r
+ in do\r
+ if (activeValue == configValue) then Nothing\r
+ else Just $ Synchronizable\r
+ configProp\r
+ activeProp\r
+ configValue\r
+ activeValue\r
+\r
+@private\r
+resolveComposite :: String -> [String] -> <ReadGraph> Maybe Resource\r
+resolveComposite pathContextUri path = DB.possibleResource (pathContextUri + (glueFilteredStrings "/" escapeUri path))\r
+\r
+@private\r
+resolveComposites :: Resource -> [[String]] -> <Proc,ReadGraph> MSet.T Resource\r
+resolveComposites pathContext paths = MSet.fromList (mapMaybe (resolveComposite (DB.uriOf pathContext)) paths)\r
+\r
+@private\r
+reverseSynchronizableComponents :: (Resource -> <ReadGraph> [Variable]) -> [[String]] -> <Proc,ReadGraph> [Variable]\r
+reverseSynchronizableComponents componentFinder folderPaths = let\r
+ m = DB.currentModel\r
+ configurationContext = MODEL.configurationOf m\r
+ composites = resolveComposites configurationContext folderPaths\r
+ components = componentFinder m\r
+ in\r
+ if (length folderPaths > 0) then filter (partOfComposites composites (VAR.resourceVariable configurationContext)) components\r
+ else components\r
+\r
+@private\r
+reverseSynchronizableProperties :: (Variable -> <ReadGraph> Maybe Variable) -> Variable -> <ReadGraph> [Synchronizable]\r
+reverseSynchronizableProperties experimentPropertyMapper componentVar = mapMaybe (reverseSynchronizable experimentPropertyMapper) (VAR.properties componentVar)\r
+\r
+@private\r
+formatSynchronizable :: Synchronizable -> <ReadGraph> String\r
+formatSynchronizable (Synchronizable config active configValue activeValue) = let\r
+ component = VAR.variableParent config\r
+ componentName = VAR.name component\r
+ propertyName = VAR.name config\r
+ path = unescapeUri (rvi (VAR.variableParent component))\r
+ in\r
+ path + "\t" + componentName + "\t" + propertyName + "\t" + configValue + "\t" + activeValue + "\n"\r
+\r
+@private\r
+showSynchronizable :: Synchronizable -> <ReadGraph> String \r
+showSynchronizable (Synchronizable config active configValue activeValue) = let\r
+ component = VAR.variableParent config\r
+ componentName = VAR.name component\r
+ propertyName = VAR.name config\r
+ in\r
+ componentName + " " + propertyName + " " + configValue + " -> " + activeValue\r
+\r
+"""\r
+Resolves all component properties that can be reverse synchronized from\r
+the active model's currently active solver state into the active model's\r
+configuration. The @Synchronizable@s resolved can then be passed on to other\r
+functions in this module for printing and application.\r
+\r
+Reverse synchronizability of a component and its properties is left up to\r
+argument functions. The `moduleFinder` function looks for all synchronizable components\r
+within the model specified as argument and the `experimentPropertyFilter`\r
+function filters the properties that are considered reverse-synchronizable.\r
+\r
+The @folderPaths@ argument can be used to tell the system which subfolders\r
+of the model configuration to check for reverse-synchronizable properties.\r
+For example, to specify that you want all modules contained by the root\r
+folder @Folder@ to be examined, you should just specify @[["Folder"]]@.\r
+On the other hand if you want to check only specific subfolders/drawings,\r
+you can specify them like this: @[["Folder", "Subfolder","Drawing"], ["Folder", "Subfolder 2", "Another Drawing"]]@.\r
+To examine all modules in the model configuration, the empty list @[]@\r
+can be specified.\r
+\r
+Examples:\r
+> findReverseSynchronizables []\r
+> findReverseSynchronizables [["Folder"]]\r
+> findReverseSynchronizables [["Folder", "Subfolder", "Drawing 1"], ["Folder", "Subfolder 2", "Another Drawing"]]\r
+"""\r
+findReverseSynchronizables :: (Resource -> <ReadGraph> [Variable]) ->\r
+ (Variable -> <ReadGraph> Maybe Variable) ->\r
+ [[String]] -> <Proc,ReadGraph> [Synchronizable]\r
+findReverseSynchronizables componentFinder experimentPropertyMapper folderPaths =\r
+ concatMap (reverseSynchronizableProperties experimentPropertyMapper)\r
+ (reverseSynchronizableComponents componentFinder folderPaths)\r
+\r
+"""\r
+Formats the specified list of synchronizables into a String where each\r
+line of text represents a single synchronizable in the following\r
+tab-separated format that can be directly copy-pasted into e.g. Excel:\r
+\r
+<path>\t<componentName>\t<propertyName>\t<configValue>\t<activeValue>\r
+\r
+Example:\r
+> print (formatSynchronizables (findReverseSynchronizables []))\r
+"""\r
+formatSynchronizables :: [Synchronizable] -> <ReadGraph> String \r
+formatSynchronizables syncs = concatStrings $ map formatSynchronizable syncs\r
+\r
+@private\r
+applyReverseSynchronization :: Synchronizable -> <Proc,WriteGraph> ()\r
+applyReverseSynchronization s = do\r
+ print ("Reverse synchronizing " + (showSynchronizable s))\r
+ match s with\r
+ (Synchronizable configVar _ _ activeValue) -> VAR.setPropertyValue configVar "HasDisplayValue" activeValue\r
+\r
+"""\r
+Applies a list of reverse synchronization operations into the active model's configuration.\r
+\r
+Example:\r
+> applyReverseSynchronizations (findReverseSynchronizables [])\r
+"""\r
+applyReverseSynchronizations :: [Synchronizable] -> <Proc,WriteGraph> ()\r
+applyReverseSynchronizations syncs = do\r
+ DB.disableDependencies ()\r
+ for syncs applyReverseSynchronization\r
Code Review / simantics / platform.git / blobdiff