X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FSharedOntologies.scl;h=212a4fbaf0011b130f69efdd2c772d0f3b58ac2b;hp=86229ad5e5dd1c431e8c3a8ed4664d7ab9b29115;hb=9ad7e1083f6c05bc19febf7b40bfe41db26c3877;hpb=969bd23cab98a79ca9101af33334000879fb60c5

diff --git a/bundles/org.simantics.modeling/scl/Simantics/SharedOntologies.scl b/bundles/org.simantics.modeling/scl/Simantics/SharedOntologies.scl
index 86229ad5e..212a4fbaf 100644
--- a/bundles/org.simantics.modeling/scl/Simantics/SharedOntologies.scl
+++ b/bundles/org.simantics.modeling/scl/Simantics/SharedOntologies.scl
@@ -1,183 +1,184 @@
-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 -> ()
-    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
+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