hsparql 0.3.6 → 0.3.7

raw patch · 8 files changed

+2554/−1288 lines, 8 filesdep +connectiondep +http-clientdep +http-conduitdep ~rdf4hPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: connection, http-client, http-conduit, string-qq

Dependency ranges changed: rdf4h

API changes (from Hackage documentation)

Files

• Database/HSparql/Connection.hs +139/−109
• Database/HSparql/QueryGenerator.hs +1558/−1150
• hsparql.cabal +15/−6
• tests/AllTests.hs +32/−23
• tests/DBPedia.hs +168/−0
• tests/Database/HSparql/ConnectionTest.hs +27/−0
• tests/Database/HSparql/QueryGeneratorTest.hs +589/−0
• tests/Wikidata.hs +26/−0

@@ -1,159 +1,186 @@+{-# LANGUAGE OverloadedStrings #-}+ module Database.HSparql.Connection-    ( Database.HSparql.Connection.EndPoint-    , BindingValue(..)+  ( Database.HSparql.Connection.EndPoint,+    BindingValue (..),+     -- * submit queries using HSparql DSL-    , selectQuery-    , constructQuery-    , askQuery-    , updateQuery-    , describeQuery+    selectQuery,+    constructQuery,+    askQuery,+    updateQuery,+    describeQuery,+     -- * submit queries using raw SPARQL strings-    , selectQueryRaw-    , constructQueryRaw-    , askQueryRaw-    , updateQueryRaw-    , describeQueryRaw-    )+    selectQueryRaw,+    constructQueryRaw,+    askQueryRaw,+    updateQueryRaw,+    describeQueryRaw,+  ) where  import Control.Monad-import Data.Maybe-import Network.HTTP-import Text.XML.Light-import Database.HSparql.QueryGenerator-import Text.RDF.RDF4H.TurtleParser+import Control.Monad.IO.Class+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as LB+import Data.Maybe (isJust, mapMaybe) import qualified Data.RDF as RDF import qualified Data.Text as T import qualified Data.Text.Encoding as E-import qualified Data.ByteString.Char8 as B--import Network.URI hiding (URI)+import qualified Data.Text.Encoding as T+import Database.HSparql.QueryGenerator+import Network.Connection (TLSSettings (..))+import Network.HTTP+import Network.HTTP.Conduit+import Network.HTTP.Types.Header+import Text.RDF.RDF4H.TurtleParser+import Text.XML.Light --- |URI of the SPARQL endpoint.+-- | URI of the SPARQL endpoint. type EndPoint = String --- |Local representations of incoming XML results.-data BindingValue = Bound RDF.Node    -- ^RDF Node (UNode, BNode, LNode)-                  | Unbound       -- ^Unbound result value-                  deriving (Show, Eq)+-- | Local representations of incoming XML results.+data BindingValue+  = -- | RDF Node (UNode, BNode, LNode)+    Bound RDF.Node+  | -- | Unbound result value+    Unbound+  deriving (Show, Eq) --- |Base 'QName' for results with a SPARQL-result URI specified.+-- | Base 'QName' for results with a SPARQL-result URI specified. sparqlResult :: String -> QName-sparqlResult s = (unqual s) { qURI = Just "http://www.w3.org/2005/sparql-results#" }+sparqlResult s = (unqual s) {qURI = Just "http://www.w3.org/2005/sparql-results#"} --- |Transform the 'String' result from the HTTP request into a two-dimensional---  table storing the bindings for each variable in each row.+-- | Transform the 'String' result from the HTTP request into a two-dimensional+--   table storing the bindings for each variable in each row. structureContent :: String -> Maybe [[BindingValue]] structureContent s =-  do e <- doc-     return $ map (projectResult $ vars e) $ findElements (sparqlResult "result") e-  where doc :: Maybe Element-        doc = parseXMLDoc s+  do+    e <- doc+    return $ map (projectResult $ vars e) $ findElements (sparqlResult "result") e+  where+    doc :: Maybe Element+    doc = parseXMLDoc s -        vars :: Element -> [String]-        vars = mapMaybe (findAttr $ unqual "name") . findElements (sparqlResult "variable")+    vars :: Element -> [String]+    vars = mapMaybe (findAttr $ unqual "name") . findElements (sparqlResult "variable") -        projectResult :: [String] -> Element -> [BindingValue]-        projectResult vs e = map pVar vs-          where pVar v = maybe Unbound (value . head . elChildren) $ filterElement (pred_ v) e-                pred_ v e' = isJust $ do a <- findAttr (unqual "name") e'-                                         guard $ a == v+    projectResult :: [String] -> Element -> [BindingValue]+    projectResult vs e = map pVar vs+      where+        pVar v = maybe Unbound (value . head . elChildren) $ filterElement (pred_ v) e+        pred_ v e' = isJust $ do+          a <- findAttr (unqual "name") e'+          guard $ a == v -        value :: Element -> BindingValue-        value e =-          case qName (elName e) of-            "uri"     -> Bound $ RDF.unode $ (T.pack $ strContent e)-            "literal" -> case findAttr (unqual "datatype") e of-                           Just dt -> Bound $ RDF.lnode $ RDF.typedL (T.pack $ strContent e) (T.pack dt)-                           Nothing -> case findAttr langAttr e of-                                        Just lang_ -> Bound $ RDF.lnode $ RDF.plainLL (T.pack $ strContent e) (T.pack lang_)-                                        Nothing    -> Bound $ RDF.lnode $ RDF.plainL (T.pack $ strContent e)-            -- TODO: what about blank nodes?-            _         -> Unbound+    value :: Element -> BindingValue+    value e =+      case qName (elName e) of+        "uri" -> Bound $ RDF.unode $ T.pack $ strContent e+        "literal" -> case findAttr (unqual "datatype") e of+          Just dt -> Bound $ RDF.lnode $ RDF.typedL (T.pack $ strContent e) (T.pack dt)+          Nothing -> case findAttr langAttr e of+            Just lang_ -> Bound $ RDF.lnode $ RDF.plainLL (T.pack $ strContent e) (T.pack lang_)+            Nothing -> Bound $ RDF.lnode $ RDF.plainL (T.pack $ strContent e)+        -- TODO: what about blank nodes?+        _ -> Unbound -        langAttr :: QName-        langAttr = blank_name { qName = "lang", qPrefix = Just "xml" }+    langAttr :: QName+    langAttr = blank_name {qName = "lang", qPrefix = Just "xml"} --- |Parses the response from a SPARQL ASK query. Either "true" or "false" is expected+-- | Parses the response from a SPARQL ASK query. Either "true" or "false" is expected parseAsk :: String -> Bool parseAsk s-  | (s' == "true" || s' == "yes") = True-  | (s' == "false"|| s' == "no")  = False+  | s' == "true" || s' == "yes" = True+  | s' == "false" || s' == "no" = False   | otherwise = error $ "Unexpected Ask response: " ++ s-  where s' = reverse $ dropWhile (=='\n') $ reverse s+  where+    s' = reverse $ dropWhile (== '\n') $ reverse s --- |Parses the response from a SPARQL UPDATE query.  An empty body is expected+-- | Parses the response from a SPARQL UPDATE query.  An empty body is expected parseUpdate :: String -> Bool parseUpdate s   | s == "" = True   | otherwise = error $ "Unexpected Update response: " ++ s ---- |Connect to remote 'EndPoint' and find all possible bindings for the--- 'Variable's in the 'SelectQueryRaw action.+-- | Connect to remote 'EndPoint' and find all possible bindings for the+--  'Variable's in the 'SelectQueryRaw action. selectQuery :: Database.HSparql.Connection.EndPoint -> Query SelectQuery -> IO (Maybe [[BindingValue]]) selectQuery ep q = selectQueryRaw ep (createSelectQuery q) --- |Connect to remote 'EndPoint' and find all possible bindings for the---  'Variable's in the 'SelectQueryRaw action.+-- | Connect to remote 'EndPoint' and find all possible bindings for the+--   'Variable's in the 'SelectQueryRaw action. askQuery :: Database.HSparql.Connection.EndPoint -> Query AskQuery -> IO Bool askQuery ep q = askQueryRaw ep (createAskQuery q) --- |Connect to remote 'EndPoint' and find all possible bindings for the---  'Variable's in the 'SelectQueryRaw action.+-- | Connect to remote 'EndPoint' and find all possible bindings for the+--   'Variable's in the 'SelectQueryRaw action. updateQuery :: Database.HSparql.Connection.EndPoint -> Query UpdateQuery -> IO Bool updateQuery ep q = updateQueryRaw ep (createUpdateQuery q) --- |Connect to remote 'EndPoint' and construct 'TriplesGraph' from given---  'ConstructQueryRaw action. /Provisional implementation/.+-- | Connect to remote 'EndPoint' and construct 'TriplesGraph' from given+--   'ConstructQueryRaw action. /Provisional implementation/. constructQuery :: (RDF.Rdf a) => Database.HSparql.Connection.EndPoint -> Query ConstructQuery -> IO (RDF.RDF a) constructQuery ep q = constructQueryRaw ep (createConstructQuery q) --- |Connect to remote 'EndPoint' and construct 'TriplesGraph' from given---  'ConstructQueryRaw action. /Provisional implementation/.+-- | Connect to remote 'EndPoint' and construct 'TriplesGraph' from given+--   'ConstructQueryRaw action. /Provisional implementation/. describeQuery :: (RDF.Rdf a) => Database.HSparql.Connection.EndPoint -> Query DescribeQuery -> IO (RDF.RDF a) describeQuery ep q = describeQueryRaw ep (createDescribeQuery q) - selectQueryRaw :: Database.HSparql.Connection.EndPoint -> String -> IO (Maybe [[BindingValue]]) selectQueryRaw ep q = do   let uri = ep ++ "?" ++ urlEncodeVars [("query", q)]-      h1 = mkHeader HdrAccept "application/sparql-results+xml"-      h2 = mkHeader HdrUserAgent "hsparql-client"-      request = Request { rqURI = fromJust $ parseURI uri-                        , rqHeaders = [h1,h2]-                        , rqMethod = GET-                        , rqBody = ""-                        }-  response <- simpleHTTP request >>= getResponseBody-  return $ structureContent response+      h1 = (hAccept, "application/sparql-results+xml")+      h2 = (hUserAgent, "hsparql-client")+  request' <- parseRequest uri+  let request =+        request'+          { method = "GET",+            requestHeaders = [h1, h2]+          }+  let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing+  manager <- liftIO $ newManager settings+  resp <- httpLbs request manager+  return $ structureContent (LB.unpack (responseBody resp))  askQueryRaw :: Database.HSparql.Connection.EndPoint -> String -> IO Bool askQueryRaw ep q = do   let uri = ep ++ "?" ++ urlEncodeVars [("query", q)]-      hdr1 = Header HdrUserAgent "hsparql-client"-      hdr2 = Header HdrAccept "text/plain"-      hdr3 = Header HdrAccept "text/boolean"-      hdr4 = Header HdrAcceptCharset "utf-8"-      request  = insertHeaders [hdr1,hdr2,hdr3,hdr4] (getRequest uri)-  response <- simpleHTTP request >>= getResponseBody-  return $ parseAsk response+      h1 = (hUserAgent, "hsparql-client")+      h2 = (hAccept, "text/plain")+      h3 = (hAccept, "text/boolean")+      h4 = (hAcceptCharset, "utf-8")+  request' <- parseRequest uri+  let request =+        request'+          { method = "GET",+            requestHeaders = [h1, h2, h3, h4]+          }+  let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing+  manager <- liftIO $ newManager settings+  resp <- httpLbs request manager+  return $ parseAsk (LB.unpack (responseBody resp))  updateQueryRaw :: Database.HSparql.Connection.EndPoint -> String -> IO Bool updateQueryRaw ep q = do   let uri = ep       body = q-      h1 = mkHeader HdrContentLength $ show (length body)-      h2 = mkHeader HdrContentType "application/sparql-update"-      h3 = mkHeader HdrUserAgent "hsparql-client"-      request = Request { rqURI = fromJust $ parseURI uri-                        , rqHeaders = [h1,h2,h3]-                        , rqMethod = POST-                        , rqBody = body-                        }-  response <- simpleHTTP request >>= getResponseBody---    return $ structureContent response-  return $ parseUpdate response+      h1 = (hContentLength, B.pack (show (length body)))+      h2 = (hContentType, "application/sparql-update")+      h3 = (hUserAgent, "hsparql-client")+  request' <- parseRequest uri+  let request =+        request'+          { method = "POST",+            requestHeaders = [h1, h2, h3],+            requestBody = RequestBodyBS (T.encodeUtf8 (T.pack body))+          }+  let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing+  manager <- liftIO $ newManager settings+  resp <- httpLbs request manager+  return $ parseUpdate (LB.unpack (responseBody resp))  constructQueryRaw :: (RDF.Rdf a) => Database.HSparql.Connection.EndPoint -> String -> IO (RDF.RDF a) constructQueryRaw ep q = do@@ -171,16 +198,19 @@     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'+-- | Takes a generated uri and makes simple HTTP request,+--  asking for RDF N3 serialization. Returns either 'ParseFailure' or 'RDF' httpCallForRdf :: RDF.Rdf a => String -> IO (Either RDF.ParseFailure (RDF.RDF a)) httpCallForRdf uri = do-  let h1 = mkHeader HdrUserAgent "hsparql-client"-      h2 = mkHeader HdrAccept "text/turtle"-      request = Request { rqURI = fromJust $ parseURI uri-                          , rqHeaders = [h1,h2]-                          , rqMethod = GET-                          , rqBody = ""-                          }-  response <- simpleHTTP request >>= getResponseBody-  return $ RDF.parseString (TurtleParser Nothing Nothing) $ E.decodeUtf8 (B.pack response)+  let h1 = (hUserAgent, "hsparql-client")+      h2 = (hAccept, "text/turtle")+  request' <- parseRequest uri+  let request =+        request'+          { method = "GET",+            requestHeaders = [h1, h2]+          }+  let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing+  manager <- liftIO $ newManager settings+  resp <- httpLbs request manager+  return $ RDF.parseString (TurtleParser Nothing Nothing) $ E.decodeUtf8 (LB.toStrict (responseBody resp))

@@ -1,1150 +1,1558 @@-{-# LANGUAGE ExistentialQuantification, OverloadedLists #-}---- |The query generator DSL for SPARQL, used when connecting to remote---  endpoints.-module Database.HSparql.QueryGenerator-  ( -- * Creating Queries-    createSelectQuery-  , createConstructQuery-  , createAskQuery-  , createUpdateQuery-  , createDescribeQuery-  -- * Query Actions-  , prefix-  , var-  , Database.HSparql.QueryGenerator.triple, triple_-  , mkPredicateObject-  , constructTriple, constructTriple_-  , askTriple, askTriple_-  , updateTriple, updateTriple_-  , describeIRI, describeIRI_-  , optional, optional_-  , union, union_-  , exists, notExists-  , filterExpr, filterExpr_-  , bind, bind_-  , subQuery, subQuery_-  , select-  , selectVars-  , as--  -- ** Duplicate handling-  , distinct, distinct_-  , reduced, reduced_--  -- ** Limit handling-  , limit, limit_--  -- ** Groups handling-  , groupBy, groupBy_--  -- ** Order handling-  , orderNext-  , orderNextAsc-  , orderNextDesc--  -- ** Auxiliary-  , (.:.)-  , iriRef--  -- * Term Manipulation--  -- ** Operations-  , (.+.), (.-.), (.*.), (./.), (.&&.), (.||.)--  -- ** Relations-  , (.==.), (.!=.), (.<.), (.>.), (.<=.), (.>=.)--  -- ** Negation-  , notExpr--  -- ** Builtin aggregation functions-  , count-  , sum_-  , min_-  , max_-  , avg-  , groupConcat--  -- ** Builtin Functions-  , str-  , lang-  , langMatches-  , datatype-  , bound-  , sameTerm-  , isIRI-  , isURI-  , isBlank-  , isLiteral-  , regex, regexOpts-  , strlen-  , substr-  , ucase, lcase-  , strstarts, strends-  , contains-  , strbefore, strafter-  , abs_-  , round_-  , ceil-  , floor_-  , concat_-  , replace-  , rand--  -- * Printing Queries-  , qshow--  -- * Types-  , Query-  , Prefix-  , Variable-  , VarOrNode(..)-  , BlankNodePattern-  , Pattern-  , SelectQuery(..)-  , SelectExpr(..)-  , ConstructQuery(..)-  , AskQuery(..)-  , UpdateQuery(..)-  , DescribeQuery(..)--  -- * Classes-  , TermLike (..)-  , SubjectTermLike-  , PredicateTermLike-  , ObjectTermLike-  )-where--import           Control.Monad.State-import           Data.List (intercalate, intersperse)-import qualified Data.List as L-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NE-import qualified Data.Text as T-import qualified Data.RDF as RDF---- State monads---- |The 'State' monad applied to 'QueryData'.-type Query a = State QueryData a---- |Execute a 'Query' action, starting with initial 'QueryData', then process--- the resulting 'QueryData'.-execQuery :: QueryData -> Query a -> (QueryData -> b) -> b-execQuery qd q f = f $ execState q qd---- |Execute a 'Query' action, starting with the empty 'queryData', then process--- the resulting 'QueryData'.-execQuery0 :: Query a -> (QueryData -> b) -> b-execQuery0 = execQuery queryData---- |Execute a 'Select Query' action, returning the 'String' representation of the query.-createSelectQuery :: Query SelectQuery -> String-createSelectQuery q = execQuery0 (specifyVars q) qshow--specifyVars :: Query SelectQuery -> Query ()-specifyVars q = do-  query <- q-  modify $ \s -> s { vars = queryExpr query, queryType = SelectType }---- |Execute a 'Construct Query' action, returning the 'String' representation of the query.-createConstructQuery :: Query ConstructQuery -> String-createConstructQuery q = execQuery0 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 = execQuery0 specifyType qshow-  where specifyType :: Query ()-        specifyType = do-          query <- q-          modify $ \s -> s { askTriples = queryAsk query, queryType = AskType }---- |Execute a 'Update Query' action, returning the 'String' representation of the query.-createUpdateQuery :: Query UpdateQuery -> String-createUpdateQuery q = execQuery0 specifyType qshow-  where specifyType :: Query ()-        specifyType = do-          query <- q-          modify $ \s -> s { updateTriples = queryUpdate query, queryType = UpdateType }---- |Execute a 'Describe Query' action, returning the 'String' representation of the query.-createDescribeQuery :: Query DescribeQuery -> String-createDescribeQuery q = execQuery0 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.-prefix :: T.Text -> IRIRef -> Query Prefix-prefix pre (AbsoluteIRI node) = do-  let p = Prefix pre node-  modify $ \s -> s { prefixes = p : prefixes s }-  return p-prefix _ _ = error "prefix requires an absolute IRI"---- |Create and return a variable to the query, usable in later expressions.-var :: Query Variable-var = do qis <- gets (NE.init . subQueryIdx)-         n <- gets varsIdx-         let sqis = NE.fromList (qis ++ [n])-         modify $ \s -> s { varsIdx = n + 1 }-         return $ Variable sqis---- |Restrict the query to only results for which values match constants in this---  triple, or for which the variables can be bound.-triple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern-triple a b c = do-  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)-  modify $ \s -> s { pattern = appendPattern t (pattern s) }-  return t--triple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()-triple_ a b c = void $ triple a b c--constructTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern-constructTriple a b c = do-  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)-  modify $ \s -> s { constructTriples = appendTriple t (constructTriples s) }-  return t--constructTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()-constructTriple_ a b c = void $ constructTriple a b c--askTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern-askTriple a b c = do-  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)-  modify $ \s -> s { askTriples = appendTriple t (askTriples s) }-  return t--askTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()-askTriple_ a b c = void $ askTriple a b c--updateTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern-updateTriple a b c = do-  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c) -- TODO: should only allow terms-  modify $ \s -> s { updateTriples = appendTriple t (updateTriples s) }-  return t--updateTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()-updateTriple_ a b c = void $ updateTriple a b c--describeIRI :: IRIRef -> Query IRIRef-describeIRI newIri = do-  modify $ \s -> s { describeURI = Just newIri }-  return newIri--describeIRI_ :: IRIRef -> Query ()-describeIRI_ = void . describeIRI--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.-optional :: Query a -> Query Pattern-optional q = do-  -- Determine the patterns by executing the action on a blank QueryData, and-  -- then pulling the patterns out from there.-  let option  = execQuery0 q $ OptionalGraphPattern . pattern-  modify $ \s -> s { pattern = appendPattern option (pattern s) }-  return option--optional_ :: Query a -> Query ()-optional_ = void . optional---- |Add a union structure to the query pattern. As with 'optional' blocks,---  variables must be defined prior to the opening of any block.-union :: Query a -> Query b -> Query Pattern-union q1 q2 = do-  let p1    = execQuery0 q1 pattern-      p2    = execQuery0 q2 pattern-      union' = UnionGraphPattern p1 p2-  modify $ \s -> s { pattern = appendPattern union' (pattern s) }-  return union'--union_ :: Query a -> Query b -> Query ()-union_ a b = void $ union a b--exists :: Query a -> Query Pattern-exists q = do-  let p = execQuery0 q pattern-      exists' = ExistsPattern p-  return exists'--notExists :: Query a -> Query Pattern-notExists q = do-  let p = execQuery0 q pattern-      notExists' = NotExistsPattern p-  return notExists'---- |Restrict results to only those for which the given expression is true.-filterExpr :: (TermLike a) => a -> Query Pattern-filterExpr e = do-  let f = Filter (expr e)-  modify $ \s -> s { pattern = appendPattern f (pattern s) }-  return f--filterExpr_ :: (TermLike a) => a -> Query ()-filterExpr_ = void . filterExpr---- |Bind the result of an expression to a variable.-bind :: Expr -> Variable -> Query Pattern-bind e v = do-  let b = Bind (expr e) v-  modify $ \s -> s { pattern = appendPattern b (pattern s) }-  return b--bind_ :: Expr -> Variable -> Query ()-bind_ a b = void $ bind a b---- |Perform a subquery.-subQuery :: Query SelectQuery -> Query Pattern-subQuery q = do-  -- Manage subquery indexes-  qis <- gets subQueryIdx-  let sqis = qis |> 0-      qis' = NE.fromList $ NE.init qis ++ [NE.last qis + 1]-  -- Execute the subquery action-  let subQueryData0 = queryData { subQueryIdx = sqis }-      subQueryData = execQuery subQueryData0 (specifyVars q) id-  -- Merge prefixes-  prefixesParentQuery <- gets prefixes-  let prefixesSubQuery = prefixes subQueryData-      newPrefixes = prefixesParentQuery `L.union` prefixesSubQuery-  -- Create the subquery pattern and remove prefixes from the subquery-  let sq = SubQuery $ subQueryData { prefixes = [] }-  -- Append the subquery pattern, update the subquery index and the prefixes.-  modify $ \s -> s { pattern = appendPattern sq (pattern s)-                   , subQueryIdx = qis'-                   , prefixes = newPrefixes  }-  return sq--subQuery_ :: Query SelectQuery -> Query ()-subQuery_ = void . subQuery---- Random auxiliary---- |Form a 'Node', with the 'Prefix' and reference name.-(.:.) :: Prefix -> T.Text -> IRIRef-(.:.) = PrefixedName----- Duplicate handling---- |Set duplicate handling to 'Distinct'. By default, there are no reductions.-distinct :: Query Duplicates-distinct = do modify $ \s -> s { duplicates = Distinct }-              gets duplicates--distinct_ :: Query ()-distinct_ = void distinct---- |Set duplicate handling to 'Reduced'. By default, there are no reductions.-reduced :: Query Duplicates-reduced = do modify $ \s -> s { duplicates = Reduced }-             gets duplicates--reduced_ :: Query ()-reduced_ = void reduced---- |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--limit_ :: Int -> Query ()-limit_ = void . limit---- 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--groupBy_ :: (TermLike a) => a -> Query ()-groupBy_ = void . groupBy---- Order handling---- |Alias of 'orderNextAsc'.-orderNext :: (TermLike a) => a -> Query ()-orderNext = orderNextAsc---- |Order the results, after any previous ordering, based on the term, in---  ascending order.-orderNextAsc :: (TermLike a) => a -> Query ()-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 = modify $ \s -> s { ordering = ordering s ++ [Desc $ expr x] }---- |Permit variables and values to seemlessly be put into argument for 'triple'---  and similar functions-class TermLike a where-  varOrTerm :: a -> VarOrTerm--  expr :: a -> Expr-  expr = VarOrTermExpr . varOrTerm--instance TermLike Variable where-  varOrTerm = Var--instance TermLike IRIRef where-  varOrTerm = Term . IRIRefTerm--instance TermLike BlankNodePattern where-  varOrTerm [] = Term (BNode Nothing)-  varOrTerm xs = BlankNodePattern' xs--  expr [] = error "FIXME: blank node expression"-  expr _ = error "cannot use a blank node pattern as an expression"--instance TermLike Expr where-  varOrTerm = error "cannot use an expression as a term"-  expr = id--instance TermLike Integer where-  varOrTerm = Term . NumericLiteralTerm-  expr = NumericExpr . NumericLiteralExpr--instance TermLike T.Text where-  varOrTerm = Term . RDFLiteralTerm . RDF.plainL--instance TermLike (T.Text, T.Text) where-  varOrTerm (s, lang') = Term . RDFLiteralTerm $ RDF.plainLL s lang'--instance TermLike (T.Text, IRIRef) where-  varOrTerm (s, ref) = Term . RDFLiteralTerm $ RDF.typedL s (getFQN ref)--instance TermLike Bool where-  varOrTerm = Term . BooleanLiteralTerm--instance TermLike RDF.Node where-  varOrTerm n@(RDF.UNode _)  = Term . IRIRefTerm . AbsoluteIRI $ n-  varOrTerm (RDF.LNode lv)   = Term . RDFLiteralTerm $ lv-  varOrTerm (RDF.BNode i)    = Term . BNode . Just $ i-  varOrTerm (RDF.BNodeGen i) = Term . BNode . Just . T.pack . mconcat $ ["genid", show i]--instance TermLike VarOrNode where-  varOrTerm (Var' v) = Var v-  varOrTerm (RDFNode n) = varOrTerm n---- |Restriction of TermLike to the role of subject.-class (TermLike a) => SubjectTermLike a--instance SubjectTermLike IRIRef-instance SubjectTermLike Variable-instance SubjectTermLike BlankNodePattern---- |Restriction of TermLike to the role of predicate.-class (TermLike a) => PredicateTermLike a--instance PredicateTermLike IRIRef-instance PredicateTermLike Variable---- |Restriction of TermLike to the role of object.-class (TermLike a) => ObjectTermLike a--instance ObjectTermLike IRIRef-instance ObjectTermLike Variable-instance ObjectTermLike BlankNodePattern-instance ObjectTermLike Expr-instance ObjectTermLike Integer-instance ObjectTermLike T.Text-instance ObjectTermLike (T.Text, T.Text)-instance ObjectTermLike (T.Text, IRIRef)-instance ObjectTermLike Bool-instance ObjectTermLike VarOrNode-instance ObjectTermLike RDF.Node---- Operations-operation :: (TermLike a, TermLike b) => Operation -> a -> b -> Expr-operation op x y = NumericExpr $ OperationExpr op (expr x) (expr y)---- |Add two terms.-(.+.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.+.) = operation Add---- |Find the difference between two terms.-(.-.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.-.) = operation Subtract---- |Multiply two terms.-(.*.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.*.) = operation Multiply---- |Divide two terms.-(./.) :: (TermLike a, TermLike b) => a -> b -> Expr-(./.) = operation Divide---- | Combine two boolean terms with AND-(.&&.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.&&.) = operation And---- | Combine two boolean terms with OR-(.||.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.||.) = operation Or--infixr 2 .||.-infixr 3 .&&.-infixl 7 .*.-infixl 7 ./.-infixl 6 .+.-infixl 6 .-.---- Relations-relation :: (TermLike a, TermLike b) => Relation -> a -> b -> Expr-relation rel x y = RelationalExpr rel (expr x) (expr y)---- |Create an expression which tests the relationship of the two operands,---  evaluating their equivalence.-(.==.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.==.) = relation Equal---- |Create an expression which tests the relationship of the two operands,---  evaluating their equivalence.-(.!=.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.!=.) = relation NotEqual---- |Create an expression which tests the relationship of the two operands,---  evaluating their relative value.-(.<.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.<.) = relation LessThan---- |Create an expression which tests the relationship of the two operands,---  evaluating their relative value.-(.>.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.>.) = relation GreaterThan---- |Create an expression which tests the relationship of the two operands,---  evaluating their relative value.-(.<=.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.<=.) = relation LessThanOrEqual---- |Create an expression which tests the relationship of the two operands,---  evaluating their relative value.-(.>=.) :: (TermLike a, TermLike b) => a -> b -> Expr-(.>=.) = relation GreaterThanOrEqual--infix 4 .==., .!=., .<., .<=., .>., .>=.---- Negation---- |Negate any term-like expression, for use, e.g., in filtering.-notExpr :: (TermLike a) => a -> Expr-notExpr = NegatedExpr . expr---- Builtin Functions-type BuiltinFunc0 = Expr-builtinFunc0 :: Function -> BuiltinFunc0-builtinFunc0 f = BuiltinCall f []--type BuiltinFunc1 = forall a . (TermLike a) => a -> Expr-builtinFunc1 :: Function -> BuiltinFunc1-builtinFunc1 f x = BuiltinCall f [expr x]--type BuiltinFunc2 = forall a b . (TermLike a, TermLike b) => a -> b -> Expr-builtinFunc2 :: Function -> BuiltinFunc2-builtinFunc2 f x y = BuiltinCall f [expr x, expr y]--type BuiltinFunc3 = forall a b c . (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Expr-builtinFunc3 :: Function -> BuiltinFunc3-builtinFunc3 f x y z = BuiltinCall f [expr x, expr y, expr z]---- | Aggregate by count-count :: BuiltinFunc1-count = builtinFunc1 CountFunc---- | Aggregate by sum-sum_ :: BuiltinFunc1-sum_ = builtinFunc1 SumFunc---- | Aggregate by minimum value-min_ :: BuiltinFunc1-min_ = builtinFunc1 MinFunc---- | Aggregate by maximum value-max_ :: BuiltinFunc1-max_ = builtinFunc1 MaxFunc---- | Aggregate by average-avg :: BuiltinFunc1-avg = builtinFunc1 AvgFunc---- | Cast as a string-str :: BuiltinFunc1-str = builtinFunc1 StrFunc---- | Get the language of this element-lang :: BuiltinFunc1-lang = builtinFunc1 LangFunc---- | strlen ( string ) - get the length of a string-strlen :: BuiltinFunc1-strlen = builtinFunc1 StrLenFunc---- | substr ( string beginPosition stringLength ) - get a substring-substr :: BuiltinFunc1-substr = builtinFunc1 SubStrFunc---- | ucase ( string ) - convert to upper case-ucase :: BuiltinFunc1-ucase = builtinFunc1 UcaseFunc---- | lcase ( string ) - convert to lower case-lcase :: BuiltinFunc1-lcase = builtinFunc1 LcaseFunc---- | strstarts ( string x ) - return true if x matches the beginning of string-strstarts :: BuiltinFunc2-strstarts = builtinFunc2 StrStartsFunc---- | strends ( string x ) - return true if x matches the end of string-strends :: BuiltinFunc2-strends = builtinFunc2 StrEndsFunc---- | contains ( string x ) - return true if x matches anywhere in string-contains :: BuiltinFunc2-contains = builtinFunc2 ContainsFunc---- | strbefore ( string x ) - return the string preceding a match to x-strbefore :: BuiltinFunc2-strbefore = builtinFunc2 StrBeforeFunc---- | strafter ( string x ) - return the string after a match to x-strafter :: BuiltinFunc2-strafter = builtinFunc2 StrAfterFunc---- | concat_ ( x y ) - concatenate strings x and y-concat_ :: BuiltinFunc2-concat_ = builtinFunc2 ConcatFunc---- | replace ( string p r ) - replace literal p with literal r in string-replace :: BuiltinFunc3-replace = builtinFunc3 ReplaceFunc---- | abs_ ( x ) - take the absolute value of number x-abs_ :: BuiltinFunc1-abs_ = builtinFunc1 AbsFunc---- | round ( x ) - round x to the nearest integer-round_ :: BuiltinFunc1-round_ = builtinFunc1 RoundFunc---- | ceil ( number ) - round x up to the nearest integer-ceil :: BuiltinFunc1-ceil = builtinFunc1 CeilFunc---- | floor ( number ) - round x down to the nearest integer-floor_ :: BuiltinFunc1-floor_ = builtinFunc1 FloorFunc---- | rand ( ) - produce a random number between 0 and 1-rand :: BuiltinFunc0-rand = builtinFunc0 RandFunc---- | Aggregate a column by string concatenation with a separator.-groupConcat :: (TermLike a) => a -> String -> Expr-groupConcat x sep = ParameterizedCall GroupConcat [expr x] [("separator", "\"" ++ sep ++ "\"")]--langMatches :: BuiltinFunc2-langMatches = builtinFunc2 LangMatchesFunc--datatype :: BuiltinFunc1-datatype = builtinFunc1 DataTypeFunc--bound :: Variable -> Expr-bound x = BuiltinCall BoundFunc [expr x]--sameTerm :: BuiltinFunc2-sameTerm = builtinFunc2 SameTermFunc--isIRI :: BuiltinFunc1-isIRI = builtinFunc1 IsIRIFunc--isURI :: BuiltinFunc1-isURI = builtinFunc1 IsURIFunc--isBlank :: BuiltinFunc1-isBlank = builtinFunc1 IsBlankFunc--isLiteral :: BuiltinFunc1-isLiteral = builtinFunc1 IsLiteralFunc--regex :: BuiltinFunc2-regex = builtinFunc2 RegexFunc--regexOpts :: BuiltinFunc3-regexOpts = builtinFunc3 RegexFunc---- Default QueryData-queryData :: QueryData-queryData = QueryData-    { prefixes   = []-    , varsIdx    = 0-    , vars       = []-    , queryType  = TypeNotSet-    , subQueryIdx = [0]-    , pattern    = GroupGraphPattern []-    , constructTriples = []-    , askTriples = []-    , updateTriples = []-    , describeURI = Nothing-    , duplicates = NoLimits-    , groups    = []-    , ordering   = []-    , limits     = NoLimit-    }----- Query representation-class QueryShow a where-  -- |Convert most query-related types to a 'String', most importantly-  --  'QueryData's.-  qshow :: a -> String--data Duplicates = NoLimits | Distinct | Reduced-                deriving (Show)--data Limit = NoLimit | Limit Int-           deriving (Show)--data Prefix = Prefix T.Text RDF.Node-            deriving (Show, Eq)--data Variable = Variable (NonEmpty Int)-              deriving (Show)--data DynamicPredicate = forall a. (PredicateTermLike a, QueryShow a, Show a) => DynamicPredicate a-data DynamicObject = forall a. (ObjectTermLike a, QueryShow a, Show a) => DynamicObject a-type DynamicPredicateObject = (DynamicPredicate, DynamicObject)-type BlankNodePattern = [DynamicPredicateObject]--instance Show DynamicPredicate where-  show (DynamicPredicate a) = show a--instance Show DynamicObject where-  show (DynamicObject a) = show a---- |support for blank nodes.------ Define a convenient alias for `mkPredicateObject`. Note: a--- pointfree definition leads to the monomorphism restriction @(&) =--- mkPredicateObject@. An example of its use:------ > p & o = mkPredicateObject p o------ for example------ > q = do--- >   p <- prefix "" (iriRef "http://example.com/")--- >   s <- var--- >   o1 <- var--- >   o2 <- var--- >   _ <- triple s (p .:. "p1") [(p .:. "p2") & [(p .:. "p3") & o1], (p .:. "p4") & o2]--- >   return SelectQuery { queryVars = [s, o1] }------ >>> createSelectQuery q--- "PREFIX : <http://example.com/> SELECT  ?x0 ?x1 WHERE {?x0 :p1 [:p2 [:p3 ?x1]], [:p4 ?x2] .} "-mkPredicateObject :: (PredicateTermLike a, ObjectTermLike b, QueryShow a, QueryShow b, Show a, Show b) => a -> b -> DynamicPredicateObject-mkPredicateObject p o = (DynamicPredicate p, DynamicObject o)--data IRIRef = AbsoluteIRI RDF.Node-            | PrefixedName Prefix T.Text-            deriving (Show)--iriRef :: T.Text -> IRIRef-iriRef uri = AbsoluteIRI $ RDF.unode uri--getFQN :: IRIRef -> T.Text-getFQN (AbsoluteIRI (RDF.UNode n)) = n-getFQN (PrefixedName (Prefix _ (RDF.UNode n)) s) = T.append n s--- FIXME-getFQN _ = error "getFQN: input not supported"---- FIXME: Should support numeric literals, too-data GraphTerm = IRIRefTerm IRIRef-               | RDFLiteralTerm RDF.LValue-               | NumericLiteralTerm Integer-               | BooleanLiteralTerm Bool-               | BNode (Maybe T.Text)-               deriving (Show)--data VarOrTerm = Var Variable-               | Term GraphTerm-               | BlankNodePattern' BlankNodePattern-               deriving (Show)---- |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 RDF.Node-               deriving (Show)--data Operation = Add | Subtract | Multiply | Divide | And | Or-               deriving (Show)--data NumericExpr = NumericLiteralExpr Integer-                 | OperationExpr Operation Expr Expr-                 deriving (Show)--data Relation = Equal | NotEqual | LessThan | GreaterThan | LessThanOrEqual | GreaterThanOrEqual-              deriving (Show)--data Function = CountFunc | SumFunc | MinFunc | MaxFunc | AvgFunc-              | StrFunc | LangFunc | LangMatchesFunc-              | DataTypeFunc | BoundFunc | SameTermFunc-              | IsIRIFunc | IsURIFunc | IsBlankFunc | IsLiteralFunc-              | RegexFunc-              | StrLenFunc | SubStrFunc | UcaseFunc | LcaseFunc-              | StrStartsFunc | StrEndsFunc | ContainsFunc | StrBeforeFunc-              | StrAfterFunc | ConcatFunc | ReplaceFunc-              | AbsFunc | RoundFunc | CeilFunc | FloorFunc | RandFunc-              deriving (Show)--data ParameterizedFunction = GroupConcat deriving (Show)--data Expr = OrExpr [Expr]-          | AndExpr [Expr]-          | NegatedExpr Expr-          | RelationalExpr Relation Expr Expr-          | NumericExpr NumericExpr-          | BuiltinCall Function [Expr]-          | VarOrTermExpr VarOrTerm-          | ParameterizedCall ParameterizedFunction [Expr] [(String, String)]-          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-             | OptionalGraphPattern GroupGraphPattern-             | UnionGraphPattern GroupGraphPattern GroupGraphPattern-             | SubQuery QueryData-             | ExistsPattern GroupGraphPattern-             | NotExistsPattern GroupGraphPattern--data GroupGraphPattern = GroupGraphPattern [Pattern]--newtype GroupBy = GroupBy Expr--data OrderBy = Asc Expr-             | 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-    { prefixes   :: [Prefix]-    , varsIdx    :: Int-    , vars       :: [SelectExpr]-    , queryType  :: QueryType-    , subQueryIdx :: NonEmpty Int-    , pattern    :: GroupGraphPattern-    , constructTriples :: [Pattern] -- QTriple-    , askTriples :: [Pattern]-    , updateTriples :: [Pattern]-    , describeURI :: Maybe IRIRef-    , duplicates :: Duplicates-    , groups    :: [GroupBy]-    , ordering   :: [OrderBy]-    , limits     :: Limit-    }---data QueryType = SelectType | ConstructType | AskType | UpdateType | DescribeType | TypeNotSet--data ConstructQuery = ConstructQuery-    { queryConstructs :: [Pattern] }--data AskQuery = AskQuery-    { queryAsk :: [Pattern] }--data UpdateQuery = UpdateQuery-    { queryUpdate :: [Pattern] }--data SelectQuery = SelectQuery-    { queryExpr :: [SelectExpr] }--data DescribeQuery = DescribeQuery-    { queryDescribe :: IRIRef }---- QueryShow instances-instance QueryShow BlankNodePattern where-  qshow [] = "[]"-  qshow xs = intercalate ", " $ fmap qshow xs--instance QueryShow DynamicPredicateObject where-  qshow (DynamicPredicate p, DynamicObject o) = mconcat ["[", qshow p, " ", qshow o, "]"]--instance QueryShow Duplicates where-  qshow NoLimits = ""-  qshow Distinct = "DISTINCT"-  qshow Reduced  = "REDUCED"--instance QueryShow Limit where-  qshow NoLimit   = ""-  qshow (Limit n) = "Limit " ++ show n--instance QueryShow RDF.Node where-  qshow (RDF.UNode n) = "<" ++ T.unpack n ++ ">"-  qshow (RDF.BNode n) = "_:" ++ T.unpack n-  qshow (RDF.BNodeGen i) = "_:genid" ++ show i-  qshow (RDF.LNode n) = qshow n--instance QueryShow RDF.LValue where-  qshow (RDF.PlainL lit)       = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\""]-  qshow (RDF.PlainLL lit lang_) = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\"@", lang_]-  qshow (RDF.TypedL lit dtype) = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\"^^<", dtype, ">"]--instance QueryShow Prefix where-  qshow (Prefix pre ref) = "PREFIX " ++ (T.unpack pre) ++ ": " ++ qshow ref--instance QueryShow [Prefix] where-  qshow = unwords . fmap qshow--instance QueryShow Variable where-  qshow (Variable vs) = "?x" ++ indexes-    where indexes = mconcat . intersperse "_" . fmap show . NE.toList $ vs--instance QueryShow [Variable] where-  qshow = unwords . fmap qshow--instance QueryShow IRIRef where-  qshow (AbsoluteIRI n) = qshow n-  qshow (PrefixedName (Prefix pre _) s) = (T.unpack pre) ++ ":" ++ (T.unpack s)--instance QueryShow (Maybe IRIRef) where-  qshow (Just r) = qshow r-  qshow Nothing = ""--instance QueryShow GraphTerm where-  qshow (IRIRefTerm ref)           = qshow ref-  qshow (RDFLiteralTerm s)         = qshow s-  qshow (BooleanLiteralTerm True)  = show ("true" :: String)-  qshow (BooleanLiteralTerm False) = show ("false" :: String)-  qshow (NumericLiteralTerm i)     = show i-  qshow (BNode Nothing)            = "[]"-  qshow (BNode (Just i))           = "_:" ++ T.unpack i--instance QueryShow VarOrTerm where-  qshow (Var  v) = qshow v-  qshow (Term t) = qshow t-  qshow (BlankNodePattern' bn) = qshow bn--instance QueryShow [VarOrTerm] where-  qshow = unwords . fmap qshow--instance QueryShow Operation where-  qshow Add      = "+"-  qshow Subtract = "-"-  qshow Multiply = "*"-  qshow Divide   = "/"-  qshow And      = "&&"-  qshow Or       = "||"--instance QueryShow NumericExpr where-  qshow (NumericLiteralExpr n) = show n-  qshow (OperationExpr op x y) = qshow x ++ qshow op ++ qshow y--instance QueryShow Relation where-  qshow Equal              = "="-  qshow NotEqual           = "!="-  qshow LessThan           = "<"-  qshow GreaterThan        = ">"-  qshow LessThanOrEqual    = "<="-  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"-  qshow DataTypeFunc    = "DATATYPE"-  qshow BoundFunc       = "BOUND"-  qshow SameTermFunc    = "sameTerm"-  qshow IsIRIFunc       = "isIRI"-  qshow IsURIFunc       = "isURI"-  qshow IsBlankFunc     = "isBlank"-  qshow IsLiteralFunc   = "isLiteral"-  qshow RegexFunc       = "REGEX"-  qshow StrLenFunc      = "STRLEN"-  qshow SubStrFunc      = "SUBSTR"-  qshow UcaseFunc       = "UCASE"-  qshow LcaseFunc       = "LCASE"-  qshow StrStartsFunc   = "STRSTARTS"-  qshow StrEndsFunc     = "STARTENDS"-  qshow ContainsFunc    = "CONTAINS"-  qshow StrBeforeFunc   = "STRBEFORE"-  qshow StrAfterFunc    = "STRAFTER"-  qshow ConcatFunc      = "CONCAT"-  qshow ReplaceFunc     = "REPLACE"-  qshow AbsFunc         = "ABS"-  qshow RoundFunc       = "ROUND"-  qshow CeilFunc        = "CEIL"-  qshow FloorFunc       = "FLOOR"-  qshow RandFunc        = "RAND"--instance QueryShow ParameterizedFunction where-  qshow GroupConcat = "GROUP_CONCAT"--instance QueryShow Expr where-  qshow = qshow'-    where qshow' (VarOrTermExpr vt) = qshow vt-          qshow' (OrExpr es)        = wrap $ intercalate " || " $ map qshow es-          qshow' (AndExpr es)       = wrap $ intercalate " && " $ map qshow es-          qshow' (NegatedExpr e')   = wrap $ '!' : qshow e'-          qshow' (RelationalExpr rel e1 e2) = wrap $ qshow e1 ++ qshow rel ++ qshow e2-          qshow' (NumericExpr e')   = wrap $ qshow e'-          qshow' (BuiltinCall f es) = wrap $ qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ ")"-          qshow' (ParameterizedCall f es kwargs) = wrap $ qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ " ; " ++ (intercalate "," $ map pair kwargs) ++ ")"-          wrap e = "(" ++ e ++ ")"-          pair (k, v) = k ++ "=" ++ v---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 ++ " ."-  qshow (Bind e v)      = "BIND(" ++ qshow e ++ " AS " ++ qshow v ++ ")"-  qshow (OptionalGraphPattern p)  = "OPTIONAL " ++ qshow p-  qshow (UnionGraphPattern p1 p2) = qshow p1 ++ " UNION " ++ qshow p2-  qshow (ExistsPattern p) = "EXISTS" ++ qshow p-  qshow (NotExistsPattern p) = "NOT EXISTS" ++ qshow p-  qshow (SubQuery qd)   = intercalate " " ["{", qshow qd, "}"]--instance QueryShow [Pattern] where-  qshow = unwords . fmap qshow--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 QueryData where-  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-                      , "SELECT"-                      , qshow (duplicates qd)-                      , qshow (vars qd)-                      , whereClause-                      , solutionModifier-                      ]-            ConstructType ->-             unwords [ prefixDecl-                     , "CONSTRUCT {"-                     , qshow (constructTriples qd)-                     , "}"-                     , whereClause-                     ]-            DescribeType ->-             unwords [ prefixDecl-                     , "DESCRIBE"-                     , qshow (describeURI qd)-                     , whereClause-                     ]-            AskType ->-             unwords [ prefixDecl-                     , "ASK {"-                     , qshow (askTriples qd)-                     , "}"-                     ]-            UpdateType ->-             unwords [ prefixDecl-                     , "INSERT DATA {"-                     , qshow (updateTriples qd)-                     , "}"-                     ]-            -- FIXME-            TypeNotSet ->-              error "instance QueryShow QueryData: TypeNotSet not supported."----- Internal utilities-escapeSpecialChar :: T.Text -> T.Text-escapeSpecialChar = T.concatMap handleChar-  -- FIXME: probably more cases to handle-  where handleChar '\n' = "\n"-        handleChar '\t' = "\t"-        handleChar '\r' = "\r"-        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' ("":ws) = unwords' ws-unwords' (w:ws)  = w ++ go ws-  where-    go []      = ""-    go ("":vs) = go vs-    go (v:vs)  = ' ' : (v ++ go vs)---- | Append a element to a 'NonEmpty' list.-(|>) :: NonEmpty a -> a -> NonEmpty a-xs |> x = NE.fromList $ NE.toList xs ++ [x]+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++-- | The query generator DSL for SPARQL, used when connecting to remote+--   endpoints.+module Database.HSparql.QueryGenerator+  ( -- * Creating Queries+    createSelectQuery,+    createConstructQuery,+    createAskQuery,+    createUpdateQuery,+    createDescribeQuery,++    -- * Query Actions+    prefix,+    var,+    embeddedTriple,+    Database.HSparql.QueryGenerator.triple,+    triple_,+    mkPredicateObject,+    constructTriple,+    constructTriple_,+    askTriple,+    askTriple_,+    updateTriple,+    updateTriple_,+    describeIRI,+    describeIRI_,+    optional,+    optional_,+    service,+    service_,+    union,+    union_,+    filterExpr,+    filterExpr_,+    filterExists,+    filterExists_,+    filterNotExists,+    filterNotExists_,+    bind,+    bind_,+    subQuery,+    subQuery_,+    select,+    selectVars,+    as,++    -- ** Property paths++    -- | SPARQL 1.1 property paths documentation: https://www.w3.org/TR/sparql11-query/#propertypaths+    a,++    -- *** Binary operators++    -- **** Property path binary operators+    (.//.),+    (.|.),++    -- **** Negative property set binary operators+    (..|..),++    -- *** Unary operators++    -- **** Property path unary operators+    inv,+    (*.),+    (+.),+    (?.),++    -- **** Negative property set unary operators+    neg,+    inv',++    -- ** Duplicate handling+    distinct,+    distinct_,+    reduced,+    reduced_,++    -- ** Limit handling+    limit,+    limit_,++    -- ** Groups handling+    groupBy,+    groupBy_,++    -- ** Order handling+    orderNext,+    orderNextAsc,+    orderNextDesc,++    -- ** Auxiliary+    (.:.),+    iriRef,++    -- * Term Manipulation++    -- ** Operations+    (.+.),+    (.-.),+    (.*.),+    (./.),+    (.&&.),+    (.||.),++    -- ** Relations+    (.==.),+    (.!=.),+    (.<.),+    (.>.),+    (.<=.),+    (.>=.),++    -- ** Negation+    notExpr,++    -- ** Builtin aggregation functions+    count,+    sum_,+    min_,+    max_,+    avg,+    groupConcat,++    -- ** Builtin Functions+    str,+    lang,+    langMatches,+    datatype,+    bound,+    sameTerm,+    isIRI,+    isURI,+    isBlank,+    isLiteral,+    regex,+    regexOpts,+    strlen,+    substr,+    ucase,+    lcase,+    strstarts,+    strends,+    contains,+    strbefore,+    strafter,+    abs_,+    round_,+    ceil,+    floor_,+    concat_,+    replace,+    rand,++    -- * Printing Queries+    qshow,++    -- * Types+    Query,+    Prefix,+    Variable,+    VarOrNode (..),+    BlankNodePattern,+    Pattern,+    SelectQuery (..),+    SelectExpr (..),+    ConstructQuery (..),+    AskQuery (..),+    UpdateQuery (..),+    DescribeQuery (..),++    -- * Classes+    TermLike (..),+    SubjectTermLike,+    PredicateTermLike,+    ObjectTermLike,+  )+where++import Control.Monad.State+import Data.List (intercalate, intersperse)+import qualified Data.List as L+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import qualified Data.RDF as RDF+import qualified Data.Text as T+import qualified Network.URI as URI++-- State monads++-- | The 'State' monad applied to 'QueryData'.+type Query a = State QueryData a++-- | Execute a 'Query' action, starting with initial 'QueryData', then process+--  the resulting 'QueryData'.+execQuery :: QueryData -> Query a -> (QueryData -> b) -> b+execQuery qd q f = f $ execState q qd++-- | Execute a 'Query' action, starting with the empty 'queryData', then process+--  the resulting 'QueryData'.+execQuery0 :: Query a -> (QueryData -> b) -> b+execQuery0 = execQuery queryData++-- | Execute a 'Select Query' action, returning the 'String' representation of the query.+createSelectQuery :: Query SelectQuery -> String+createSelectQuery q = execQuery0 (specifyVars q) qshow++specifyVars :: Query SelectQuery -> Query ()+specifyVars q = do+  query <- q+  modify $ \s -> s {vars = queryExpr query, queryType = SelectType}++-- | Execute a 'Construct Query' action, returning the 'String' representation of the query.+createConstructQuery :: Query ConstructQuery -> String+createConstructQuery q = execQuery0 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 = execQuery0 specifyType qshow+  where+    specifyType :: Query ()+    specifyType = do+      query <- q+      modify $ \s -> s {askTriples = queryAsk query, queryType = AskType}++-- | Execute a 'Update Query' action, returning the 'String' representation of the query.+createUpdateQuery :: Query UpdateQuery -> String+createUpdateQuery q = execQuery0 specifyType qshow+  where+    specifyType :: Query ()+    specifyType = do+      query <- q+      modify $ \s -> s {updateTriples = queryUpdate query, queryType = UpdateType}++-- | Execute a 'Describe Query' action, returning the 'String' representation of the query.+createDescribeQuery :: Query DescribeQuery -> String+createDescribeQuery q = execQuery0 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.+prefix :: T.Text -> IRIRef -> Query Prefix+prefix pre (AbsoluteIRI node) = do+  let p = Prefix pre node+  modify $ \s -> s {prefixes = p : prefixes s}+  return p+prefix _ _ = error "prefix requires an absolute IRI"++-- | Create and return a variable to the query, usable in later expressions.+var :: Query Variable+var = do+  qis <- gets (NE.init . subQueryIdx)+  n <- gets varsIdx+  let sqis = NE.fromList (qis ++ [n])+  modify $ \s -> s {varsIdx = n + 1}+  return $ Variable sqis++-- | Create an embedded triple usable in an expression.+--   See SPARQL* at <https://wiki.blazegraph.com/wiki/index.php/Reification_Done_Right>+--   or <https://arxiv.org/abs/1406.3399>.+embeddedTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> EmbeddedTriple+embeddedTriple a b c = EmbeddedTriple $ EmbeddedTriple' (varOrTerm a) (varOrTerm b) (varOrTerm c)++-- | Restrict the query to only results for which values match constants in this+--   triple, or for which the variables can be bound.+triple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern+triple a b c = do+  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)+  modify $ \s -> s {pattern = appendPattern t (pattern s)}+  return t++triple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()+triple_ a b c = void $ triple a b c++constructTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern+constructTriple a b c = do+  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)+  modify $ \s -> s {constructTriples = appendTriple t (constructTriples s)}+  return t++constructTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()+constructTriple_ a b c = void $ constructTriple a b c++askTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern+askTriple a b c = do+  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)+  modify $ \s -> s {askTriples = appendTriple t (askTriples s)}+  return t++askTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()+askTriple_ a b c = void $ askTriple a b c++updateTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern+updateTriple a b c = do+  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c) -- TODO: should only allow terms+  modify $ \s -> s {updateTriples = appendTriple t (updateTriples s)}+  return t++updateTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()+updateTriple_ a b c = void $ updateTriple a b c++describeIRI :: IRIRef -> Query IRIRef+describeIRI newIri = do+  modify $ \s -> s {describeURI = Just newIri}+  return newIri++describeIRI_ :: IRIRef -> Query ()+describeIRI_ = void . describeIRI++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.+optional :: Query a -> Query Pattern+optional q = do+  -- Determine the patterns by executing the action on a blank QueryData, and+  -- then pulling the patterns out from there.+  let option = execQuery0 q $ OptionalGraphPattern . pattern+  modify $ \s -> s {pattern = appendPattern option (pattern s)}+  return option++optional_ :: Query a -> Query ()+optional_ = void . optional++-- | Instruct a federated query processor to invoke the portion of a SPARQL+--  query against a remote SPARQL endpoint.+--+--  For example+--+--  > createQuery $ do+--  >   foaf <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")+--  >+--  >   person    <- var+--  >   name      <- var+--  >+--  >   triple_ (iriRef "http://example.org/myfoaf/I") (foaf .:. "knows") person+--  >+--  >   _ <- service (iriRef "http://people.example.org/sparql") $ do+--  >     triple_ person (foaf .:. "name") name+--  >+--  >   selectVars [name]+--+--   produces the SPARQL query:+--+--  > PREFIX foaf: <http://xmlns.com/foaf/0.1/>+--  > SELECT ?x1 WHERE {+--  >   <http://example.org/myfoaf/I> foaf:knows ?x0 .+--  >   SERVICE <http://people.example.org/sparql> {+--  >     ?x0 foaf:name ?x1 .+--  >   }+--  > }+service ::+  -- | SPARQL endpoint+  IRIRef ->+  -- | SPARQL query to invoke against a remote SPARQL endpoint+  Query a ->+  Query Pattern+service endpoint q = do+  -- Determine the patterns by executing the action on a blank QueryData, and+  -- then pulling the patterns out from there.+  let servicePatternGroup = execQuery0 q $ ServiceGraphPattern endpoint . pattern+  modify $ \s -> s {pattern = appendPattern servicePatternGroup (pattern s)}+  return servicePatternGroup++-- | Same as 'service', but without returning the query patterns.+service_ :: IRIRef -> Query a -> Query ()+service_ q = void . service q++-- | Add a union structure to the query pattern. As with 'optional' blocks,+--   variables must be defined prior to the opening of any block.+union :: Query a -> Query b -> Query Pattern+union q1 q2 = do+  let p1 = execQuery0 q1 pattern+      p2 = execQuery0 q2 pattern+      union' = UnionGraphPattern p1 p2+  modify $ \s -> s {pattern = appendPattern union' (pattern s)}+  return union'++union_ :: Query a -> Query b -> Query ()+union_ a b = void $ union a b++filterExists :: Query a -> Query Pattern+filterExists q = do+  let p = execQuery0 q pattern+      filterExists' = FilterExistsPattern p+  modify $ \s -> s {pattern = appendPattern filterExists' (pattern s)}+  return filterExists'++filterExists_ :: Query a -> Query ()+filterExists_ = void . filterExists++filterNotExists :: Query a -> Query Pattern+filterNotExists q = do+  let p = execQuery0 q pattern+      filterNotExists' = FilterNotExistsPattern p+  modify $ \s -> s {pattern = appendPattern filterNotExists' (pattern s)}+  return filterNotExists'++filterNotExists_ :: Query a -> Query ()+filterNotExists_ = void . filterNotExists++-- | Restrict results to only those for which the given expression is true.+filterExpr :: (TermLike a) => a -> Query Pattern+filterExpr e = do+  let f = Filter (expr e)+  modify $ \s -> s {pattern = appendPattern f (pattern s)}+  return f++filterExpr_ :: (TermLike a) => a -> Query ()+filterExpr_ = void . filterExpr++-- | Bind the result of an expression to a variable.+bind :: Expr -> Variable -> Query Pattern+bind e v = do+  let b = Bind (expr e) v+  modify $ \s -> s {pattern = appendPattern b (pattern s)}+  return b++bind_ :: Expr -> Variable -> Query ()+bind_ a b = void $ bind a b++-- | Perform a subquery.+subQuery :: Query SelectQuery -> Query Pattern+subQuery q = do+  -- Manage subquery indexes+  qis <- gets subQueryIdx+  let sqis = qis |> 0+      qis' = NE.fromList $ NE.init qis ++ [NE.last qis + 1]+  -- Execute the subquery action+  let subQueryData0 = queryData {subQueryIdx = sqis}+      subQueryData = execQuery subQueryData0 (specifyVars q) id+  -- Merge prefixes+  prefixesParentQuery <- gets prefixes+  let prefixesSubQuery = prefixes subQueryData+      newPrefixes = prefixesSubQuery `L.union` prefixesParentQuery+  -- Create the subquery pattern and remove prefixes from the subquery+  let sq = SubQuery $ subQueryData {prefixes = []}+  -- Append the subquery pattern, update the subquery index and the prefixes.+  modify $ \s ->+    s+      { pattern = appendPattern sq (pattern s),+        subQueryIdx = qis',+        prefixes = newPrefixes+      }+  return sq++subQuery_ :: Query SelectQuery -> Query ()+subQuery_ = void . subQuery++-- Random auxiliary++-- | Form a 'Node', with the 'Prefix' and reference name.+(.:.) :: Prefix -> T.Text -> IRIRef+(.:.) = PrefixedName++-- Duplicate handling++-- | Set duplicate handling to 'Distinct'. By default, there are no reductions.+distinct :: Query Duplicates+distinct = do+  modify $ \s -> s {duplicates = Distinct}+  gets duplicates++distinct_ :: Query ()+distinct_ = void distinct++-- | Set duplicate handling to 'Reduced'. By default, there are no reductions.+reduced :: Query Duplicates+reduced = do+  modify $ \s -> s {duplicates = Reduced}+  gets duplicates++reduced_ :: Query ()+reduced_ = void reduced++-- | 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++limit_ :: Int -> Query ()+limit_ = void . limit++-- 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++groupBy_ :: (TermLike a) => a -> Query ()+groupBy_ = void . groupBy++-- Order handling++-- | Alias of 'orderNextAsc'.+orderNext :: (TermLike a) => a -> Query ()+orderNext = orderNextAsc++-- | Order the results, after any previous ordering, based on the term, in+--   ascending order.+orderNextAsc :: (TermLike a) => a -> Query ()+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 = modify $ \s -> s {ordering = ordering s ++ [Desc $ expr x]}++-- | Permit variables and values to seemlessly be put into argument for 'triple'+--   and similar functions+class TermLike a where+  varOrTerm :: a -> VarOrTerm++  expr :: a -> Expr+  expr = VarOrTermExpr . varOrTerm++instance TermLike Variable where+  varOrTerm = Var++instance TermLike IRIRef where+  varOrTerm = Term . IRIRefTerm++instance TermLike PropertyPathExpr where+  varOrTerm = Term . PropertyPathTerm++instance TermLike EmbeddedTriple where+  varOrTerm (EmbeddedTriple v) = v++instance TermLike BlankNodePattern where+  varOrTerm [] = Term (BNode Nothing)+  varOrTerm xs = BlankNodePattern' xs++  expr [] = error "FIXME: blank node expression"+  expr _ = error "cannot use a blank node pattern as an expression"++instance TermLike Expr where+  varOrTerm = error "cannot use an expression as a term"+  expr = id++instance TermLike Integer where+  varOrTerm = Term . NumericLiteralTerm+  expr = NumericExpr . NumericLiteralExpr++instance TermLike T.Text where+  varOrTerm = Term . RDFLiteralTerm . RDF.plainL++instance TermLike (T.Text, T.Text) where+  varOrTerm (s, lang') = Term . RDFLiteralTerm $ RDF.plainLL s lang'++instance TermLike (T.Text, IRIRef) where+  varOrTerm (s, ref) = Term . RDFLiteralTerm $ RDF.typedL s (getFQN ref)++instance TermLike Bool where+  varOrTerm = Term . BooleanLiteralTerm++instance TermLike RDF.Node where+  varOrTerm n@(RDF.UNode _) = Term . IRIRefTerm . AbsoluteIRI $ n+  varOrTerm (RDF.LNode lv) = Term . RDFLiteralTerm $ lv+  varOrTerm (RDF.BNode i) = Term . BNode . Just $ i+  varOrTerm (RDF.BNodeGen i) = Term . BNode . Just . T.pack . mconcat $ ["genid", show i]++instance TermLike VarOrNode where+  varOrTerm (Var' v) = Var v+  varOrTerm (RDFNode n) = varOrTerm n++-- | Restriction of TermLike to the role of subject.+class (TermLike a) => SubjectTermLike a++instance SubjectTermLike IRIRef++instance SubjectTermLike Variable++instance SubjectTermLike EmbeddedTriple++instance SubjectTermLike BlankNodePattern++-- | Restriction of TermLike to the role of predicate.+class (TermLike a) => PredicateTermLike a++instance PredicateTermLike IRIRef++instance PredicateTermLike Variable++instance PredicateTermLike PropertyPathExpr++-- | Restriction of TermLike to the role of object.+class (TermLike a) => ObjectTermLike a++instance ObjectTermLike IRIRef++instance ObjectTermLike Variable++instance ObjectTermLike EmbeddedTriple++instance ObjectTermLike BlankNodePattern++instance ObjectTermLike Expr++instance ObjectTermLike Integer++instance ObjectTermLike T.Text++instance ObjectTermLike (T.Text, T.Text)++instance ObjectTermLike (T.Text, IRIRef)++instance ObjectTermLike Bool++instance ObjectTermLike VarOrNode++instance ObjectTermLike RDF.Node++-- Operations+operation :: (TermLike a, TermLike b) => Operation -> a -> b -> Expr+operation op x y = NumericExpr $ OperationExpr op (expr x) (expr y)++-- | Add two terms.+(.+.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.+.) = operation Add++-- | Find the difference between two terms.+(.-.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.-.) = operation Subtract++-- | Multiply two terms.+(.*.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.*.) = operation Multiply++-- | Divide two terms.+(./.) :: (TermLike a, TermLike b) => a -> b -> Expr+(./.) = operation Divide++-- | Combine two boolean terms with AND+(.&&.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.&&.) = operation And++-- | Combine two boolean terms with OR+(.||.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.||.) = operation Or++infixr 2 .||.++infixr 3 .&&.++infixl 7 .*.++infixl 7 ./.++infixl 6 .+.++infixl 6 .-.++-- Relations+relation :: (TermLike a, TermLike b) => Relation -> a -> b -> Expr+relation rel x y = RelationalExpr rel (expr x) (expr y)++-- | Create an expression which tests the relationship of the two operands,+--   evaluating their equivalence.+(.==.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.==.) = relation Equal++-- | Create an expression which tests the relationship of the two operands,+--   evaluating their equivalence.+(.!=.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.!=.) = relation NotEqual++-- | Create an expression which tests the relationship of the two operands,+--   evaluating their relative value.+(.<.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.<.) = relation LessThan++-- | Create an expression which tests the relationship of the two operands,+--   evaluating their relative value.+(.>.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.>.) = relation GreaterThan++-- | Create an expression which tests the relationship of the two operands,+--   evaluating their relative value.+(.<=.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.<=.) = relation LessThanOrEqual++-- | Create an expression which tests the relationship of the two operands,+--   evaluating their relative value.+(.>=.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.>=.) = relation GreaterThanOrEqual++infix 4 .==., .!=., .<., .<=., .>., .>=.++-- Negation++-- | Negate any term-like expression, for use, e.g., in filtering.+notExpr :: (TermLike a) => a -> Expr+notExpr = NegatedExpr . expr++-- Builtin Functions+type BuiltinFunc0 = Expr++builtinFunc0 :: Function -> BuiltinFunc0+builtinFunc0 f = BuiltinCall f []++type BuiltinFunc1 = forall a. (TermLike a) => a -> Expr++builtinFunc1 :: Function -> BuiltinFunc1+builtinFunc1 f x = BuiltinCall f [expr x]++type BuiltinFunc2 = forall a b. (TermLike a, TermLike b) => a -> b -> Expr++builtinFunc2 :: Function -> BuiltinFunc2+builtinFunc2 f x y = BuiltinCall f [expr x, expr y]++type BuiltinFunc3 = forall a b c. (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Expr++builtinFunc3 :: Function -> BuiltinFunc3+builtinFunc3 f x y z = BuiltinCall f [expr x, expr y, expr z]++-- | Aggregate by count+count :: BuiltinFunc1+count = builtinFunc1 CountFunc++-- | Aggregate by sum+sum_ :: BuiltinFunc1+sum_ = builtinFunc1 SumFunc++-- | Aggregate by minimum value+min_ :: BuiltinFunc1+min_ = builtinFunc1 MinFunc++-- | Aggregate by maximum value+max_ :: BuiltinFunc1+max_ = builtinFunc1 MaxFunc++-- | Aggregate by average+avg :: BuiltinFunc1+avg = builtinFunc1 AvgFunc++-- | Cast as a string+str :: BuiltinFunc1+str = builtinFunc1 StrFunc++-- | Get the language of this element+lang :: BuiltinFunc1+lang = builtinFunc1 LangFunc++-- | strlen ( string ) - get the length of a string+strlen :: BuiltinFunc1+strlen = builtinFunc1 StrLenFunc++-- | substr ( string beginPosition stringLength ) - get a substring+substr :: BuiltinFunc1+substr = builtinFunc1 SubStrFunc++-- | ucase ( string ) - convert to upper case+ucase :: BuiltinFunc1+ucase = builtinFunc1 UcaseFunc++-- | lcase ( string ) - convert to lower case+lcase :: BuiltinFunc1+lcase = builtinFunc1 LcaseFunc++-- | strstarts ( string x ) - return true if x matches the beginning of string+strstarts :: BuiltinFunc2+strstarts = builtinFunc2 StrStartsFunc++-- | strends ( string x ) - return true if x matches the end of string+strends :: BuiltinFunc2+strends = builtinFunc2 StrEndsFunc++-- | contains ( string x ) - return true if x matches anywhere in string+contains :: BuiltinFunc2+contains = builtinFunc2 ContainsFunc++-- | strbefore ( string x ) - return the string preceding a match to x+strbefore :: BuiltinFunc2+strbefore = builtinFunc2 StrBeforeFunc++-- | strafter ( string x ) - return the string after a match to x+strafter :: BuiltinFunc2+strafter = builtinFunc2 StrAfterFunc++-- | concat_ ( x y ) - concatenate strings x and y+concat_ :: BuiltinFunc2+concat_ = builtinFunc2 ConcatFunc++-- | replace ( string p r ) - replace literal p with literal r in string+replace :: BuiltinFunc3+replace = builtinFunc3 ReplaceFunc++-- | abs_ ( x ) - take the absolute value of number x+abs_ :: BuiltinFunc1+abs_ = builtinFunc1 AbsFunc++-- | round ( x ) - round x to the nearest integer+round_ :: BuiltinFunc1+round_ = builtinFunc1 RoundFunc++-- | ceil ( number ) - round x up to the nearest integer+ceil :: BuiltinFunc1+ceil = builtinFunc1 CeilFunc++-- | floor ( number ) - round x down to the nearest integer+floor_ :: BuiltinFunc1+floor_ = builtinFunc1 FloorFunc++-- | rand ( ) - produce a random number between 0 and 1+rand :: BuiltinFunc0+rand = builtinFunc0 RandFunc++-- | Aggregate a column by string concatenation with a separator.+groupConcat :: (TermLike a) => a -> String -> Expr+groupConcat x sep = ParameterizedCall GroupConcat [expr x] [("separator", "\"" ++ sep ++ "\"")]++langMatches :: BuiltinFunc2+langMatches = builtinFunc2 LangMatchesFunc++datatype :: BuiltinFunc1+datatype = builtinFunc1 DataTypeFunc++bound :: Variable -> Expr+bound x = BuiltinCall BoundFunc [expr x]++sameTerm :: BuiltinFunc2+sameTerm = builtinFunc2 SameTermFunc++isIRI :: BuiltinFunc1+isIRI = builtinFunc1 IsIRIFunc++isURI :: BuiltinFunc1+isURI = builtinFunc1 IsURIFunc++isBlank :: BuiltinFunc1+isBlank = builtinFunc1 IsBlankFunc++isLiteral :: BuiltinFunc1+isLiteral = builtinFunc1 IsLiteralFunc++regex :: BuiltinFunc2+regex = builtinFunc2 RegexFunc++regexOpts :: BuiltinFunc3+regexOpts = builtinFunc3 RegexFunc++-- Default QueryData+queryData :: QueryData+queryData =+  QueryData+    { prefixes = [],+      varsIdx = 0,+      vars = [],+      queryType = TypeNotSet,+      subQueryIdx = [0],+      pattern = GroupGraphPattern [],+      constructTriples = [],+      askTriples = [],+      updateTriples = [],+      describeURI = Nothing,+      duplicates = NoLimits,+      groups = [],+      ordering = [],+      limits = NoLimit+    }++-- Query representation+class QueryShow a where+  -- | Convert most query-related types to a 'String', most importantly+  --   'QueryData's.+  qshow :: a -> String++data Duplicates = NoLimits | Distinct | Reduced+  deriving (Show)++data Limit = NoLimit | Limit Int+  deriving (Show)++data Prefix = Prefix T.Text RDF.Node+  deriving (Show, Eq)++data Variable = Variable (NonEmpty Int)+  deriving (Show)++data EmbeddedTriple = EmbeddedTriple VarOrTerm+  deriving (Show)++data DynamicPredicate = forall a. (PredicateTermLike a, QueryShow a, Show a) => DynamicPredicate a++data DynamicObject = forall a. (ObjectTermLike a, QueryShow a, Show a) => DynamicObject a++type DynamicPredicateObject = (DynamicPredicate, DynamicObject)++type BlankNodePattern = [DynamicPredicateObject]++instance Show DynamicPredicate where+  show (DynamicPredicate a) = show a++instance Show DynamicObject where+  show (DynamicObject a) = show a++-- | support for blank nodes.+--+--  Define a convenient alias for `mkPredicateObject`. Note: a+--  pointfree definition leads to the monomorphism restriction @(&) =+--  mkPredicateObject@. An example of its use:+--+--  > p & o = mkPredicateObject p o+--+--  for example+--+--  > q = do+--  >   p <- prefix "" (iriRef "http://example.com/")+--  >   s <- var+--  >   o1 <- var+--  >   o2 <- var+--  >   _ <- triple s (p .:. "p1") [(p .:. "p2") & [(p .:. "p3") & o1], (p .:. "p4") & o2]+--  >   return SelectQuery { queryVars = [s, o1] }+--+--  >>> createSelectQuery q+--  "PREFIX : <http://example.com/> SELECT  ?x0 ?x1 WHERE {?x0 :p1 [:p2 [:p3 ?x1]], [:p4 ?x2] .} "+mkPredicateObject :: (PredicateTermLike a, ObjectTermLike b, QueryShow a, QueryShow b, Show a, Show b) => a -> b -> DynamicPredicateObject+mkPredicateObject p o = (DynamicPredicate p, DynamicObject o)++data IRIRef+  = AbsoluteIRI RDF.Node+  | PrefixedName Prefix T.Text+  deriving (Show)++iriRef :: T.Text -> IRIRef+iriRef uri = AbsoluteIRI $ RDF.unode uri++getFQN :: IRIRef -> T.Text+getFQN (AbsoluteIRI (RDF.UNode n)) = n+getFQN (PrefixedName (Prefix _ (RDF.UNode n)) s) = T.append n s+-- FIXME+getFQN _ = error "getFQN: input not supported"++-- FIXME: Should support numeric literals, too+data GraphTerm+  = IRIRefTerm IRIRef+  | RDFLiteralTerm RDF.LValue+  | NumericLiteralTerm Integer+  | BooleanLiteralTerm Bool+  | BNode (Maybe T.Text)+  | PropertyPathTerm PropertyPathExpr+  deriving (Show)++data VarOrTerm+  = Var Variable+  | Term GraphTerm+  | EmbeddedTriple' VarOrTerm VarOrTerm VarOrTerm+  | BlankNodePattern' BlankNodePattern+  deriving (Show)++-- | 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 RDF.Node+  deriving (Show)++data Operation = Add | Subtract | Multiply | Divide | And | Or+  deriving (Show)++data NumericExpr+  = NumericLiteralExpr Integer+  | OperationExpr Operation Expr Expr+  deriving (Show)++data Relation = Equal | NotEqual | LessThan | GreaterThan | LessThanOrEqual | GreaterThanOrEqual+  deriving (Show)++data Function+  = CountFunc+  | SumFunc+  | MinFunc+  | MaxFunc+  | AvgFunc+  | StrFunc+  | LangFunc+  | LangMatchesFunc+  | DataTypeFunc+  | BoundFunc+  | SameTermFunc+  | IsIRIFunc+  | IsURIFunc+  | IsBlankFunc+  | IsLiteralFunc+  | RegexFunc+  | StrLenFunc+  | SubStrFunc+  | UcaseFunc+  | LcaseFunc+  | StrStartsFunc+  | StrEndsFunc+  | ContainsFunc+  | StrBeforeFunc+  | StrAfterFunc+  | ConcatFunc+  | ReplaceFunc+  | AbsFunc+  | RoundFunc+  | CeilFunc+  | FloorFunc+  | RandFunc+  deriving (Show)++data ParameterizedFunction = GroupConcat deriving (Show)++data Expr+  = OrExpr [Expr]+  | AndExpr [Expr]+  | NegatedExpr Expr+  | RelationalExpr Relation Expr Expr+  | NumericExpr NumericExpr+  | BuiltinCall Function [Expr]+  | VarOrTermExpr VarOrTerm+  | ParameterizedCall ParameterizedFunction [Expr] [(String, String)]+  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+  | FilterExistsPattern GroupGraphPattern+  | FilterNotExistsPattern GroupGraphPattern+  | Bind Expr Variable+  | OptionalGraphPattern GroupGraphPattern+  | ServiceGraphPattern IRIRef GroupGraphPattern+  | UnionGraphPattern GroupGraphPattern GroupGraphPattern+  | SubQuery QueryData+  deriving (Show)++data GroupGraphPattern = GroupGraphPattern [Pattern]+  deriving (Show)++newtype GroupBy = GroupBy Expr+  deriving (Show)++data OrderBy+  = Asc Expr+  | Desc Expr+  deriving (Show)++-- 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+  { prefixes :: [Prefix],+    varsIdx :: Int,+    vars :: [SelectExpr],+    queryType :: QueryType,+    subQueryIdx :: NonEmpty Int,+    pattern :: GroupGraphPattern,+    constructTriples :: [Pattern], -- QTriple+    askTriples :: [Pattern],+    updateTriples :: [Pattern],+    describeURI :: Maybe IRIRef,+    duplicates :: Duplicates,+    groups :: [GroupBy],+    ordering :: [OrderBy],+    limits :: Limit+  }+  deriving (Show)++data QueryType = SelectType | ConstructType | AskType | UpdateType | DescribeType | TypeNotSet+  deriving (Show)++data ConstructQuery = ConstructQuery+  {queryConstructs :: [Pattern]}++data AskQuery = AskQuery+  {queryAsk :: [Pattern]}++data UpdateQuery = UpdateQuery+  {queryUpdate :: [Pattern]}++data SelectQuery = SelectQuery+  {queryExpr :: [SelectExpr]}++data DescribeQuery = DescribeQuery+  {queryDescribe :: IRIRef}++-- QueryShow instances+instance QueryShow BlankNodePattern where+  qshow [] = "[]"+  qshow xs = intercalate ", " $ fmap qshow xs++instance QueryShow DynamicPredicateObject where+  qshow (DynamicPredicate p, DynamicObject o) = mconcat ["[", qshow p, " ", qshow o, "]"]++instance QueryShow Duplicates where+  qshow NoLimits = ""+  qshow Distinct = "DISTINCT"+  qshow Reduced = "REDUCED"++instance QueryShow Limit where+  qshow NoLimit = ""+  qshow (Limit n) = "Limit " ++ show n++instance QueryShow RDF.Node where+  qshow (RDF.UNode n) = "<" ++ T.unpack n ++ ">"+  qshow (RDF.BNode n) = "_:" ++ T.unpack n+  qshow (RDF.BNodeGen i) = "_:genid" ++ show i+  qshow (RDF.LNode n) = qshow n++instance QueryShow RDF.LValue where+  qshow (RDF.PlainL lit) = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\""]+  qshow (RDF.PlainLL lit lang_) = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\"@", lang_]+  qshow (RDF.TypedL lit dtype) = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\"^^<", dtype, ">"]++instance QueryShow Prefix where+  qshow (Prefix pre ref) = "PREFIX " ++ (T.unpack pre) ++ ": " ++ qshow ref++instance QueryShow [Prefix] where+  qshow = unwords . reverse . fmap qshow++instance QueryShow Variable where+  qshow (Variable vs) = "?x" ++ indexes+    where+      indexes = mconcat . intersperse "_" . fmap show . NE.toList $ vs++instance QueryShow [Variable] where+  qshow = unwords . fmap qshow++instance QueryShow IRIRef where+  qshow (AbsoluteIRI n) = qshow n+  qshow (PrefixedName (Prefix pre _) s) = (T.unpack pre) ++ ":" ++ (escape $ T.unpack s)+    where+      escape = URI.escapeURIString URI.isUnescapedInURIComponent++instance QueryShow (Maybe IRIRef) where+  qshow (Just r) = qshow r+  qshow Nothing = ""++instance QueryShow GraphTerm where+  qshow (IRIRefTerm ref) = qshow ref+  qshow (RDFLiteralTerm s) = qshow s+  qshow (BooleanLiteralTerm True) = show ("true" :: String)+  qshow (BooleanLiteralTerm False) = show ("false" :: String)+  qshow (NumericLiteralTerm i) = show i+  qshow (BNode Nothing) = "[]"+  qshow (BNode (Just i)) = "_:" ++ T.unpack i+  qshow (PropertyPathTerm p) = qshow p++instance QueryShow VarOrTerm where+  qshow (Var v) = qshow v+  qshow (Term t) = qshow t+  qshow (EmbeddedTriple' a b c) = intercalate " " ["<<", qshow a, qshow b, qshow c, ">>"]+  qshow (BlankNodePattern' bn) = qshow bn++instance QueryShow [VarOrTerm] where+  qshow = unwords . fmap qshow++instance QueryShow Operation where+  qshow Add = "+"+  qshow Subtract = "-"+  qshow Multiply = "*"+  qshow Divide = "/"+  qshow And = "&&"+  qshow Or = "||"++instance QueryShow NumericExpr where+  qshow (NumericLiteralExpr n) = show n+  qshow (OperationExpr op x y) = qshow x ++ qshow op ++ qshow y++instance QueryShow Relation where+  qshow Equal = "="+  qshow NotEqual = "!="+  qshow LessThan = "<"+  qshow GreaterThan = ">"+  qshow LessThanOrEqual = "<="+  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"+  qshow DataTypeFunc = "DATATYPE"+  qshow BoundFunc = "BOUND"+  qshow SameTermFunc = "sameTerm"+  qshow IsIRIFunc = "isIRI"+  qshow IsURIFunc = "isURI"+  qshow IsBlankFunc = "isBlank"+  qshow IsLiteralFunc = "isLiteral"+  qshow RegexFunc = "REGEX"+  qshow StrLenFunc = "STRLEN"+  qshow SubStrFunc = "SUBSTR"+  qshow UcaseFunc = "UCASE"+  qshow LcaseFunc = "LCASE"+  qshow StrStartsFunc = "STRSTARTS"+  qshow StrEndsFunc = "STARTENDS"+  qshow ContainsFunc = "CONTAINS"+  qshow StrBeforeFunc = "STRBEFORE"+  qshow StrAfterFunc = "STRAFTER"+  qshow ConcatFunc = "CONCAT"+  qshow ReplaceFunc = "REPLACE"+  qshow AbsFunc = "ABS"+  qshow RoundFunc = "ROUND"+  qshow CeilFunc = "CEIL"+  qshow FloorFunc = "FLOOR"+  qshow RandFunc = "RAND"++instance QueryShow ParameterizedFunction where+  qshow GroupConcat = "GROUP_CONCAT"++instance QueryShow Expr where+  qshow = qshow'+    where+      qshow' (VarOrTermExpr vt) = qshow vt+      qshow' (OrExpr es) = wrap $ intercalate " || " $ map qshow es+      qshow' (AndExpr es) = wrap $ intercalate " && " $ map qshow es+      qshow' (NegatedExpr e') = wrap $ '!' : qshow e'+      qshow' (RelationalExpr rel e1 e2) = wrap $ qshow e1 ++ qshow rel ++ qshow e2+      qshow' (NumericExpr e') = wrap $ qshow e'+      qshow' (BuiltinCall f es) = wrap $ qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ ")"+      qshow' (ParameterizedCall f es kwargs) = wrap $ qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ " ; " ++ (intercalate "," $ map pair kwargs) ++ ")"+      wrap e = "(" ++ e ++ ")"+      pair (k, v) = k ++ "=" ++ v++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 ++ " ."+  qshow (FilterExistsPattern p) = "FILTER EXISTS " ++ qshow p+  qshow (FilterNotExistsPattern p) = "FILTER NOT EXISTS " ++ qshow p+  qshow (Bind e v) = "BIND(" ++ qshow e ++ " AS " ++ qshow v ++ ")"+  qshow (OptionalGraphPattern p) = "OPTIONAL " ++ qshow p+  qshow (ServiceGraphPattern endpoint p) = "SERVICE " ++ qshow endpoint ++ " " ++ qshow p+  qshow (UnionGraphPattern p1 p2) = qshow p1 ++ " UNION " ++ qshow p2+  qshow (SubQuery qd) = intercalate " " ["{ ", qshow qd, " }"]++instance QueryShow [Pattern] where+  qshow = unwords . fmap qshow++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 QueryData where+  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,+              "SELECT",+              qshow (duplicates qd),+              qshow (vars qd),+              whereClause,+              solutionModifier+            ]+        ConstructType ->+          unwords+            [ prefixDecl,+              "CONSTRUCT {",+              qshow (constructTriples qd),+              "}",+              whereClause+            ]+        DescribeType ->+          unwords+            [ prefixDecl,+              "DESCRIBE",+              qshow (describeURI qd),+              whereClause+            ]+        AskType ->+          unwords+            [ prefixDecl,+              "ASK {",+              qshow (askTriples qd),+              "}"+            ]+        UpdateType ->+          unwords+            [ prefixDecl,+              "INSERT DATA {",+              qshow (updateTriples qd),+              "}"+            ]+        -- FIXME+        TypeNotSet ->+          error "instance QueryShow QueryData: TypeNotSet not supported."++-- Internal utilities+escapeSpecialChar :: T.Text -> T.Text+escapeSpecialChar = T.concatMap handleChar+  where+    -- FIXME: probably more cases to handle+    handleChar '\n' = "\n"+    handleChar '\t' = "\t"+    handleChar '\r' = "\r"+    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' ("" : ws) = unwords' ws+unwords' (w : ws) = w ++ go ws+  where+    go [] = ""+    go ("" : vs) = go vs+    go (v : vs) = ' ' : (v ++ go vs)++-- | Append a element to a 'NonEmpty' list.+(|>) :: NonEmpty a -> a -> NonEmpty a+xs |> x = NE.fromList $ NE.toList xs ++ [x]++-- Property paths++-- | Permit different type of property path expressions to be seemlessly be put+--  into arguments for '(.//.)' and similar functions.+class PropertyPathExprLike a where+  propertyPathExpr :: a -> PropertyPathExpr++-- | Possible expressions in a SPARQL property path.+data PropertyPathExpr+  = -- | Property path of length one expression. Ex. @rdf:type@+    PathLengthOneExpr PathLengthOne+  | -- | Ex. @foaf:knows/foaf:knows@+    SequencePathExpr PropertyPathExpr PropertyPathExpr+  | -- | Ex. @^foaf:knows@+    InversePathExpr PropertyPathExpr+  | -- | Ex. @rdfs:label|foaf:name@+    AlternativePathExpr PropertyPathExpr PropertyPathExpr+  | -- | Ex. @rdf:type/rdfs:subClassOf*@+    ZeroOrMorePathExpr PropertyPathExpr+  | -- | Ex. @foaf:knows+@+    OneOrMorePathExpr PropertyPathExpr+  | -- | Ex. @rdf:type/rdfs:subClassOf?@+    ZeroOrOnePathExpr PropertyPathExpr+  | -- | Ex. @!(rdf:type|^rdf:type)@+    NegativePropertySetExpr NegativePropertySet+  deriving (Show)++-- instance PredicateTermLike PropertyPathExpr++-- | Possible expressions in a negated property set.+data NegativePropertySet+  = NegativePropertySetPath PathLengthOne NegativePropertySet+  | NegativePropertySetPathOne PathLengthOne+  deriving (Show)++instance QueryShow NegativePropertySet where+  qshow (NegativePropertySetPath p ps) = qshow p ++ "|" ++ qshow ps+  qshow (NegativePropertySetPathOne p) = qshow p++instance Semigroup NegativePropertySet where+  (NegativePropertySetPathOne p1) <> p2 = NegativePropertySetPath p1 p2+  (NegativePropertySetPath p1 ps) <> p2 = NegativePropertySetPath p1 (ps <> p2)++instance PropertyPathExprLike PropertyPathExpr where+  propertyPathExpr = id++-- newtype IRIRef = IRIRef Text++-- instance Show IRIRef where+--   show (IRIRef iri) = unpack iri++instance PropertyPathExprLike IRIRef where+  propertyPathExpr = PathLengthOneExpr . PathLengthOneIRI++data PathLengthOne+  = PathLengthOneIRI IRIRef+  | PathLengthOneA+  | PathLengthOneInverse PathLengthOne+  deriving (Show)++instance PropertyPathExprLike PathLengthOne where+  propertyPathExpr p = PathLengthOneExpr p++instance NegativePropertySetLike PathLengthOne where+  negativePropertySet p = NegativePropertySetPathOne p++instance QueryShow PropertyPathExpr where+  qshow (PathLengthOneExpr p) = qshow p+  qshow (SequencePathExpr pexpr1 pexpr2) =+    "(" ++ qshow pexpr1 ++ "/" ++ qshow pexpr2 ++ ")"+  qshow (InversePathExpr pexpr) = "(^" ++ qshow pexpr ++ ")"+  qshow (AlternativePathExpr pexpr1 pexpr2) =+    "(" ++ qshow pexpr1 ++ "|" ++ qshow pexpr2 ++ ")"+  qshow (ZeroOrMorePathExpr pexpr) = "(" ++ qshow pexpr ++ "*)"+  qshow (OneOrMorePathExpr pexpr) = "(" ++ qshow pexpr ++ "+)"+  qshow (ZeroOrOnePathExpr pexpr) = "(" ++ qshow pexpr ++ "?)"+  qshow (NegativePropertySetExpr p) = "!(" ++ qshow p ++ ")"++instance QueryShow PathLengthOne where+  qshow (PathLengthOneIRI iri) = qshow iri+  qshow PathLengthOneA = "a"+  qshow (PathLengthOneInverse p) = "^" ++ qshow p++class NegativePropertySetLike a where+  negativePropertySet :: a -> NegativePropertySet++instance NegativePropertySetLike IRIRef where+  negativePropertySet iri = NegativePropertySetPathOne $ PathLengthOneIRI iri++instance NegativePropertySetLike NegativePropertySet where+  negativePropertySet ps = ps++-- | Creating a property path sequence.+--+--  >>> IRIRef "rdf:type" ./. IRIRef "rdfs:subClassOf" ./. IRIRef "rdfs:subClassOf"+--  rdf:type/rdfs:subClassOf/rdfs:subClassOf+infixl 5 .//.++(.//.) ::+  (PropertyPathExprLike a, PropertyPathExprLike b) =>+  a ->+  b ->+  PropertyPathExpr+x .//. y = SequencePathExpr (propertyPathExpr x) (propertyPathExpr y)++-- | Creating an alternative property path.+--+--  >>> IRIRef "rdfs:label" .|. IRIRef "foaf:name" .|. IRIRef "foaf:givenName+--  rdfs:label|foaf:name|foaf:givenName+infixl 4 .|.++(.|.) ::+  (PropertyPathExprLike a, PropertyPathExprLike b) =>+  a ->+  b ->+  PropertyPathExpr+x .|. y = AlternativePathExpr (propertyPathExpr x) (propertyPathExpr y)++-- | Creating an alternative property path inside a negative property set.+--+--  >>> neg $ IRIRef "rdfs:label" ..|.. IRIRef "foaf:name" ..|.. IRIRef "foaf:givenName"+--  !(rdfs:label|foaf:name|foaf:givenName)+infixl 4 ..|..++(..|..) ::+  (NegativePropertySetLike a, NegativePropertySetLike b) =>+  a ->+  b ->+  NegativePropertySet+p1 ..|.. p2 = negativePropertySet p1 <> negativePropertySet p2++-- | Creating an inverse property path.+--+--  >>> inv (IRIRef "foaf:mbox")+--  ^foaf:mbox+inv :: PropertyPathExprLike a => a -> PropertyPathExpr+inv p = InversePathExpr (propertyPathExpr p)++-- | Creating an inverse path of length one inside a negative property set.+--+--  >>> neg $ IRIRef "rdfs:label" ..|.. IRIRef "foaf:name" ..|.. (inv' $ IRIRef "foaf:givenName")+--  !(rdfs:label|foaf:name|^foaf:givenName)+inv' :: NegativePropertySetLike a => a -> NegativePropertySet+inv' p = case negativePropertySet p of+  NegativePropertySetPathOne p1 ->+    NegativePropertySetPathOne (PathLengthOneInverse p1)+  NegativePropertySetPath p1 ps ->+    NegativePropertySetPath (PathLengthOneInverse p1) ps++-- | Creating a negative property set.+--+--  >>> inv foafMbox+--  ^foaf:mbox+neg :: NegativePropertySet -> PropertyPathExpr+neg = NegativePropertySetExpr++-- | Variable "a" representing the @rdf:type@ property.+a :: PathLengthOne+a = PathLengthOneA++-- | Creating a zero or more path.+--+--  >>> IRIRef "rdf:type" ./. ((IRIRef "rdfs:subClassOf") *.)+--  rdf:type/rdfs:subClassOf*+(*.) :: PropertyPathExprLike a => a -> PropertyPathExpr+(*.) p = ZeroOrMorePathExpr (propertyPathExpr p)++-- | Creating a one or more path.+--+--  >>> ((IRIRef "foaf:knows") +.) ./. IRIRef "foaf:name"+--  foaf:knows+/foaf:name+(+.) :: PropertyPathExprLike a => a -> PropertyPathExpr+(+.) p = OneOrMorePathExpr (propertyPathExpr p)++-- | Creating a zero or one path.+--+--  >>> rdfType ./. (rdfsSubClassOf ?.)+--  rdf:type/rdfs:subClassOf?+(?.) :: PropertyPathExprLike a => a -> PropertyPathExpr+(?.) p = ZeroOrOnePathExpr (propertyPathExpr p)

@@ -1,5 +1,5 @@ Name:          hsparql-Version:       0.3.6+Version:       0.3.7 Synopsis:      A SPARQL query generator and DSL, and a client to query a SPARQL server. Category:      Database Description:@@ -17,7 +17,7 @@ bug-reports:   https://github.com/robstewart57/hsparql/issues Stability:     Experimental Build-type:    Simple-Cabal-Version: >= 1.9.2+Cabal-Version: >= 1.10  library   Exposed-modules: Database.HSparql.Connection@@ -26,20 +26,25 @@                , HTTP >= 4                , mtl                , xml-               , rdf4h >= 3.0.1+               , rdf4h >= 4.0.2                , bytestring                , MissingH                , network                , text                , network-uri-  extensions:  RankNTypes FlexibleInstances OverloadedStrings+               , http-client+               , http-types+               , http-conduit+               , connection+               , bytestring   ghc-options: -Wall -Wcompat+  default-language: Haskell2010  test-suite test-hsparql   type:          exitcode-stdio-1.0   main-is:       AllTests.hs   build-depends: hsparql-                 , rdf4h >= 3.0.1+                 , rdf4h >= 4.0.2                  , base                  , text                  , containers@@ -50,10 +55,14 @@                  , wai >= 3.0.0                  , warp >= 3.0.1                  , network-uri+                 , string-qq   hs-source-dirs: Database, tests   other-modules: Database.HSparql.ConnectionTest-  extensions:  OverloadedStrings, FlexibleInstances+               , Database.HSparql.QueryGeneratorTest+               , DBPedia+               , Wikidata   ghc-options: -Wall -Wcompat+  default-language: Haskell2010  source-repository head   type:     git

@@ -2,41 +2,50 @@  module Main where -import Database.HSparql.ConnectionTest- import Control.Concurrent (forkIO)+import Control.Monad (join)+import DBPedia -- to ensure the DBPedia.hs file compiles+import Database.HSparql.ConnectionTest+import Database.HSparql.QueryGeneratorTest import Network.HTTP.Types (status200) import Network.Wai import Network.Wai.Handler.Warp (run) import Test.Framework+import Wikidata -- to ensure the Wikidata.hs file compiles  main :: IO () main =-  do _ <- forkIO $ startServer-     ropts <- interpretArgsOrExit []-     defaultMainWithOpts tests ropts-     where tests = Database.HSparql.ConnectionTest.testSuite+  do+    _ <- forkIO $ startServer+    ropts <- interpretArgsOrExit []+    defaultMainWithOpts tests ropts+  where+    tests =+      Database.HSparql.ConnectionTest.testSuite+        ++ Database.HSparql.QueryGeneratorTest.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%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-                      raw_req-                          -> error $ "Unexpected URI: \n\n" ++ show raw_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+  where+    response req_ = case (join $ lookup "query" $ queryString req_) of+      Just "PREFIX dbprop: <http://dbpedia.org/resource/> PREFIX dbpedia: <http://dbpedia.org/property/> PREFIX foaf: <http://xmlns.com/foaf/0.1/> SELECT ?x1 WHERE { ?x0 dbpedia:genre dbprop:Web_browser . ?x0 foaf:name ?x1 . }" ->+        selectResponse+      Just "PREFIX foaf: <http://xmlns.com/foaf/0.1/> PREFIX dct: <http://purl.org/dc/elements/1.1/> SELECT ?x1 ?x2 WHERE { ?x0 foaf:name \"Bob\" . << ?x0 foaf:age ?x1 >> dct:source ?x2 . }" ->+        selectReifiedTripleResponse+      Just "PREFIX dbpedia: <http://dbpedia.org/resource/> PREFIX dbprop: <http://dbpedia.org/property/> ASK { ?x0 dbprop:genre dbpedia:Web_browser . }" ->+        askResponse+      Just "PREFIX dbpedia: <http://dbpedia.org/resource/> PREFIX dbprop: <http://dbpedia.org/property/> PREFIX foaf: <http://xmlns.com/foaf/0.1/> PREFIX example: <http://www.example.com/> CONSTRUCT { ?x0 example:hasName ?x1 . } WHERE { ?x0 dbprop:genre dbpedia:Web_browser . ?x0 foaf:name ?x1 . }" ->+        constructResponse+      Just "PREFIX dbpedia: <http://dbpedia.org/resource/> DESCRIBE dbpedia:Edinburgh WHERE {  }" ->+        describeResponse+      raw_req ->+        error $ "Unexpected URI: \n\n" ++ show raw_req +    selectResponse = responseFile status200 [("Content-Type", "application/sparql-results+xml")] "tests/fixtures/sparql_select_response.xml" Nothing+    selectReifiedTripleResponse = responseFile status200 [("Content-Type", "application/sparql-results+xml")] "tests/fixtures/sparql_select_reified_triple_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 app

@@ -0,0 +1,168 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module DBPedia where++import Data.RDF hiding (Query, triple)+import Data.Text+import Database.HSparql.Connection+import Database.HSparql.QueryGenerator++selectExample :: IO ()+selectExample = do+  (Just s) <- selectQuery "http://dbpedia.org/sparql" simpleSelect+  print s++selectWithLiteralExample :: IO ()+selectWithLiteralExample = do+  (Just s) <- selectQuery "http://dbpedia.org/sparql" simpleSelectWithLiteral+  putStrLn . show $ s++askExample :: IO ()+askExample = do+  res <- askQuery "http://dbpedia.org/sparql" simpleAsk+  putStrLn $ "result: " ++ show (res :: Bool)++describeExample :: IO ()+describeExample = do+  (rdfGraph :: RDF TList) <- describeQuery "http://dbpedia.org/sparql" simpleDescribe+  mapM_ print (triplesOf rdfGraph)++constructExample :: IO ()+constructExample = do+  (rdfGraph :: RDF TList) <- constructQuery "http://dbpedia.org/sparql" simpleConstruct+  mapM_ print (triplesOf rdfGraph)++simpleSelect :: Query SelectQuery+simpleSelect = do+  resource <- prefix "dbprop" (iriRef "http://dbpedia.org/resource/")+  dbpprop <- prefix "dbpedia" (iriRef "http://dbpedia.org/property/")+  foaf <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++  x <- var+  name <- var++  triple x (dbpprop .:. "genre") (resource .:. "Web_browser")+  triple x (foaf .:. "name") name++  selectVars [name]++simpleSelectWithLiteral :: Query SelectQuery+simpleSelectWithLiteral = do+  ontology <- prefix "dbpedia" (iriRef "http://dbpedia.org/ontology/")+  rdf <- prefix "rdf" (iriRef "http://www.w3.org/1999/02/22-rdf-syntax-ns#")+  rdfs <- prefix "rdfs" (iriRef "http://www.w3.org/2000/01/rdf-schema#")++  l <- var++  triple l (rdf .:. "type") (ontology .:. "ProgrammingLanguage")+  triple l (rdfs .:. "label") (("D (programming language)", "en") :: (Text, Text))++  selectVars [l]++simpleConstruct :: Query ConstructQuery+simpleConstruct = do+  resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")+  dbpprop <- prefix "dbprop" (iriRef "http://dbpedia.org/property/")+  foaf <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")+  example <- prefix "example" (iriRef "http://www.example.com/")++  x <- var+  name <- var++  construct <- constructTriple x (example .:. "hasName") name++  triple x (dbpprop .:. "genre") (resource .:. "Web_browser")+  triple x (foaf .:. "name") name++  return ConstructQuery {queryConstructs = [construct]}++simpleAsk :: Query AskQuery+simpleAsk = do+  resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")+  dbprop <- prefix "dbprop" (iriRef "http://dbpedia.org/property/")++  x <- var+  ask <- askTriple x (dbprop .:. "genre") (resource .:. "Web_browser")++  return AskQuery {queryAsk = [ask]}++simpleDescribe :: Query DescribeQuery+simpleDescribe = do+  resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")+  uri <- describeIRI (resource .:. "Edinburgh")+  return DescribeQuery {queryDescribe = uri}++trickySelect :: Query SelectQuery+trickySelect = do+  resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")+  dbpprop <- prefix "dbprop" (iriRef "http://dbpedia.org/property/")+  foaf <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")+  owl <- prefix "owl" (iriRef "http://www.w3.org/2002/07/owl#")++  x <- var+  name <- var+  fbase <- var++  -- Identify+  triple x (dbpprop .:. "genre") (resource .:. "Web_browser")++  -- Query+  triple x (foaf .:. "name") name+  optional $ do+    triple x (owl .:. "sameAs") fbase+    filterExpr $ regex fbase ("freebase" :: Text)+  filterExpr $ notExpr $ bound fbase++  distinct++  orderNext name+  orderNextDesc fbase++  selectVars [x, name, fbase]++frenchFilmsSelect :: Query SelectQuery+frenchFilmsSelect = do+  skos <- prefix "skos" (iriRef "http://www.w3.org/2004/02/skos/core#")+  film <- var+  triple film (skos .:. "subject") (iriRef "http://dbpedia.org/resource/Category:French_films")+  selectVars [film]++-- return SelectQuery {queryExpr = [film]}++fpsSelect :: Query SelectQuery+fpsSelect = do+  property <- var+  hasValue <- var+  isValueOf <- var++  union+    (triple (iriRef "http://dbpedia.org/resource/Category:First-person_shooters") property hasValue)+    (triple isValueOf property (iriRef "http://dbpedia.org/resource/Category:First-person_shooters"))++  selectVars [isValueOf]++berlinersSelect :: Query SelectQuery+berlinersSelect = do+  xsd <- prefix "xsd" (iriRef "http://www.w3.org/2001/XMLSchema#")+  prop <- prefix "prop" (iriRef "http://dbpedia.org/property/")+  dbo <- prefix "dbo" (iriRef "http://dbpedia.org/ontology/")+  foaf <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")+  resc <- prefix "resc" (iriRef "http://dbpedia.org/resource/")++  name <- var+  birth <- var+  death <- var+  person <- var+  knownfor <- var++  triple person (prop .:. "birthPlace") (resc .:. "Berlin")+  triple person (dbo .:. "birthDate") birth+  triple person (foaf .:. "name") name+  triple person (dbo .:. "deathDate") death++  filterExpr $ birth .<. ("1900-01-01" :: Text, xsd .:. "date")++  optional $ triple person (prop .:. "KnownFor") knownfor++  selectVars [name, birth, death, person, knownfor]

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Database.HSparql.ConnectionTest ( testSuite ) where  import Test.Framework (testGroup, Test)@@ -6,6 +8,7 @@  import qualified Data.Map as Map import qualified Data.RDF as RDF+import Data.Text  import Database.HSparql.Connection import Database.HSparql.QueryGenerator@@ -14,6 +17,7 @@ testSuite = [     testGroup "Database.HSparql.Connection tests" [         testCase "selectQuery" test_selectQuery+      , testCase "selectReifiedTripleQuery" test_selectReifiedTripleQuery       , testCase "askQuery" test_askQuery       , testCase "constructQuery" test_constructQuery       , testCase "describeQuery" test_describeQuery@@ -43,6 +47,29 @@               _ <- triple x (foaf .:. "name") name                select [SelectVar name]++test_selectReifiedTripleQuery :: IO ()+test_selectReifiedTripleQuery =+  let expectedBVars = Just [ [ Bound $ RDF.LNode $ RDF.TypedL "42" "http://www.w3.org/2001/XMLSchema#integer"+                             , Bound $ RDF.LNode $ RDF.PlainL "Rumors"+                             ] ]+  in do+    bvars <- selectQuery endPoint query+    assertEqual "bound variables" expectedBVars bvars++    where endPoint = "http://127.0.0.1:3000"+          query = do+              foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")+              dct      <- prefix "dct" (iriRef "http://purl.org/dc/elements/1.1/")++              bob <- var+              age <- var+              src <- var++              triple_ bob (foaf .:. "name") ("Bob" :: Text)+              triple_ (embeddedTriple bob (foaf .:. "age") age) (dct .:. "source") src++              selectVars [age, src]  test_askQuery :: IO () test_askQuery = do

@@ -0,0 +1,589 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE PostfixOperators  #-}++module Database.HSparql.QueryGeneratorTest ( testSuite ) where++import Test.Framework (testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.HUnit++import Data.Text (Text)+import qualified Data.Text as T+import Data.String.QQ (s)++import Database.HSparql.QueryGenerator++class CreateQuery a where+  createQuery :: a -> Text++instance CreateQuery (Query SelectQuery) where+  createQuery = T.pack . createSelectQuery++instance CreateQuery (Query ConstructQuery) where+  createQuery = T.pack . createConstructQuery++instance CreateQuery (Query AskQuery) where+  createQuery = T.pack . createAskQuery++instance CreateQuery (Query UpdateQuery) where+  createQuery = T.pack . createUpdateQuery++instance CreateQuery (Query DescribeQuery) where+  createQuery = T.pack . createDescribeQuery++normalizeWhitespace :: Text -> Text+normalizeWhitespace = T.strip+                      . (T.replace "  " " ")+                      . (T.replace "  " " ")+                      . (T.replace "  " " ")+                      . (T.replace "\n" " ")++queryTexts :: [(Text, Text)]+queryTexts =+  [ ( [s|+PREFIX dbpedia: <http://dbpedia.org/resource/>+PREFIX dbprop: <http://dbpedia.org/property/>+PREFIX foaf: <http://xmlns.com/foaf/0.1/>+SELECT ?x1 ?x2+WHERE {+  ?x0 dbprop:genre dbpedia:Web_browser .+  ?x0 foaf:name ?x1 .+  ?x0 foaf:page ?x2 .+}+|]+    , createQuery $ do+        resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")+        dbpprop  <- prefix "dbprop" (iriRef "http://dbpedia.org/property/")+        foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        x    <- var+        name <- var+        page <- var++        triple_ x (dbpprop .:. "genre") (resource .:. "Web_browser")+        triple_ x (foaf .:. "name") name+        triple_ x (foaf .:. "page") page++        selectVars [name, page]+    )++  , ( [s|+PREFIX dbpedia: <http://dbpedia.org/resource/>+PREFIX dbprop: <http://dbpedia.org/property/>+PREFIX foaf: <http://xmlns.com/foaf/0.1/>+PREFIX example: <http://www.example.com/>+CONSTRUCT {+  ?x0 example:hasName ?x1 .+}+WHERE {+  ?x0 dbprop:genre dbpedia:Web_browser .+  ?x0 foaf:name ?x1 .+  ?x0 foaf:page ?x2 .+}+|]+    , createQuery $ do+        resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")+        dbpprop  <- prefix "dbprop" (iriRef "http://dbpedia.org/property/")+        foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")+        example  <- prefix "example" (iriRef "http://www.example.com/")++        x    <- var+        name <- var+        page <- var++        construct <- constructTriple x (example .:. "hasName") name++        triple_ x (dbpprop .:. "genre") (resource .:. "Web_browser")+        triple_ x (foaf .:. "name") name+        triple_ x (foaf .:. "page") page++        return ConstructQuery { queryConstructs = [construct] }+    )++  , ( [s|+PREFIX dbpedia: <http://dbpedia.org/resource/> DESCRIBE dbpedia:Edinburgh WHERE {  }+|]+    , createQuery $ do+        resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")+        uri <- describeIRI (resource .:. "Edinburgh")+        return DescribeQuery { queryDescribe = uri }+    )++  , ( [s|+PREFIX dbpedia: <http://dbpedia.org/resource/>+PREFIX dbprop: <http://dbpedia.org/property/>+ASK {+  ?x0 dbprop:genre dbpedia:Web_browser .+}+|]+    , createQuery $ do+        resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")+        dbprop  <- prefix "dbprop" (iriRef "http://dbpedia.org/property/")++        x <- var+        ask <- askTriple x (dbprop .:. "genre") (resource .:. "Web_browser")++        return AskQuery { queryAsk = [ask] }+    )++  -- https://github.com/robstewart57/hsparql/pull/31+  , ( [s|+PREFIX : <http://example1.com/>+PREFIX ex: <http://example2.com/>+SELECT ?x0 WHERE {+  ?x0 :property1 :X .+  FILTER ((?x1>(10))&&(?x1<(20))) .+  {+    SELECT ((AVG(?x0_0)) AS ?x1)+    WHERE {+      ?x0 :property2 [ex:property3 ?x0_0] .+    }+  }+}+|]+    , createQuery $ do+      p1 <- prefix "" (iriRef "http://example1.com/")+      s <- var+      v <- var+      triple_ s (p1 .:. "property1") (p1 .:. "X")+      filterExpr_ $ (v .>. (10::Integer)) .&&. (v .<. (20::Integer))+      subQuery_ $ do+        p2 <- prefix "ex" (iriRef "http://example2.com/")+        v' <- var+        triple_ s (p1 .:. "property2") [mkPredicateObject (p2 .:. "property3") v']+        select [avg v' `as` v]+      selectVars [s]+    )++  -- https://www.w3.org/TR/sparql11-query/#OptionalMatching+  , ( [s|+PREFIX foaf: <http://xmlns.com/foaf/0.1/>+SELECT ?x1 ?x2+WHERE {+  ?x0 foaf:name ?x1 .+  OPTIONAL { ?x0 foaf:mbox ?x2 . }+}+|]+    , createQuery $ do+        foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        x <- var+        name <- var+        mbox <- var++        triple_ x (foaf .:. "name") name++        optional_ $ do+          triple_ x (foaf .:. "mbox") mbox++        selectVars [name, mbox]+    )++  -- https://www.w3.org/TR/sparql11-query/#alternatives+  , ( [s|+PREFIX dc10: <http://purl.org/dc/elements/1.0/>+PREFIX dc11: <http://purl.org/dc/elements/1.1/>++SELECT ?x1+WHERE { { ?x0 dc10:title ?x1 . } UNION { ?x0 dc11:title ?x1 . } }+|]+    , createQuery $ do+        dc10     <- prefix "dc10" (iriRef "http://purl.org/dc/elements/1.0/")+        dc11     <- prefix "dc11" (iriRef "http://purl.org/dc/elements/1.1/")++        book <- var+        title <- var++        let tt10 = triple_ book (dc10 .:. "title") title+            tt11 = triple_ book (dc11 .:. "title") title+          in union_ tt10 tt11++        selectVars [title]+    )++  -- https://www.w3.org/TR/sparql11-query/#neg-notexists+  , ( [s|+PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>+PREFIX foaf: <http://xmlns.com/foaf/0.1/>++SELECT ?x0+WHERE+{+  ?x0 rdf:type foaf:Person .+  FILTER NOT EXISTS { ?x0 foaf:name ?x1 . }+}+|]+    , createQuery $ do+        rdf  <- prefix "rdf" (iriRef "http://www.w3.org/1999/02/22-rdf-syntax-ns#")+        foaf <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        person <- var+        name <- var++        triple_ person (rdf .:. "type") (foaf .:. "Person")++        filterNotExists_ $ do+          triple_ person (foaf .:. "name") name++        selectVars [person]+    )++  , ( [s|+PREFIX ex: <http://example.com/>++SELECT ?x0 ?x1+WHERE+{+  ?x0 ex:foo%20bar ?x1 .+}+|]+    , createQuery $ do+        ex <- prefix "ex" (iriRef "http://example.com/")++        s <- var+        o <- var++        triple_ s (ex .:. "foo bar") o++        selectVars [s, o]+    )++  -- Count distinct subjects and objects query+  , ( [s|+SELECT ((COUNT(?x0)) AS ?x4)+WHERE+{+  {+    SELECT DISTINCT ?x0 WHERE {+      { ?x0 ?x2 ?x3 . } UNION+      { ?x1 ?x2 ?x0 . }+    }+  }+}+|]+    , createQuery $ do+        r <- var+        s <- var+        p <- var+        o <- var++        subQuery_ $ do+          let tt1 = triple_ r p o+              tt2 = triple_ s p r+           in do+             distinct_+             union_ tt1 tt2+             selectVars [r]++        countVar <- var+        select [count r `as` countVar]+    )++  -- Count number of instances of each class in the dataset.+  , ( [s|+SELECT ?x1 ((COUNT(?x0)) AS ?x2) WHERE {+  ?x0 <http://www.w3.org/1999/02/22-rdf-syntax-ns#type> ?x1 .+} GROUP BY ?x1+|]+    , createQuery $ do+        s <- var+        o <- var++        triple_ s (iriRef "http://www.w3.org/1999/02/22-rdf-syntax-ns#type") o++        groupBy_ o++        countVar <- var+        select [SelectVar o, count s `as` countVar]+    )++  -- Count number of resources typed with a class from Wikidata.+  , ( [s|+SELECT ((COUNT(?x0)) AS ?x2) WHERE {+  ?x0 <http://www.w3.org/1999/02/22-rdf-syntax-ns#type> ?x1 .+  FILTER (CONTAINS((STR(?x1)), "http://www.wikidata.org/entity")) .+}+|]+    , createQuery $ do+        s <- var+        o <- var++        triple_ s (iriRef "http://www.w3.org/1999/02/22-rdf-syntax-ns#type") o++        filterExpr_ $ contains (str o) ("http://www.wikidata.org/entity" :: Text)++        countVar <- var+        select [count s `as` countVar]+    )++  -- Create a federated query+  , ( [s|+PREFIX foaf: <http://xmlns.com/foaf/0.1/>+SELECT ?x1 WHERE {+  <http://example.org/myfoaf/I> foaf:knows ?x0 .+  SERVICE <http://people.example.org/sparql> {+    ?x0 foaf:name ?x1 .+  }+}+|]+    , createQuery $ do+        foaf <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        person    <- var+        name      <- var++        triple_ (iriRef "http://example.org/myfoaf/I") (foaf .:. "knows") person++        service_ (iriRef "http://people.example.org/sparql") $ do+          triple_ person (foaf .:. "name") name++        selectVars [name]+    )++  -- Create query containing property paths+  , ( [s|+PREFIX foaf: <http://xmlns.com/foaf/0.1/>++SELECT ?x0 ?x1 WHERE {+  ?x0 ((foaf:knows/foaf:knows)/foaf:name) ?x1 .+}+|]+    , createQuery $ do+        foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        s <- var+        o <- var++        let foafKnows = foaf .:. "knows"+        let foafName = foaf .:. "name"+        triple_ s (foafKnows .//. foafKnows .//. foafName) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX foaf: <http://xmlns.com/foaf/0.1/>++SELECT ?x0 ?x1 WHERE {+  ?x0 (^foaf:mbox) ?x1 .+}+|]+    , createQuery $ do+        foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        s <- var+        o <- var++        let foafMbox = foaf .:. "mbox"+        triple_ s (inv foafMbox) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX foaf: <http://xmlns.com/foaf/0.1/>++SELECT ?x0 ?x1 WHERE {+  ?x0 (foaf:knows/(^foaf:knows)) ?x1 .+}+|]+    , createQuery $ do+        foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        s <- var+        o <- var++        let foafKnows = foaf .:. "knows"+        triple_ s (foafKnows .//. inv foafKnows) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX foaf: <http://xmlns.com/foaf/0.1/>++SELECT ?x0 ?x1 WHERE {+  ?x0 (foaf:knows/(^foaf:knows)) ?x1 .+}+|]+    , createQuery $ do+        foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        s <- var+        o <- var++        let foafKnows = foaf .:. "knows"+        triple_ s (foafKnows .//. inv foafKnows) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX foaf: <http://xmlns.com/foaf/0.1/>++SELECT ?x0 ?x1 WHERE {+  ?x0 ((foaf:knows+)/foaf:name) ?x1 .+}+|]+    , createQuery $ do+        foaf     <- prefix "foaf" (iriRef "http://xmlns.com/foaf/0.1/")++        s <- var+        o <- var++        let foafKnows = foaf .:. "knows"+        let foafName = foaf .:. "name"+        triple_ s ((foafKnows +.) .//. foafName) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX ex: <http://example.com/>++SELECT ?x0 ?x1 WHERE {+  ?x0 ((ex:motherOf|ex:fatherOf)+) ?x1 .+}+|]+    , createQuery $ do+        ex     <- prefix "ex" (iriRef "http://example.com/")++        s <- var+        o <- var++        let exMotherOf = ex .:. "motherOf"+        let exFatherOf = ex .:. "fatherOf"+        triple_ s ((exMotherOf .|. exFatherOf) +.) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX ex: <http://example.com/>++SELECT ?x0 ?x1 WHERE {+  ?x0 ((ex:motherOf|ex:fatherOf)+) ?x1 .+}+|]+    , createQuery $ do+        ex     <- prefix "ex" (iriRef "http://example.com/")++        s <- var+        o <- var++        let exMotherOf = ex .:. "motherOf"+        let exFatherOf = ex .:. "fatherOf"+        triple_ s ((exMotherOf .|. exFatherOf) +.) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>+PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>++SELECT ?x0 ?x1 WHERE {+  ?x0 (rdf:type/(rdfs:subClassOf*)) ?x1 .+}+|]+    , createQuery $ do+        rdf  <- prefix "rdf" (iriRef "http://www.w3.org/1999/02/22-rdf-syntax-ns#")+        rdfs <- prefix "rdfs" (iriRef "http://www.w3.org/2000/01/rdf-schema#")++        s <- var+        o <- var++        let rdfType = rdf .:. "type"+        let rdfsSubClassOf = rdfs .:. "subClassOf"+        triple_ s (rdfType .//. (rdfsSubClassOf *.)) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>++SELECT ?x0 ?x1 WHERE {+  ?x0 (a/(rdfs:subClassOf*)) ?x1 .+}+|]+    , createQuery $ do+        rdfs <- prefix "rdfs" (iriRef "http://www.w3.org/2000/01/rdf-schema#")++        s <- var+        o <- var++        let rdfsSubClassOf = rdfs .:. "subClassOf"+        triple_ s (a .//. (rdfsSubClassOf *.)) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>++SELECT ?x0 ?x1 WHERE {+  ?x0 (a/(rdfs:subClassOf?)) ?x1 .+}+|]+    , createQuery $ do+        rdfs <- prefix "rdfs" (iriRef "http://www.w3.org/2000/01/rdf-schema#")++        s <- var+        o <- var++        let rdfsSubClassOf = rdfs .:. "subClassOf"+        triple_ s (a .//. (rdfsSubClassOf ?.)) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>+PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>++SELECT ?x0 ?x1 WHERE {+  ?x0 !(rdf:type|rdfs:subClassOf|a) ?x1 .+}+|]+    , createQuery $ do+        rdf  <- prefix "rdf" (iriRef "http://www.w3.org/1999/02/22-rdf-syntax-ns#")+        rdfs <- prefix "rdfs" (iriRef "http://www.w3.org/2000/01/rdf-schema#")++        s <- var+        o <- var++        let rdfType = rdf .:. "type"+        let rdfsSubClassOf = rdfs .:. "subClassOf"+        triple_ s (neg $ rdfType ..|.. rdfsSubClassOf ..|.. a) o++        selectVars [s, o]+    )++  , ( [s|+PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>++SELECT ?x0 ?x1 WHERE {+  ?x0 !(rdf:type|^rdf:type) ?x1 .+}+|]+    , createQuery $ do+        rdf  <- prefix "rdf" (iriRef "http://www.w3.org/1999/02/22-rdf-syntax-ns#")++        s <- var+        o <- var++        let rdfType = rdf .:. "type"+        triple_ s (neg $ rdfType ..|.. inv' rdfType) o++        selectVars [s, o]+    )+  ]++testSuite :: [Test.Framework.Test]+testSuite = [+    testGroup "Database.HSparql.QueryGenerator tests" $ (`map` queryTexts) $+      \(expected, actual) -> testCase (T.unpack expected) $ do+        assertEqual "" (normalizeWhitespace expected) (normalizeWhitespace actual)+  ]+

@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Wikidata where++import Control.Monad (forM_)+import Data.Maybe+import Database.HSparql.Connection+import Database.HSparql.QueryGenerator++wikidataTest :: IO ()+wikidataTest = do+  (Just s) <- selectQuery "https://query.wikidata.org/sparql" wdtQuery+  forM_ s print++wdtQuery :: Query SelectQuery+wdtQuery = do+  s <- var+  p <- var+  o <- var++  triple s p o++  limit 10++  selectVars [s, p, o]