diff --git a/Database/HSparql/Connection.hs b/Database/HSparql/Connection.hs --- a/Database/HSparql/Connection.hs +++ b/Database/HSparql/Connection.hs @@ -1,17 +1,18 @@ module Database.HSparql.Connection - ( EndPoint + ( Database.HSparql.Connection.EndPoint , BindingValue(..) , selectQuery , constructQuery + , askQuery + , describeQuery ) where import Control.Monad import Data.Maybe -import qualified Network.HTTP as HTTP +import Network.HTTP import Text.XML.Light import Database.HSparql.QueryGenerator -import Data.RDF.TriplesGraph import Text.RDF.RDF4H.TurtleParser import Data.RDF import qualified Data.ByteString.Lazy.Char8 as B @@ -65,30 +66,63 @@ langAttr :: QName langAttr = blank_name { qName = "lang", qPrefix = Just "xml" } +-- |Parses the response from a SPARQL ASK query. Either "true" or "false" is expected +parseAsk :: String -> Bool +parseAsk s + | s == "true" = True + | s == "false" = False + | otherwise = error $ "Unexpected Ask response: " ++ s + -- |Connect to remote 'EndPoint' and find all possible bindings for the -- 'Variable's in the 'SelectQuery' action. -selectQuery :: EndPoint -> Query SelectQuery -> IO (Maybe [[BindingValue]]) +selectQuery :: Database.HSparql.Connection.EndPoint -> Query SelectQuery -> IO (Maybe [[BindingValue]]) selectQuery ep q = do - let uri = ep ++ "?" ++ HTTP.urlEncodeVars [("query", createSelectQuery q)] - request = HTTP.replaceHeader HTTP.HdrUserAgent "hsparql-client" (HTTP.getRequest uri) - response <- HTTP.simpleHTTP request >>= HTTP.getResponseBody + let uri = ep ++ "?" ++ urlEncodeVars [("query", createSelectQuery q)] + request = replaceHeader HdrUserAgent "hsparql-client" (getRequest uri) + response <- simpleHTTP request >>= getResponseBody return $ structureContent response +-- |Connect to remote 'EndPoint' and find all possible bindings for the +-- 'Variable's in the 'SelectQuery' action. +askQuery :: Database.HSparql.Connection.EndPoint -> Query AskQuery -> IO Bool +askQuery ep q = do + let uri = ep ++ "?" ++ urlEncodeVars [("query", createAskQuery q)] + request = replaceHeader HdrUserAgent "hsparql-client" (getRequest uri) + response <- simpleHTTP request >>= getResponseBody + return $ parseAsk response + + -- |Connect to remote 'EndPoint' and construct 'TriplesGraph' from given -- 'ConstructQuery' action. /Provisional implementation/. -constructQuery :: EndPoint -> Query ConstructQuery -> IO TriplesGraph +constructQuery :: forall rdf. (RDF rdf) => Database.HSparql.Connection.EndPoint -> Query ConstructQuery -> IO rdf constructQuery ep q = do - let uri = ep ++ "?" ++ HTTP.urlEncodeVars [("query", createConstructQuery q)] - h1 = HTTP.mkHeader HTTP.HdrUserAgent "hsparql-client" - h2 = HTTP.mkHeader HTTP.HdrAccept "text/rdf+n3" - request = HTTP.Request { HTTP.rqURI = fromJust $ parseURI uri - , HTTP.rqHeaders = [h1,h2] - , HTTP.rqMethod = HTTP.GET - , HTTP.rqBody = "" - } - response <- HTTP.simpleHTTP request >>= HTTP.getResponseBody - let rdfGraph = parseString (TurtleParser Nothing Nothing) (B.pack response) + let uri = ep ++ "?" ++ urlEncodeVars [("query", createConstructQuery q)] + rdfGraph <- httpCallForRdf uri case rdfGraph of Left e -> error $ show e Right graph -> return graph + + +-- |Connect to remote 'EndPoint' and construct 'TriplesGraph' from given +-- 'ConstructQuery' action. /Provisional implementation/. +describeQuery :: forall rdf. (RDF rdf) => Database.HSparql.Connection.EndPoint -> Query DescribeQuery -> IO rdf +describeQuery ep q = do + let uri = ep ++ "?" ++ urlEncodeVars [("query", createDescribeQuery q)] + rdfGraph <- httpCallForRdf uri + case rdfGraph of + Left e -> error $ show e + Right graph -> return graph +-- |Takes a generated uri and makes simple HTTP request, +-- asking for RDF N3 serialization. Returns either 'ParseFailure' or 'RDF' +httpCallForRdf :: RDF rdf => String -> IO (Either ParseFailure rdf) +httpCallForRdf uri = do + let h1 = mkHeader HdrUserAgent "hsparql-client" + h2 = mkHeader HdrAccept "text/rdf+n3" + request = Request { rqURI = fromJust $ parseURI uri + , rqHeaders = [h1,h2] + , rqMethod = GET + , rqBody = "" + } + response <- simpleHTTP request >>= getResponseBody + return $ parseString (TurtleParser Nothing Nothing) (B.pack response) diff --git a/Database/HSparql/QueryGenerator.hs b/Database/HSparql/QueryGenerator.hs --- a/Database/HSparql/QueryGenerator.hs +++ b/Database/HSparql/QueryGenerator.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ExtendedDefaultRules, FlexibleInstances, Rank2Types #-} -- |The query generator DSL for SPARQL, used when connecting to remote -- endpoints. @@ -6,11 +5,15 @@ ( -- * Creating Queries createSelectQuery , createConstructQuery + , createAskQuery + , createDescribeQuery -- * Query Actions , prefix , var , triple , constructTriple + , askTriple + , describeIRI , optional , union , filterExpr @@ -61,13 +64,14 @@ , Pattern , SelectQuery(..) , ConstructQuery(..) + , AskQuery(..) + , DescribeQuery(..) ) where import Control.Monad.State import Data.List (intercalate) -import Debug.Trace -- State monads @@ -88,13 +92,28 @@ -- |Execute a 'Construct Query' action, returning the 'String' representation of the query. createConstructQuery :: Query ConstructQuery -> String -createConstructQuery q = trace (execQuery specifyType qshow) execQuery specifyType qshow +createConstructQuery q = execQuery specifyType qshow where specifyType :: Query () specifyType = do query <- q modify $ \s -> s { constructTriples = queryConstructs query, queryType = ConstructType } +-- |Execute a 'Ask Query' action, returning the 'String' representation of the query. +createAskQuery :: Query AskQuery -> String +createAskQuery q = execQuery specifyType qshow + where specifyType :: Query () + specifyType = do + query <- q + modify $ \s -> s { askTriples = queryAsk query, queryType = AskType } +-- |Execute a 'Ask Query' action, returning the 'String' representation of the query. +createDescribeQuery :: Query DescribeQuery -> String +createDescribeQuery q = execQuery specifyType qshow + where specifyType :: Query () + specifyType = do + query <- q + modify $ \s -> s { describeURI = Just (queryDescribe query), queryType = DescribeType } + -- Manipulate data within monad -- |Add a prefix to the query, given an IRI reference, and return it. @@ -125,7 +144,18 @@ modify $ \s -> s { constructTriples = appendTriple t (constructTriples s) } return t +askTriple :: (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Query Pattern +askTriple a b c = do + let t = Triple (varOrTerm a) (varOrTerm b) (varOrTerm c) + modify $ \s -> s { askTriples = appendTriple t (askTriples s) } + return t +describeIRI :: IRIRef -> Query IRIRef +describeIRI newIri = do + modify $ \s -> s { describeURI = Just newIri } + return newIri + + -- |Add optional constraints on matches. Variable bindings within the optional -- action are lost, so variables must always be defined prior to opening the -- optional block. @@ -339,6 +369,8 @@ , queryType = TypeNotSet , pattern = GroupGraphPattern [] , constructTriples = [] + , askTriples = [] + , describeURI = Nothing , duplicates = NoLimits , ordering = [] } @@ -418,21 +450,30 @@ , queryType :: QueryType , pattern :: GroupGraphPattern , constructTriples :: [Pattern] -- Triple + , askTriples :: [Pattern] + , describeURI :: Maybe IRIRef , duplicates :: Duplicates , ordering :: [OrderBy] } -data QueryType = SelectType | ConstructType | TypeNotSet +data QueryType = SelectType | ConstructType | AskType | DescribeType | TypeNotSet -data QueryForm = SelectForm QueryData | ConstructForm QueryData +data QueryForm = SelectForm QueryData | ConstructForm QueryData | AskForm QueryData | DescribeForm QueryData data ConstructQuery = ConstructQuery { queryConstructs :: [Pattern] } +data AskQuery = AskQuery + { queryAsk :: [Pattern] } + data SelectQuery = SelectQuery { queryVars :: [Variable] } +data DescribeQuery = DescribeQuery + { queryDescribe :: IRIRef } + + -- QueryShow instances instance (QueryShow a) => QueryShow [a] where qshow xs = unwords $ map qshow xs @@ -452,12 +493,17 @@ qshow (IRIRef r) = "<" ++ r ++ ">" qshow (PrefixedName (Prefix pre _) s) = pre ++ ":" ++ s +instance QueryShow (Maybe IRIRef) where + qshow (Just r) = qshow r + qshow Nothing = "" + instance QueryShow RDFLiteral where -- Always use triple-quoted strings to avoid having to deal with quote-escaping qshow (RDFLiteral s) = "\"\"\"" ++ s ++ "\"\"\"" qshow (RDFLiteralLang s lang') = "\"\"\"" ++ s ++ "\"\"\"@" ++ lang' qshow (RDFLiteralIRIRef s ref) = "\"\"\"" ++ s ++ "\"\"\"^^" ++ qshow ref + instance QueryShow GraphTerm where qshow (IRIRefTerm ref) = qshow ref qshow (RDFLiteralTerm s) = qshow s @@ -510,8 +556,8 @@ qshow' (BuiltinCall f es) = qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ ")" instance QueryShow Pattern where - qshow (Triple a b c) = qshow [a, b, c] ++ "." - qshow (Filter e) = "FILTER " ++ qshow e ++ "." + qshow (Triple a b c) = qshow [a, b, c] ++ " ." + qshow (Filter e) = "FILTER " ++ qshow e ++ " ." qshow (OptionalGraphPattern p) = "OPTIONAL " ++ qshow p qshow (UnionGraphPattern p1 p2) = qshow p1 ++ " UNION " ++ qshow p2 @@ -533,15 +579,36 @@ qshow (ConstructForm qd) = "CONSTRUCT { " ++ qshow (constructTriples qd) ++ " }" + qshow (AskForm qd) = "ASK { " ++ qshow (askTriples qd) ++ " }" + qshow (DescribeForm qd) = "DESCRIBE " ++ qshow (describeURI qd) + instance QueryShow QueryData where - qshow qd = let showFormedQuery = case queryType qd of - SelectType -> qshow (SelectForm qd) - ConstructType -> qshow (ConstructForm qd) - in unwords $ [ qshow (prefixes qd) - , showFormedQuery - , "WHERE" - , qshow (pattern qd) - ] ++ case ordering qd of + qshow qd = let whereStmt = unwords $ + ["WHERE" + , qshow (pattern qd) + ] ++ case ordering qd of [] -> [] os -> "ORDER BY" : map qshow os + + query = case queryType qd of + SelectType -> + unwords [ qshow (prefixes qd) + , qshow (SelectForm qd) + , whereStmt + ] + ConstructType -> + unwords [ qshow (prefixes qd) + , qshow (ConstructForm qd) + , whereStmt + ] + DescribeType -> + unwords [ qshow (prefixes qd) + , qshow (DescribeForm qd) + , whereStmt + ] + AskType -> + unwords [ qshow (prefixes qd) + , qshow (AskForm qd) + ] + in query diff --git a/hsparql.cabal b/hsparql.cabal --- a/hsparql.cabal +++ b/hsparql.cabal @@ -1,6 +1,6 @@ Name: hsparql Homepage: https://github.com/robstewart57/hsparql -Version: 0.1.2 +Version: 0.1.4 Synopsis: A SPARQL query generator and DSL, and a client to query a SPARQL server. Category: Database Description: @@ -14,17 +14,24 @@ License-file: LICENSE Author: Jeff Wheeler Maintainer: Rob Stewart +homepage: https://github.com/robstewart57/hsparql +bug-reports: https://github.com/robstewart57/hsparql/issues Stability: Experimental Build-type: Simple - +Cabal-Version: >= 1.6 -Build-depends: base >= 4 && < 5 -Build-depends: HTTP >= 4 -Build-depends: mtl -Build-depends: xml -Build-depends: rdf4h -Build-depends: bytestring -Build-depends: network +library + Exposed-modules: Database.HSparql.Connection + , Database.HSparql.QueryGenerator + Build-depends: base >= 4 && < 5 + , HTTP >= 4 + , mtl + , xml + , rdf4h + , bytestring + , network + extensions: RankNTypes FlexibleInstances -Exposed-modules: Database.HSparql.Connection - Database.HSparql.QueryGenerator +source-repository head + type: git + location: git://github.com/robstewart57/hsparql.git