summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2018-02-22 13:19:18 +0300
committerdefanor <defanor@uberspace.net>2018-02-22 13:19:18 +0300
commit8d3da9e7af2ae5986d3551cea8dee39ea9b2cdd6 (patch)
treee63d8df0fe32e3b642c591617f4dbdf1353f0f4a
parent906669784eebc833366c1a6d348eacca7d5cc964 (diff)
Refine the documentation
-rw-r--r--Redland.hs86
-rw-r--r--Redland/Util.hs17
2 files changed, 99 insertions, 4 deletions
diff --git a/Redland.hs b/Redland.hs
index 397da47..4bfa88d 100644
--- a/Redland.hs
+++ b/Redland.hs
@@ -1,4 +1,88 @@
-module Redland where
+{- |
+Module : Redland
+Maintainer : defanor <defanor@uberspace.net>
+Stability : unstable
+Portability : non-portable (GHC extensions are used)
+<http://librdf.org/ Redland RDF library> bindings. See
+<http://librdf.org/docs/api/index.html the original API> for in-depth
+descriptions.
+
+= Library organization
+
+- Raw bindings are provided by "Redland.LowLevel". Normally they
+ should not be used directly.
+
+- Refined versions (using Haskell types) of those are provided by
+ "Redland.MidLevel". One should still be careful with the allocated
+ resources while using those, for instance by using 'withNew'. A rule
+ of thumb is that whenever you see an 'Initializer', it's a good idea
+ to wrap it into 'withNew'.
+
+- Utility functions and types are provided by "Redland.Util". Those
+ don't strictly correspond to functions of the original API.
+
+
+= Usage example
+
+> import Redland
+>
+> input :: String
+> input = "<?xml version=\"1.0\"?>\
+> \<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"\
+> \ xmlns:dc=\"http://purl.org/dc/elements/1.1/\">\
+> \ <rdf:Description rdf:about=\"http://www.dajobe.org/\">\
+> \ <dc:title>Dave Beckett's Home Page</dc:title>\
+> \ <dc:creator>Dave Beckett</dc:creator>\
+> \ <dc:description>The generic home page of Dave Beckett.</dc:description>\
+> \ </rdf:Description>\
+> \</rdf:RDF>\
+> \"
+>
+> main :: IO ()
+> main =
+> withWSMU "memory" [] "example" "" "http://example.librdf.org/" $
+> \world storage model uri -> do
+> -- parse and insert
+> guessingParseStringIntoModel world model uri input
+> -- query
+> withQuery world model "sparql"
+> "SELECT ?foo ?bar ?baz WHERE { ?foo ?bar ?baz }" (Just uri) $
+> mapM_ print
+> -- search statements
+> withStatements world model (Triple Nothing Nothing Nothing) $
+> mapM_ print
+
+It prints the following:
+
+> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/title"),("baz",LiteralNode "Dave Beckett's Home Page")]
+> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/creator"),("baz",LiteralNode "Dave Beckett")]
+> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/description"),("baz",LiteralNode "The generic home page of Dave Beckett.")]
+> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/title"), object = Just (LiteralNode "Dave Beckett's Home Page")}
+> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/creator"), object = Just (LiteralNode "Dave Beckett")}
+> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/description"), object = Just (LiteralNode "The generic home page of Dave Beckett.")}
+
+
+-}
+
+module Redland ( module Redland.MidLevel
+ , module Redland.Util
+ , RedlandWorld
+ , RedlandHash
+ , RedlandModel
+ , RedlandNode
+ , RedlandParser
+ , RedlandQuery
+ , RedlandQueryResults
+ , RedlandStatement
+ , RedlandStorage
+ , RedlandStream
+ , RedlandURI
+ , ForeignPtr
+ )
+where
+
+import Foreign
+import Redland.LowLevel
import Redland.MidLevel
import Redland.Util
diff --git a/Redland/Util.hs b/Redland/Util.hs
index 3d34206..9d3744d 100644
--- a/Redland/Util.hs
+++ b/Redland/Util.hs
@@ -20,6 +20,7 @@ import Redland.MidLevel
-- * Hashes
+-- | Mostly a conversion function.
withHash :: ForeignPtr RedlandWorld
-> String
-> [(String, String)]
@@ -33,6 +34,7 @@ withHash world factory l f =
-- * RDF Graph (librdf_model)
+-- | Wrapper around 'modelFindStatements'.
withStatements :: ForeignPtr RedlandWorld
-> ForeignPtr RedlandModel
-> Triple
@@ -46,11 +48,13 @@ withStatements world model t f =
-- * RDF term (librdf_node)
+-- | Haskell representation of 'RedlandNode'.
data Node = BlankNode String
| LiteralNode String
| ResourceNode String
deriving (Eq, Show)
+-- | A conversion function.
redlandNodeToNode :: ForeignPtr RedlandNode -> IO Node
redlandNodeToNode rn = do
isBlank <- nodeIsBlank rn
@@ -61,6 +65,7 @@ redlandNodeToNode rn = do
(_, True, _) -> LiteralNode <$> nodeGetLiteralValue rn
_ -> ResourceNode <$> (nodeGetURI rn >>= uriAsString)
+-- | A conversion function.
nodeToRedlandNode :: ForeignPtr RedlandWorld
-> Node
-> Initializer RedlandNode
@@ -72,7 +77,7 @@ nodeToRedlandNode world (ResourceNode s) =
-- * Parsers
--- | Tries different parsers until one of them succeeds.
+-- | Guesses a parser name, and applies it.
guessingParseStringIntoModel :: ForeignPtr RedlandWorld
-> ForeignPtr RedlandModel
-> ForeignPtr RedlandURI
@@ -81,13 +86,14 @@ guessingParseStringIntoModel :: ForeignPtr RedlandWorld
-- ^ string to parse
-> IO ()
guessingParseStringIntoModel world model uri str = do
- parser <- parserGuessName2 world Nothing (Just str) Nothing
- withNew (redlandParser world parser Nothing Nothing) $ \p ->
+ parserName <- parserGuessName2 world Nothing (Just str) Nothing
+ withNew (redlandParser world parserName Nothing Nothing) $ \p ->
parseStringIntoModel p str uri model
-- * Querying
+-- | Querying helper.
withQuery :: ForeignPtr RedlandWorld
-> ForeignPtr RedlandModel
-> String
@@ -107,6 +113,7 @@ withQuery world model ql qs bURI f =
type QueryResults = [[(String, Node)]]
+-- | A conversion function.
queryResultsToList :: ForeignPtr RedlandQueryResults -> IO QueryResults
queryResultsToList qr = do
done <- queryResultsFinished qr
@@ -128,11 +135,13 @@ queryResultsToList qr = do
-- * RDF Triple (librdf_statement)
+-- | Haskell representation of 'RedlandStatement'.
data Triple = Triple { subject :: Maybe Node
, predicate :: Maybe Node
, object :: Maybe Node
} deriving (Eq, Show)
+-- | A conversion function.
statementToTriple :: ForeignPtr RedlandStatement
-> IO Triple
statementToTriple statement = do
@@ -150,6 +159,7 @@ statementToTriple statement = do
Just c' -> Just <$> redlandNodeToNode c'
Nothing -> pure Nothing
+-- | A conversion function.
tripleToStatement :: ForeignPtr RedlandWorld
-> Triple
-> Initializer RedlandStatement
@@ -166,6 +176,7 @@ tripleToStatement world (Triple s p o) = do
-- * Stream of triples (librdf_statement)
+-- | A conversion function.
streamToList :: ForeignPtr RedlandStream -> IO [Triple]
streamToList stream = do
done <- streamEnd stream