hsparql 0.3.1 → 0.3.2

raw patch · 5 files changed

+394/−289 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Database/HSparql/Connection.hs +73/−77
• Database/HSparql/QueryGenerator.hs +276/−173
• hsparql.cabal +3/−1
• tests/AllTests.hs +20/−20
• tests/Database/HSparql/ConnectionTest.hs +22/−18

@@ -15,7 +15,7 @@ import Text.XML.Light import Database.HSparql.QueryGenerator import Text.RDF.RDF4H.TurtleParser-import Data.RDF+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@@ -26,9 +26,9 @@ type EndPoint = String  -- |Local representations of incoming XML results.-data BindingValue = Bound Data.RDF.Node    -- ^RDF Node (UNode, BNode, LNode)+data BindingValue = Bound RDF.Node    -- ^RDF Node (UNode, BNode, LNode)                   | Unbound       -- ^Unbound result value-  deriving (Show, Eq)+                  deriving (Show, Eq)  -- |Base 'QName' for results with a SPARQL-result URI specified. sparqlResult :: String -> QName@@ -38,34 +38,34 @@ --  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 $ Data.RDF.unode $ (T.pack $ strContent e)-              "literal" -> case findAttr (unqual "datatype") e of-                             Just dt -> Bound $ Data.RDF.lnode $ Data.RDF.typedL (T.pack $ strContent e) (T.pack dt)-                             Nothing -> case findAttr langAttr e of-                                          Just lang -> Bound $ Data.RDF.lnode $ Data.RDF.plainLL (T.pack $ strContent e) (T.pack lang)-                                          Nothing   -> Bound $ Data.RDF.lnode $ Data.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 parseAsk :: String -> Bool@@ -73,8 +73,7 @@   | (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 parseUpdate :: String -> Bool@@ -86,74 +85,71 @@ --  'Variable's in the 'SelectQuery' action. selectQuery :: Database.HSparql.Connection.EndPoint -> Query SelectQuery -> IO (Maybe [[BindingValue]]) selectQuery ep q = do-    let uri      = ep ++ "?" ++ urlEncodeVars [("query", createSelectQuery 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+  let uri = ep ++ "?" ++ urlEncodeVars [("query", createSelectQuery 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  -- |Connect to remote 'EndPoint' and find all possible bindings for the --  'Variable's in the 'SelectQuery' action. askQuery :: Database.HSparql.Connection.EndPoint -> Query AskQuery -> IO Bool askQuery ep q = do-    let uri = ep ++ "?" ++ urlEncodeVars [("query", createAskQuery 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-+  let uri = ep ++ "?" ++ urlEncodeVars [("query", createAskQuery 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  -- |Connect to remote 'EndPoint' and find all possible bindings for the --  'Variable's in the 'SelectQuery' action. updateQuery :: Database.HSparql.Connection.EndPoint -> Query UpdateQuery -> IO Bool updateQuery ep q = do-    let uri = ep-        body = createUpdateQuery 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+  let uri = ep+      body = createUpdateQuery 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-+  return $ parseUpdate response  -- |Connect to remote 'EndPoint' and construct 'TriplesGraph' from given --  'ConstructQuery' action. /Provisional implementation/.-constructQuery :: (Rdf a) => Database.HSparql.Connection.EndPoint -> Query ConstructQuery -> IO (RDF a)+constructQuery :: (RDF.Rdf a) => Database.HSparql.Connection.EndPoint -> Query ConstructQuery -> IO (RDF.RDF a) constructQuery ep q = do-    let uri      = ep ++ "?" ++ urlEncodeVars [("query", createConstructQuery q)]-    rdfGraph <- httpCallForRdf uri-    case rdfGraph of-      Left e -> error $ show e-      Right graph -> return graph-   +  let uri = ep ++ "?" ++ urlEncodeVars [("query", createConstructQuery q)]+  rdfGraph <- httpCallForRdf uri+  case rdfGraph of+    Left e -> error $ show e+    Right graph -> return graph  -- |Connect to remote 'EndPoint' and construct 'TriplesGraph' from given --  'ConstructQuery' action. /Provisional implementation/.-describeQuery :: (Rdf a) => Database.HSparql.Connection.EndPoint -> Query DescribeQuery -> IO (RDF a)+describeQuery :: (RDF.Rdf a) => Database.HSparql.Connection.EndPoint -> Query DescribeQuery -> IO (RDF.RDF a) describeQuery ep q = do-    let uri      = ep ++ "?" ++ urlEncodeVars [("query", createDescribeQuery q)]-    rdfGraph <- httpCallForRdf uri-    case rdfGraph of-      Left e -> error $ show e-      Right graph -> return graph-    +  let uri = ep ++ "?" ++ urlEncodeVars [("query", createDescribeQuery q)]+  rdfGraph <- httpCallForRdf uri+  case rdfGraph of+    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'-httpCallForRdf :: Rdf a => String -> IO (Either ParseFailure (RDF a))+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"@@ -163,4 +159,4 @@                           , rqBody = ""                           }   response <- simpleHTTP request >>= getResponseBody-  return $ parseString (TurtleParser Nothing Nothing) $ E.decodeUtf8 (B.pack response)+  return $ RDF.parseString (TurtleParser Nothing Nothing) $ E.decodeUtf8 (B.pack response)

@@ -1,85 +1,95 @@+{-# LANGUAGE ExistentialQuantification #-}  -- |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-    , constructTriple-    , askTriple-    , updateTriple-    , describeIRI-    , optional-    , union-    , filterExpr+  ( -- * Creating Queries+    createSelectQuery+  , createConstructQuery+  , createAskQuery+  , createUpdateQuery+  , createDescribeQuery+  -- * Query Actions+  , prefix+  , var+  , Database.HSparql.QueryGenerator.triple+  , mkPredicateObject+  , constructTriple+  , askTriple+  , updateTriple+  , describeIRI+  , optional+  , union+  , filterExpr+  , bind -    -- ** Duplicate handling-    , distinct-    , reduced+  -- ** Duplicate handling+  , distinct+  , reduced -    -- ** Limit handling-    , limit+  -- ** Limit handling+  , limit -    -- ** Order handling-    , orderNext-    , orderNextAsc-    , orderNextDesc+  -- ** Order handling+  , orderNext+  , orderNextAsc+  , orderNextDesc -    -- ** Auxiliary-    , (.:.)-    , iriRef+  -- ** Auxiliary+  , (.:.)+  , iriRef -    -- * Term Manipulation+  -- * Term Manipulation -    -- ** Operations-    , (.+.), (.-.), (.*.), (./.), (.&&.), (.||.)+  -- ** Operations+  , (.+.), (.-.), (.*.), (./.), (.&&.), (.||.) -    -- ** Relations-    , (.==.), (.!=.), (.<.), (.>.), (.<=.), (.>=.)+  -- ** Relations+  , (.==.), (.!=.), (.<.), (.>.), (.<=.), (.>=.) -    -- ** Negation-    , notExpr+  -- ** Negation+  , notExpr -    -- ** Builtin Functions-    , str-    , lang-    , langMatches-    , datatype-    , bound-    , sameTerm-    , isIRI-    , isURI-    , isBlank-    , isLiteral-    , regex, regexOpts+  -- ** Builtin Functions+  , str+  , lang+  , langMatches+  , datatype+  , bound+  , sameTerm+  , isIRI+  , isURI+  , isBlank+  , isLiteral+  , regex, regexOpts -    -- * Printing Queries-    , qshow+  -- * Printing Queries+  , qshow -    -- * Types-    , Query-    , Variable-    , VarOrNode(..)-    , Pattern-    , SelectQuery(..)-    , ConstructQuery(..)-    , AskQuery(..)-    , UpdateQuery(..)-    , DescribeQuery(..)-    )+  -- * Types+  , Query+  , Variable+  , VarOrNode(..)+  , BlankNodePattern+  , Pattern+  , SelectQuery(..)+  , ConstructQuery(..)+  , AskQuery(..)+  , UpdateQuery(..)+  , DescribeQuery(..)++  -- * Classes+  , TermLike (..)+  , SubjectTermLike+  , PredicateTermLike+  , ObjectTermLike+  ) where  import Control.Monad.State import Data.List (intercalate) import qualified Data.Text as T-import Data.RDF+import qualified Data.RDF as RDF  -- State monads @@ -94,50 +104,52 @@ -- |Execute a 'Select Query' action, returning the 'String' representation of the query. createSelectQuery :: Query SelectQuery -> String createSelectQuery q = execQuery specifyVars qshow-    where specifyVars :: Query ()-          specifyVars = do query <- q-                           modify $ \s -> s { vars = queryVars query , queryType = SelectType }+  where specifyVars :: Query ()+        specifyVars = do+          query <- q+          modify $ \s -> s { vars = queryVars query , queryType = SelectType }  -- |Execute a 'Construct Query' action, returning the 'String' representation of the query. createConstructQuery :: Query ConstructQuery -> String createConstructQuery q = execQuery specifyType qshow-    where specifyType :: Query ()-          specifyType = do-           query <- q-           modify $ \s -> s { constructTriples = queryConstructs query, queryType = ConstructType }+  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 = execQuery specifyType qshow-    where specifyType :: Query ()-          specifyType = do-           query <- q-           modify $ \s -> s { askTriples = queryAsk query, queryType = AskType }+  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 = execQuery specifyType qshow-    where specifyType :: Query ()-          specifyType = do-           query <- q-           modify $ \s -> s { updateTriples = queryUpdate query, queryType = UpdateType }+  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 = execQuery specifyType qshow-    where specifyType :: Query ()-          specifyType = do-           query <- q-           modify $ \s -> s { describeURI = Just (queryDescribe query), queryType = DescribeType }+  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+  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@@ -147,35 +159,34 @@  -- |Restrict the query to only results for which values match constants in this --  triple, or for which the variables can be bound.-triple :: (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Query Pattern+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-+  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)+  modify $ \s -> s { pattern = appendPattern t (pattern s) }+  return t -constructTriple :: (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Query Pattern+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+  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)+  modify $ \s -> s { constructTriples = appendTriple t (constructTriples s) }+  return t -askTriple :: (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Query Pattern+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+  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)+  modify $ \s -> s { askTriples = appendTriple t (askTriples s) }+  return t -updateTriple :: (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Query Pattern+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+  let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c) -- TODO: should only allow terms+  modify $ \s -> s { updateTriples = appendTriple t (updateTriples s) }+  return t  describeIRI :: IRIRef -> Query IRIRef describeIRI newIri = do-    modify $ \s -> s { describeURI = Just newIri }-    return newIri+  modify $ \s -> s { describeURI = Just newIri }+  return newIri   -- |Add optional constraints on matches. Variable bindings within the optional@@ -183,29 +194,35 @@ --  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  = execQuery q $ OptionalGraphPattern . pattern-    modify $ \s -> s { pattern = appendPattern option (pattern s) }-    return option+  -- Determine the patterns by executing the action on a blank QueryData, and+  -- then pulling the patterns out from there.+  let option  = execQuery q $ OptionalGraphPattern . pattern+  modify $ \s -> s { pattern = appendPattern option (pattern s) }+  return option  -- |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    = execQuery q1 pattern-        p2    = execQuery q2 pattern-        union' = UnionGraphPattern p1 p2-    modify $ \s -> s { pattern = appendPattern union' (pattern s) }-    return union'+union q1 q2 = do+  let p1    = execQuery q1 pattern+      p2    = execQuery q2 pattern+      union' = UnionGraphPattern p1 p2+  modify $ \s -> s { pattern = appendPattern union' (pattern s) }+  return union'  -- |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+  let f = Filter (expr e)+  modify $ \s -> s { pattern = appendPattern f (pattern s) }+  return f +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+ -- Random auxiliary  -- |Form a 'Node', with the 'Prefix' and reference name.@@ -235,7 +252,7 @@  -- |Alias of 'orderNextAsc'. orderNext :: (TermLike a) => a -> Query ()-orderNext = orderNextAsc +orderNext = orderNextAsc  -- |Order the results, after any previous ordering, based on the term, in --  ascending order.@@ -247,8 +264,8 @@ 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+-- |Permit variables and values to seemlessly be put into argument for 'triple'+--  and similar functions class TermLike a where   varOrTerm :: a -> VarOrTerm @@ -261,6 +278,13 @@ 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@@ -270,23 +294,55 @@   expr = NumericExpr . NumericLiteralExpr  instance TermLike T.Text where-  varOrTerm = Term . RDFLiteralTerm . plainL+  varOrTerm = Term . RDFLiteralTerm . RDF.plainL  instance TermLike (T.Text, T.Text) where-  varOrTerm (s, lang') = Term . RDFLiteralTerm $ plainLL s lang'+  varOrTerm (s, lang') = Term . RDFLiteralTerm $ RDF.plainLL s lang'  instance TermLike (T.Text, IRIRef) where-  varOrTerm (s, ref) = Term . RDFLiteralTerm $ typedL s (getFQN ref)+  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@(UNode _)) = (Term . IRIRefTerm . AbsoluteIRI) n-  varOrTerm (RDFNode (LNode lv))  = (Term . RDFLiteralTerm) lv-  -- TODO: non-exhaustive: missing BNode, BNodeGen+  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)@@ -429,7 +485,6 @@     }  - -- Query representation class QueryShow a where   -- |Convert most query-related types to a 'String', most importantly@@ -442,39 +497,57 @@ data Limit = NoLimit | Limit Int            deriving (Show) -data Prefix = Prefix T.Text Node+data Prefix = Prefix T.Text RDF.Node             deriving (Show)  data Variable = Variable Int               deriving (Show) -data IRIRef = AbsoluteIRI Node+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++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 $ unode uri+iriRef uri = AbsoluteIRI $ RDF.unode uri  getFQN :: IRIRef -> T.Text-getFQN (AbsoluteIRI (UNode n)) = n-getFQN (PrefixedName (Prefix _ (UNode n)) s) = T.append n s+getFQN (AbsoluteIRI (RDF.UNode n)) = n+getFQN (PrefixedName (Prefix _ (RDF.UNode n)) s) = T.append n s+-- FIXME+getFQN _ = error "getFQN: input not supported" --- Should support numeric literals, too+-- FIXME: Should support numeric literals, too data GraphTerm = IRIRefTerm IRIRef-               | RDFLiteralTerm LValue+               | 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 Node+               | RDFNode RDF.Node                deriving (Show)  data Operation = Add | Subtract | Multiply | Divide | And | Or@@ -503,8 +576,10 @@  data Pattern = QTriple VarOrTerm VarOrTerm VarOrTerm              | Filter Expr+             | Bind Expr Variable              | OptionalGraphPattern GroupGraphPattern              | UnionGraphPattern GroupGraphPattern GroupGraphPattern+ data GroupGraphPattern = GroupGraphPattern [Pattern]  data OrderBy = Asc Expr@@ -555,9 +630,13 @@   -- QueryShow instances-instance (QueryShow a) => QueryShow [a] where-  qshow xs = unwords $ map qshow xs+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"@@ -567,15 +646,29 @@   qshow NoLimit   = ""   qshow (Limit n) = "Limit " ++ show n -instance QueryShow Node where-  qshow (UNode n) = "<" ++ T.unpack 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 v) = "?x" ++ show v +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)@@ -584,22 +677,23 @@   qshow (Just r) = qshow r   qshow Nothing = "" -instance QueryShow LValue where-  qshow (PlainL s)        = "\"" ++ (T.unpack $ escapeQuotes s) ++ "\""-  qshow (PlainLL s lang') = "\"" ++ (T.unpack $ escapeQuotes s) ++ "\"@" ++ (T.unpack lang')-  qshow (TypedL s ref)    = "\"" ++ (T.unpack $ escapeQuotes s) ++ "\"^^" ++ "<" ++ (T.unpack ref) ++ ">"- instance QueryShow GraphTerm where   qshow (IRIRefTerm ref)           = qshow ref   qshow (RDFLiteralTerm s)         = qshow s-  qshow (BooleanLiteralTerm True)  = show "true"-  qshow (BooleanLiteralTerm False) = show "false"+  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 = "-"@@ -634,22 +728,26 @@   qshow RegexFunc       = "REGEX"  instance QueryShow Expr where-  qshow (VarOrTermExpr vt) = qshow vt-  qshow e = "(" ++ qshow' e ++ ")"-    where qshow' (OrExpr es)        = intercalate " || " $ map qshow es-          qshow' (AndExpr es)       = intercalate " && " $ map qshow es-          qshow' (NegatedExpr e')   = '!' : qshow e'-          qshow' (RelationalExpr rel e1 e2) = qshow e1 ++ qshow rel ++ qshow e2-          qshow' (NumericExpr e')   = qshow e'-          qshow' (BuiltinCall f es) = qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ ")"+  qshow = 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) ++ ")"+          wrap e = "(" ++ e ++ ")"  instance QueryShow Pattern where-  qshow (QTriple a b c) = qshow [a, b, c] ++ " ."-  qshow (Filter e)     = "FILTER " ++ qshow e ++ " ."-+  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 +instance QueryShow [Pattern] where+  qshow = unwords . fmap qshow+ instance QueryShow GroupGraphPattern where   qshow (GroupGraphPattern ps) = "{" ++ qshow ps ++ "}" @@ -657,20 +755,15 @@   qshow (Asc e)  = "ASC(" ++ qshow e ++ ")"   qshow (Desc e) = "DESC(" ++ qshow e ++ ")" - instance QueryShow QueryForm where-  qshow (SelectForm qd) =  unwords +  qshow (SelectForm qd) =  unwords                         [ "SELECT"-                         , qshow (duplicates qd)-                         , qshow (vars qd)+                        , qshow (duplicates qd)+                        , qshow (vars qd)                         ]-   qshow (ConstructForm qd) = "CONSTRUCT { " ++ qshow (constructTriples qd) ++ " }"-   qshow (AskForm qd) = "ASK { " ++ qshow (askTriples qd) ++ " }"-   qshow (UpdateForm qd) = "INSERT DATA { " ++ qshow (updateTriples qd) ++ " }"-   qshow (DescribeForm qd) = "DESCRIBE " ++ qshow (describeURI qd)  instance QueryShow QueryData where@@ -682,33 +775,43 @@                                       os -> "ORDER BY" : map qshow os                   query = case queryType qd of-                  SelectType -> +                  SelectType ->                    unwords [ qshow (prefixes qd)                            , qshow (SelectForm qd)                            , whereStmt                            , qshow (limits qd)                            ]-                  ConstructType -> +                  ConstructType ->                    unwords [ qshow (prefixes qd)                            , qshow (ConstructForm qd)                            , whereStmt                            ]-                  DescribeType -> +                  DescribeType ->                    unwords [ qshow (prefixes qd)                            , qshow (DescribeForm qd)                            , whereStmt                            ]-                  AskType -> +                  AskType ->                    unwords [ qshow (prefixes qd)                            , qshow (AskForm qd)                            ]-                  UpdateType -> +                  UpdateType ->                    unwords [ qshow (prefixes qd)                            , qshow (UpdateForm qd)                            ]+                  -- FIXME+                  TypeNotSet ->+                    error "instance QueryShow QueryData: TypeNotSet not supported."              in query   -- Internal utilities-escapeQuotes :: T.Text -> T.Text-escapeQuotes = T.replace "\"" "\\\""+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

@@ -1,6 +1,6 @@ Name:          hsparql Homepage:      https://github.com/robstewart57/hsparql-Version:       0.3.1+Version:       0.3.2 Synopsis:      A SPARQL query generator and DSL, and a client to query a SPARQL server. Category:      Database Description:@@ -34,6 +34,7 @@                , text                , network-uri   extensions:  RankNTypes FlexibleInstances OverloadedStrings+  ghc-options: -Wall -Wcompat  test-suite test-hsparql   type:          exitcode-stdio-1.0@@ -53,6 +54,7 @@   hs-source-dirs: Database, tests   other-modules: Database.HSparql.ConnectionTest   extensions:  OverloadedStrings, FlexibleInstances+  ghc-options: -Wall -Wcompat  source-repository head   type:     git

@@ -4,38 +4,38 @@  import Database.HSparql.ConnectionTest -import Control.Concurrent (forkIO,threadDelay)-import Control.Exception.Base (bracket_)-import Network.HTTP.Types (status200, status500)+import Control.Concurrent (forkIO)+import Network.HTTP.Types (status200) import Network.Wai import Network.Wai.Handler.Warp (run) import Test.Framework +main :: IO () main =-  do forkIO $ startServer+  do _ <- forkIO $ startServer      ropts <- interpretArgsOrExit []      defaultMainWithOpts tests ropts      where tests = Database.HSparql.ConnectionTest.testSuite  app :: Application app req respond = respond $ response req-     where-       response req = case rawQueryString req of-                        "?query=PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20SELECT%20%20%3Fx1%20WHERE%20%7B%3Fx0%20dbpedia%3Agenre%20dbprop%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D%20"-                            -> selectResponse-                        "?query=PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20ASK%20%7B%20%3Fx0%20dbprop%3Agenre%20dbpedia%3AWeb_browser%20.%20%7D"-                            -> askResponse-                        "?query=PREFIX%20example%3A%20%3Chttp%3A%2F%2Fwww.example.com%2F%3E%20PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20CONSTRUCT%20%7B%20%3Fx0%20example%3AhasName%20%3Fx1%20.%20%7D%20WHERE%20%7B%3Fx0%20dbprop%3Agenre%20dbpedia%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D"-                            -> constructResponse-                        "?query=PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20DESCRIBE%20dbpedia%3AEdinburgh%20WHERE%20%7B%7D"-                            -> describeResponse-                        otherwise-                            -> error $ "Unexpected URI: \n\n" ++ show (rawQueryString req)+   where+     response req_ = case rawQueryString req_ of+                      "?query=PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20SELECT%20%20%3Fx1%20WHERE%20%7B%3Fx0%20dbpedia%3Agenre%20dbprop%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D%20"+                          -> selectResponse+                      "?query=PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20ASK%20%7B%20%3Fx0%20dbprop%3Agenre%20dbpedia%3AWeb_browser%20.%20%7D"+                          -> askResponse+                      "?query=PREFIX%20example%3A%20%3Chttp%3A%2F%2Fwww.example.com%2F%3E%20PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20CONSTRUCT%20%7B%20%3Fx0%20example%3AhasName%20%3Fx1%20.%20%7D%20WHERE%20%7B%3Fx0%20dbprop%3Agenre%20dbpedia%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D"+                          -> constructResponse+                      "?query=PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20DESCRIBE%20dbpedia%3AEdinburgh%20WHERE%20%7B%7D"+                          -> describeResponse+                      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+     selectResponse = responseFile status200 [("Content-Type", "application/sparql-results+xml")] "tests/fixtures/sparql_select_response.xml" Nothing+     askResponse = responseFile status200 [("Content-Type", "text/plain")] "tests/fixtures/sparql_ask_response.text" Nothing+     constructResponse = responseFile status200 [("Content-Type", "text/turtle")] "tests/fixtures/sparql_construct_response.ttl" Nothing+     describeResponse = responseFile status200 [("Content-Type", "text/turtle")] "tests/fixtures/sparql_describe_response.ttl" Nothing   startServer :: IO ()

@@ -1,16 +1,16 @@ module Database.HSparql.ConnectionTest ( testSuite ) where -import Test.Framework (testGroup)+import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit import Test.HUnit  import qualified Data.Map as Map-import qualified Data.Text as T import qualified Data.RDF as RDF  import Database.HSparql.Connection import Database.HSparql.QueryGenerator +testSuite :: [Test.Framework.Test] testSuite = [     testGroup "Database.HSparql.Connection tests" [         testCase "selectQuery" test_selectQuery@@ -20,6 +20,7 @@     ]   ] +test_selectQuery :: IO () test_selectQuery =   let expectedBVars = Just [ [ Bound $ RDF.lnode $ RDF.plainLL "Kazehakase" "en" ]                            , [ Bound $ RDF.lnode $ RDF.plainLL "Netscape Browser" "en" ]@@ -38,33 +39,35 @@               x    <- var               name <- var -              triple x (dbpprop .:. "genre") (resource .:. "Web_browser")-              triple x (foaf .:. "name") name+              _ <- triple x (dbpprop .:. "genre") (resource .:. "Web_browser")+              _ <- triple x (foaf .:. "name") name                return SelectQuery { queryVars = [name] } +test_askQuery :: IO () test_askQuery = do-    bool <- askQuery endPoint query-    assertBool "invalid" bool+  bool <- askQuery endPoint query+  assertBool "invalid" bool -    where endPoint = "http://127.0.0.1:3000"-          query = do-              resource <- prefix "dbpedia" (iriRef "http://dbpedia.org/resource/")-              dbprop  <- prefix "dbprop" (iriRef "http://dbpedia.org/property/")+  where endPoint = "http://127.0.0.1:3000"+        query = 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")+            x <- var+            ask <- askTriple x (dbprop .:. "genre") (resource .:. "Web_browser") -              return AskQuery { queryAsk = [ask] }+            return AskQuery { queryAsk = [ask] } +test_constructQuery :: IO () test_constructQuery =-  let expectedGraph :: RDF.TriplesList+  let expectedGraph :: RDF.RDF RDF.TList       expectedGraph = RDF.mkRdf expectedTriples Nothing (RDF.PrefixMappings Map.empty)       expectedTriples = [ RDF.Triple (RDF.unode "http://dbpedia.org/resource/Kazehakase")                                      (RDF.unode "http://www.example.com/hasName")                                      (RDF.lnode $ RDF.plainLL "Kazehakase" "en") ]   in do-    graph <- constructQuery endPoint query :: IO RDF.TriplesList+    graph <- constructQuery endPoint query :: IO (RDF.RDF RDF.TList)     assertBool "RDF does not include the constructed triple" $ RDF.isIsomorphic expectedGraph graph      where endPoint = "http://127.0.0.1:3000"@@ -78,15 +81,16 @@               name <- var                construct <- constructTriple x (example .:. "hasName") name-              triple x (dbpprop .:. "genre") (resource .:. "Web_browser")-              triple x (foaf .:. "name") name+              _ <- triple x (dbpprop .:. "genre") (resource .:. "Web_browser")+              _ <- triple x (foaf .:. "name") name                return ConstructQuery { queryConstructs = [construct] } +test_describeQuery :: IO () test_describeQuery =   let expectedNode = RDF.unode "http://dbpedia.org/resource/Edinburgh"   in do-    graph <- describeQuery endPoint query :: IO RDF.TriplesList+    graph <- describeQuery endPoint query :: IO (RDF.RDF RDF.TList)     assertBool "RDF does not include the required node" $ RDF.rdfContainsNode graph expectedNode      where endPoint = "http://127.0.0.1:3000"