]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.modeling/scl/Simantics/SharedOntologies.scl
Change jersey from 2.25.1 to 2.26 to resolve resource-locator problems
[simantics/platform.git] / bundles / org.simantics.modeling / scl / Simantics / SharedOntologies.scl
1 import "JavaBuiltin" as Java
2 include "Simantics/Variables"
3 include "Simantics/Ontologies"
4 include "Simantics/SCL"
5 include "Simantics/Misc"
6 import "http://www.simantics.org/Layer0-1.1/Entity" as ENTITY
7
8 createClusterSet :: Resource -> <WriteGraph> ()
9 createClusterSet r = do
10     newClusterSet r
11     selectClusterSet r
12     ()
13
14 createLibrary :: Resource -> Resource -> String -> Boolean -> <WriteGraph> Resource
15 createLibrary parentLibrary libraryType name clusterSet = do
16     selectClusterSet parentLibrary
17     library = newResource ()
18     match clusterSet with
19         True -> createClusterSet library
20         False -> ()
21     claim library L0.InstanceOf libraryType
22     claimRelatedValue library L0.HasName name
23     claim parentLibrary L0.ConsistsOf library
24     library
25
26 uriParts :: String -> [String]
27 uriParts uri = do
28     match uri with
29         "http://" -> []
30         _ -> do
31             parts = splitURI uri
32             addList (uriParts (parts!0)) (parts!1)
33
34 getOrCreateLibrary :: Resource -> Resource -> String -> Boolean -> <WriteGraph> Resource
35 getOrCreateLibrary parentLibrary libraryType name clusterSet = do
36     match possibleResourceChild parentLibrary name with
37         Just child -> child
38         Nothing -> createLibrary parentLibrary libraryType name clusterSet
39     
40 createSharedOntology :: String -> Resource -> <WriteGraph> Resource
41 createSharedOntology uri ontologyType = do
42     path = uriParts uri
43     lastId = length path - 1
44     parentLibrary = foldl (\p id -> getOrCreateLibrary p L0.Library (path!id) False) 
45         (getRootLibrary ()) 
46         [0..lastId-1]
47     res = getOrCreateLibrary parentLibrary ontologyType (path!lastId) True
48     createSCLModule res "SCLMain"
49     res
50     
51 traverseOntologies :: Resource -> (Resource -> <ReadGraph> Boolean) -> <ReadGraph> [Resource]
52 traverseOntologies library filterFn =
53     if library `isInstanceOf` L0.Ontology then (filter filterFn [library])
54     else if library `isInstanceOf` SIMU.Model then []
55     else if library `isInstanceOf` L0.Library then
56         foldl (\result r -> (result + (traverseOntologies r filterFn))) [] (library # L0.ConsistsOf)
57     else []
58
59 traverseSharedOntologies :: Resource -> <ReadGraph> [Resource]
60 traverseSharedOntologies library = traverseOntologies library acceptSharedOntology
61
62 acceptSharedOntology :: Resource -> <ReadGraph> Boolean
63 acceptSharedOntology ontology =
64     if ontology `isInstanceOf` L0.SharedOntology then
65         not $ relatedValue ontology L0.SharedOntology.treatAsSystemOntology
66     else False
67
68 traverseSystemOntologies :: Resource -> <ReadGraph> [Resource]
69 traverseSystemOntologies library = traverseOntologies library acceptSystemOntology
70
71 acceptSystemOntology :: Resource -> <ReadGraph> Boolean
72 acceptSystemOntology ontology = 
73     if ontology `isInstanceOf` L0.SharedOntology then
74         relatedValue ontology L0.SharedOntology.treatAsSystemOntology
75     else True
76
77 linkSharedOntology :: Resource -> Resource -> <WriteGraph> ()
78 linkSharedOntology model ontology = do
79     markUndoPoint ()
80     claim model L0.IsLinkedTo ontology
81     addCommentMetadata ("Linked shared ontology " + (relatedValue2 ontology L0.HasName) + " to " + (relatedValue2 model L0.HasName))  
82     ()
83
84 unlinkSharedOntology :: Resource -> Resource -> <WriteGraph> ()
85 unlinkSharedOntology model ontology = do
86     markUndoPoint ()
87     deny model L0.IsLinkedTo ontology
88     addCommentMetadata ("Unlinked shared ontology " + (relatedValue2 ontology L0.HasName) + " from " + (relatedValue2 model L0.HasName))
89     ()
90
91 getSharedOntologies :: () -> <ReadGraph> [Resource]
92 getSharedOntologies dummy = traverseSharedOntologies $ getRootLibrary ()
93
94 getSystemOntologies :: () -> <ReadGraph> [Resource]
95 getSystemOntologies dummy = traverseSystemOntologies $ getRootLibrary ()
96
97 getVisibleSystemOntologies :: () -> <ReadGraph> [Resource]
98 getVisibleSystemOntologies dummy = do
99     match (queryPreference "org.simantics" "ontology.visibility") with
100       "shared" -> []
101       "all" -> getSystemOntologies ()
102       "" -> []
103
104 usedSharedOntologies :: Resource -> <ReadGraph> [Resource]
105 usedSharedOntologies model = do
106     ontologies = getSharedOntologies ()
107     let f e = existsStatement3 model L0.IsLinkedTo e
108     in filter f ontologies
109
110 availableSharedOntologies :: Resource -> <ReadGraph> [Resource]
111 availableSharedOntologies r = do
112     ontologies = getSharedOntologies ()
113     ontologies = filter f ontologies
114         where f ontology = not $ existsStatement3 r L0.IsLinkedTo ontology
115     ontologies = filter f ontologies
116         where f ontology = not $ isLinkedToDeep ontology r
117     ontologies
118
119 querySharedOntologyType :: () -> <ReadGraph> Resource
120 querySharedOntologyType dummy = do
121     ontologies = listOntologies ()
122     types = foldl (\result ontology -> (result + (searchByType ontology L0.IndexRootType))) [] $ listOntologies ()
123     types = filter f types
124       where f res = not $ isInheritedFrom res SIMU.Model 
125     types = filter f types
126       where f res = not $ existsStatement res L0.Abstract 
127     types!0
128
129 importJava "org.simantics.modeling.ModelingUtils" where
130     importSharedOntologyWithUI :: Variable -> <ReadGraph> ()
131     importSharedOntology :: String -> ()
132     createSharedOntologyWithUI :: Resource -> <ReadGraph> ()
133     unlinkSharedOntologyWithUI :: Variable -> [Resource] -> <ReadGraph> ()
134     createNewVersionWithUI :: Resource -> <ReadGraph> ()
135     createNewVersionWithoutUI :: Resource -> <WriteGraph> ()
136     exportSharedOntology :: Resource -> String -> String -> Integer -> <ReadGraph> () 
137     publishComponentTypeWithUI :: Resource -> <WriteGraph> ()
138     publishSharedOntologyWithUI :: Resource -> <WriteGraph> ()
139     isLinkedToDeep :: Resource -> Resource -> <ReadGraph> Boolean
140     publish :: Resource -> <WriteGraph> ()
141     
142 publishAction :: Resource -> <Proc> ()
143 publishAction res = do
144   syncWrite (\() -> publish res)
145   ()
146
147 publishComponentTypeAction :: Resource -> <Proc> ()
148 publishComponentTypeAction res = do
149   syncWrite (\() -> publishComponentTypeWithUI res)
150   ()
151
152 publishSharedOntologyAction :: Resource -> <Proc> ()
153 publishSharedOntologyAction res = do
154   syncWrite (\() -> publishSharedOntologyWithUI res)
155   ()
156
157 newVersionAction :: Resource -> <Proc> ()
158 newVersionAction res = do
159   syncRead (\() -> createNewVersionWithUI res)
160   ()
161   
162 isNotPublished :: Resource -> <ReadGraph> Boolean
163 isNotPublished r = match (untypedPossibleRelatedValue r ENTITY.published) with
164   Just a -> False
165   Nothing -> True
166
167 isContainerNotPublished :: Resource -> <ReadGraph> Boolean
168 isContainerNotPublished r = match (possibleIndexRoot r) with
169   Just root -> isNotPublished root
170   Nothing -> True
171   
172 isPublished :: Resource -> <ReadGraph> Boolean
173 isPublished r = match (untypedPossibleRelatedValue r ENTITY.published) with
174   Just a -> True
175   Nothing -> False
176
177 isLocked :: Resource -> <ReadGraph> Boolean
178 isLocked r = existsStatement r STR.ComponentType.Locked
179
180 isNotLocked = not . isLocked
181
182 treatAsSystemOntology :: Resource -> Boolean  -> <WriteGraph> ()
183 treatAsSystemOntology sharedOntology setting = claimRelatedValue sharedOntology L0.SharedOntology.treatAsSystemOntology setting