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,23 @@ module Database.HSparql.Connection ( EndPoint , BindingValue(..) - , query + , selectQuery + , constructQuery ) where import Control.Monad import Data.Maybe -import Network.HTTP +import qualified Network.HTTP as 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 +import Network.URI hiding (URI) + -- |URI of the SPARQL endpoint. type EndPoint = String @@ -37,7 +43,7 @@ doc = parseXMLDoc s vars :: Element -> [String] - vars = catMaybes . map (findAttr $ unqual "name") . findElements (sparqlResult "variable") + vars = mapMaybe (findAttr $ unqual "name") . findElements (sparqlResult "variable") projectResult :: [String] -> Element -> [BindingValue] projectResult vs e = map pVar vs @@ -60,10 +66,29 @@ 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 +-- 'Variable's in the 'SelectQuery' action. +selectQuery :: 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 return $ structureContent response + +-- |Connect to remote 'EndPoint' and construct 'TriplesGraph' from given +-- 'ConstructQuery' action. /Provisional implementation/. +constructQuery :: EndPoint -> Query ConstructQuery -> IO TriplesGraph +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) + case rdfGraph of + Left e -> error $ show e + Right graph -> return graph + diff --git a/Database/HSparql/QueryGenerator.hs b/Database/HSparql/QueryGenerator.hs --- a/Database/HSparql/QueryGenerator.hs +++ b/Database/HSparql/QueryGenerator.hs @@ -4,12 +4,13 @@ -- endpoints. module Database.HSparql.QueryGenerator ( -- * Creating Queries - createQuery - + createSelectQuery + , createConstructQuery -- * Query Actions , prefix , var , triple + , constructTriple , optional , union , filterExpr @@ -57,12 +58,17 @@ -- * Types , Query , Variable + , Pattern + , SelectQuery(..) + , ConstructQuery(..) ) where import Control.Monad.State import Data.List (intercalate) +import Debug.Trace + -- State monads -- |The 'State' monad applied to 'QueryData'. @@ -73,20 +79,29 @@ execQuery :: Query a -> (QueryData -> b) -> b execQuery q f = f $ execState q queryData --- |Execute a 'Query' action, returning the 'String' representation of the query. -createQuery :: Query [Variable] -> String -createQuery q = execQuery specifyVars qshow +-- |Execute a 'Select Query' action, returning the 'String' representation of the query. +createSelectQuery :: Query SelectQuery -> String +createSelectQuery q = execQuery specifyVars qshow where specifyVars :: Query () - specifyVars = do vs <- q - modify $ \s -> s { vars = vs } + specifyVars = do query <- q + modify $ \s -> s { vars = queryVars query , queryType = SelectType } +-- |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 + where specifyType :: Query () + specifyType = do + query <- q + modify $ \s -> s { constructTriples = queryConstructs query, queryType = ConstructType } + + -- Manipulate data within monad -- |Add a prefix to the query, given an IRI reference, and return it. -prefix :: IRIRef -> Query Prefix -prefix ref = do n <- gets prefixIdx - let p = Prefix n ref - modify $ \s -> s { prefixIdx = n + 1, prefixes = p : prefixes s } +prefix :: String -> IRIRef -> Query Prefix +prefix pre ref = do -- n <- gets prefixIdx + let p = Prefix pre ref + modify $ \s -> s { {- prefixIdx = n + 1, -} prefixes = p : prefixes s } return p -- |Create and return a variable to the query, usable in later expressions. @@ -103,6 +118,14 @@ modify $ \s -> s { pattern = appendPattern t (pattern s) } return t + +constructTriple :: (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Query Pattern +constructTriple a b c = do + let t = Triple (varOrTerm a) (varOrTerm b) (varOrTerm c) + modify $ \s -> s { constructTriples = appendTriple t (constructTriples s) } + return t + + -- |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. @@ -120,9 +143,9 @@ union q1 q2 = do let p1 = execQuery q1 pattern p2 = execQuery q2 pattern - union = UnionGraphPattern p1 p2 - modify $ \s -> s { pattern = appendPattern union (pattern s) } - return union + union' = UnionGraphPattern p1 p2 + modify $ \s -> s { pattern = appendPattern union' (pattern s) } + return union' -- |Restrict results to only those for which the given expression is true. filterExpr :: (TermLike a) => a -> Query Pattern @@ -163,12 +186,12 @@ -- |Order the results, after any previous ordering, based on the term, in -- ascending order. orderNextAsc :: (TermLike a) => a -> Query () -orderNextAsc x = do modify $ \s -> s { ordering = (ordering s) ++ [Asc $ expr x] } +orderNextAsc x = modify $ \s -> s { ordering = ordering s ++ [Asc $ expr x] } -- |Order the results, after any previous ordering, based on the term, in -- descending order. orderNextDesc :: (TermLike a) => a -> Query () -orderNextDesc x = do modify $ \s -> s { ordering = (ordering s) ++ [Desc $ expr x] } +orderNextDesc x = modify $ \s -> s { ordering = ordering s ++ [Desc $ expr x] } -- Permit variables and values to seemlessly be put into argument for 'triple' -- and similar functions @@ -196,7 +219,7 @@ varOrTerm = Term . RDFLiteralTerm . RDFLiteral instance TermLike ([Char], [Char]) where - varOrTerm (s, lang) = Term . RDFLiteralTerm $ RDFLiteralLang s lang + varOrTerm (s, lang') = Term . RDFLiteralTerm $ RDFLiteralLang s lang' instance TermLike ([Char], IRIRef) where varOrTerm (s, ref) = Term . RDFLiteralTerm $ RDFLiteralIRIRef s ref @@ -309,15 +332,19 @@ -- Default QueryData queryData :: QueryData queryData = QueryData - { prefixIdx = 0 - , prefixes = [] + { {- prefixIdx = 0 + , -} prefixes = [] , varsIdx = 0 , vars = [] + , queryType = TypeNotSet , pattern = GroupGraphPattern [] + , constructTriples = [] , duplicates = NoLimits , ordering = [] } + + -- Query representation class QueryShow a where -- |Convert most query-related types to a 'String', most importantly @@ -326,10 +353,12 @@ data Duplicates = NoLimits | Distinct | Reduced -data Prefix = Prefix Int IRIRef +-- data Prefix = Prefix Int IRIRef +data Prefix = Prefix String IRIRef data Variable = Variable Int + data IRIRef = IRIRef String | PrefixedName Prefix String @@ -375,22 +404,38 @@ | Desc Expr -- Auxiliary, but fairly useful +-- TODO don't add to end appendPattern :: Pattern -> GroupGraphPattern -> GroupGraphPattern appendPattern p (GroupGraphPattern ps) = GroupGraphPattern (ps ++ [p]) +appendTriple :: a -> [a] -> [a] +appendTriple t ts = t : ts + data QueryData = QueryData - { prefixIdx :: Int - , prefixes :: [Prefix] + { prefixes :: [Prefix] , varsIdx :: Int , vars :: [Variable] + , queryType :: QueryType , pattern :: GroupGraphPattern + , constructTriples :: [Pattern] -- Triple , duplicates :: Duplicates , ordering :: [OrderBy] } + +data QueryType = SelectType | ConstructType | TypeNotSet + +data QueryForm = SelectForm QueryData | ConstructForm QueryData + +data ConstructQuery = ConstructQuery + { queryConstructs :: [Pattern] } + +data SelectQuery = SelectQuery + { queryVars :: [Variable] } + -- QueryShow instances instance (QueryShow a) => QueryShow [a] where - qshow xs = intercalate " " $ map qshow xs + qshow xs = unwords $ map qshow xs instance QueryShow Duplicates where qshow NoLimits = "" @@ -398,19 +443,19 @@ qshow Reduced = "REDUCED" instance QueryShow Prefix where - qshow (Prefix n ref) = "PREFIX p" ++ show n ++ ": " ++ qshow ref + qshow (Prefix pre ref) = "PREFIX " ++ pre ++ ": " ++ qshow ref instance QueryShow Variable where qshow (Variable v) = "?x" ++ show v instance QueryShow IRIRef where qshow (IRIRef r) = "<" ++ r ++ ">" - qshow (PrefixedName (Prefix n ref) s) = "p" ++ show n ++ ":" ++ s + qshow (PrefixedName (Prefix pre _) s) = pre ++ ":" ++ s 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 (RDFLiteralLang s lang') = "\"\"\"" ++ s ++ "\"\"\"@" ++ lang' qshow (RDFLiteralIRIRef s ref) = "\"\"\"" ++ s ++ "\"\"\"^^" ++ qshow ref instance QueryShow GraphTerm where @@ -459,10 +504,10 @@ qshow e = "(" ++ qshow' e ++ ")" where qshow' (OrExpr es) = intercalate " || " $ map qshow es qshow' (AndExpr es) = intercalate " && " $ map qshow es - qshow' (NegatedExpr e) = '!' : qshow e + qshow' (NegatedExpr e') = '!' : qshow e' qshow' (RelationalExpr rel e1 e2) = qshow e1 ++ qshow rel ++ qshow e2 - qshow' (NumericExpr e) = qshow e - qshow' (BuiltinCall f es) = qshow f ++ "(" ++ (intercalate ", " $ map qshow es) ++ ")" + qshow' (NumericExpr e') = qshow e' + qshow' (BuiltinCall f es) = qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ ")" instance QueryShow Pattern where qshow (Triple a b c) = qshow [a, b, c] ++ "." @@ -478,14 +523,25 @@ qshow (Asc e) = "ASC(" ++ qshow e ++ ")" qshow (Desc e) = "DESC(" ++ qshow e ++ ")" + +instance QueryShow QueryForm where + qshow (SelectForm qd) = unwords + [ "SELECT" + , qshow (duplicates qd) + , qshow (vars qd) + ] + + qshow (ConstructForm qd) = "CONSTRUCT { " ++ qshow (constructTriples qd) ++ " }" + + instance QueryShow QueryData where - qshow qd = intercalate " " $ [ qshow (prefixes qd) - , "SELECT" - , qshow (duplicates qd) - , qshow (vars qd) + 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 [] -> [] - os -> ["ORDER BY"] ++ map qshow os - + os -> "ORDER BY" : map qshow os diff --git a/hsparql.cabal b/hsparql.cabal --- a/hsparql.cabal +++ b/hsparql.cabal @@ -1,5 +1,6 @@ Name: hsparql -Version: 0.1.1 +Homepage: https://github.com/robstewart57/hsparql +Version: 0.1.2 Synopsis: A SPARQL query generator and DSL, and a client to query a SPARQL server. Category: Database Description: @@ -8,17 +9,22 @@ Haskell data structures. Example queries are included in the tests: - . + . License: BSD3 License-file: LICENSE Author: Jeff Wheeler -Maintainer: jeff@jeffwheeler.name - +Maintainer: Rob Stewart +Stability: Experimental Build-type: Simple + + Build-depends: base >= 4 && < 5 Build-depends: HTTP >= 4 -Build-depends: monads-fd +Build-depends: mtl Build-depends: xml +Build-depends: rdf4h +Build-depends: bytestring +Build-depends: network Exposed-modules: Database.HSparql.Connection Database.HSparql.QueryGenerator