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