From 8d3da9e7af2ae5986d3551cea8dee39ea9b2cdd6 Mon Sep 17 00:00:00 2001 From: defanor Date: Thu, 22 Feb 2018 13:19:18 +0300 Subject: Refine the documentation --- Redland.hs | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++- Redland/Util.hs | 17 ++++++++++-- 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 +Stability : unstable +Portability : non-portable (GHC extensions are used) + bindings. See + 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 = "\ +> \ \ xmlns:dc=\"http://purl.org/dc/elements/1.1/\">\ +> \ \ +> \ Dave Beckett's Home Page\ +> \ Dave Beckett\ +> \ The generic home page of Dave Beckett.\ +> \ \ +> \\ +> \" +> +> 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 -- cgit v1.2.3