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