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
type EndPoint = String
data BindingValue = URI String
| Literal String
| TypedLiteral String String
| LangLiteral String String
| Unbound
deriving (Show, Eq)
sparqlResult :: String -> QName
sparqlResult s = (unqual s) { qURI = Just "http://www.w3.org/2005/sparql-results#" }
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" }
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