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