hsparql 0.1.1 → 0.1.2
raw patch · 3 files changed
+137/−50 lines, 3 filesdep +bytestringdep +mtldep +networkdep −monads-fdnew-uploader
Dependencies added: bytestring, mtl, network, rdf4h
Dependencies removed: monads-fd
Files
- Database/HSparql/Connection.hs +35/−10
- Database/HSparql/QueryGenerator.hs +91/−35
- hsparql.cabal +11/−5
Database/HSparql/Connection.hs view
@@ -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+
Database/HSparql/QueryGenerator.hs view
@@ -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
hsparql.cabal view
@@ -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:- <http://community.haskell.org/~jeffwheeler/hsparql/tests/DBPedia.hs>.+ <https://github.com/robstewart57/hsparql/blob/master/tests/DBPedia.hs>. License: BSD3 License-file: LICENSE Author: Jeff Wheeler-Maintainer: jeff@jeffwheeler.name-+Maintainer: Rob Stewart <robstewart57@gmail.com>+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