packages feed

hasparql-client (empty) → 0.1

raw patch · 8 files changed

+383/−0 lines, 8 filesdep +HTTPdep +basedep +monads-fdsetup-changed

Dependencies added: HTTP, base, monads-fd, network, xml

Files

+ Database/HaSparqlClient.hs view
@@ -0,0 +1,9 @@+-- | Main module+module Database.HaSparqlClient (module Database.HaSparqlClient.Types, +                                module Database.HaSparqlClient.Values, +                                module Database.HaSparqlClient.Queries) +                                where++import Database.HaSparqlClient.Types+import Database.HaSparqlClient.Values+import Database.HaSparqlClient.Queries
+ Database/HaSparqlClient/Queries.hs view
@@ -0,0 +1,150 @@+{- | This module provides functions to access remote endpoints.
+     'runSelectQuery' and 'runAskQuery' may not work if you try to override the output format. See also about 'HGET' and 'HPOST'.
+-}
+
+module Database.HaSparqlClient.Queries (runQuery, runSelectQuery, runAskQuery) where
+
+import Network.URI
+import Network.HTTP
+import Text.XML.Light
+import Data.Maybe
+import Control.Monad (guard)
+import Data.Char (toLower)
+
+import Database.HaSparqlClient.Types
+import Database.HaSparqlClient.Values
+
+
+{- | Execute a service. On success returns a string created from the service. By default, the string is a representation in XML, other formats such as Turtle and N3 could be returned by adding the output format from the list of optional parameters. Returns an error message on failure. SPARUL and SPARQL can be performed.
+-}
+runQuery :: Service -> Method -> IO(Either String String)
+runQuery = getSparqlRequest right . constructURI 
+
+{- | Find all possible values for a query of type SELECT and may return several lists of 'BindingValue'. URI, Literal and Blank Nodes are now types in Haskell. If it fails returns an error message. -}
+runSelectQuery :: Service ->  Method -> IO(Either String [[BindingValue]])
+runSelectQuery =  getSparqlRequest (parse $ parseSparqlVariables >>= parseSparqlResults) . constructURI
+-- @
+--  select = do
+--     res <- runSelectQuery defaultService HPOST
+--     case res of
+--       Left e -> print $ "Error:" ++ e
+--       Right s -> print s
+-- @
+-- | Return Right True or Right False for a query of type ASK. If it fails returns an error message.
+runAskQuery :: Service -> Method -> IO(Either String Bool)
+runAskQuery serv m= do 
+                                    b <- getSparqlRequest (parse parseSparqlBooleanResult) (constructURI serv) m
+                                    case b of
+                                        Right x -> case x of
+                                                    Just True -> return $ Right True
+                                                    Just False -> return $ Right False
+                                                    _ -> return $ Left "Boolean binding not found."
+                                        Left x -> return $ Left x
+-- @
+--  ask = do
+--     let s = Sparql "http://dbpedia.org/sparql/" query Nothing [] []
+--     res <- runAskQuery s HGET
+--       where
+--         query = "PREFIX prop: <http://dbpedia.org/property/>" ++
+--          " ASK { <http://dbpedia.org/resource/Amazon_River> prop:length ?amazon ." ++
+--          " <http://dbpedia.org/resource/Nile> prop:length ?nile ." ++
+--          "FILTER(?amazon > ?nile) .} "
+--     case res of
+--       Left e -> print $ "Error:" ++ e
+--       Right s -> print s
+-- @
+-- In case of success makes the request and transforms the result depending on the callback function.
+getSparqlRequest :: (String -> Either String b) -> Either String (URI,[ExtraParameters]) -> Method -> IO (Either String b)
+getSparqlRequest f u m = case u of
+                            Left err -> return $ Left err
+                            Right uri -> do
+                                              resp <- getRespBody uri m
+                                              case resp of
+                                                Left err -> return $ Left (show err)
+                                                Right rsp -> case rspCode rsp of
+                                                                (2,_,_) -> do 
+                                                                            let xml = rspBody rsp
+                                                                            return $ f xml
+                                                                (a,b,c) -> do
+                                                                        let rspErr = rspBody rsp
+                                                                        return $ Left rspErr
+
+-- This function looks if the Endpoint is a valid URI, then returns the URI and other parameters are fixed and added.                                            
+constructURI :: Service -> Either String (URI,[ExtraParameters])                                            
+constructURI (Sparql endpoint query defg ng oth) = case parseURI endpoint of
+                                                    Nothing -> Left "Bad string for endpoint."
+                                                    Just uri -> Right (uri,[("query",query)] ++ defaultgraph defg++ othervars ng ++ filtparams oth)
+  where
+   othervars lst = [("named-graph-uri",x)|x<-lst]
+   defaultgraph dg = case dg of
+                        Nothing -> []
+                        Just g -> [("default-graph-uri", g)]
+   filtparams = filter bool
+   bool (a,b)
+            |lower a /= "named-graph-uri" && lower a /= "default-graph-uri" = True
+            |otherwise = False
+   lower = map toLower
+         
+quri :: Maybe String
+quri = Just "http://www.w3.org/2005/sparql-results#"
+
+-- Find the names for all sparql variables in the XML document.
+parseSparqlVariables :: Element -> [String]    
+parseSparqlVariables doc = mapMaybe attr (findElements (QName "variable" quri Nothing) doc)
+
+  where
+   attr = findAttr (QName "name" Nothing Nothing)
+
+-- Transform the XmlElement recivied from HTTP request with variable's name in lists.
+parseSparqlResults :: [String] -> Element -> [[BindingValue]]
+parseSparqlResults vars = map (parseSparqlBindings vars) . findElements (QName "result" quri Nothing)
+
+     
+parseSparqlBindings :: [String] -> Element -> [BindingValue]
+parseSparqlBindings vars doc = map pVar vars
+  where
+   pVar v  = maybe Unbound (elementBinding . head . elChildren) $ filterElement (pred v) doc
+   pred v e = isJust $ do 
+                        a <- findAttr (unqual "name") e
+                        guard $ a == v
+                        
+-- Parse the XML document and returns the Boolean value as Maybe Bool 
+parseSparqlBooleanResult  :: Element -> Maybe Bool
+parseSparqlBooleanResult doc =  case (findElement (QName "boolean" quri Nothing) doc) of
+                                    Just elem -> case (strContent elem) of
+                                                    "true" -> Just True
+                                                    "false" -> Just False
+                                    _ -> Nothing
+
+-- Transform an XML element in a BindingValue.                                                          
+elementBinding :: Element -> BindingValue
+elementBinding e = case qName (elName e) of
+                "uri" -> Database.HaSparqlClient.Types.URI (strContent e)
+                "literal" -> case findAttr (unqual "datatype") e of
+                                    Just dt -> TypedLiteral (strContent e) dt
+                                    Nothing -> case findAttr langAttr e of
+                                        Just lang -> LangLiteral (strContent e) lang
+                                        Nothing  -> Literal (strContent e)
+                "bnode" -> BNode (strContent e)
+                _ -> Unbound
+  where
+    langAttr = blank_name {qName = "lang", qPrefix = Just "xml"}
+
+getRespBody :: (URI,[ExtraParameters]) -> Method -> IO (Either IOError (Response String))
+getRespBody u m = catch (simpleHTTP(mountRequest m u) >>= (\(Right rsp) -> return (Right rsp))) (return . Left )
+
+-- Make an HTTP GET or POST, according to the SPARQL protocol, some endpoints do not yet support POST requests. Some SPARQL queries, perhaps machine generated, may be longer than can be reliably conveyed by way of the HTTP GET. In those cases the POST may be used.
+mountRequest m (uri,params) = case m of
+                HPOST -> (Request uri POST [mkHeader HdrContentType "application/x-www-form-urlencoded", mkHeader HdrAccept accept, mkHeader HdrContentLength (show $ length $ urlEncodeVars params), mkHeader HdrUserAgent "hasparql-client-0.1"] (urlEncodeVars params))
+                _ -> insertHeaders [mkHeader HdrAccept accept] (getRequest $ show uri ++ "?" ++ urlEncodeVars params)
+
+-- Parse XML documents depending on the generic function in the argument.                 
+parse f s = case parseXMLDoc s of
+                Just doc -> Right (f doc)
+                Nothing -> Left "Internal error parsing xml results."
+
+right :: b -> Either a b
+right = Right
+
+-- Defaults MIME/Types for SPARQL queries. '*/*' for all other possibilities.
+accept = "application/sparql-results+xml, application/rdf+xml, */*"
+ Database/HaSparqlClient/Types.hs view
@@ -0,0 +1,56 @@+-- | Type definitions.+module Database.HaSparqlClient.Types (-- * SELECT binding value+    BindingValue(..), +    -- * SPARQL service+    Service(..), +    -- ** Required elements+    Endpoint, Query, +    -- ** Optional elements+    DefaultGraph, NamedGraph, ExtraParameters, Key, Value, +    -- * Request method+    Method(..),+    defaultService) where++-- | Representation for SELECT query result format.+data BindingValue = URI String -- ^ URI reference to remote resource.+                    | Literal String -- ^ Literal string without datatype or lang.+                    | TypedLiteral String String -- ^ Literal with datatype URI.+                    | LangLiteral  String String -- ^ Literal with language.+                    | BNode String  -- ^ Blank Node with label.+                    | Unbound -- ^ Unbound result value.+                    deriving (Eq, Show) ++-- | Local representation for a SPARQL service.+data Service = Sparql{ endpoint :: Endpoint, +                query :: Query, +                defaultgraph :: DefaultGraph, +                namedgraph :: [NamedGraph], +                optionalparameters :: [(ExtraParameters)]+                } deriving (Eq, Show)++-- | Represents a SPARQL endpoint.+type Endpoint = String++-- | SPARQL query 'String'.+type Query = String++-- | Add a default graph URI. Overrides the default graph from SPARQL queries.+type DefaultGraph = Maybe String++-- | Add a named graph URI. Overrides named graphs from SPARQL queries.+type NamedGraph = String++-- | Some SPARQL endpoints require extra key value pairs. E.g., in Virtuoso Server, one would add should-sponge=soft to the query forcing virtuoso to retrieve graphs that are not stored in its local database. Can be for example, used to try others output formats in 'RunQuery' depending on the server.+type ExtraParameters = (Key,Value)++-- | key of the query part.+type Key = String -- ^ named-graph-uri and default-graph-uri keys not allowed here. They're removed.++-- | value of the query part.+type Value = String++-- | Set to HTTP GET or POST request, according to the SPARQL protocol, some endpoints do not yet support POST requests. Some SPARQL queries, perhaps machine generated, may be longer than can be reliably conveyed by way of the HTTP GET. In those cases the POST may be used.+data Method = HGET | HPOST deriving (Eq, Show)++-- | Just a example.+defaultService = Sparql "http://dbpedia.org/sparql" "select ?s ?p ?o where {?s ?p ?o} limit 1" Nothing [] []
+ Database/HaSparqlClient/Values.hs view
@@ -0,0 +1,57 @@+-- | This module provides some convenience functions to get values from BindingValue. +module Database.HaSparqlClient.Values(-- * Getting values+                                    languageValue, datatypeValue, uriValue, literalValue, bnodeValue, value, +                                    -- * XML representation+                                    showsparql) where++import Database.HaSparqlClient.Types++-- | SPARQL XML representation.+class ShowQuery a where+  showsparql :: a -> String+    +-- | SPARQL XML representation for 'BindingValue'.+instance ShowQuery BindingValue where+  showsparql (URI uri) = "<uri>" ++ uri ++ "</uri>"+  showsparql (Literal str) = "<literal>"++ str ++ "</literal>"+  showsparql (TypedLiteral str tp) = "<literal datatype=\"" ++ tp ++ "\">" ++ str ++ "</literal>"+  showsparql (BNode str) = "<bnode>" ++ str ++ "</bnode>"+  showsparql (LangLiteral str lan) = "<literal xml:lang=\"" ++ lan ++ "\">" ++ str ++ "</literal>"+  showsparql _ = ""++-- | Get the language value for a 'BindingValue'. Return 'Nothing' if 'BindingValue' is not 'LangLiteral'.+languageValue :: BindingValue -> Maybe String+languageValue (LangLiteral str lan) = Just lan+languageValue _ = Nothing ++-- | Get the datatype value for a 'BindingValue'. Return 'Nothing' if 'BindingValue' is not 'TypedLiteral'.+datatypeValue :: BindingValue -> Maybe String+datatypeValue (TypedLiteral str tp) = Just tp+datatypeValue _ = Nothing++-- | Get the 'URI' value for a BindingValue. Return 'Nothing' if 'BindingValue' is not 'URI'.+uriValue :: BindingValue -> Maybe String+uriValue (URI str) = Just str+uriValue _ = Nothing++-- | Get the literal value for a 'BindingValue'. Return 'Nothing' if not is of the any literal type.+literalValue :: BindingValue -> Maybe String+literalValue (Literal str) = Just str+literalValue (TypedLiteral str tp) = Just str+literalValue (LangLiteral str lan) = Just str+literalValue _ = Nothing++-- | Get the 'BNode' value for a 'BindingValue'. Return 'Nothing' if 'BindingValue' is not 'BNode'.+bnodeValue :: BindingValue -> Maybe String+bnodeValue (BNode bno) = Just bno+bnodeValue _ = Nothing++-- | Get the value for a 'BindingValue'. Return 'Nothing' if BindingValue is 'Unbound'.+value :: BindingValue -> Maybe String+value res = case (uriValue res) of+				Nothing -> case (literalValue res) of+							Nothing -> case (bnodeValue res) of+									Nothing -> Nothing+									Just bno -> Just bno+							Just lit -> Just lit+				Just uri -> Just uri
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011 Luiz Damascena++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Tests/Tests.hs view
@@ -0,0 +1,56 @@+module Main where+import Database.HaSparqlClient++{- See some SPARQL endpoints: +http://www.w3.org/wiki/SparqlEndpoints+All examples work with HGET and HPOST.+-}++{- Expected: Right True or Right False+   Is the Amazon river longer than the Nile River?+   Example found at: http://www.cambridgesemantics.com/2008/09/sparql-by-example/#%2837%29+-}+ask = do+        let s = Sparql "http://dbpedia.org/sparql/" query Nothing [] []+        res <- runAskQuery s HGET+        printf res+  where+   query = "PREFIX prop: <http://dbpedia.org/property/>" +++    "ASK { <http://dbpedia.org/resource/Amazon_River> prop:length ?amazon ." +++     " <http://dbpedia.org/resource/Nile> prop:length ?nile ." +++     "FILTER(?amazon > ?nile) .} "+++select = do +    let s = Sparql "http://api.talis.com/stores/periodicals/services/sparql" "select ?x where {?x a ?z} limit 10" Nothing [][]+    res <- runSelectQuery s HGET+    printf res+        +-- Find places near the Eiffel Tower in a radius of 20 Km.+select2 = do+        let s = Sparql "http://dbpedia.org/sparql" query Nothing [] []+        res <- runSelectQuery s HPOST+        printf res+  where+    query = "SELECT DISTINCT ?resource ?label (bif:st_distance( ?point1,?point2 )) AS ?distance "+                    ++ "WHERE {<http://dbpedia.org/resource/Eiffel_Tower> geo:geometry ?point1."+                    ++ "?resource geo:geometry ?point2."+                    ++ "?resource rdfs:label ?label."+                    ++ "?resource a ?type."+                    ++ "FILTER ((?type = <http://www.opengis.net/gml/_Feature>) || (?type = <http://dbpedia.org/ontology/Place>))."+                    ++ "FILTER(bif:st_intersects(?point2,?point1,20))."+                    ++ "FILTER( lang( ?label ) = \"en\")."+                    ++ "FILTER(?resource != <http://dbpedia.org/resource/Eiffel_Tower>)."+                    ++ "} ORDER BY ASC(?distance) LIMIT 20"+{- +    Findl all musical artists.+    Example found at: http://dbtune.org/jamendo/+-}+describe = do+            let s = Sparql "http://dbtune.org/jamendo/sparql/" "Describe <http://purl.org/ontology/mo/MusicArtist>" Nothing [] []+            res <- runQuery s HGET+            printf res+--Just print.+printf x = case x of+            Left e -> print $ "Error:" ++ e+            Right s -> print s
+ hasparql-client.cabal view
@@ -0,0 +1,22 @@+Name:           hasparql-client+Version:        0.1+License:        BSD3+License-file:   LICENSE+Author:         Luiz Damascena <luizscence@gmail.com>+Maintainer:     Luiz Damascena+Homepage:       https://github.com/lhpaladin/HaSparql-Client+Category:       Semantic Web, Database+Synopsis:       This package enables to write SPARQL queries to remote endpoints.+Description:    This package enables to write SPARQL queries to remote endpoints. It provides many of the options provided through the SPARQL protocol.+                It was inspired by HSparql and SPARQL Python Wrapper (Python). For more information see also:+                    http://www.w3.org/TR/rdf-sparql-protocol/+                    http://www.w3.org/2005/sparql-results#+                TODO list:+                   Add internal conversion to RDFXML, N3, Turtle and JSON.+                   Implement a parser to validate SPARQL queries.+Stability:     experimental+Build-type:    Simple+Build-depends: base >= 4 && < 5, HTTP >= 4, monads-fd, xml, network+extra-source-files: Tests/Tests.hs++Exposed-Modules: Database.HaSparqlClient, Database.HaSparqlClient.Types, Database.HaSparqlClient.Values, Database.HaSparqlClient.Queries