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