hsparql 0.1.2 → 0.1.4
raw patch · 3 files changed
+152/−44 lines, 3 files
Files
- Database/HSparql/Connection.hs +52/−18
- Database/HSparql/QueryGenerator.hs +82/−15
- hsparql.cabal +18/−11
Database/HSparql/Connection.hs view
@@ -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)
Database/HSparql/QueryGenerator.hs view
@@ -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
hsparql.cabal view
@@ -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 <robstewart57@gmail.com>+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