diff --git a/Database/HSparql/QueryGenerator.hs b/Database/HSparql/QueryGenerator.hs --- a/Database/HSparql/QueryGenerator.hs +++ b/Database/HSparql/QueryGenerator.hs @@ -22,6 +22,9 @@ , union , filterExpr , bind + , select + , selectVars + , as -- ** Duplicate handling , distinct @@ -30,6 +33,9 @@ -- ** Limit handling , limit + -- ** Groups handling + , groupBy + -- ** Order handling , orderNext , orderNextAsc @@ -50,6 +56,13 @@ -- ** Negation , notExpr + -- ** Builtin aggregation functions + , count + , sum_ + , min_ + , max_ + , avg + -- ** Builtin Functions , str , lang @@ -73,6 +86,7 @@ , BlankNodePattern , Pattern , SelectQuery(..) + , SelectExpr(..) , ConstructQuery(..) , AskQuery(..) , UpdateQuery(..) @@ -107,7 +121,7 @@ where specifyVars :: Query () specifyVars = do query <- q - modify $ \s -> s { vars = queryVars query , queryType = SelectType } + modify $ \s -> s { vars = queryExpr query, queryType = SelectType } -- |Execute a 'Construct Query' action, returning the 'String' representation of the query. createConstructQuery :: Query ConstructQuery -> String @@ -188,7 +202,12 @@ modify $ \s -> s { describeURI = Just newIri } return newIri +selectVars :: [Variable] -> Query SelectQuery +selectVars vs = return SelectQuery { queryExpr = fmap SelectVar vs } +select :: [SelectExpr] -> Query SelectQuery +select es = return SelectQuery { queryExpr = es } + -- |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. @@ -248,6 +267,14 @@ limit n = do modify $ \s -> s { limits = Limit n } gets limits +-- Grouping + +-- |Divide the solution into one or more groups. +groupBy :: (TermLike a) => a -> Query [GroupBy] +groupBy e = do + modify $ \s -> s { groups = groups s ++ [GroupBy . expr $ e] } + gets groups + -- Order handling -- |Alias of 'orderNextAsc'. @@ -412,6 +439,8 @@ (.>=.) :: (TermLike a, TermLike b) => a -> b -> Expr (.>=.) = relation GreaterThanOrEqual +infix 4 .==., .!=., .<., .<=., .>., .>=. + -- Negation -- |Negate any term-like expression, for use, e.g., in filtering. @@ -431,6 +460,21 @@ builtinFunc3 :: Function -> BuiltinFunc3 builtinFunc3 f x y z = BuiltinCall f [expr x, expr y, expr z] +count :: BuiltinFunc1 +count = builtinFunc1 CountFunc + +sum_ :: BuiltinFunc1 +sum_ = builtinFunc1 SumFunc + +min_ :: BuiltinFunc1 +min_ = builtinFunc1 MinFunc + +max_ :: BuiltinFunc1 +max_ = builtinFunc1 MaxFunc + +avg :: BuiltinFunc1 +avg = builtinFunc1 AvgFunc + str :: BuiltinFunc1 str = builtinFunc1 StrFunc @@ -480,8 +524,9 @@ , updateTriples = [] , describeURI = Nothing , duplicates = NoLimits - , limits = NoLimit + , groups = [] , ordering = [] + , limits = NoLimit } @@ -580,9 +625,11 @@ data Relation = Equal | NotEqual | LessThan | GreaterThan | LessThanOrEqual | GreaterThanOrEqual deriving (Show) -data Function = StrFunc | LangFunc | LangMatchesFunc | DataTypeFunc | BoundFunc - | SameTermFunc | IsIRIFunc | IsURIFunc | IsBlankFunc - | IsLiteralFunc | RegexFunc +data Function = CountFunc| SumFunc | MinFunc | MaxFunc | AvgFunc + | StrFunc | LangFunc | LangMatchesFunc + | DataTypeFunc | BoundFunc | SameTermFunc + | IsIRIFunc | IsURIFunc | IsBlankFunc | IsLiteralFunc + | RegexFunc deriving (Show) data Expr = OrExpr [Expr] @@ -594,6 +641,13 @@ | VarOrTermExpr VarOrTerm deriving (Show) +data SelectExpr = SelectExpr Expr Variable + | SelectVar Variable + deriving (Show) + +as :: Expr -> Variable -> SelectExpr +e `as` v = SelectExpr e v + data Pattern = QTriple VarOrTerm VarOrTerm VarOrTerm | Filter Expr | Bind Expr Variable @@ -602,6 +656,8 @@ data GroupGraphPattern = GroupGraphPattern [Pattern] +newtype GroupBy = GroupBy Expr + data OrderBy = Asc Expr | Desc Expr @@ -616,7 +672,7 @@ data QueryData = QueryData { prefixes :: [Prefix] , varsIdx :: Int - , vars :: [Variable] + , vars :: [SelectExpr] , queryType :: QueryType , pattern :: GroupGraphPattern , constructTriples :: [Pattern] -- QTriple @@ -624,8 +680,9 @@ , updateTriples :: [Pattern] , describeURI :: Maybe IRIRef , duplicates :: Duplicates - , limits :: Limit + , groups :: [GroupBy] , ordering :: [OrderBy] + , limits :: Limit } @@ -643,12 +700,11 @@ { queryUpdate :: [Pattern] } data SelectQuery = SelectQuery - { queryVars :: [Variable] } + { queryExpr :: [SelectExpr] } data DescribeQuery = DescribeQuery { queryDescribe :: IRIRef } - -- QueryShow instances instance QueryShow BlankNodePattern where qshow [] = "[]" @@ -735,6 +791,11 @@ qshow GreaterThanOrEqual = ">=" instance QueryShow Function where + qshow CountFunc = "COUNT" + qshow SumFunc = "SUM" + qshow MinFunc = "MIN" + qshow MaxFunc = "MAX" + qshow AvgFunc = "AVG" qshow StrFunc = "STR" qshow LangFunc = "LANG" qshow LangMatchesFunc = "LANGMATCHES" @@ -758,6 +819,13 @@ qshow' (BuiltinCall f es) = wrap $ qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ ")" wrap e = "(" ++ e ++ ")" +instance QueryShow SelectExpr where + qshow (SelectVar v) = qshow v + qshow (SelectExpr e v) = mconcat ["(", qshow e, " AS ", qshow v, ")"] + +instance QueryShow [SelectExpr] where + qshow = intercalate " " . fmap qshow + instance QueryShow Pattern where qshow (QTriple a b c) = intercalate " " [qshow a, qshow b, qshow c, "."] qshow (Filter e) = "FILTER " ++ qshow e ++ " ." @@ -771,10 +839,21 @@ instance QueryShow GroupGraphPattern where qshow (GroupGraphPattern ps) = "{" ++ qshow ps ++ "}" +instance QueryShow GroupBy where + qshow (GroupBy e) = qshow e + +instance QueryShow [GroupBy] where + qshow [] = "" + qshow gs = unwords $ "GROUP BY" : fmap qshow gs + instance QueryShow OrderBy where qshow (Asc e) = "ASC(" ++ qshow e ++ ")" qshow (Desc e) = "DESC(" ++ qshow e ++ ")" +instance QueryShow [OrderBy] where + qshow [] = "" + qshow os = unwords $ "ORDER BY" : fmap qshow os + instance QueryShow QueryForm where qshow (SelectForm qd) = unwords [ "SELECT" @@ -787,42 +866,43 @@ qshow (DescribeForm qd) = "DESCRIBE " ++ qshow (describeURI qd) instance QueryShow QueryData where - 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 - , qshow (limits qd) - ] - 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) - ] - UpdateType -> - unwords [ qshow (prefixes qd) - , qshow (UpdateForm qd) - ] - -- FIXME - TypeNotSet -> - error "instance QueryShow QueryData: TypeNotSet not supported." - in query + qshow qd = query + where prefixDecl = qshow (prefixes qd) + whereClause = unwords ["WHERE", qshow (pattern qd)] + groupClause = qshow . groups $ qd + -- TODO: HAVING clause + orderClause = qshow . ordering $ qd + -- TODO: Offset + limitOffsetClauses = qshow (limits qd) + solutionModifier = unwords' [groupClause, orderClause, limitOffsetClauses] + query = case queryType qd of + SelectType -> + unwords' [ prefixDecl + , qshow (SelectForm qd) + , whereClause + , solutionModifier + ] + ConstructType -> + unwords [ prefixDecl + , qshow (ConstructForm qd) + , whereClause + ] + DescribeType -> + unwords [ prefixDecl + , qshow (DescribeForm qd) + , whereClause + ] + AskType -> + unwords [ prefixDecl + , qshow (AskForm qd) + ] + UpdateType -> + unwords [ prefixDecl + , qshow (UpdateForm qd) + ] + -- FIXME + TypeNotSet -> + error "instance QueryShow QueryData: TypeNotSet not supported." -- Internal utilities @@ -835,3 +915,13 @@ handleChar '"' = "\\\"" handleChar '\\' = "\\\\" handleChar c = T.singleton c + +-- | Alternative version of 'unwords' that avoid adding spaces on empty strings. +{-# NOINLINE [1] unwords' #-} +unwords' :: [String] -> String +unwords' [] = "" +unwords' (w:ws) = w ++ go ws + where + go [] = "" + go ("":vs) = go vs + go (v:vs) = ' ' : (v ++ go vs) 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.3.3 +Version: 0.3.4 Synopsis: A SPARQL query generator and DSL, and a client to query a SPARQL server. Category: Database Description: diff --git a/tests/AllTests.hs b/tests/AllTests.hs --- a/tests/AllTests.hs +++ b/tests/AllTests.hs @@ -21,7 +21,7 @@ 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" + "?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 diff --git a/tests/Database/HSparql/ConnectionTest.hs b/tests/Database/HSparql/ConnectionTest.hs --- a/tests/Database/HSparql/ConnectionTest.hs +++ b/tests/Database/HSparql/ConnectionTest.hs @@ -42,7 +42,7 @@ _ <- triple x (dbpprop .:. "genre") (resource .:. "Web_browser") _ <- triple x (foaf .:. "name") name - return SelectQuery { queryVars = [name] } + select [SelectVar name] test_askQuery :: IO () test_askQuery = do