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