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 -> String "Appends the string representation of the value to the string builder in a read transaction." gappend :: Resource -> StringBuilder.T -> a -> 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 -> Maybe (Resource,Resource) getSecondaryFunctionalReference :: Resource -> 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 "" createResourceSet :: () -> /* not necessary in our case*/ ResourceSet @JavaName add addResourceSet :: ResourceSet -> Resource -> /* not necessary in our case*/ Boolean resourceId :: Resource -> Resource -> 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