diff --git a/Database/HSparql/QueryGenerator.hs b/Database/HSparql/QueryGenerator.hs --- a/Database/HSparql/QueryGenerator.hs +++ b/Database/HSparql/QueryGenerator.hs @@ -24,6 +24,9 @@ , distinct , reduced + -- ** Limit handling + , limit + -- ** Order handling , orderNext , orderNextAsc @@ -63,6 +66,7 @@ -- * Types , Query , Variable + , VarOrNode(..) , Pattern , SelectQuery(..) , ConstructQuery(..) @@ -222,6 +226,12 @@ reduced = do modify $ \s -> s { duplicates = Reduced } gets duplicates +-- |Set limit handling to the given value. By default, there are no limits. +-- Note: negative numbers cause no query results to be returned. +limit :: Int -> Query Limit +limit n = do modify $ \s -> s { limits = Limit n } + gets limits + -- Order handling -- |Alias of 'orderNextAsc'. @@ -272,6 +282,12 @@ instance TermLike Bool where varOrTerm = Term . BooleanLiteralTerm +instance TermLike VarOrNode where + varOrTerm (Var' v) = Var v + varOrTerm (RDFNode n@(UNode _)) = (Term . IRIRefTerm . AbsoluteIRI) n + varOrTerm (RDFNode (LNode lv)) = (Term . RDFLiteralTerm) lv + -- TODO: non-exhaustive: missing BNode, BNodeGen + -- Operations operation :: (TermLike a, TermLike b) => Operation -> a -> b -> Expr operation op x y = NumericExpr $ OperationExpr op (expr x) (expr y) @@ -387,6 +403,7 @@ , updateTriples = [] , describeURI = Nothing , duplicates = NoLimits + , limits = NoLimit , ordering = [] } @@ -400,6 +417,8 @@ data Duplicates = NoLimits | Distinct | Reduced +data Limit = NoLimit | Limit Int + data Prefix = Prefix T.Text Node data Variable = Variable Int @@ -423,6 +442,12 @@ data VarOrTerm = Var Variable | Term GraphTerm +-- |Enables programmatic construction of triples where it is not known in +-- advance which parts of the triple will be variables and which will be +-- 'Node's. +data VarOrNode = Var' Variable + | RDFNode Node + data Operation = Add | Subtract | Multiply | Divide data NumericExpr = NumericLiteralExpr Integer @@ -470,6 +495,7 @@ , updateTriples :: [Pattern] , describeURI :: Maybe IRIRef , duplicates :: Duplicates + , limits :: Limit , ordering :: [OrderBy] } @@ -503,6 +529,10 @@ qshow Distinct = "DISTINCT" qshow Reduced = "REDUCED" +instance QueryShow Limit where + qshow NoLimit = "" + qshow (Limit n) = "Limit " ++ show n + instance QueryShow Node where qshow (UNode n) = "<" ++ T.unpack n ++ ">" @@ -620,6 +650,7 @@ unwords [ qshow (prefixes qd) , qshow (SelectForm qd) , whereStmt + , qshow (limits qd) ] ConstructType -> unwords [ qshow (prefixes qd) 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.2.5 +Version: 0.2.6 Synopsis: A SPARQL query generator and DSL, and a client to query a SPARQL server. Category: Database Description: @@ -12,7 +12,7 @@ . License: BSD3 License-file: LICENSE -Author: Jeff Wheeler +Author: Jeff Wheeler, Rob Stewart Maintainer: Rob Stewart homepage: https://github.com/robstewart57/hsparql bug-reports: https://github.com/robstewart57/hsparql/issues @@ -27,18 +27,19 @@ , HTTP >= 4 , mtl , xml - , rdf4h >= 1.0.0 + , rdf4h >= 1.3.1 , bytestring , MissingH , network , text + , network-uri extensions: RankNTypes FlexibleInstances OverloadedStrings test-suite test-hsparql type: exitcode-stdio-1.0 main-is: AllTests.hs build-depends: hsparql - , rdf4h >= 1.0.0 + , rdf4h >= 1.3.1 , base , text , containers @@ -46,8 +47,9 @@ , HUnit , test-framework , test-framework-hunit - , wai >= 2.0.0 - , warp + , wai >= 3.0.0 + , warp >= 3.0.1 + , network-uri hs-source-dirs: Database, tests extensions: OverloadedStrings, FlexibleInstances diff --git a/tests/AllTests.hs b/tests/AllTests.hs --- a/tests/AllTests.hs +++ b/tests/AllTests.hs @@ -2,37 +2,41 @@ module Main where +import Database.HSparql.ConnectionTest + +import Control.Concurrent (forkIO,threadDelay) +import Control.Exception.Base (bracket_) +import Network.HTTP.Types (status200, status500) import Network.Wai import Network.Wai.Handler.Warp (run) -import Network.HTTP.Types (status200, status500) - -import Control.Concurrent (forkIO) - import Test.Framework -import Database.HSparql.ConnectionTest - main = - do forkIO startServer + do forkIO $ startServer ropts <- interpretArgsOrExit [] defaultMainWithOpts tests ropts where tests = Database.HSparql.ConnectionTest.testSuite +app :: Application +app req respond = respond $ response req + where + response req = case rawQueryString req of + "?query=PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20SELECT%20%20%3Fx1%20WHERE%20%7B%3Fx0%20dbpedia%3Agenre%20dbprop%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D%20" + -> selectResponse + "?query=PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20ASK%20%7B%20%3Fx0%20dbprop%3Agenre%20dbpedia%3AWeb_browser%20.%20%7D" + -> askResponse + "?query=PREFIX%20example%3A%20%3Chttp%3A%2F%2Fwww.example.com%2F%3E%20PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20CONSTRUCT%20%7B%20%3Fx0%20example%3AhasName%20%3Fx1%20.%20%7D%20WHERE%20%7B%3Fx0%20dbprop%3Agenre%20dbpedia%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D" + -> constructResponse + "?query=PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20DESCRIBE%20dbpedia%3AEdinburgh%20WHERE%20%7B%7D" + -> describeResponse + otherwise + -> error $ "Unexpected URI: \n\n" ++ show (rawQueryString req) + + selectResponse = responseFile status200 [("Content-Type", "application/sparql-results+xml")] "tests/fixtures/sparql_select_response.xml" Nothing + askResponse = responseFile status200 [("Content-Type", "text/plain")] "tests/fixtures/sparql_ask_response.text" Nothing + constructResponse = responseFile status200 [("Content-Type", "text/turtle")] "tests/fixtures/sparql_construct_response.ttl" Nothing + describeResponse = responseFile status200 [("Content-Type", "text/turtle")] "tests/fixtures/sparql_describe_response.ttl" Nothing + + startServer :: IO () -startServer = run 3000 testServer - where testServer req = return $ response req - response req = case rawQueryString req of - "?query=PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20SELECT%20%20%3Fx1%20WHERE%20%7B%3Fx0%20dbpedia%3Agenre%20dbprop%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D" - -> selectResponse - "?query=PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20ASK%20%7B%20%3Fx0%20dbprop%3Agenre%20dbpedia%3AWeb_browser%20.%20%7D" - -> askResponse - "?query=PREFIX%20example%3A%20%3Chttp%3A%2F%2Fwww.example.com%2F%3E%20PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20CONSTRUCT%20%7B%20%3Fx0%20example%3AhasName%20%3Fx1%20.%20%7D%20WHERE%20%7B%3Fx0%20dbprop%3Agenre%20dbpedia%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D" - -> constructResponse - "?query=PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20DESCRIBE%20dbpedia%3AEdinburgh%20WHERE%20%7B%7D" - -> describeResponse - otherwise - -> error "Unexpected URI" - selectResponse = responseFile status200 [("Content-Type", "application/sparql-results+xml")] "tests/fixtures/sparql_select_response.xml" Nothing - askResponse = responseFile status200 [("Content-Type", "text/plain")] "tests/fixtures/sparql_ask_response.text" Nothing - constructResponse = responseFile status200 [("Content-Type", "text/turtle")] "tests/fixtures/sparql_construct_response.ttl" Nothing - describeResponse = responseFile status200 [("Content-Type", "text/turtle")] "tests/fixtures/sparql_describe_response.ttl" Nothing +startServer = run 3000 app