]> gerrit.simantics Code Review - simantics/r.git/blob - org.simantics.r/scl/R/RConfiguration.scl
Share project "org.simantics.r.feature" into "https://www.simantics.org/svn/simantics"
[simantics/r.git] / org.simantics.r / scl / R / RConfiguration.scl
1 import "R/R" as R\r
2 \r
3 import "Simantics/DB"\r
4 import "http://www.simantics.org/R-1.0" as ROntology\r
5 import "http://www.simantics.org/Layer0-1.1" as L0\r
6 \r
7 """Creates a new session configuration to graph. This function does\r
8 not link it to any other resources."""\r
9 createSessionConfiguration :: Resource -> R.SessionConfiguration -> <WriteGraph> Resource\r
10 createSessionConfiguration parent (R.SessionConfiguration host port username password) = do \r
11     r = newResource ()\r
12     claim r L0.InstanceOf ROntology.SessionConfiguration\r
13     claim r L0.PartOf parent\r
14     claimRelatedValue r L0.HasName host\r
15     claimRelatedValue r ROntology.SessionConfiguration.host host\r
16     claimRelatedValue r ROntology.SessionConfiguration.port") port\r
17     claimRelatedValue r ROntology.SessionConfiguration.username username\r
18     claimRelatedValue r ROntology.SessionConfiguration.password password\r
19     r\r
20 \r
21 addScript :: Resource -> String -> <WriteGraph> Resource\r
22 addScript sessionConfiguration scriptText = do \r
23     r = newResource ()\r
24     claim r L0.InstanceOf ROntology.Script\r
25     claim sessionConfiguration ROntology.SessionConfiguration.hasScript r\r
26     claimRelatedValue r ROntology.Script.text scriptText\r
27     r\r
28 \r
29 readSessionConfiguration :: Resource -> <ReadGraph> R.SessionConfiguration\r
30 readSessionConfiguration r = R.SessionConfiguration\r
31     (relatedValue r ROntology.SessionConfiguration.host)\r
32     (relatedValue r ROntology.SessionConfiguration.port)\r
33     (relatedValue r ROntology.SessionConfiguration.username)\r
34     (relatedValue r ROntology.SessionConfiguration.password)\r
35 \r
36 writeSession :: R.Session -> <WriteGraph> Resource\r
37 writeSession session = do \r
38     r = newResource ()\r
39     claim r L0.InstanceOf ROntology.Session\r
40     claimRelatedValue r L0.HasName $ R.sessionIdOf session\r
41     r\r
42 \r
43 readSession :: Resource -> <ReadGraph,Proc> R.Session\r
44 readSession r = let\r
45     sessionId = relatedValue r L0.HasName\r
46   in match R.sessionById sessionId with\r
47     Just session -> session\r
48     Nothing -> R.getOrCreateSession (readSessionConfiguration $ singleObject r L0.PartOf) sessionId\r
49       \r
50 \r
51 createSession :: Resource -> <WriteGraph,Proc> Resource\r
52 createSession configurationResource = do\r
53     session = R.createSession $ readSessionConfiguration configurationResource\r
54     for (configurationResource # ROntology.SessionConfiguration.hasScript $ \s -> do\r
55         scriptText = relatedValue s ROntology.Script.text")\r
56         R.asyncExec session (R.evalR_ scriptText)\r
57     sessionResource = writeSession session\r
58     claim configurationResource L0.ConsistsOf sessionResource\r
59     sessionResource\r
60 \r
61 deleteSession :: Resource -> <WriteGraph,Proc> ()\r
62 deleteSession r = do\r
63     session = readSession r\r
64     R.closeSession session\r
65     denyAllStatements r\r
66 \r