diff options
| author | defanor <defanor@uberspace.net> | 2018-02-23 15:32:10 +0300 |
|---|---|---|
| committer | defanor <defanor@uberspace.net> | 2018-02-23 15:50:35 +0300 |
| commit | cf2776fc2ce561cffc85bf9e6a11289372ea7fbb (patch) | |
| tree | 0260823a9486c2a1d2fa46c11f25ad0349839ffe /Redland/Util.hs | |
| parent | 64ede85539277d676f4b9bed88599ce0b9150f23 (diff) | |
Support literal node types/languages
Diffstat (limited to 'Redland/Util.hs')
| -rw-r--r-- | Redland/Util.hs | 25 |
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 |