19e83d30b571a7dfd9cf197090b1fecbe72939ea
[simantics/platform.git] / bundles / org.simantics.scl.db / scl / Simantics / DB.scl
1 import "JavaBuiltin" as Java
2 include "http://www.simantics.org/Layer0-1.1" as L0
3 import "Map" as Map
4
5 infixl 5 (#)
6  
7 effect ReadGraph
8     "graph"
9     "org.simantics.db.ReadGraph"
10
11 effect WriteGraph
12     "graph"
13     "org.simantics.db.WriteGraph"
14     
15 importJava "org.simantics.db.Resource" where
16     "A resource is a node in a semantic graph."
17     data Resource
18     
19     "Returns the 64-bit unique identifier of the resource."
20     @JavaName getResourceId
21     resourceId :: Resource -> Long
22     
23 importJava "org.simantics.db.ReadGraph" where
24     data ReadGraphX
25     
26 instance Ord Resource where
27     compare a b = compare (resourceId a) (resourceId b)
28   
29 instance Show Resource where
30     show r = "#" + show (resourceId r)
31
32 instance Show Statement where
33     show s = "#" + show (resourceId ( subjectOf s)) + "#" + show (resourceId ( predicateOf s)) + "#" + show (resourceId ( objectOf s))
34
35 importJava "org.simantics.db.Statement" where
36     "A statement is an edge in a semantic graph."
37     data Statement
38     
39     @JavaName getSubject
40     subjectOf :: Statement -> Resource
41     @JavaName getPredicate
42     predicateOf :: Statement -> Resource
43     @JavaName getObject
44     objectOf :: Statement -> Resource
45     
46     isAsserted :: Statement -> Resource -> <ReadGraph> Boolean
47     
48 importJava "org.simantics.db.ReadGraph" where
49     "Converts an absolute URI to a resource or returns `Nothing` if there is no such resource."
50     @JavaName getPossibleResource
51     possibleResource :: String -> <ReadGraph> (Maybe Resource)
52     
53     getDataType :: Resource -> <ReadGraph> Datatype
54
55     @JavaName getSupertypes
56     superTypesOf :: Resource -> <ReadGraph> Set.T Resource
57     
58     @private
59     @JavaName getURI
60     uriOfResource :: Resource -> <ReadGraph> String
61     
62     @JavaName getObjects
63     objects_ :: Resource -> Resource -> <ReadGraph> Collection Resource
64     
65     @JavaName getStatements
66     statements_ :: Resource -> Resource -> <ReadGraph> Collection Statement
67     
68     @JavaName hasStatement
69     existsStatement :: Resource -> Resource -> <ReadGraph> Boolean
70     
71     @JavaName hasStatement
72     existsStatement3 :: Resource -> Resource -> Resource -> <ReadGraph> Boolean
73
74     "Assumes that there is exactly one object with the given subject and predicate and returns it."
75     @JavaName getSingleObject
76     singleObject :: Resource -> Resource -> <ReadGraph> Resource
77
78     """
79     If there is exactly one object with the given `subject` and `predicate`,
80     `possibleObject subject predicate` returns it. Otherwise, it returns
81     `Nothing`.
82     """
83     @JavaName getPossibleObject
84     possibleObject :: Resource -> Resource -> <ReadGraph> Maybe Resource
85
86     "Assumes that there is exactly one statement with the given subject and predicate and returns it."
87     @JavaName getSingleStatement
88     singleStatement :: Resource -> Resource -> <ReadGraph> Statement
89
90     @JavaName getPossibleStatement
91     possibleStatement :: Resource -> Resource -> <ReadGraph> Maybe Statement
92
93     @JavaName getRelatedVariantValue
94     relatedVariantValue :: Resource -> Resource -> <ReadGraph> Variant
95
96     @JavaName getRelatedValue
97     relatedValue_ :: Resource -> Resource -> Binding a -> <ReadGraph> a
98     
99     @JavaName getRelatedValue
100     untypedRelatedValue :: Resource -> Resource -> <ReadGraph> a
101
102     @JavaName getRelatedValue2
103     relatedValue2 :: Resource -> Resource -> <ReadGraph> a
104
105     @JavaName getRelatedVariantValue2
106     relatedVariantValue2 :: Resource -> Resource -> <ReadGraph> Variant
107     
108     @JavaName getPossibleRelatedValue
109     possibleRelatedValue_ :: Resource -> Resource -> Binding a -> <ReadGraph> Maybe a
110     
111     @JavaName getPossibleRelatedValue
112     untypedPossibleRelatedValue :: Resource -> Resource -> <ReadGraph> Maybe a
113     
114     @private
115     @JavaName getValue
116     valueOf_ :: Resource -> Binding a -> <ReadGraph> a
117     
118     @private
119     @JavaName getVariantValue
120     variantValueOf_ :: Resource -> <ReadGraph> Variant
121     
122     @JavaName getValue
123     untypedValueOf :: Resource -> <ReadGraph> Dynamic
124     
125     @JavaName getPossibleValue
126     untypedPossibleValueOf :: Resource -> <ReadGraph> Maybe Dynamic
127     
128     @JavaName getInverse
129     inverseOf :: Resource -> <ReadGraph> Resource
130     
131     @JavaName getSingleType
132     singleTypeOf :: Resource -> Resource -> <ReadGraph> Resource
133     
134     @JavaName getPossibleType
135     possibleTypeOf :: Resource -> Resource -> <ReadGraph> Maybe Resource
136     
137     "`isInstanceOf r t` returns true, if `r` is an instance of `t`"
138     isInstanceOf :: Resource -> Resource -> <ReadGraph> Boolean
139     isSubrelationOf :: Resource -> Resource -> <ReadGraph> Boolean
140     isInheritedFrom :: Resource -> Resource -> <ReadGraph> Boolean
141     
142     getRootLibrary :: () -> <ReadGraph> Resource
143
144 importJava "org.simantics.db.layer0.util.ExtendedUris" where
145     "Converts an absolute URI to a resource"
146     @JavaName resolveAbsoluteUri    
147     resource :: String -> <ReadGraph> Resource
148     
149     "Converts a relative URI to a resource starting from the given resource"
150     @JavaName resolveRelativeUri
151     relativeResource :: Resource -> String -> <ReadGraph> Resource
152
153 "Reads the value of a literal that is an object with the given subject and predicate"
154 @inline
155 relatedValue :: Serializable a => Resource -> Resource -> <ReadGraph> a
156 relatedValue s p = relatedValue_ s p binding
157
158 @inline
159 possibleRelatedValue :: Serializable a => Resource -> Resource -> <ReadGraph> Maybe a
160 possibleRelatedValue s p = possibleRelatedValue_ s p binding
161
162 class Browsable a where
163     fromUri :: String -> <ReadGraph> a
164
165     "Returns the URI of the given value."
166     uriOf :: a -> <ReadGraph> String
167   
168     "Reads the name of the value."
169     nameOf :: a -> <ReadGraph> String
170     possibleNameOf :: a -> <ReadGraph> Maybe String
171     
172     valueOf :: Serializable v => a -> <ReadGraph> v
173     
174     variantValueOf :: a -> <ReadGraph> Variant 
175     
176     children :: a -> <ReadGraph> [a]
177     parent :: a -> <ReadGraph> a
178     possibleParent :: a -> <ReadGraph> Maybe a
179     
180     child :: a -> String -> <ReadGraph> a
181     possibleChild :: a -> String -> <ReadGraph> Maybe a
182     
183 instance Browsable Resource where
184     fromUri = resource
185     uriOf = uriOfResource
186     nameOf r = relatedValue r L0.HasName
187     possibleNameOf r = possibleRelatedValue r L0.HasName
188     @inline
189     valueOf r = valueOf_ r binding
190     variantValueOf = variantValueOf_
191     
192     children r = r # L0.ConsistsOf
193     parent r = singleObject r L0.PartOf
194     possibleParent r = possibleObject r L0.PartOf
195     
196     possibleChild = possibleResourceChild
197     child r n = fromJust (possibleResourceChild r n)
198
199 importJava "org.simantics.db.WriteOnlyGraph" where
200     markUndoPoint :: () -> <WriteGraph> ()
201
202 importJava "org.simantics.db.WriteGraph" where
203     "Creates a new resource."
204     newResource :: () -> <WriteGraph> Resource
205     "Adds a statement to the semantic graph."
206     claim :: Resource -> Resource -> Resource -> <WriteGraph> ()
207     @JavaName claimLiteral
208     claimRelatedValue_ :: Resource -> Resource -> a -> Binding a -> <WriteGraph> ()
209     @JavaName claimLiteral
210     untypedClaimRelatedValue :: Resource -> Resource -> a -> <WriteGraph> ()
211     @JavaName claimValue
212     untypedClaimValue :: Resource -> a -> <WriteGraph> ()
213     @JavaName claimLiteral
214     claimRelatedValueWithType_ :: Resource -> Resource -> Resource -> a -> Binding a -> <WriteGraph> ()
215     "Removes a statement with the given subject, predicate and object"
216     deny :: Resource -> Resource -> Resource -> <WriteGraph> ()
217     @JavaName deny
218     denyByPredicate :: Resource -> Resource -> <WriteGraph> ()
219     @JavaName deny
220     denyAllStatements :: Resource -> <WriteGraph> ()
221     newClusterSet :: Resource -> <WriteGraph> ()
222     @JavaName denyValue
223     denyValue :: Resource -> <WriteGraph> ()
224
225 claimAssertion :: Resource -> Resource -> Resource -> <WriteGraph> ()
226 claimAssertion type_ predicate object = do
227     ass = newResource ()
228     claim ass L0.HasPredicate predicate
229     claim ass L0.HasObject object
230     claim type_ L0.Asserts ass
231
232 "Sets the value of the literal that is an object with the given subject and predicate."
233 @inline
234 claimRelatedValue :: Serializable a => Resource -> Resource -> a -> <WriteGraph> ()
235 claimRelatedValue s p v = claimRelatedValue_ s p v binding
236
237 @inline
238 claimRelatedValueWithType :: Serializable a => Resource -> Resource -> Resource -> a -> <WriteGraph> ()
239 claimRelatedValueWithType s p t v = claimRelatedValueWithType_ s p t v binding
240
241 importJava "org.simantics.layer0.utils.direct.GraphUtils" where
242     @JavaName getPossibleChild
243     possibleResourceChild :: Resource -> String -> <ReadGraph> (Maybe Resource)
244
245 @deprecated "Use function children instead."
246 resourceChildrenOf :: Resource -> <ReadGraph> [Resource]
247 resourceChildrenOf r = r # L0.ConsistsOf
248
249 importJava "org.simantics.db.common.utils.OrderedSetUtils" where
250     @JavaName add
251     addToOrderedSet :: Resource -> Resource -> <WriteGraph> Boolean
252     
253     @JavaName set
254     setOrderedSet :: Resource -> [Resource] -> <WriteGraph> Boolean
255     
256     @JavaName getSingleOwnerList
257     parentOrderedSet :: Resource -> <ReadGraph> Resource
258     
259     @JavaName toList
260     elementsOfOrderedSet :: Resource -> <ReadGraph> [Resource]
261     
262 importJava "org.simantics.db.common.utils.ListUtils" where
263     @JavaName toList
264     elementsOfList :: Resource -> <ReadGraph> [Resource]
265     
266     @JavaName create
267     createList :: [Resource] -> <WriteGraph> Resource
268     
269     @javaName insertBack
270     insertBack :: Resource -> [Resource] -> <WriteGraph> ()
271     
272     @javaName removeElement
273     removeElement :: Resource -> Resource -> <WriteGraph> Boolean
274     
275     @javaName swapWithPrevious
276     swapWithPrevious :: Resource -> Resource -> <WriteGraph> Boolean
277
278     @javaName swapWithNext
279     swapWithNext :: Resource -> Resource -> <WriteGraph> Boolean
280
281
282 importJava "org.simantics.db.common.utils.CommonDBUtils" where
283     isParent :: Resource -> Resource -> <ReadGraph> Boolean
284     possibleRelatedString :: Resource -> Resource -> <ReadGraph> Maybe String
285     possibleRelatedInteger :: Resource -> Resource -> <ReadGraph> Maybe Integer
286     objectsWithType :: Resource -> Resource -> Resource -> <ReadGraph> [Resource]
287     possibleObjectWithType :: Resource -> Resource -> Resource -> <ReadGraph> Maybe Resource
288
289 importJava "org.simantics.db.common.utils.NameUtils" where
290     findFreshName :: String -> Resource -> <ReadGraph> String
291     findFreshEscapedName :: String -> Resource -> <ReadGraph> String
292
293 "`subject # predicate` returns all objects with the given `subject` and `predicate`."
294 (#) :: Resource -> Resource -> <ReadGraph> [Resource]
295 subject # predicate = collectionToList $ objects_ subject predicate
296
297 "statements subject predicate` returns all statements with the given subject and predicate."
298 statements :: Resource -> Resource -> <ReadGraph> [Statement]
299 statements subject predicate = collectionToList $ statements_ subject predicate
300
301 importJava "org.simantics.scl.db.SCLFunctions" where
302     "Executes a read transaction and waits that it completes."
303     syncRead :: (() -> <Proc,ReadGraph> a) -> <Proc> a
304     "Executes a write transaction and waits that it completes."
305     syncWrite :: (() -> <Proc,ReadGraph,WriteGraph> a) -> <Proc> a
306     "Executes a delayed write transaction and waits that it completes."
307     delayedSyncWrite :: (() -> <Proc,WriteGraph> a) -> <Proc> a
308     
309     "Begins a read transaction and immediately returns."
310     asyncRead :: (() -> <Proc,ReadGraph> a) -> <Proc> ()
311     "Begins a write transaction and immediately returns."
312     asyncWrite :: (() -> <Proc,ReadGraph,WriteGraph> a) -> <Proc> ()
313     
314     virtualSyncWriteMem :: String -> (() -> <ReadGraph,WriteGraph> a) -> <WriteGraph> a
315     virtualSyncWriteWS :: String -> (() -> <ReadGraph,WriteGraph> a) -> <WriteGraph> a
316     
317     safeExec :: (() -> <Proc> a) -> <Proc> a
318     activateOnce :: Resource -> <Proc> ()
319     syncActivateOnce :: Resource -> <WriteGraph, Proc> ()
320     resourceFromId :: Long -> <ReadGraph> Resource
321     enableDependencies :: () -> <WriteGraph> ()
322     disableDependencies :: () -> <WriteGraph> ()
323     
324     unaryQuery :: (a -> <ReadGraph,e> b) -> a -> <ReadGraph> b
325     unaryQueryCached :: (a -> <ReadGraph,e> b) -> a -> <ReadGraph> b
326
327     "Makes a new read request with given procedure for calculating the result. The request is cached only if the current request is listened."
328     subquery :: (<ReadGraph,Proc> a) -> <ReadGraph,Proc> a
329     "Makes a new read request with given procedure for calculating the result. The request is always cached."
330     subqueryC :: (<ReadGraph,Proc> a) -> <ReadGraph,Proc> a
331     "Tries to convert the given Dynamic value to a value with the inferred type"
332     possibleFromDynamic :: Typeable a => String -> Dynamic -> Maybe a
333
334 importJava "org.simantics.db.layer0.util.Layer0Utils" where
335     undo :: () -> <Proc> String
336     undoOperations :: Integer -> <Proc> String
337     redo :: () -> <Proc> String
338     queryDebugSupport :: String -> <Proc> String
339     queryListSupport :: String -> <Proc> String
340     addCommentMetadata :: String -> <WriteGraph> ()
341     sortByCluster :: [a] -> (a->Resource) -> <ReadGraph> [a]
342     makeSynchronous :: Boolean -> <ReadGraph> ()
343     listOntologies :: () -> <ReadGraph> [Resource]
344     emptyTrashBin :: () -> <Proc> ()
345     purgeDatabase :: () -> <Proc> ()
346     prettyPrintResource :: Resource -> <ReadGraph> String
347
348     @private
349     @JavaName copyTo
350     copyTo_ :: Resource -> Resource -> <WriteGraph> Collection Resource
351     @JavaName getPossiblePredicateByName
352     possiblePredicateByName :: Resource -> String -> <ReadGraph> Maybe Resource
353
354 copyTo :: Resource -> Resource -> <WriteGraph> Resource
355 copyTo targetContainer source = do
356     (collectionToList $ copyTo_ targetContainer source)!0
357
358 importJava "org.simantics.db.common.utils.CommonDBUtils" where
359     selectClusterSet :: Resource -> <WriteGraph> () 
360
361 importJava "org.simantics.Simantics" where
362     @JavaName getProjectResource
363     currentProject :: () -> /*<Proc>*/ Resource
364
365 // Move to somewhere more generic module
366 importJava "java.util.Collection" where
367     data Collection a
368
369 importJava "java.util.ArrayList" where
370     @JavaName "<init>"
371     collectionToList :: Collection a -> [a]
372 /*@macro
373 collectionToList :: Collection a -> [a]
374 collectionToList x = Java.unsafeCoerce x
375 */ 
376
377 resourceToCollection :: a -> Collection a
378 resourceToCollection x = Java.unsafeCoerce x
379
380 newEntity :: [Resource -> <ReadGraph,WriteGraph> ()] -> <ReadGraph,WriteGraph> Resource
381 newEntity entitySpecs = do
382     entity = newResource ()
383     for entitySpecs (\spec -> spec entity)
384     entity
385
386 updateEntity :: Resource -> [Resource -> <ReadGraph,WriteGraph> ()] -> <ReadGraph,WriteGraph> Resource
387 updateEntity entity entitySpecs = do
388     for entitySpecs (\spec -> spec entity)
389     entity
390
391 hasStatement predicate object entity = 
392     claim entity predicate object
393 hasProperty relation value entity = 
394     claimRelatedValue entity relation value
395 hasPossibleProperty relation value entity =
396     match value with
397       Just v -> claimRelatedValue entity relation v
398       Nothing -> ()
399 hasTypedProperty relation value t entity = 
400     claimRelatedValueWithType entity relation t value        
401 hasName (n :: String) = hasProperty L0.HasName n
402 hasLabel (l :: String) = hasProperty L0.HasLabel l
403 hasType t = hasStatement L0.InstanceOf t
404 hasParent p = hasStatement L0.PartOf p
405
406 importJava "org.simantics.databoard.util.URIStringUtils" where
407     @JavaName splitURISCL
408     splitURI :: String -> [String]
409     @JavaName escape
410     escapeURI :: String -> String
411     @JavaName unescape
412     unescapeURI :: String -> String
413
414 @private
415 importJava "org.simantics.db.layer0.request.ActiveModels" where
416     @JavaName getPossibleActiveModel
417     activeModel :: Resource -> <ReadGraph> Maybe Resource
418
419 "Gives the current active model."
420 currentModel :: <ReadGraph> Resource
421 currentModel = match activeModel (currentProject ()) with
422     Just model -> model
423     Nothing -> fail "No active model."
424
425 startUndoPoint :: String -> <WriteGraph> ()
426 startUndoPoint string = do
427     markUndoPoint ()
428     addCommentMetadata (string)
429     ()
430
431 @inline
432 lift1Read :: (a -> <ReadGraph,Proc> b) -> (a -> <Proc> b)
433 lift1Read f x = syncRead (\_ -> f x)
434
435 @inline
436 lift2Read :: (a -> b -> <ReadGraph,Proc> c) -> (a -> b -> <Proc> c)
437 lift2Read f x y = syncRead (\_ -> f x y)
438
439 @inline
440 lift3Read :: (a -> b -> c -> <ReadGraph,Proc> d) -> (a -> b -> c -> <Proc> d)
441 lift3Read f x y z = syncRead (\_ -> f x y z)
442
443 @inline
444 lift1Write :: (a -> <WriteGraph,Proc> b) -> (a -> <Proc> b)
445 lift1Write f x = syncWrite (\_ -> f x)
446
447 @inline
448 lift2Write :: (a -> b -> <WriteGraph,Proc> c) -> (a -> b -> <Proc> c)
449 lift2Write f x y = syncWrite (\_ -> f x y)
450
451 @inline
452 lift3Write :: (a -> b -> c -> <WriteGraph,Proc> d) -> (a -> b -> c -> <Proc> d)
453 lift3Write f x y z = syncWrite (\_ -> f x y z)
454
455 """
456 Returns a child Browsable of the specified parent that has that is the child
457 of the specified parent with the specified name path.
458 """
459 childWithPath :: Browsable a => a -> [String] -> <ReadGraph> a
460 childWithPath parent path = 
461     foldl (\r name -> match possibleChild r name with
462               Just c -> c
463               Nothing -> fail ("Didn't find " + name + ".") 
464           ) 
465           parent path
466
467 """
468 Like `childWithPath` but returns Maybe a which will be `Nothing` if no child
469 was found.
470 """
471 possibleChildWithPath :: Browsable a => a -> [String] -> <ReadGraph> Maybe a
472 possibleChildWithPath parent path = 
473     foldl (\r name -> match r with
474               Just c -> possibleChild c name
475               Nothing -> Nothing 
476           ) 
477           (Just parent) path