1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
{- |
Module : Redland.Util
Maintainer : defanor <defanor@uberspace.net>
Stability : unstable
Portability : non-portable (GHC extensions are used)
Utility functions based on mid-level bindings.
-}
module Redland.Util where
import Foreign
import Control.Exception
import Redland.LowLevel
import Redland.MidLevel
-- * Hashes
withHash :: ForeignPtr RedlandWorld
-> String
-> [(String, String)]
-> (ForeignPtr RedlandHash -> IO a)
-> IO a
withHash world factory l f =
withNew (redlandHash world factory) $ \hash -> do
mapM_ (uncurry (hashPutStrings hash)) l
f hash
-- * RDF term (librdf_node)
data Node = BlankNode String
| LiteralNode String
| ResourceNode String
deriving (Eq, Show)
redlandNodeToNode :: ForeignPtr RedlandNode -> IO Node
redlandNodeToNode rn = do
isBlank <- nodeIsBlank rn
isLiteral <- nodeIsLiteral rn
isResource <- nodeIsResource rn
case (isBlank, isLiteral, isResource) of
(True, _, _) -> BlankNode <$> nodeGetBlankIdentifier rn
(_, True, _) -> LiteralNode <$> nodeGetLiteralValue rn
_ -> ResourceNode <$> (nodeGetURI rn >>= uriAsString)
-- * 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
-- * Querying
withQuery :: ForeignPtr RedlandWorld
-> ForeignPtr RedlandModel
-> String
-- ^ query language
-> String
-- ^ query string
-> Maybe (ForeignPtr RedlandURI)
-- ^ base URI
-> (QueryResults -> IO a)
-> 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
-- * Query results
type QueryResults = [[(String, Node)]]
queryResultsToList :: ForeignPtr RedlandQueryResults -> IO QueryResults
queryResultsToList qr = do
done <- queryResultsFinished qr
if done
then pure []
else do
bindingCnt <- queryResultsGetBindingsCount qr
bindings <- mapM readBinding [0..bindingCnt - 1]
next <- queryResultsNext qr
rest <- if next then queryResultsToList qr else pure []
pure (bindings : rest)
where
readBinding :: Int -> IO (String, Node)
readBinding n = do
name <- queryResultsGetBindingName qr n
val <- queryResultsGetBindingValue qr n >>= redlandNodeToNode
pure (name, val)
-- * Other
-- | Initializes world, storage, model, and base URI at once.
withWSMU :: String
-- ^ storage factory
-> [(String, String)]
-- ^ storage options
-> String
-- ^ storage identifier
-> String
-- ^ model options
-> String
-- ^ base URI
-> (ForeignPtr RedlandWorld ->
ForeignPtr RedlandStorage ->
ForeignPtr RedlandModel ->
ForeignPtr RedlandURI ->
IO a)
-> IO a
withWSMU sFactory sOpt sIdent mOpt bURI f =
withNew redlandWorld $ \world ->
withHash world "memory" sOpt $ \sOpt' ->
withNew (redlandStorageWithOptions world sFactory sIdent sOpt') $ \storage ->
withNew (redlandModel world storage mOpt) $ \model ->
withNew (redlandURI world bURI) $ \uri ->
f world storage model uri
|
