Migrated source code from Simantics SVN

[simantics/platform.git] / bundles / org.simantics.modeling / scl / Simantics / SharedOntologies.scl

diff --git a/bundles/org.simantics.modeling/scl/Simantics/SharedOntologies.scl b/bundles/org.simantics.modeling/scl/Simantics/SharedOntologies.scl
new file mode 100644 (file)
index 0000000..86229ad
--- /dev/null
+++ b/bundles/org.simantics.modeling/scl/Simantics/SharedOntologies.scl
@@ -0,0 +1,183 @@
+import "JavaBuiltin" as Java\r
+include "Simantics/Variables"\r
+include "Simantics/Ontologies"\r
+include "Simantics/SCL"\r
+include "Simantics/Misc"\r
+import "http://www.simantics.org/Layer0-1.1/Entity" as ENTITY\r
+\r
+createClusterSet :: Resource -> <WriteGraph> ()\r
+createClusterSet r = do\r
+    newClusterSet r\r
+    selectClusterSet r\r
+    ()\r
+\r
+createLibrary :: Resource -> Resource -> String -> Boolean -> <WriteGraph> Resource\r
+createLibrary parentLibrary libraryType name clusterSet = do\r
+    selectClusterSet parentLibrary\r
+    library = newResource ()\r
+    match clusterSet with\r
+        True -> createClusterSet library\r
+        False -> ()\r
+    claim library L0.InstanceOf libraryType\r
+    claimRelatedValue library L0.HasName name\r
+    claim parentLibrary L0.ConsistsOf library\r
+    library\r
+\r
+uriParts :: String -> [String]\r
+uriParts uri = do\r
+    match uri with\r
+        "http://" -> []\r
+        _ -> do\r
+            parts = splitURI uri\r
+            addList (uriParts (parts!0)) (parts!1)\r
+\r
+getOrCreateLibrary :: Resource -> Resource -> String -> Boolean -> <WriteGraph> Resource\r
+getOrCreateLibrary parentLibrary libraryType name clusterSet = do\r
+    match possibleResourceChild parentLibrary name with\r
+        Just child -> child\r
+        Nothing -> createLibrary parentLibrary libraryType name clusterSet\r
+    \r
+createSharedOntology :: String -> Resource -> <WriteGraph> Resource\r
+createSharedOntology uri ontologyType = do\r
+    path = uriParts uri\r
+    lastId = length path - 1\r
+    parentLibrary = foldl (\p id -> getOrCreateLibrary p L0.Library (path!id) False) \r
+        (getRootLibrary ()) \r
+        [0..lastId-1]\r
+    res = getOrCreateLibrary parentLibrary ontologyType (path!lastId) True\r
+    createSCLModule res "SCLMain"\r
+    res\r
+    \r
+traverseOntologies :: Resource -> (Resource -> <ReadGraph> Boolean) -> <ReadGraph> [Resource]\r
+traverseOntologies library filterFn =\r
+    if library `isInstanceOf` L0.Ontology then (filter filterFn [library])\r
+    else if library `isInstanceOf` SIMU.Model then []\r
+    else if library `isInstanceOf` L0.Library then\r
+        foldl (\result r -> (result + (traverseOntologies r filterFn))) [] (library # L0.ConsistsOf)\r
+    else []\r
+\r
+traverseSharedOntologies :: Resource -> <ReadGraph> [Resource]\r
+traverseSharedOntologies library = traverseOntologies library acceptSharedOntology\r
+\r
+acceptSharedOntology :: Resource -> <ReadGraph> Boolean\r
+acceptSharedOntology ontology =\r
+    if ontology `isInstanceOf` L0.SharedOntology then\r
+        not $ relatedValue ontology L0.SharedOntology.treatAsSystemOntology\r
+    else False\r
+\r
+traverseSystemOntologies :: Resource -> <ReadGraph> [Resource]\r
+traverseSystemOntologies library = traverseOntologies library acceptSystemOntology\r
+\r
+acceptSystemOntology :: Resource -> <ReadGraph> Boolean\r
+acceptSystemOntology ontology = \r
+    if ontology `isInstanceOf` L0.SharedOntology then\r
+        relatedValue ontology L0.SharedOntology.treatAsSystemOntology\r
+    else True\r
+\r
+linkSharedOntology :: Resource -> Resource -> <WriteGraph> ()\r
+linkSharedOntology model ontology = do\r
+    markUndoPoint ()\r
+    claim model L0.IsLinkedTo ontology\r
+    addCommentMetadata ("Linked shared ontology " + (relatedValue2 ontology L0.HasName) + " to " + (relatedValue2 model L0.HasName))  \r
+    ()\r
+\r
+unlinkSharedOntology :: Resource -> Resource -> <WriteGraph> ()\r
+unlinkSharedOntology model ontology = do\r
+    markUndoPoint ()\r
+    deny model L0.IsLinkedTo ontology\r
+    addCommentMetadata ("Unlinked shared ontology " + (relatedValue2 ontology L0.HasName) + " from " + (relatedValue2 model L0.HasName))\r
+    ()\r
+\r
+getSharedOntologies :: () -> <ReadGraph> [Resource]\r
+getSharedOntologies dummy = traverseSharedOntologies $ getRootLibrary ()\r
+\r
+getSystemOntologies :: () -> <ReadGraph> [Resource]\r
+getSystemOntologies dummy = traverseSystemOntologies $ getRootLibrary ()\r
+\r
+getVisibleSystemOntologies :: () -> <ReadGraph> [Resource]\r
+getVisibleSystemOntologies dummy = do\r
+    match (queryPreference "org.simantics" "ontology.visibility") with\r
+      "shared" -> []\r
+      "all" -> getSystemOntologies ()\r
+      "" -> []\r
+\r
+usedSharedOntologies :: Resource -> <ReadGraph> [Resource]\r
+usedSharedOntologies model = do\r
+    ontologies = getSharedOntologies ()\r
+    let f e = existsStatement3 model L0.IsLinkedTo e\r
+    in filter f ontologies\r
+\r
+availableSharedOntologies :: Resource -> <ReadGraph> [Resource]\r
+availableSharedOntologies r = do\r
+    ontologies = getSharedOntologies ()\r
+    ontologies = filter f ontologies\r
+        where f ontology = not $ existsStatement3 r L0.IsLinkedTo ontology\r
+    ontologies = filter f ontologies\r
+        where f ontology = not $ isLinkedToDeep ontology r\r
+    ontologies\r
+\r
+querySharedOntologyType :: () -> <ReadGraph> Resource\r
+querySharedOntologyType dummy = do\r
+    ontologies = listOntologies ()\r
+    types = foldl (\result ontology -> (result + (searchByType ontology L0.IndexRootType))) [] $ listOntologies ()\r
+    types = filter f types\r
+      where f res = not $ isInheritedFrom res SIMU.Model \r
+    types = filter f types\r
+      where f res = not $ existsStatement res L0.Abstract \r
+    types!0\r
+\r
+importJava "org.simantics.modeling.ModelingUtils" where\r
+    importSharedOntologyWithUI :: Variable -> <ReadGraph> ()\r
+    importSharedOntology :: String -> ()\r
+    createSharedOntologyWithUI :: Resource -> <ReadGraph> ()\r
+    unlinkSharedOntologyWithUI :: Variable -> [Resource] -> <ReadGraph> ()\r
+    createNewVersionWithUI :: Resource -> <ReadGraph> ()\r
+    createNewVersionWithoutUI :: Resource -> <WriteGraph> ()\r
+    exportSharedOntology :: Resource -> String -> String -> Integer -> <ReadGraph> () \r
+    publishComponentTypeWithUI :: Resource -> <WriteGraph> ()\r
+    publishSharedOntologyWithUI :: Resource -> <WriteGraph> ()\r
+    isLinkedToDeep :: Resource -> Resource -> <ReadGraph> Boolean\r
+    publish :: Resource -> <WriteGraph> ()\r
+    \r
+publishAction :: Resource -> <Proc> ()\r
+publishAction res = do\r
+  syncWrite (\() -> publish res)\r
+  ()\r
+\r
+publishComponentTypeAction :: Resource -> <Proc> ()\r
+publishComponentTypeAction res = do\r
+  syncWrite (\() -> publishComponentTypeWithUI res)\r
+  ()\r
+\r
+publishSharedOntologyAction :: Resource -> <Proc> ()\r
+publishSharedOntologyAction res = do\r
+  syncWrite (\() -> publishSharedOntologyWithUI res)\r
+  ()\r
+\r
+newVersionAction :: Resource -> <Proc> ()\r
+newVersionAction res = do\r
+  syncRead (\() -> createNewVersionWithUI res)\r
+  ()\r
+  \r
+isNotPublished :: Resource -> <ReadGraph> Boolean\r
+isNotPublished r = match (untypedPossibleRelatedValue r ENTITY.published) with\r
+  Just a -> False\r
+  Nothing -> True\r
+\r
+isContainerNotPublished :: Resource -> <ReadGraph> Boolean\r
+isContainerNotPublished r = match (possibleIndexRoot r) with\r
+  Just root -> isNotPublished root\r
+  Nothing -> True\r
+  \r
+isPublished :: Resource -> <ReadGraph> Boolean\r
+isPublished r = match (untypedPossibleRelatedValue r ENTITY.published) with\r
+  Just a -> True\r
+  Nothing -> False\r
+\r
+isLocked :: Resource -> <ReadGraph> Boolean\r
+isLocked r = existsStatement r STR.ComponentType.Locked\r
+\r
+isNotLocked = not . isLocked\r
+\r
+treatAsSystemOntology :: Resource -> Boolean  -> <WriteGraph> ()\r
+treatAsSystemOntology sharedOntology setting = claimRelatedValue sharedOntology L0.SharedOntology.treatAsSystemOntology setting\r