X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.scl.db%2Fscl%2FSimantics%2FGShow.scl;h=c3e899a8c06ff2b83956144f359f17e7a2cb3ae1;hb=ff1c29bf73b3e5ea939dc1987540aa0240dc4ae6;hp=4373353723043dbb95f6b11b8a05560646ecbcb3;hpb=969bd23cab98a79ca9101af33334000879fb60c5;p=simantics%2Fplatform.git

diff --git a/bundles/org.simantics.scl.db/scl/Simantics/GShow.scl b/bundles/org.simantics.scl.db/scl/Simantics/GShow.scl
index 437335372..c3e899a8c 100644
--- a/bundles/org.simantics.scl.db/scl/Simantics/GShow.scl
+++ b/bundles/org.simantics.scl.db/scl/Simantics/GShow.scl
@@ -1,197 +1,201 @@
-include "Simantics/DB" hiding (resourceId)
-import "http://www.simantics.org/Layer0-1.1" as L0
-import "http://www.simantics.org/Modeling-1.2" as MOD
-import "StringBuilder" as StringBuilder
-
-class GShow a where
-    "Converts a value to string in a read transtion."
-    gshow :: Resource -> a -> <Proc,ReadGraph> String
-    "Appends the string representation of the value to the string builder in a read transaction."
-    gappend :: Resource -> StringBuilder.T -> a -> <Proc,ReadGraph> StringBuilder.T
-    graphPrecedence :: a -> Integer
-    
-    gshow ctx v = StringBuilder.toString (gappend ctx StringBuilder.new v)
-    gappend ctx sb v = StringBuilder.appendString sb $ gshow ctx v
-    graphPrecedence v = 0
-
-instance (GShow a) => GShow (Par a) where
-    gappend ctx sb (Par outerPrec v) = do
-        prec = graphPrecedence v
-        if prec > outerPrec
-        then do
-            sb << "("
-            gappend ctx sb v
-            sb << ")"
-        else gappend ctx sb v
-                              
-instance GShow String where
-    gappend _ = (<+)
-
-instance GShow Integer where
-    gshow _ = show
-    graphPrecedence v = if v >= 0 then 0 else 100
-
-instance GShow Long where
-    gshow _ = show
-    graphPrecedence v = if v >= 0 then 0 else 100
-
-instance GShow Float where
-    gshow _ = show
-    graphPrecedence v = if v >= 0 then 0 else 100
-
-instance GShow Double where
-    gshow _ = show
-    graphPrecedence v = if v >= 0 then 0 else 100
-
-instance GShow Boolean where
-    gshow _ = show
-
-instance GShow DoubleArray where
-    gappend _ sb v = sb << "toDoubleArray " <+ fromDoubleArray v
-    graphPrecedence v = 1
-
-importJava "org.simantics.utils.bytes.Base64" where
-    @JavaName encode
-    encodeBase64 :: ByteArray -> String
-    @JavaName decode
-    decodeBase64 :: String -> ByteArray
-
-instance GShow ByteArray where
-    gappend _ sb v = sb << "decodeBase64 " <+ (encodeBase64 v)
-    graphPrecedence v = 1
-    
-@private
-importJava "org.simantics.db.layer0.util.ExtendedUris" where
-    getPrimaryFunctionalReference :: Resource -> <ReadGraph> Maybe (Resource,Resource)
-    getSecondaryFunctionalReference :: Resource -> <ReadGraph> Maybe (Resource,Resource)
-
-data ResourceId =
-    NamedChildOf ResourceId String
-  | PropertyOf ResourceId String
-  | AbsoluteUri String
-  | ContextRelativeUri String
-
-@private
-importJava "gnu.trove.set.hash.THashSet" where
-    data ResourceSet
-    @JavaName "<init>"
-    createResourceSet :: () -> /*<Proc> not necessary in our case*/ ResourceSet
-    @JavaName add
-    addResourceSet :: ResourceSet -> Resource -> /*<Proc> not necessary in our case*/ Boolean
-
-resourceId :: Resource -> Resource -> <ReadGraph> Maybe ResourceId
-resourceId ctx r = loop r
-   where
-    guardSet = createResourceSet ()
-    loop r = if addResourceSet guardSet r 
-      then 
-        (guard (r == ctx) >> return (ContextRelativeUri "")) 
-        `morelse`
-        (guard (r == getRootLibrary ()) >> return (AbsoluteUri "http:/"))
-        `morelse`
-        (mdo
-            (p,rel) <- getPrimaryFunctionalReference r
-            path <- loop p
-            relName <- possibleNameOf rel
-            return $ simplifyResourceIdHead $ PropertyOf path relName
-        )
-        `morelse`
-        (mdo
-            p <- possibleObject r L0.PartOf
-            path <- loop p
-            name <- possibleNameOf r
-            return $ simplifyResourceIdHead $ NamedChildOf path name
-        )
-        `morelse`
-        (mdo
-            (p,rel) <- getSecondaryFunctionalReference r
-            path <- loop p
-            relName <- possibleNameOf rel
-            return $ simplifyResourceIdHead $ PropertyOf path relName
-        )
-        `morelse`
-        Nothing
-      else Nothing
-
-@private
-importJava "org.simantics.databoard.util.URIStringUtils" where
-    escape :: String -> String
-
-simplifyResourceIdHead (NamedChildOf (AbsoluteUri uri) name) = AbsoluteUri (uri + "/" + escape name)  
-simplifyResourceIdHead (NamedChildOf (ContextRelativeUri uri) name) = ContextRelativeUri (uri + "/" + escape name)
-simplifyResourceIdHead (PropertyOf (AbsoluteUri uri) name) = AbsoluteUri (uri + "#" + escape name)  
-simplifyResourceIdHead (PropertyOf (ContextRelativeUri uri) name) = ContextRelativeUri (uri + "#" + escape name)
-simplifyResourceIdHead id = id
-
-instance Show ResourceId where
-    sb <+ NamedChildOf parent name = sb << "fromJust (possibleResourceChild " <+ Par 0 parent << " " <+ name << ")"
-    sb <+ ContextRelativeUri uri = sb << "modelResource " <+ uri
-    sb <+ AbsoluteUri uri = sb << "resource " <+ uri
-    
-    precedence _ = 1
-
-instance GShow Resource where
-    gappend ctx sb r = sb <+ fromJust (resourceId ctx r)
-    graphPrecedence v = 1
-
-instance (GShow a) => GShow [a] where
-    gappend ctx sb l = do
-        len = length l
-        loop i = if i < len 
-                 then do 
-                     if (i>0) then sb << ", " else sb
-                     gappend ctx sb (l!i)
-                     loop (i+1)
-                 else sb << "]"
-        sb << "[" 
-        loop 0
-
-instance GShow () where
-    gshow _ _ = "()"
-
-instance (GShow a, GShow b) => GShow (a, b) where
-    gappend ctx sb (x, y) = do
-        sb << "(" 
-        gappend ctx sb x 
-        sb << ", " 
-        gappend ctx sb y 
-        sb << ")"
-
-instance (GShow a, GShow b, GShow c) => GShow (a, b, c) where
-    gappend ctx sb (x, y, z) = do
-        sb << "(" 
-        gappend ctx sb x 
-        sb << ", " 
-        gappend ctx sb y
-        sb << ", " 
-        gappend ctx sb z 
-        sb << ")"
-
-instance (GShow a, GShow b, GShow c, GShow d) => GShow (a, b, c, d) where
-    gappend ctx sb (x, y, z, w) = do
-        sb << "(" 
-        gappend ctx sb x 
-        sb << ", " 
-        gappend ctx sb y
-        sb << ", " 
-        gappend ctx sb z 
-        sb << ", " 
-        gappend ctx sb w
-        sb << ")"
-
-instance (GShow a) => GShow (Maybe a) where
-    gappend ctx sb Nothing = sb << "Nothing"
-    gappend ctx sb (Just x) = do
-        sb << "Just "
-        gappend ctx sb (Par 0 x)
-    graphPrecedence (Just x) = 1
-    graphPrecedence Nothing = 0
-
-instance (GShow a, GShow b) => GShow (Either a b) where
-    gappend ctx sb (Left x) = do
-        sb << "Left "
-        gappend ctx sb (Par 0 x)
-    gappend ctx sb (Right x) = do
-        sb << "Right "
-        gappend ctx sb (Par 0 x)    
-    graphPrecedence _ = 1
+module {
+    features = [edo]
+}
+
+include "Simantics/DB" hiding (resourceId)
+import "http://www.simantics.org/Layer0-1.1" as L0
+import "http://www.simantics.org/Modeling-1.2" as MOD
+import "StringBuilder" as StringBuilder
+
+class GShow a where
+    "Converts a value to string in a read transtion."
+    gshow :: Resource -> a -> <Proc,ReadGraph> String
+    "Appends the string representation of the value to the string builder in a read transaction."
+    gappend :: Resource -> StringBuilder.T -> a -> <Proc,ReadGraph> StringBuilder.T
+    graphPrecedence :: a -> Integer
+    
+    gshow ctx v = StringBuilder.toString (gappend ctx StringBuilder.new v)
+    gappend ctx sb v = StringBuilder.appendString sb $ gshow ctx v
+    graphPrecedence v = 0
+
+instance (GShow a) => GShow (Par a) where
+    gappend ctx sb (Par outerPrec v) = do
+        prec = graphPrecedence v
+        if prec > outerPrec
+        then do
+            sb << "("
+            gappend ctx sb v
+            sb << ")"
+        else gappend ctx sb v
+                              
+instance GShow String where
+    gappend _ = (<+)
+
+instance GShow Integer where
+    gshow _ = show
+    graphPrecedence v = if v >= 0 then 0 else 100
+
+instance GShow Long where
+    gshow _ = show
+    graphPrecedence v = if v >= 0 then 0 else 100
+
+instance GShow Float where
+    gshow _ = show
+    graphPrecedence v = if v >= 0 then 0 else 100
+
+instance GShow Double where
+    gshow _ = show
+    graphPrecedence v = if v >= 0 then 0 else 100
+
+instance GShow Boolean where
+    gshow _ = show
+
+instance GShow DoubleArray where
+    gappend _ sb v = sb << "toDoubleArray " <+ fromDoubleArray v
+    graphPrecedence v = 1
+
+importJava "org.simantics.utils.bytes.Base64" where
+    @JavaName encode
+    encodeBase64 :: ByteArray -> String
+    @JavaName decode
+    decodeBase64 :: String -> ByteArray
+
+instance GShow ByteArray where
+    gappend _ sb v = sb << "decodeBase64 " <+ (encodeBase64 v)
+    graphPrecedence v = 1
+    
+@private
+importJava "org.simantics.db.layer0.util.ExtendedUris" where
+    getPrimaryFunctionalReference :: Resource -> <ReadGraph> Maybe (Resource,Resource)
+    getSecondaryFunctionalReference :: Resource -> <ReadGraph> Maybe (Resource,Resource)
+
+data ResourceId =
+    NamedChildOf ResourceId String
+  | PropertyOf ResourceId String
+  | AbsoluteUri String
+  | ContextRelativeUri String
+
+@private
+importJava "gnu.trove.set.hash.THashSet" where
+    data ResourceSet
+    @JavaName "<init>"
+    createResourceSet :: () -> /*<Proc> not necessary in our case*/ ResourceSet
+    @JavaName add
+    addResourceSet :: ResourceSet -> Resource -> /*<Proc> not necessary in our case*/ Boolean
+
+resourceId :: Resource -> Resource -> <ReadGraph> Maybe ResourceId
+resourceId ctx r = loop r
+   where
+    guardSet = createResourceSet ()
+    loop r = if addResourceSet guardSet r 
+      then 
+        (guard (r == ctx) >> return (ContextRelativeUri "")) 
+        `morelse`
+        (guard (r == getRootLibrary ()) >> return (AbsoluteUri "http:/"))
+        `morelse`
+        (edo
+            (p,rel) <- getPrimaryFunctionalReference r
+            path <- loop p
+            relName <- possibleNameOf rel
+            return $ simplifyResourceIdHead $ PropertyOf path relName
+        )
+        `morelse`
+        (edo
+            p <- possibleObject r L0.PartOf
+            path <- loop p
+            name <- possibleNameOf r
+            return $ simplifyResourceIdHead $ NamedChildOf path name
+        )
+        `morelse`
+        (edo
+            (p,rel) <- getSecondaryFunctionalReference r
+            path <- loop p
+            relName <- possibleNameOf rel
+            return $ simplifyResourceIdHead $ PropertyOf path relName
+        )
+        `morelse`
+        Nothing
+      else Nothing
+
+@private
+importJava "org.simantics.databoard.util.URIStringUtils" where
+    escape :: String -> String
+
+simplifyResourceIdHead (NamedChildOf (AbsoluteUri uri) name) = AbsoluteUri (uri + "/" + escape name)  
+simplifyResourceIdHead (NamedChildOf (ContextRelativeUri uri) name) = ContextRelativeUri (uri + "/" + escape name)
+simplifyResourceIdHead (PropertyOf (AbsoluteUri uri) name) = AbsoluteUri (uri + "#" + escape name)  
+simplifyResourceIdHead (PropertyOf (ContextRelativeUri uri) name) = ContextRelativeUri (uri + "#" + escape name)
+simplifyResourceIdHead id = id
+
+instance Show ResourceId where
+    sb <+ NamedChildOf parent name = sb << "fromJust (possibleResourceChild " <+ Par 0 parent << " " <+ name << ")"
+    sb <+ ContextRelativeUri uri = sb << "modelResource " <+ uri
+    sb <+ AbsoluteUri uri = sb << "resource " <+ uri
+    
+    precedence _ = 1
+
+instance GShow Resource where
+    gappend ctx sb r = sb <+ fromJust (resourceId ctx r)
+    graphPrecedence v = 1
+
+instance (GShow a) => GShow [a] where
+    gappend ctx sb l = do
+        len = length l
+        loop i = if i < len 
+                 then do 
+                     if (i>0) then sb << ", " else sb
+                     gappend ctx sb (l!i)
+                     loop (i+1)
+                 else sb << "]"
+        sb << "[" 
+        loop 0
+
+instance GShow () where
+    gshow _ _ = "()"
+
+instance (GShow a, GShow b) => GShow (a, b) where
+    gappend ctx sb (x, y) = do
+        sb << "(" 
+        gappend ctx sb x 
+        sb << ", " 
+        gappend ctx sb y 
+        sb << ")"
+
+instance (GShow a, GShow b, GShow c) => GShow (a, b, c) where
+    gappend ctx sb (x, y, z) = do
+        sb << "(" 
+        gappend ctx sb x 
+        sb << ", " 
+        gappend ctx sb y
+        sb << ", " 
+        gappend ctx sb z 
+        sb << ")"
+
+instance (GShow a, GShow b, GShow c, GShow d) => GShow (a, b, c, d) where
+    gappend ctx sb (x, y, z, w) = do
+        sb << "(" 
+        gappend ctx sb x 
+        sb << ", " 
+        gappend ctx sb y
+        sb << ", " 
+        gappend ctx sb z 
+        sb << ", " 
+        gappend ctx sb w
+        sb << ")"
+
+instance (GShow a) => GShow (Maybe a) where
+    gappend ctx sb Nothing = sb << "Nothing"
+    gappend ctx sb (Just x) = do
+        sb << "Just "
+        gappend ctx sb (Par 0 x)
+    graphPrecedence (Just x) = 1
+    graphPrecedence Nothing = 0
+
+instance (GShow a, GShow b) => GShow (Either a b) where
+    gappend ctx sb (Left x) = do
+        sb << "Left "
+        gappend ctx sb (Par 0 x)
+    gappend ctx sb (Right x) = do
+        sb << "Right "
+        gappend ctx sb (Par 0 x)    
+    graphPrecedence _ = 1