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