From 906669784eebc833366c1a6d348eacca7d5cc964 Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Thu, 22 Feb 2018 00:51:57 +0300
Subject: Add a few statements and streams functions

---
 Redland/Util.hs | 108 +++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 87 insertions(+), 21 deletions(-)

(limited to 'Redland/Util.hs')

diff --git a/Redland/Util.hs b/Redland/Util.hs
index 0472dde..3d34206 100644
--- a/Redland/Util.hs
+++ b/Redland/Util.hs
@@ -11,7 +11,8 @@ Utility functions based on mid-level bindings.
 module Redland.Util where
 
 import Foreign
-import Control.Exception
+import Control.Monad
+import Data.Maybe
 
 import Redland.LowLevel
 import Redland.MidLevel
@@ -30,6 +31,19 @@ withHash world factory l f =
   f hash
 
 
+-- * RDF Graph (librdf_model)
+
+withStatements :: ForeignPtr RedlandWorld
+               -> ForeignPtr RedlandModel
+               -> Triple
+               -> ([Triple] -> IO a)
+               -> IO a
+withStatements world model t f =
+  withNew (tripleToStatement world t) $ \statement ->
+  withNew (modelFindStatements model statement) $
+  streamToList >=> f
+
+
 -- * RDF term (librdf_node)
 
 data Node = BlankNode String
@@ -47,28 +61,29 @@ redlandNodeToNode rn = do
     (_, True, _) -> LiteralNode <$> nodeGetLiteralValue rn
     _ -> ResourceNode <$> (nodeGetURI rn >>= uriAsString)
 
+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 (ResourceNode s) =
+  withNew (redlandURI world s) $ nodeFromURI world
+
 
 -- * Parsers
 
 -- | Tries different parsers until one of them succeeds.
-tryParseStringIntoModel :: ForeignPtr RedlandWorld
-                        -> [String]
-                        -- ^ parsers to try
-                        -> ForeignPtr RedlandModel
-                        -> ForeignPtr RedlandURI
-                        -- ^ base URI
-                        -> String
-                        -- ^ string to parse
-                        -> IO ()
-tryParseStringIntoModel world (parser:parsers) model uri str =
-  handle tryNext $
-  withNew (redlandParser world (Just parser) Nothing Nothing) $ \parser ->
-  parseStringIntoModel parser str uri model
-  where
-    tryNext :: RedlandException -> IO ()
-    tryNext (OperationException _) = tryParseStringIntoModel world parsers model uri str
-    tryNext e = throw e
-tryParseStringIntoModel world [] model uri str = throw ParseFailure
+guessingParseStringIntoModel :: ForeignPtr RedlandWorld
+                             -> ForeignPtr RedlandModel
+                             -> ForeignPtr RedlandURI
+                             -- ^ base URI
+                             -> String
+                             -- ^ string to parse
+                             -> IO ()
+guessingParseStringIntoModel world model uri str = do
+  parser <- parserGuessName2 world Nothing (Just str) Nothing
+  withNew (redlandParser world parser Nothing Nothing) $ \p ->
+    parseStringIntoModel p str uri model
 
 
 -- * Querying
@@ -85,8 +100,7 @@ withQuery :: ForeignPtr RedlandWorld
           -> IO a
 withQuery world model ql qs bURI f =
   withNew (redlandQuery world ql Nothing qs bURI) $ \query ->
-  withNew (modelQueryExecute model query) $ \results ->
-  queryResultsToList results >>= f
+  withNew (modelQueryExecute model query) $ queryResultsToList >=> f
 
 
 -- * Query results
@@ -112,6 +126,58 @@ queryResultsToList qr = do
           pure (name, val)
 
 
+-- * RDF Triple (librdf_statement)
+
+data Triple = Triple { subject :: Maybe Node
+                     , predicate :: Maybe Node
+                     , object :: Maybe Node
+                     } deriving (Eq, Show)
+
+statementToTriple :: ForeignPtr RedlandStatement
+                  -> IO Triple
+statementToTriple statement = do
+  s <- componentToTriple statementGetSubject
+  p <- componentToTriple statementGetPredicate
+  o <- componentToTriple statementGetObject
+  pure $ Triple s p o
+  where
+    componentToTriple :: (ForeignPtr RedlandStatement ->
+                          IO (Maybe (ForeignPtr RedlandNode)))
+                      -> IO (Maybe Node)
+    componentToTriple f = do
+      c <- f statement
+      case c of
+        Just c' -> Just <$> redlandNodeToNode c'
+        Nothing -> pure Nothing
+
+tripleToStatement :: ForeignPtr RedlandWorld
+                  -> Triple
+                  -> Initializer RedlandStatement
+tripleToStatement world (Triple s p o) = do
+  statement <- redlandStatement world
+  let maybeSet f mn = case mn of
+        Just n -> withNew (nodeToRedlandNode world n) $ \n' ->
+          f statement (Just n')
+        Nothing -> pure ()
+  maybeSet statementSetSubject s
+  maybeSet statementSetPredicate p
+  maybeSet statementSetObject o
+  pure statement
+
+-- * Stream of triples (librdf_statement)
+
+streamToList :: ForeignPtr RedlandStream -> IO [Triple]
+streamToList stream = do
+  done <- streamEnd stream
+  if done
+    then pure []
+    else do
+    triple <- streamGetObject stream >>= statementToTriple
+    next <- streamNext stream
+    rest <- if next then streamToList stream else pure []
+    pure (triple : rest)
+
+
 -- * Other
 
 -- | Initializes world, storage, model, and base URI at once.
-- 
cgit v1.2.3