X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FReverseSynchronization.scl;h=b10fb65ed45d62c1bd2d64d0fc25e91ddbf0e6a7;hp=2aa22f1cedd4824719e835188c5141ad5a2c8b47;hb=refs%2Fchanges%2F38%2F238%2F2;hpb=24e2b34260f219f0d1644ca7a138894980e25b14 diff --git a/bundles/org.simantics.modeling/scl/Simantics/ReverseSynchronization.scl b/bundles/org.simantics.modeling/scl/Simantics/ReverseSynchronization.scl index 2aa22f1ce..b10fb65ed 100644 --- a/bundles/org.simantics.modeling/scl/Simantics/ReverseSynchronization.scl +++ b/bundles/org.simantics.modeling/scl/Simantics/ReverseSynchronization.scl @@ -1,166 +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 +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