Permalink
Browse files

Initial import

  • Loading branch information...
0 parents commit b3eb299a77a981ba5e8ca14adc4386ebafce4976 @jeffwheeler committed May 23, 2010
Showing with 611 additions and 0 deletions.
  1. +69 −0 Database/HSparql/Connection.hs
  2. +491 −0 Database/HSparql/QueryGenerator.hs
  3. +24 −0 LICENSE
  4. +3 −0 Setup.lhs
  5. +24 −0 hsparql.cabal
@@ -0,0 +1,69 @@
+module Database.HSparql.Connection
+ ( EndPoint
+ , BindingValue(..)
+ , query
+ )
+where
+
+import Control.Monad
+import Data.Maybe
+import Network.HTTP
+import Text.XML.Light
+
+import Database.HSparql.QueryGenerator
+
+-- |URI of the SPARQL endpoint.
+type EndPoint = String
+
+-- |Local representations of incoming XML results.
+data BindingValue = URI String -- ^Absolute reference to remote resource.
+ | Literal String -- ^Simple literal string.
+ | TypedLiteral String String -- ^Literal element with type resource
+ | LangLiteral String String -- ^Literal element with language resource
+ | Unbound -- ^Unbound result value
+ deriving (Show, Eq)
+
+-- |Base 'QName' for results with a SPARQL-result URI specified.
+sparqlResult :: String -> QName
+sparqlResult s = (unqual s) { qURI = Just "http://www.w3.org/2005/sparql-results#" }
+
+-- |Transform the 'String' result from the HTTP request into a two-dimensional
+-- table storing the bindings for each variable in each row.
+structureContent :: String -> Maybe [[BindingValue]]
+structureContent s =
+ do e <- doc
+ return $ map (projectResult $ vars e) $ findElements (sparqlResult "result") e
+ where doc :: Maybe Element
+ doc = parseXMLDoc s
+
+ vars :: Element -> [String]
+ vars = catMaybes . map (findAttr $ unqual "name") . findElements (sparqlResult "variable")
+
+ projectResult :: [String] -> Element -> [BindingValue]
+ projectResult vs e = map pVar vs
+ where pVar v = maybe Unbound (value . head . elChildren) $ filterElement (pred v) e
+ pred v e = isJust $ do a <- findAttr (unqual "name") e
+ guard $ a == v
+
+ value :: Element -> BindingValue
+ value e =
+ case qName (elName e) of
+ "uri" -> URI (strContent e)
+ "literal" -> case findAttr (unqual "datatype") e of
+ Just dt -> TypedLiteral (strContent e) dt
+ Nothing -> case findAttr langAttr e of
+ Just lang -> LangLiteral (strContent e) lang
+ Nothing -> Literal (strContent e)
+ _ -> Unbound
+
+ langAttr :: QName
+ langAttr = blank_name { qName = "lang", qPrefix = Just "xml" }
+
+-- |Connect to remote 'EndPoint' and find all possible bindings for the
+-- 'Variable's in the 'Query' action.
+query :: EndPoint -> Query [Variable] -> IO (Maybe [[BindingValue]])
+query ep q = do
+ let uri = ep ++ "?" ++ urlEncodeVars [("query", createQuery q)]
+ request = replaceHeader HdrUserAgent "hsparql-client" (getRequest uri)
+ response <- simpleHTTP request >>= getResponseBody
+ return $ structureContent response
Oops, something went wrong.

0 comments on commit b3eb299

Please sign in to comment.