diff --git a/Database/HSparql/Connection.hs b/Database/HSparql/Connection.hs --- a/Database/HSparql/Connection.hs +++ b/Database/HSparql/Connection.hs @@ -15,7 +15,9 @@ import Database.HSparql.QueryGenerator import Text.RDF.RDF4H.TurtleParser import Data.RDF -import qualified Data.ByteString.Lazy.Char8 as B +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) @@ -23,11 +25,8 @@ type EndPoint = String -- |Local representations of incoming XML results. -data BindingValue = URI String -- ^Absolute reference to remote resource. - | Literal String -- ^Simple literal string. - | TypedLiteral String String -- ^Literal element with type resource - | LangLiteral String String -- ^Literal element with language resource - | Unbound -- ^Unbound result value +data BindingValue = Bound Data.RDF.Node -- ^RDF Node (UNode, BNode, LNode) + | Unbound -- ^Unbound result value deriving (Show, Eq) -- |Base 'QName' for results with a SPARQL-result URI specified. @@ -55,12 +54,13 @@ value :: Element -> BindingValue value e = case qName (elName e) of - "uri" -> URI (strContent e) + "uri" -> Bound $ Data.RDF.unode $ T.pack $ strContent e "literal" -> case findAttr (unqual "datatype") e of - Just dt -> TypedLiteral (strContent e) dt + Just dt -> Bound $ Data.RDF.lnode $ Data.RDF.typedL (T.pack $ strContent e) (T.pack dt) Nothing -> case findAttr langAttr e of - Just lang -> LangLiteral (strContent e) lang - Nothing -> Literal (strContent e) + 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 langAttr :: QName @@ -99,8 +99,8 @@ let uri = ep ++ "?" ++ urlEncodeVars [("query", createConstructQuery q)] rdfGraph <- httpCallForRdf uri case rdfGraph of - Left e -> error $ show e - Right graph -> return graph + Left e -> error $ show e + Right graph -> return graph -- |Connect to remote 'EndPoint' and construct 'TriplesGraph' from given @@ -110,19 +110,19 @@ let uri = ep ++ "?" ++ urlEncodeVars [("query", createDescribeQuery q)] rdfGraph <- httpCallForRdf uri case rdfGraph of - Left e -> error $ show e - Right graph -> return graph + 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 rdf => String -> IO (Either ParseFailure rdf) httpCallForRdf uri = do - let h1 = mkHeader HdrUserAgent "hsparql-client" - h2 = mkHeader HdrAccept "text/rdf+n3" - request = Request { rqURI = fromJust $ parseURI uri + 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 $ parseString (TurtleParser Nothing Nothing) (B.pack response) + response <- simpleHTTP request >>= getResponseBody + return $ parseString (TurtleParser Nothing Nothing) (E.decodeUtf8 (B.pack response)) diff --git a/Database/HSparql/QueryGenerator.hs b/Database/HSparql/QueryGenerator.hs --- a/Database/HSparql/QueryGenerator.hs +++ b/Database/HSparql/QueryGenerator.hs @@ -106,7 +106,7 @@ query <- q modify $ \s -> s { askTriples = queryAsk query, queryType = AskType } --- |Execute a 'Ask Query' action, returning the 'String' representation of the query. +-- |Execute a 'Describe Query' action, returning the 'String' representation of the query. createDescribeQuery :: Query DescribeQuery -> String createDescribeQuery q = execQuery specifyType qshow where specifyType :: Query () diff --git a/hsparql.cabal b/hsparql.cabal --- a/hsparql.cabal +++ b/hsparql.cabal @@ -1,6 +1,6 @@ Name: hsparql Homepage: https://github.com/robstewart57/hsparql -Version: 0.1.4 +Version: 0.2.0 Synopsis: A SPARQL query generator and DSL, and a client to query a SPARQL server. Category: Database Description: @@ -18,7 +18,7 @@ bug-reports: https://github.com/robstewart57/hsparql/issues Stability: Experimental Build-type: Simple -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.8 library Exposed-modules: Database.HSparql.Connection @@ -27,10 +27,28 @@ , HTTP >= 4 , mtl , xml - , rdf4h + , rdf4h >= 1.0.0 , bytestring , network + , text extensions: RankNTypes FlexibleInstances + +test-suite test-hsparql + type: exitcode-stdio-1.0 + main-is: AllTests.hs + build-depends: hsparql + , rdf4h + , base + , text + , Cabal >= 1.9.2 + , http-types + , HUnit + , test-framework + , test-framework-hunit + , wai + , warp + hs-source-dirs: Database, tests + extensions: OverloadedStrings, FlexibleInstances source-repository head type: git diff --git a/tests/AllTests.hs b/tests/AllTests.hs new file mode 100644 --- /dev/null +++ b/tests/AllTests.hs @@ -0,0 +1,29 @@ + +module Main where + +import Network.Wai +import Network.Wai.Handler.Warp (run) +import Network.HTTP.Types (status200, status500) + +import Control.Concurrent (forkIO) + +import Test.Framework + +import Database.HSparql.ConnectionTest + +main = + do forkIO startServer + ropts <- interpretArgsOrExit [] + defaultMainWithOpts tests ropts + where tests = Database.HSparql.ConnectionTest.testSuite + +startServer :: IO () +startServer = run 3000 testServer + where testServer req = return $ response req + response req = case rawQueryString req of + "?query=PREFIX%20foaf%3A%20%3Chttp%3A%2F%2Fxmlns.com%2Ffoaf%2F0.1%2F%3E%20PREFIX%20dbpedia%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fproperty%2F%3E%20PREFIX%20dbprop%3A%20%3Chttp%3A%2F%2Fdbpedia.org%2Fresource%2F%3E%20SELECT%20%20%3Fx1%20WHERE%20%7B%3Fx0%20dbpedia%3Agenre%20dbprop%3AWeb_browser%20.%20%3Fx0%20foaf%3Aname%20%3Fx1%20.%7D" + -> selectResponse + otherwise + -> errorResponse + selectResponse = ResponseFile status200 [("Content-Type", "application/xml")] "tests/fixtures/sparql_select_response.xml" Nothing + errorResponse = responseLBS status500 [] ""