1 include "Simantics/DB" hiding (resourceId)
\r
2 import "http://www.simantics.org/Layer0-1.1" as L0
\r
3 import "http://www.simantics.org/Modeling-1.2" as MOD
\r
4 import "StringBuilder" as StringBuilder
\r
7 "Converts a value to string in a read transtion."
\r
8 gshow :: Resource -> a -> <Proc,ReadGraph> String
\r
9 "Appends the string representation of the value to the string builder in a read transaction."
\r
10 gappend :: Resource -> StringBuilder.T -> a -> <Proc,ReadGraph> StringBuilder.T
\r
11 graphPrecedence :: a -> Integer
\r
13 gshow ctx v = StringBuilder.toString (gappend ctx StringBuilder.new v)
\r
14 gappend ctx sb v = StringBuilder.appendString sb $ gshow ctx v
\r
15 graphPrecedence v = 0
\r
17 instance (GShow a) => GShow (Par a) where
\r
18 gappend ctx sb (Par outerPrec v) = do
\r
19 prec = graphPrecedence v
\r
25 else gappend ctx sb v
\r
27 instance GShow String where
\r
30 instance GShow Integer where
\r
32 graphPrecedence v = if v >= 0 then 0 else 100
\r
34 instance GShow Long where
\r
36 graphPrecedence v = if v >= 0 then 0 else 100
\r
38 instance GShow Float where
\r
40 graphPrecedence v = if v >= 0 then 0 else 100
\r
42 instance GShow Double where
\r
44 graphPrecedence v = if v >= 0 then 0 else 100
\r
46 instance GShow Boolean where
\r
49 instance GShow DoubleArray where
\r
50 gappend _ sb v = sb << "toDoubleArray " <+ fromDoubleArray v
\r
51 graphPrecedence v = 1
\r
53 importJava "org.simantics.utils.bytes.Base64" where
\r
55 encodeBase64 :: ByteArray -> String
\r
57 decodeBase64 :: String -> ByteArray
\r
59 instance GShow ByteArray where
\r
60 gappend _ sb v = sb << "decodeBase64 " <+ (encodeBase64 v)
\r
61 graphPrecedence v = 1
\r
64 importJava "org.simantics.db.layer0.util.ExtendedUris" where
\r
65 getPrimaryFunctionalReference :: Resource -> <ReadGraph> Maybe (Resource,Resource)
\r
66 getSecondaryFunctionalReference :: Resource -> <ReadGraph> Maybe (Resource,Resource)
\r
69 NamedChildOf ResourceId String
\r
70 | PropertyOf ResourceId String
\r
71 | AbsoluteUri String
\r
72 | ContextRelativeUri String
\r
75 importJava "gnu.trove.set.hash.THashSet" where
\r
78 createResourceSet :: () -> /*<Proc> not necessary in our case*/ ResourceSet
\r
80 addResourceSet :: ResourceSet -> Resource -> /*<Proc> not necessary in our case*/ Boolean
\r
82 resourceId :: Resource -> Resource -> <ReadGraph> Maybe ResourceId
\r
83 resourceId ctx r = loop r
\r
85 guardSet = createResourceSet ()
\r
86 loop r = if addResourceSet guardSet r
\r
88 (guard (r == ctx) >> return (ContextRelativeUri ""))
\r
90 (guard (r == getRootLibrary ()) >> return (AbsoluteUri "http:/"))
\r
93 (p,rel) <- getPrimaryFunctionalReference r
\r
95 relName <- possibleNameOf rel
\r
96 return $ simplifyResourceIdHead $ PropertyOf path relName
\r
100 p <- possibleObject r L0.PartOf
\r
102 name <- possibleNameOf r
\r
103 return $ simplifyResourceIdHead $ NamedChildOf path name
\r
107 (p,rel) <- getSecondaryFunctionalReference r
\r
109 relName <- possibleNameOf rel
\r
110 return $ simplifyResourceIdHead $ PropertyOf path relName
\r
117 importJava "org.simantics.databoard.util.URIStringUtils" where
\r
118 escape :: String -> String
\r
120 simplifyResourceIdHead (NamedChildOf (AbsoluteUri uri) name) = AbsoluteUri (uri + "/" + escape name)
\r
121 simplifyResourceIdHead (NamedChildOf (ContextRelativeUri uri) name) = ContextRelativeUri (uri + "/" + escape name)
\r
122 simplifyResourceIdHead (PropertyOf (AbsoluteUri uri) name) = AbsoluteUri (uri + "#" + escape name)
\r
123 simplifyResourceIdHead (PropertyOf (ContextRelativeUri uri) name) = ContextRelativeUri (uri + "#" + escape name)
\r
124 simplifyResourceIdHead id = id
\r
126 instance Show ResourceId where
\r
127 sb <+ NamedChildOf parent name = sb << "fromJust (possibleResourceChild " <+ Par 0 parent << " " <+ name << ")"
\r
128 sb <+ ContextRelativeUri uri = sb << "modelResource " <+ uri
\r
129 sb <+ AbsoluteUri uri = sb << "resource " <+ uri
\r
133 instance GShow Resource where
\r
134 gappend ctx sb r = sb <+ fromJust (resourceId ctx r)
\r
135 graphPrecedence v = 1
\r
137 instance (GShow a) => GShow [a] where
\r
138 gappend ctx sb l = do
\r
140 loop i = if i < len
\r
142 if (i>0) then sb << ", " else sb
\r
143 gappend ctx sb (l!i)
\r
149 instance GShow () where
\r
152 instance (GShow a, GShow b) => GShow (a, b) where
\r
153 gappend ctx sb (x, y) = do
\r
160 instance (GShow a, GShow b, GShow c) => GShow (a, b, c) where
\r
161 gappend ctx sb (x, y, z) = do
\r
170 instance (GShow a, GShow b, GShow c, GShow d) => GShow (a, b, c, d) where
\r
171 gappend ctx sb (x, y, z, w) = do
\r
182 instance (GShow a) => GShow (Maybe a) where
\r
183 gappend ctx sb Nothing = sb << "Nothing"
\r
184 gappend ctx sb (Just x) = do
\r
186 gappend ctx sb (Par 0 x)
\r
187 graphPrecedence (Just x) = 1
\r
188 graphPrecedence Nothing = 0
\r
190 instance (GShow a, GShow b) => GShow (Either a b) where
\r
191 gappend ctx sb (Left x) = do
\r
193 gappend ctx sb (Par 0 x)
\r
194 gappend ctx sb (Right x) = do
\r
196 gappend ctx sb (Par 0 x)
\r
197 graphPrecedence _ = 1
\r