hxt-7.1: doc/cookbook/SPARQLParser.hs
{- |
Module : SPARQLParser
Author : Manuel Ohlendorf
Maintainer : Manuel Ohlendorf
Stability : experimental
Portability: portable
Version :
The SPARQL query language Parsec parser. Exports the main parser. The grammar of the query language can be found here: <file:../grammar.txt>
-}
--Some of the parsers cover more than one production. Some abbreviations have been commented out.
module SPARQLParser
(parseSPARQL)
where
import Char
(toLower
,toUpper
)
import Text.ParserCombinators.Parsec
import SPARQLDataTypes
import RDFDataTypes
import Monad
import Text.XML.HXT.Parser.XmlParser
(skipS0
)
-- some useful token and symbol parser
xsd, rdf, rdfType, booleanD, integerD, doubleD :: String
xsd = "http://www.w3.org/2001/XMLSchema#"
rdf = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
rdfType = rdf ++"type"
booleanD = xsd ++ "boolean"
doubleD = xsd ++ "double"
integerD = xsd ++ "integer"
lbrace, rbrace, dot, com, semcol :: Parser ()
lbrace = tokenParser (symbol "{")
rbrace = tokenParser (symbol "}")
dot = tokenParser (symbol ".")
com = tokenParser (symbol ",")
semcol = tokenParser (symbol ";")
caseChar :: Char -> CharParser st Char
caseChar c = satisfy (\x -> toUpper x == toUpper c) <?> ""
caseString :: String -> CharParser st ()
caseString cs = mapM_ caseChar cs <?> ""
tokenParser :: Parser String -> Parser ()
tokenParser p
= try ( do
skipS0
p
skipS0
)
symbol :: String -> Parser String
symbol s = try (string s)
-- | The main entry point to the parser.
-- Creates a 'Query' as result, which contains all SPARQL abbreviations.
-- In order to evaluate the result, it has to be normalised before.
-- see "SPARQLFunctions" for normalisation function
parseSPARQL :: Parser Query
parseSPARQL
= do
skipS0
qr <- query
skipS0
eof
return qr
-- [1] in the case of 'SELECT *' a query is returned, which matches every triple
query :: Parser Query
query
= do
caseString "SELECT"
skipS0
a <- do string "*"
return (["s","p","o"])
<|> selectClause
skipS0
b <- option [] whereClause
return (if b == [] then (QueryN a [triple])
else (Query a (GraphPattern b)))
where triple = TriplePatN (SubjectVar "s") (PredicateVar "p") (ObjectVar "o")
-- [2]
selectClause :: Parser [Var]
selectClause
= do
a <- varPlus
return a
-- not part of the gramma
varPlus :: Parser [Var]
varPlus = do
a <- var
skipS0
b <- many var
return (a :b)
-- [3]
whereClause :: Parser [PatternElement]
whereClause
= do
caseString "WHERE"
skipS0
a <- graphPattern
skipS0
eof
return a
--[4]
graphPattern :: Parser [PatternElement]
graphPattern
= do
lbrace
a <- patternElementsList
rbrace <?> "end of graph pattern"
return (a)
-- [5]
patternElementsList :: Parser [PatternElement]
patternElementsList
= do
skipS0
a <- patternElement
b <- option [] patternElementsListTail
return (a : b)
--[6]
patternElementsListTail :: Parser [PatternElement]
patternElementsListTail
= do
dot
a <- option [] patternElementsList
return a
-- [7]
patternElement:: Parser PatternElement
patternElement = do
skipS0
pe <- do tr <- triples
return (PET tr)
<|>
do gr <- graphPattern
return (PEG gr)
return pe
--[8]
triples :: Parser TriplePattern
triples = do
subj <- do
v <- var
return (SubjectVar v)
<|>
do
g <- graphTerm
return (Subject g)
predObL <- propertyListNotEmpty
return (TriplePat subj predObL)
-- [9]
propertyList:: Parser [(Predicate,[Object])]
propertyList = do
a <- option [] propertyListNotEmpty
return a
-- [10]
propertyListNotEmpty:: Parser [(Predicate,[Object])]
propertyListNotEmpty = do
skipS0
p <- (do
v <- var
return (PredicateVar v)
<|>
do
u <- uri
return (Predicate u)
<|>
do
string "a"
return (Predicate rdfType)
)
skipS0
obl <- objectList
skipS0
t <- option [] propertyListTail
return ((p,obl):t)
-- [11]
propertyListTail:: Parser [(Predicate,[Object])]
propertyListTail = do
semcol
a <- option [] propertyList
return a
-- [12]
objectList :: Parser [Object]
objectList = do
a <- object
b <- option [] objectTail
return (a:b)
-- [13]
objectTail :: Parser [Object]
objectTail = do
com
a <- option [] (objectList)
return (a)
-- [14]
--verb :: Parser String
--verb = varOrURI -- <|> string "a"
-- [15]
object :: Parser Object
object = do v <- var
return (ObjectVar v)
<|>
do g <- graphTerm
return (Object g)
--original:
-- varOrTerm <|> triplesNode <?> "object"
-- [16]
{-varOrURI :: Parser String
varOrURI = do v <- var
return (show v)
<|>
do u <- uri
return (show u)
-- [17]
varOrTerm :: Parser String
varOrTerm = do v <- var
return (show v)
<|>
do g <- graphTerm
return (show g)
-}
-- [18][32]
var :: Parser Var
var = do {
; char '?' <|> char '$'
; variable <- (ncname2 <|> ncname1)
; skipS0
; return (variable)
}
<?> "Variable"
-- [19] [26]
graphTerm :: Parser RDFTerm
graphTerm = do
a <-rdfTerm
return (a)
-- <|>
-- (string "()" <?> "")
-- [20]
rdfTerm :: Parser RDFTerm
rdfTerm = do u <- uri
return (URIRef u)
<|> rdfLiteral
<|> blankNode
<|> numericLiteral
<|> booleanLiteral
-- [21]
numericLiteral :: Parser RDFTerm
numericLiteral = do i <- try floatingPoint
return (RDFTypedLiteral i doubleD)
<|>
do f <- integerP
return (RDFTypedLiteral f integerD)
-- [22]
rdfLiteral :: Parser RDFTerm
rdfLiteral = do
a <- stringP
(b,c) <- option ("","") (do l <-langtag
return (l,"")
<|>
do string "\^\^"
u <- uri
return ("",u)
)
return (if (c =="")
then if (b == "")
then (RDFLiteral a)
else (RDFLangLiteral a b)
else (RDFTypedLiteral a c)
)
<?> "RDF Literal"
-- [23]
booleanLiteral :: Parser RDFTerm
booleanLiteral = do caseString "TRUE"
return (RDFTypedLiteral "TRUE" booleanD)
<|>
do caseString "FALSE"
return (RDFTypedLiteral "FALSE" booleanD)
<?> "Boolean Literal"
-- [25] [27] [30]
uri :: Parser URI
uri = do {char '<'
;theUri <-many (noneOf ">")
;char '>' <?> "end of URI"
;return (theUri)
}
<?> "URI"
-- [26]
blankNode :: Parser RDFTerm
blankNode
= do
lab <- bnode_label
return (BlankNode lab)
<?> "BlankNode"-- <|> string "[]"
-- [28] Integer [37] <INTEGER_10> und [42] <DIGITS>
integerP :: Parser String
integerP = many1 digit <?> "Integer"
--[29] [38]
floatingPoint :: Parser String
floatingPoint
= do
a <- many1 digit
b <- try (do
char '.'
c <- many digit
d <- option "" exponentP
return ('.':c++d)
<|>
exponentP
)
return (a++b)
<|>
do
char '.'
a <- many1 digit
b <- option "" exponentP
return ("0."++a++b)
<?> "floating point"
-- [39]
exponentP :: Parser String
exponentP = do
a <- oneOf "eE"
b <- option '+' (oneOf "+-")
c <- many1 digit
return (a:b:c)
<?> "exponent"
--[31]
bnode_label :: Parser String
bnode_label = do
string "_:"
lab <- (ncname2 <|> ncname1)
return lab
-- [33][34][35][36]
langtag :: Parser String
langtag
= do {char '@'
;s1 <- many1 letter
;s2 <- many (do
char '-'
s3 <- (many1 alphaNum)
return ('-' : s3)
)
;return ((map toLower) $ (s1 ++ (concat s2)))
}
<?> "Language Tag"
-- [24]
stringP :: Parser String
stringP = string_literal1 <|> string_literal2
--[40]
string_literal1 :: Parser String
string_literal1
= do
char '\''
str <- (many (noneOf "'\\\n\r"))
char '\''
return str
--[41]
string_literal2 :: Parser String
string_literal2
= do
char '"'
str <- (many (noneOf "\"\\\n\r"))
char '"'
return str
-- [43]
ncchar1 :: Parser Char
ncchar1 = oneOf ['A' .. 'Z']
<|> oneOf['a'..'z']
<|> oneOf ['\x00c0' .. '\x00D6']
<|> oneOf ['\x00D8' .. '\x00F6']
<|> oneOf ['\x00F8' .. '\x02FF']
<|> oneOf ['\x0370' .. '\x037D']
<|> oneOf ['\x037F' .. '\x1FFF']
<|> oneOf ['\x200C' .. '\x200D']
<|> oneOf ['\x2070' .. '\x218F']
<|> oneOf ['\x2C00' .. '\x2FEF']
<|> oneOf ['\x3001' .. '\xD7FF']
<|> oneOf ['\xF900' .. '\xFFFF']
-- [44] [45]
ncchar_end :: Parser Char
ncchar_end = ncchar1 <|> char '_' <|> char '-' <|> digit <|> char '\x00B7'
-- [45]
--ncchar_full :: Parser Char
--ncchar_full = ncchar_end <|> char '.'
--[46]
ncname1 :: Parser String
ncname1 = do
c <- ncchar1
rs1 <- many ncchar_end
rs2 <- many ( do
xs1 <- many1 (char '.')
xs2 <- many1 ncchar_end
return (xs1 ++ xs2)
)
return (c : rs1 ++ concat rs2)
--[47]
ncname2 :: Parser String
ncname2 = do
c <- char '_'
rs1 <- many ncchar_end
rs2 <- many ( do
xs1 <- many1 (char '.')
xs2 <- many1 ncchar_end
return (xs1 ++ xs2)
)
return (c : rs1 ++ concat rs2)