hsparql (empty) → 0.0
raw patch · 5 files changed
+470/−0 lines, 5 filesdep +HTTPdep +basedep +containerssetup-changed
Dependencies added: HTTP, base, containers, monads-fd, xml
Files
- Database/HSparql/Connection.hs +57/−0
- Database/HSparql/QueryGenerator.hs +364/−0
- LICENSE +24/−0
- Setup.lhs +3/−0
- hsparql.cabal +22/−0
+ Database/HSparql/Connection.hs view
@@ -0,0 +1,57 @@+module Database.HSparql.Connection where++import Control.Monad+import Data.Maybe+import Network.HTTP+import Text.XML.Light++import Database.HSparql.QueryGenerator++type EndPoint = String++data BindingValue = URI String+ | Literal String+ | TypedLiteral String String -- value, type+ | LangLiteral String String -- value, lang + | Unbound+ deriving (Show, Eq)++sparqlResult :: String -> QName+sparqlResult s = (unqual s) { qURI = Just "http://www.w3.org/2005/sparql-results#" }++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++ vars :: Element -> [String]+ vars = catMaybes . map (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++ value :: Element -> BindingValue+ value e =+ case qName (elName e) of+ "uri" -> 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)+ _ -> Unbound++ langAttr :: QName+ langAttr = blank_name { qName = "lang", qPrefix = Just "xml" }++-- query :: EndPoint -> Query [Variable] -> IO (Maybe [[Element]])+query ep q = do+ let uri = ep ++ "?" ++ urlEncodeVars [("query", createQuery q)]+ request = replaceHeader HdrUserAgent "hsparql-client" (getRequest uri)+ response <- simpleHTTP request >>= getResponseBody+ return $ structureContent response
+ Database/HSparql/QueryGenerator.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE ExtendedDefaultRules, FlexibleInstances, Rank2Types #-}+module Database.HSparql.QueryGenerator where++import Control.Monad.State+import Data.List (intercalate)++-- State monads+type Query a = State QueryData a++execQuery :: Query a -> (QueryData -> b) -> b+execQuery q f = f $ execState q queryData++createQuery :: Query [Variable] -> String+createQuery q = execQuery specifyVars qshow+ where specifyVars :: Query ()+ specifyVars = do vs <- q+ modify $ \s -> s { vars = vs }++-- Manipulate data within monad+prefix :: IRIRef -> Query Prefix+prefix ref = do n <- gets prefixIdx+ let p = Prefix n ref+ modify $ \s -> s { prefixIdx = n + 1, prefixes = p : prefixes s }+ return p++var :: Query Variable+var = do n <- gets varsIdx+ modify $ \s -> s { varsIdx = n + 1 }+ return $ Variable n++triple :: (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Query Pattern+triple a b c = do+ let t = Triple (varOrTerm a) (varOrTerm b) (varOrTerm c)+ modify $ \s -> s { pattern = appendPattern t (pattern s) }+ return t++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++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++filterExpr :: (TermLike a) => a -> Query Pattern+filterExpr e = do+ let f = Filter (expr e)+ modify $ \s -> s { pattern = appendPattern f (pattern s) }+ return f++-- Random auxiliary+(.:.) :: Prefix -> String -> IRIRef+(.:.) = PrefixedName++iriRef :: String -> IRIRef+iriRef = IRIRef++-- Duplicate handling+distinct :: Query Duplicates+distinct = do modify $ \s -> s { duplicates = Distinct }+ gets duplicates++reduced :: Query Duplicates+reduced = do modify $ \s -> s { duplicates = Reduced }+ gets duplicates++-- Order handling+orderNext, orderNextAsc, orderNextDesc :: (TermLike a) => a -> Query ()+orderNext = orderNextAsc ++orderNextAsc x = do modify $ \s -> s { ordering = (ordering s) ++ [Asc $ expr x] }+orderNextDesc x = do 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 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 [Char] where+ varOrTerm = Term . RDFLiteralTerm . RDFLiteral++instance TermLike ([Char], [Char]) where+ varOrTerm (s, lang) = Term . RDFLiteralTerm $ RDFLiteralLang s lang++instance TermLike ([Char], IRIRef) where+ varOrTerm (s, ref) = Term . RDFLiteralTerm $ RDFLiteralIRIRef s ref++instance TermLike Bool where+ varOrTerm = Term . BooleanLiteralTerm++-- Operations+operation :: (TermLike a, TermLike b) => Operation -> a -> b -> Expr+operation op x y = NumericExpr $ OperationExpr op (expr x) (expr y)++(.+.), (.-.), (.*.), (./.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.+.) = operation Add+(.-.) = operation Subtract+(.*.) = operation Multiply+(./.) = operation Divide++-- Relations+relation :: (TermLike a, TermLike b) => Relation -> a -> b -> Expr+relation rel x y = RelationalExpr rel (expr x) (expr y)++(.==.), (.!=.), (.<.), (.>.), (.<=.), (.>=.) :: (TermLike a, TermLike b) => a -> b -> Expr+(.==.) = relation Equal+(.!=.) = relation NotEqual+(.<.) = relation LessThan+(.>.) = relation GreaterThan+(.<=.) = relation LessThanOrEqual+(.>=.) = relation GreaterThanOrEqual++-- Negation+notExpr :: (TermLike a) => a -> Expr+notExpr = NegatedExpr . expr++-- Builtin Functions+type BuiltinFunc1 = (TermLike a) => a -> Expr+builtinFunc1 :: Function -> BuiltinFunc1+builtinFunc1 f x = BuiltinCall f [expr x]++type BuiltinFunc2 = (TermLike a, TermLike b) => a -> b -> Expr+builtinFunc2 :: Function -> BuiltinFunc2+builtinFunc2 f x y = BuiltinCall f [expr x, expr y]++str :: BuiltinFunc1+str = builtinFunc1 StrFunc++lang :: BuiltinFunc1+lang = builtinFunc1 LangFunc++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++-- Default QueryData+queryData :: QueryData+queryData = QueryData+ { prefixIdx = 0+ , prefixes = []+ , varsIdx = 0+ , vars = []+ , pattern = GroupGraphPattern []+ , duplicates = NoLimits+ , ordering = []+ }++-- Query representation+class QueryShow a where+ qshow :: a -> String++data Duplicates = NoLimits | Distinct | Reduced++data Prefix = Prefix Int IRIRef++data Variable = Variable Int++data IRIRef = IRIRef String+ | PrefixedName Prefix String ++data RDFLiteral = RDFLiteral String+ | RDFLiteralLang String String+ | RDFLiteralIRIRef String IRIRef++-- Should support numeric literals, too+data GraphTerm = IRIRefTerm IRIRef+ | RDFLiteralTerm RDFLiteral+ | NumericLiteralTerm Integer+ | BooleanLiteralTerm Bool++data VarOrTerm = Var Variable+ | Term GraphTerm++data Operation = Add | Subtract | Multiply | Divide++data NumericExpr = NumericLiteralExpr Integer+ | OperationExpr Operation Expr Expr++data Relation = Equal | NotEqual | LessThan | GreaterThan | LessThanOrEqual | GreaterThanOrEqual++data Function = StrFunc | LangFunc | LangMatchesFunc | DataTypeFunc | BoundFunc+ | SameTermFunc | IsIRIFunc | IsURIFunc | IsBlankFunc+ | IsLiteralFunc | RegexFunc++data Expr = OrExpr [Expr]+ | AndExpr [Expr]+ | NegatedExpr Expr+ | RelationalExpr Relation Expr Expr+ | NumericExpr NumericExpr+ | BuiltinCall Function [Expr]+ | VarOrTermExpr VarOrTerm++data Pattern = Triple VarOrTerm VarOrTerm VarOrTerm+ | Filter Expr+ | OptionalGraphPattern GroupGraphPattern+ | UnionGraphPattern GroupGraphPattern GroupGraphPattern+data GroupGraphPattern = GroupGraphPattern [Pattern]++data OrderBy = Asc Expr+ | Desc Expr++-- Auxiliary, but fairly useful+appendPattern :: Pattern -> GroupGraphPattern -> GroupGraphPattern+appendPattern p (GroupGraphPattern ps) = GroupGraphPattern (ps ++ [p])++data QueryData = QueryData+ { prefixIdx :: Int+ , prefixes :: [Prefix]+ , varsIdx :: Int+ , vars :: [Variable]+ , pattern :: GroupGraphPattern+ , duplicates :: Duplicates+ , ordering :: [OrderBy]+ }++-- QueryShow instances+instance (QueryShow a) => QueryShow [a] where+ qshow xs = intercalate " " $ map qshow xs++instance QueryShow Duplicates where+ qshow NoLimits = ""+ qshow Distinct = "DISTINCT"+ qshow Reduced = "REDUCED"++instance QueryShow Prefix where+ qshow (Prefix n ref) = "PREFIX p" ++ show n ++ ": " ++ qshow ref++instance QueryShow Variable where+ qshow (Variable v) = "?x" ++ show v++instance QueryShow IRIRef where+ qshow (IRIRef r) = "<" ++ r ++ ">"+ qshow (PrefixedName (Prefix n ref) s) = "p" ++ show n ++ ":" ++ s++instance QueryShow RDFLiteral where+ -- Always use triple-quoted strings to avoid having to deal with quote-escaping+ qshow (RDFLiteral s) = "\"\"\"" ++ s ++ "\"\"\""+ qshow (RDFLiteralLang s lang) = "\"\"\"" ++ s ++ "\"\"\"@" ++ lang+ qshow (RDFLiteralIRIRef s ref) = "\"\"\"" ++ s ++ "\"\"\"^^" ++ qshow 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"++instance QueryShow VarOrTerm where+ qshow (Var v) = qshow v+ qshow (Term t) = qshow t++instance QueryShow Operation where+ qshow Add = "+"+ qshow Subtract = "-"+ qshow Multiply = "*"+ qshow Divide = "/"++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 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"++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) ++ ")"++instance QueryShow Pattern where+ qshow (Triple a b c) = qshow [a, b, c] ++ "."+ qshow (Filter e) = "FILTER " ++ qshow e ++ "."++ qshow (OptionalGraphPattern p) = "OPTIONAL " ++ qshow p+ qshow (UnionGraphPattern p1 p2) = qshow p1 ++ " UNION " ++ qshow p2++instance QueryShow GroupGraphPattern where+ qshow (GroupGraphPattern ps) = "{" ++ qshow ps ++ "}"++instance QueryShow OrderBy where+ qshow (Asc e) = "ASC(" ++ qshow e ++ ")"+ qshow (Desc e) = "DESC(" ++ qshow e ++ ")"++instance QueryShow QueryData where+ qshow qd = intercalate " " $ [ qshow (prefixes qd)+ , "SELECT"+ , qshow (duplicates qd)+ , qshow (vars qd)+ , "WHERE"+ , qshow (pattern qd)+ ] ++ case ordering qd of+ [] -> []+ os -> ["ORDER BY"] ++ map qshow os+
+ LICENSE view
@@ -0,0 +1,24 @@+* Copyright (c) 2009, Jeff Wheeler+* All rights reserved.+*+* Redistribution and use in source and binary forms, with or without+* modification, are permitted provided that the following conditions are met:+* * Redistributions of source code must retain the above copyright+* notice, this list of conditions and the following disclaimer.+* * 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.+* * Neither the name of the <organization> nor the+* names of its contributors may be used to endorse or promote products+* derived from this software without specific prior written permission.+*+* THIS SOFTWARE IS PROVIDED BY <copyright holder> ''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 <copyright holder> 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
+ hsparql.cabal view
@@ -0,0 +1,22 @@+Name: hsparql+Version: 0.0+Synopsis: A SPARQL query generator and DSL, and a client to query a SPARQL server.+Category: Database+Description:+ hsparql includes a DSL to easily create queries, as well as methods to+ submit those queries to a SPARQL server, returning the results as simple+ Haskell data structures.+License: BSD3+License-file: LICENSE+Author: Jeff Wheeler+Maintainer: jeff@jeffwheeler.name++Build-type: Simple+Build-depends: base >= 4 && < 5+Build-depends: containers+Build-depends: HTTP >= 4+Build-depends: monads-fd+Build-depends: xml++Exposed-modules: Database.HSparql.Connection+ Database.HSparql.QueryGenerator