summaryrefslogtreecommitdiffstats
path: root/Redland/Util.hs
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2018-02-23 15:32:10 +0300
committerdefanor <defanor@uberspace.net>2018-02-23 15:50:35 +0300
commitcf2776fc2ce561cffc85bf9e6a11289372ea7fbb (patch)
tree0260823a9486c2a1d2fa46c11f25ad0349839ffe /Redland/Util.hs
parent64ede85539277d676f4b9bed88599ce0b9150f23 (diff)
downloadredland-cf2776fc2ce561cffc85bf9e6a11289372ea7fbb.zip
redland-cf2776fc2ce561cffc85bf9e6a11289372ea7fbb.tar.gz
redland-cf2776fc2ce561cffc85bf9e6a11289372ea7fbb.tar.bz2
Support literal node types/languages
Diffstat (limited to 'Redland/Util.hs')
-rw-r--r--Redland/Util.hs25
1 files changed, 22 insertions, 3 deletions
diff --git a/Redland/Util.hs b/Redland/Util.hs
index 2bcd947..962bf2e 100644
--- a/Redland/Util.hs
+++ b/Redland/Util.hs
@@ -47,9 +47,13 @@ withStatements world model t f =
-- * RDF term (librdf_node)
+data LiteralNodeType = XMLSchema String
+ | LanguageTag String
+ deriving (Ord, Eq, Show)
+
-- | Haskell representation of 'RedlandNode'.
data Node = BlankNode String
- | LiteralNode String
+ | LiteralNode String (Maybe LiteralNodeType)
| ResourceNode String
deriving (Ord, Eq, Show)
@@ -61,7 +65,16 @@ redlandNodeToNode rn = do
isResource <- nodeIsResource rn
case (isBlank, isLiteral, isResource) of
(True, _, _) -> BlankNode <$> nodeGetBlankIdentifier rn
- (_, True, _) -> LiteralNode <$> nodeGetLiteralValue rn
+ (_, True, _) -> do
+ litVal <- nodeGetLiteralValue rn
+ litLang <- nodeGetLiteralValueLanguage rn
+ litType <- nodeGetLiteralValueDatatypeURI rn
+ litXML <- nodeGetLiteralValueIsWellFormedXML rn
+ let nType = case (litLang, litType) of
+ (Just l, _) -> Just $ LanguageTag l
+ (_, Just t) -> Just $ XMLSchema t
+ _ -> Nothing
+ pure $ LiteralNode litVal nType
_ -> ResourceNode <$> (nodeGetURI rn >>= uriAsString)
-- | A conversion function.
@@ -69,7 +82,13 @@ nodeToRedlandNode :: ForeignPtr RedlandWorld
-> Node
-> Initializer RedlandNode
nodeToRedlandNode world (BlankNode s) = nodeFromBlankIdentifier world (Just s)
-nodeToRedlandNode world (LiteralNode s) = nodeFromLiteral world s Nothing False
+nodeToRedlandNode world (LiteralNode s (Just (LanguageTag l))) =
+ nodeFromTypedLiteral world s (Just l) Nothing
+nodeToRedlandNode world (LiteralNode s (Just (XMLSchema uri))) =
+ withNew (redlandURI world uri) $ \uri' ->
+ nodeFromTypedLiteral world s Nothing (Just uri')
+nodeToRedlandNode world (LiteralNode s Nothing) =
+ nodeFromTypedLiteral world s Nothing Nothing
nodeToRedlandNode world (ResourceNode s) =
withNew (redlandURI world s) $ nodeFromURI world