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