bundles/org.simantics.scl.db/scl/Simantics/DB.scl

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