--------------------------------------------------------------------------------
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : N3Parser
-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke
-- License : GPL V2
--
-- Maintainer : Douglas Burke
-- Stability : experimental
-- Portability : H98
--
-- This Module implements a Notation 3 parser (see [1], [2], [3]), returning a
-- new 'RDFGraph' consisting of triples and namespace information parsed from
-- the supplied N3 input string, or an error indication.
--
-- Uses the Parsec monadic parser library.
--
-- REFERENCES:
--
-- 1
-- Notation3 (N3): A readable RDF syntax,
-- W3C Team Submission 14 January 2008
--
-- 2
-- Tim Berners-Lee's design issues series notes and description
--
-- 3
-- Notation 3 Primer by Sean Palmer
--
-- NOTES:
--
-- UTF-8 handling is not really tested.
--
-- No performance testing has been applied.
--
-- Not all N3 grammar elements are supported, including:
--
-- - @\@forSome@ (we read it in but ignore the arguments)
--
-- - @\@forAll@ (this causes a parse error)
--
-- - formulae are lightly tested
--
-- - string support is incomplete (e.g. unrecognized escape characters
-- such as @\\q@ are probably handled incorrectly)
--
--------------------------------------------------------------------------------
module Swish.RDF.N3Parser
( ParseResult
, parseN3
, parseN3fromString
, parseAnyfromString
, parseTextFromString, parseAltFromString
, parseNameFromString, parsePrefixFromString
, parseAbsURIrefFromString, parseLexURIrefFromString, parseURIref2FromString
-- * Exports for parsers that embed Notation3 in a bigger syntax
, N3Parser, N3State(..), SpecialMap
, whiteSpace, symbol, lexeme, eof, identStart, identLetter
--
, getPrefix -- a combination of the old defaultPrefix and namedPrefix productions
, n3symbol -- replacement for uriRef2 -- TODO: check this is semantically correct
, quickVariable -- was varid
, lexUriRef
, document, subgraph
, newBlankNode
)
where
import Swish.RDF.RDFGraph
( RDFGraph, RDFLabel(..)
, ToRDFLabel(..)
, NamespaceMap
, LookupFormula(..)
, addArc
, setFormula
, setNamespaces
, emptyRDFGraph
)
import Swish.RDF.GraphClass (arc)
import Swish.Utils.LookupMap
( LookupMap(..)
, LookupEntryClass(..)
, mapFind, mapFindMaybe, mapReplaceOrAdd, mapAdd, mapReplace )
import Swish.Utils.Namespace
( Namespace(..)
, ScopedName(..)
, getScopedNameURI
, makeScopedName, makeUriScopedName
, makeQNameScopedName
, nullScopedName
)
import Swish.Utils.QName (QName, getQNameURI)
import Swish.RDF.Vocabulary
( langName
, rdf_type
, rdf_first, rdf_rest, rdf_nil
, owl_sameAs, log_implies
, xsd_boolean, xsd_integer, xsd_decimal, xsd_double
)
import Swish.RDF.RDFParser
( SpecialMap
, mapPrefix
, prefixTable, specialTable
, ParseResult, RDFParser
, n3Style, n3Lexer, ignore
, annotateParsecError
, mkTypedLit
)
import Control.Applicative
import Control.Monad (forM_, foldM)
import Network.URI (URI,
relativeTo,
parseURI, parseURIReference, uriToString)
import Data.Maybe (fromMaybe, fromJust)
import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
import qualified Text.ParserCombinators.Parsec as PC
import qualified Text.ParserCombinators.Parsec.Token as P
import Data.Char (isSpace, chr)
----------------------------------------------------------------------
-- Set up token parsers
----------------------------------------------------------------------
lexer :: P.TokenParser N3State
lexer = n3Lexer
whiteSpace :: N3Parser ()
whiteSpace = P.whiteSpace lexer
symbol :: String -> N3Parser String
symbol = P.symbol lexer
lexeme :: N3Parser a -> N3Parser a
lexeme = P.lexeme lexer
identStart , identLetter :: CharParser st Char
identStart = P.identStart n3Style
identLetter = P.identLetter n3Style
----------------------------------------------------------------------
-- Define parser state and helper functions
----------------------------------------------------------------------
-- | N3 parser state
data N3State = N3State
{ graphState :: RDFGraph -- Graph under construction
, thisNode :: RDFLabel -- current context node (aka 'this')
, prefixUris :: NamespaceMap -- namespace prefix mapping table
, syntaxUris :: SpecialMap -- special name mapping table
, nodeGen :: Int -- blank node id generator
, keywordsList :: [String] -- contents of the @keywords statement
, allowLocalNames :: Bool -- True if @keywords used so that bare names are QNames in default namespace
}
-- | Functions to update N3State vector (use with Parsec updateState)
setPrefix :: String -> String -> N3State -> N3State
setPrefix pre uri st = st { prefixUris=p' }
where
p' = mapReplaceOrAdd (Namespace pre uri) (prefixUris st)
-- | Set name for special syntax element
setSName :: String -> ScopedName -> N3State -> N3State
setSName nam snam st = st { syntaxUris=s' }
where
s' = mapReplaceOrAdd (nam,snam) (syntaxUris st)
setSUri :: String -> String -> N3State -> N3State
setSUri nam suri = setSName nam (makeScopedName "" suri "")
-- | Set the list of tokens that can be used without needing the leading
-- \@ symbol.
setKeywordsList :: [String] -> N3State -> N3State
setKeywordsList ks st = st { keywordsList = ks, allowLocalNames = True }
-- Functions to access state:
-- | Get name for special syntax element, default null
getSName :: N3State -> String -> ScopedName
getSName st nam = mapFind nullScopedName nam (syntaxUris st)
getSUri :: N3State -> String -> String
getSUri st nam = getScopedNameURI $ getSName st nam
-- Map prefix to namespace
getPrefixNs :: N3State -> String -> Namespace
getPrefixNs st pre = Namespace pre (mapPrefix (prefixUris st) pre)
getKeywordsList :: N3State -> [String]
getKeywordsList = keywordsList
getAllowLocalNames :: N3State -> Bool
getAllowLocalNames = allowLocalNames
-- Return function to update graph in N3 parser state,
-- using the supplied function of a graph
-- (use returned function with Parsec updateState)
updateGraph :: ( RDFGraph -> RDFGraph ) -> N3State -> N3State
updateGraph f s = s { graphState = f (graphState s) }
----------------------------------------------------------------------
-- Define top-level parser function:
-- accepts a string and returns a graph or error
----------------------------------------------------------------------
type N3Parser a = RDFParser N3State a
-- | Parse a string as N3 (with no real base URI).
--
-- See 'parseN3' if you need to provide a base URI.
--
parseN3fromString ::
String -- ^ input in N3 format.
-> ParseResult
parseN3fromString = parseAnyfromString document Nothing
-- | Parse a string with an optional base URI.
--
-- See also 'parseN3fromString'.
--
parseN3 ::
String -- ^ input in N3 format.
-> Maybe QName -- ^ optional base URI
-> ParseResult
parseN3 = flip (parseAnyfromString document)
{-
-- useful for testing
test :: String -> RDFGraph
test = either error id . parseAnyfromString document Nothing
-}
-- | Function to supply initial context and parse supplied term.
--
-- We augment the Parsec error with the context.
--
parseAnyfromString :: N3Parser a -- ^ parser to apply
-> Maybe QName -- ^ base URI of the input, or @Nothing@ to use default base value
-> String -- ^ input to be parsed
-> Either String a
parseAnyfromString parser mbase input =
let pmap = LookupMap [] -- [Namespace "" "#"] -- [] -- emptyLookupMap -- LookupMap prefixTable
muri = fmap makeQNameScopedName mbase
smap = LookupMap $ specialTable muri
pstate = N3State
{ graphState = emptyRDFGraph
, thisNode = NoNode
, prefixUris = pmap
, syntaxUris = smap
, nodeGen = 0
, keywordsList = ["a", "is", "of", "true", "false"] -- not 100% sure about true/false here
, allowLocalNames = False
}
puri = case mbase of
Just base -> fmap showURI $ appendUris (getQNameURI base) "#"
_ -> Right "#"
-- this is getting a bit ugly
in case puri of
Left emsg -> Left $ "Invalid base: " ++ emsg
Right p -> case runParser parser (setPrefix "" p pstate) "" input of
Right res -> Right res
Left err -> Left $ annotateParsecError 1 (lines input) err
newBlankNode :: N3Parser RDFLabel
newBlankNode = do
s <- getState
let n = succ (nodeGen s)
setState $ s { nodeGen = n }
return $ Blank (show n)
-- Test functions for selected element parsing
parseTextFromString :: String -> String -> Either String String
parseTextFromString s =
parseAnyfromString (string s) Nothing
parseAltFromString :: String -> String -> String -> Either String String
parseAltFromString s1 s2 =
parseAnyfromString ( string s1 <|> string s2 ) Nothing
parseNameFromString :: String -> Either String String
parseNameFromString =
parseAnyfromString n3Name Nothing
{-
This has been made tricky by the attempt to remove the default list
of prefixes from the starting point of a N3 parse and the subsequent
attempt to add every new namespace we come across to the parser state.
So we add in the original default namespaces for testing, since
this routine is really for testing.
-}
addTestPrefixes :: N3Parser ()
addTestPrefixes = updateState $ \st -> st { prefixUris = LookupMap prefixTable } -- should append to existing map
parsePrefixFromString :: String -> Either String Namespace
parsePrefixFromString =
parseAnyfromString p Nothing
where
p = do
addTestPrefixes
pref <- n3Name
st <- getState
return (getPrefixNs st pref) -- map prefix to namespace
parseAbsURIrefFromString :: String -> Either String String
parseAbsURIrefFromString =
parseAnyfromString (fmap showURI explicitURI) Nothing
-- parseAnyfromString absUriRef Nothing
parseLexURIrefFromString :: String -> Either String String
parseLexURIrefFromString =
parseAnyfromString lexUriRef Nothing
parseURIref2FromString :: String -> Either String ScopedName
parseURIref2FromString =
parseAnyfromString (addTestPrefixes >> n3symbol) Nothing
-- parseAnyfromString uriRef2 Nothing
----------------------------------------------------------------------
-- Syntax productions
----------------------------------------------------------------------
{-
TODO:
- this parser is a *lot* slower than the original one
-}
-- helper routines
comma, semiColon , fullStop :: N3Parser ()
comma = ignore $ symbol ","
semiColon = ignore $ symbol ";"
fullStop = ignore $ symbol "."
-- a specialization of bracket/between
br :: String -> String -> N3Parser a -> N3Parser a
br lsym rsym = between (symbol lsym) (symbol rsym)
-- The @ character is optional if the keyword is in the
-- keyword list
--
atSign :: String -> N3Parser ()
atSign s = do
st <- getState
let p = ignore $ char '@'
if s `elem` getKeywordsList st
then PC.optional p
else p
atWord :: String -> N3Parser String
atWord s = do
atSign s
-- TODO: does it really make sense to add the not-followed-by-a-colon rule here?
-- apply to both cases even though should only really be necessary
-- when the at sign is not given
--
lexeme $ string s *> notFollowedBy (char ':')
return s
showURI :: URI -> String
showURI u = uriToString id u ""
-- TODO: look at using URIs throughout
getScopedNameURI' :: URI -> String
getScopedNameURI' = showURI
-- getScopedNameURI' = getScopedNameURI . makeUriScopedName . showURI
{-
Since operatorLabel can be used to add a label with an
unknown namespace, we need to ensure that the namespace
is added if not known. If the namespace prefix is already
in use then it is over-written (rather than add a new
prefix for the label).
TODO:
- could we use the reverse lookupmap functionality to
find if the given namespace URI is in the namespace
list? If it is, use it's key otherwise do a
mapReplaceOrAdd for the input namespace.
-}
operatorLabel :: ScopedName -> N3Parser RDFLabel
operatorLabel snam@(ScopedName sns _) = do
st <- getState
let opmap = prefixUris st
pkey = entryKey sns
pval = entryVal sns
rval = Res snam
-- the lookup and the replacement could be fused
case mapFindMaybe pkey opmap of
Just val | val == pval -> return rval
| otherwise -> do
setState $ st { prefixUris = mapReplace opmap sns }
return rval
_ -> do
setState $ st { prefixUris = mapAdd opmap sns }
return rval
{-
Add statement to graph in N3 parser state.
To support literals that are written directly/implicitly - i.e. as
true/false/1/1.0/1.0e23 - rather than a string with an explicit
datatype we need to special case handling of the object label for
literals. Is this actually needed? The N3 Formatter now doesn't
display the xsd: datatypes on output, but there may be issues with
other formats (e.g RDF/XML once it is supported).
-}
type AddStatement = RDFLabel -> N3Parser ()
addStatement :: RDFLabel -> RDFLabel -> AddStatement
addStatement s p o@(Lit _ (Just dtype)) | dtype `elem` [xsd_boolean, xsd_integer, xsd_decimal, xsd_double] = do
st <- getState
let stmt = arc s p o
oldp = prefixUris st
ogs = graphState st
newp = mapReplaceOrAdd (snScope dtype) oldp
setState $ st { prefixUris = newp, graphState = addArc stmt ogs }
addStatement s p o = updateState (updateGraph (addArc (arc s p o) ))
addStatementRev :: RDFLabel -> RDFLabel -> AddStatement
addStatementRev o p s = addStatement s p o
{-
A number of productions require a name, which starts with
[A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]
and then has
[\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*
we encode this as the n3Name production
-}
initChar , bodyChar :: String
initChar =
['A'..'Z'] ++ "_" ++ ['a'..'z'] ++
map chr
([0x00c0..0x00d6] ++ [0x00d8..0x00f6] ++ [0x00f8..0x02ff] ++ [0x0370..0x037d] ++ [0x037f..0x1fff] ++ [0x200c..0x200d] ++ [0x2070..0x218f] ++ [0x2c00..0x2fef] ++ [0x3001..0xd7ff] ++ [0xf900..0xfdcf] ++ [0xfdf0..0xfffd] ++ [0x00010000..0x000effff])
bodyChar =
'-' : ['0'..'9'] ++ ['A'..'Z'] ++ "_" ++ ['a'..'z'] ++
map chr
(0x00b7 : [0x00c0..0x00d6] ++ [0x00d8..0x00f6] ++ [0x00f8..0x037d] ++ [0x037f..0x1fff] ++ [0x200c..0x200d] ++ [0x203f..0x2040] ++ [0x2070..0x218f] ++ [0x2c00..0x2fef] ++ [0x3001..0xd7ff] ++ [0xf900..0xfdcf] ++ [0xfdf0..0xfffd] ++ [0x00010000..0x000effff])
n3Name :: N3Parser String
n3Name = (:) <$> n3Init <*> n3Body
where
n3Init = oneOf initChar > "Initial character of a name"
n3Body = many (oneOf bodyChar) > "Body of the name"
{-
quickvariable ::= \?[A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*
-}
-- TODO: is mapping to Var correct?
quickVariable :: N3Parser RDFLabel
quickVariable = char '?' *> (Var <$> n3Name) > "quickvariable"
{-
string ::= ("""[^"\\]*(?:(?:\\.|"(?!""))[^"\\]*)*""")|("[^"\\]*(?:\\.[^"\\]*)*")
or
string ::= tripleQuoted | singleQUoted
-}
n3string :: N3Parser String
n3string = tripleQuoted <|> singleQuoted > "string"
{-
singleQuoted ::= "[^"\\]*(?:\\.[^"\\]*)*"
asciiChars :: String
asciiChars = map chr [0x20..0x7e]
asciiCharsN3 :: String
asciiCharsN3 = filter (`notElem` "\\\"") asciiChars
-}
-- the grammer has only upper-case A-F but some lower case values
-- seen in the wild, so support them
--
ntHexDigit :: N3Parser Char
ntHexDigit = oneOf $ ['0'..'9'] ++ ['A'..'F'] ++ ['a'..'f']
hex4 :: N3Parser Char
hex4 = do
digs <- count 4 ntHexDigit
let dstr = "0x" ++ digs
dchar = read dstr :: Int
return $ chr dchar
hex8 :: N3Parser Char
hex8 = do
digs <- count 8 ntHexDigit
let dstr = "0x" ++ digs
dchar = read dstr :: Int
if dchar <= 0x10FFFF
then return $ chr dchar
else unexpected "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"
{-
This is very similar to NTriples accept that also allow the escaping of '
even though it is not required.
The Python rules allow \N{name}, where name is the Unicode name. It's
not clear whether we need to support this too, so for now we do not.
-}
protectedChar :: N3Parser Char
protectedChar =
(char 't' *> return '\t')
<|> (char 'n' *> return '\n')
<|> (char 'r' *> return '\r')
<|> (char '"' *> return '"')
<|> (char '\'' *> return '\'')
<|> (char '\\' *> return '\\')
<|> (char 'u' *> hex4)
<|> (char 'U' *> hex8)
-- Accept an escape character or any character as long as it isn't
-- a new-line or quote. Unrecognized escape sequences should therefore
-- be left alone by this.
--
n3Character :: N3Parser Char
n3Character =
(char '\\' *> (protectedChar <|> return '\\'))
<|> noneOf "\"\n"
{-
<|> (oneOf asciiCharsN3 > "ASCII character")
-- TODO: bodyChar and asciiCharsN3 overlap
<|> (oneOf bodyChar > "Unicode character")
-}
sQuot :: N3Parser Char
sQuot = char '"'
singleQuoted :: N3Parser String
singleQuoted = between sQuot sQuot $ many n3Character
{-
tripleQUoted ::= """[^"\\]*(?:(?:\\.|"(?!""))[^"\\]*)*"""
-}
tripleQuoted :: N3Parser String
tripleQuoted = tQuot *> manyTill (n3Character <|> sQuot <|> char '\n') tQuot
where
tQuot = try (count 3 sQuot)
getDefaultPrefix :: N3Parser Namespace
getDefaultPrefix = do
s <- getState
return (getPrefixNs s "")
addBase :: URI -> N3Parser ()
addBase = updateState . setSUri "base" . getScopedNameURI'
addPrefix :: Maybe String -> URI -> N3Parser ()
addPrefix p = updateState . setPrefix (fromMaybe "" p) . getScopedNameURI'
{-|
Update the set of keywords that can be given without
an \@ sign.
-}
updateKeywordsList :: [String] -> N3Parser ()
updateKeywordsList = updateState . setKeywordsList
{-
document ::= | statements_optional EOF
-}
document :: N3Parser RDFGraph
document = mkGr <$> (whiteSpace *> statementsOptional *> eof *> getState)
where
mkGr s = setNamespaces (prefixUris s) (graphState s)
{-
statements_optional ::= | statement "." statements_optional
| void
-}
statementsOptional :: N3Parser ()
statementsOptional = ignore $ endBy (lexeme statement) fullStop
{-
statement ::= | declaration
| existential
| simpleStatement
| universal
-}
statement :: N3Parser ()
statement =
declaration
<|> existential
<|> universal
<|> simpleStatement
-- having an error here leads to less informative errors in general, it seems
-- > "statement (existential or universal quantification or a simple statement)"
{-
declaration ::= | "@base" explicituri
| "@keywords" barename_csl
| "@prefix" prefix explicituri
-}
-- TODO: do we need the try statements here? atWord would need to have a try on '@'
-- (if applicable) which should mean being able to get rid of try
--
declaration :: N3Parser ()
declaration =
(try (atWord "base") >> explicitURI >>= addBase)
<|>
(try (atWord "keywords") >> bareNameCsl >>= updateKeywordsList)
<|>
(try (atWord "prefix") *> getPrefix)
> "declaration"
getPrefix :: N3Parser ()
getPrefix = do
p <- lexeme prefix
u <- explicitURI
addPrefix p u
{-
explicituri ::= <[^>]*>
Note: white space is to be ignored within <>
-}
explicitURI :: N3Parser URI
explicitURI = do
let lb = char '<'
rb = char '>'
-- TODO: do the whitespace definitions match?
ustr <- between lb (rb > "end of URI '>'") $ many (satisfy (/= '>'))
let uclean = filter (not . isSpace) ustr
s <- getState
let base = getSUri s "base"
case appendUris base uclean of
Right uri -> return uri
Left emsg -> fail emsg
appendUris :: String -> String -> Either String URI
appendUris base uri =
case parseURI uri of
Just absuri -> Right absuri
_ -> case parseURIReference uri of
Just reluri ->
let baseuri = fromJust $ parseURI base
in case relativeTo reluri baseuri of
Just resuri -> Right resuri
_ -> Left $ "Unable to append <" ++ uri ++ "> to base=<" ++ base ++ ">"
_ -> Left $ "Invalid URI: <" ++ uri ++ ">"
-- production from the old parser
lexUriRef :: N3Parser String
lexUriRef = fmap showURI $ lexeme explicitURI
{-
barename ::= [A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*
barename_csl ::= | barename barename_csl_tail
| void
barename_csl_tail ::= | "," barename barename_csl_tail
| void
-}
bareNameCsl :: N3Parser [String]
bareNameCsl = sepBy (lexeme bareName) comma
bareName :: N3Parser String
bareName = n3Name > "barename"
{-
prefix ::= ([A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*)?:
-}
prefix :: N3Parser (Maybe String)
prefix = optional (lexeme n3Name) <* char ':'
> "prefix name"
{-
symbol ::= | explicituri
| qname
symbol_csl ::= | symbol symbol_csl_tail
| void
symbol_csl_tail ::= | "," symbol symbol_csl_tail
| void
-}
n3symbol :: N3Parser ScopedName
n3symbol =
((makeUriScopedName . showURI) <$> explicitURI)
<|> qname
> "symbol"
symbolCsl :: N3Parser [ScopedName]
symbolCsl = sepBy (lexeme n3symbol) comma
{-
qname ::= (([A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*)?:)?[A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*
TODO:
Note that, for now, we explicitly handle blank nodes
(of the form _:name) direcly in pathItem'.
This is not a good idea since qname' is used elsewhere
and so shouldn't we do the same thing there too?
-}
qname :: N3Parser ScopedName
qname =
(char ':' *> toSN getDefaultPrefix)
<|> (n3Name >>= fullOrLocalQName)
> "QName"
where
toSN p = ScopedName <$> p <*> (n3Name <|> return "")
fullOrLocalQName :: String -> N3Parser ScopedName
fullOrLocalQName name =
(char ':' *> fullQName name)
<|> localQName name
fullQName :: String -> N3Parser ScopedName
fullQName name = do
pre <- findPrefix name
lname <- n3Name <|> return ""
return $ ScopedName pre lname
findPrefix :: String -> N3Parser Namespace
findPrefix pre = do
st <- getState
case mapFindMaybe pre (prefixUris st) of
Just uri -> return $ Namespace pre uri
Nothing -> unexpected $ "Prefix '" ++ pre ++ ":' not bound."
localQName :: String -> N3Parser ScopedName
localQName name = do
st <- getState
if getAllowLocalNames st
then do
pre <- getDefaultPrefix
return $ ScopedName pre name
else fail "Invalid 'bare' word" -- TODO: not ideal error message; can we handle this case differently?
{-
existential ::= | "@forSome" symbol_csl
For now we just read in the symbols and ignore them,
since we do not mark blank nodes as existentially quantified
(we assume this is the case).
TODO: fix this?
-}
existential :: N3Parser ()
existential = try (atWord "forSome") *> symbolCsl >> return ()
{-
simpleStatement ::= | subject propertylist
-}
simpleStatement :: N3Parser ()
simpleStatement = subject >>= propertyListWith
{-
subject ::= | expression
-}
subject :: N3Parser RDFLabel
subject = lexeme expression
{-
expression ::= | pathitem pathtail
pathtail ::= | "!" expression
| "^" expression
| void
-}
expression :: N3Parser RDFLabel
expression = do
i <- pathItem
let backwardExpr = char '!' *> return addStatementRev
forwardExpr = char '^' *> return addStatement
mpt <- optional
( (,) <$> lexeme (forwardExpr <|> backwardExpr) <*> lexeme expression )
case mpt of
Nothing -> return i
Just (addFunc, pt) -> do
bNode <- newBlankNode
addFunc bNode pt i
return bNode
{-
pathitem ::= | "(" pathlist ")"
| "[" propertylist "]"
| "{" formulacontent "}"
| boolean
| literal
| numericliteral
| quickvariable
| symbol
pathlist ::= | expression pathlist
| void
Need to think about how to handle formulae, since need to know the context
of the call to know where to add them.
TOOD: may include direct support for blank nodes here,
namely convert _:stringval -> Blank stringval since although
this should be done by symbol the types don't seem to easily match
up (at first blush anyway)
-}
pathItem :: N3Parser RDFLabel
pathItem =
br "(" ")" pathList
<|> br "[" "]" propertyListBNode
<|> br "{" "}" formulaContent
<|> try boolean
<|> literal
<|> numericLiteral
<|> quickVariable
<|> Blank <$> (string "_:" *> n3Name) -- TODO a hack that needs fixing
<|> Res <$> n3symbol
> "pathitem"
{-
we create a blank node for the list and return it, whilst
adding the list contents to the graph
-}
pathList :: N3Parser RDFLabel
pathList = do
cts <- many (lexeme expression) > "pathlist"
eNode <- operatorLabel rdf_nil
case cts of
[] -> return eNode
(c:cs) -> do
sNode <- newBlankNode
first <- operatorLabel rdf_first
addStatement sNode first c
lNode <- foldM addElem sNode cs
rest <- operatorLabel rdf_rest
addStatement lNode rest eNode
return sNode
where
addElem prevNode curElem = do
bNode <- newBlankNode
first <- operatorLabel rdf_first
rest <- operatorLabel rdf_rest
addStatement prevNode rest bNode
addStatement bNode first curElem
return bNode
{-
formulacontent ::= | statementlist
statementlist ::= | statement statementtail
| void
statementtail ::= | "." statementlist
| void
-}
restoreState :: N3State -> N3Parser N3State
restoreState origState = do
oldState <- getState
setState $ origState { nodeGen = nodeGen oldState }
return oldState
{-
We create a subgraph and assign it to a blank node, returning the
blank node. At present it is a combination of the subgraph and formula
productions from the origial parser.
TODO: is it correct?
-}
formulaContent :: N3Parser RDFLabel
formulaContent = do
bNode <- newBlankNode
pstate <- getState
let fstate = pstate { graphState = emptyRDFGraph, thisNode = bNode }
setState fstate
statementList
oldState <- restoreState pstate
updateState $ updateGraph $ setFormula (Formula bNode (graphState oldState))
return bNode
subgraph :: RDFLabel -> N3Parser RDFGraph
subgraph this = do
pstate <- getState
let fstate = pstate { graphState = emptyRDFGraph, thisNode = this }
setState fstate -- switch new state into parser
statementsOptional -- parse statements of formula
oldState <- restoreState pstate
return $ graphState oldState
statementList :: N3Parser ()
statementList = ignore $ sepEndBy (lexeme statement) fullStop
{-
boolean ::= | "@false"
| "@true"
-}
boolean :: N3Parser RDFLabel
boolean = mkTypedLit xsd_boolean <$>
(try (atWord "false") <|> atWord "true")
{-
dtlang ::= | "@" langcode
| "^^" symbol
| void
literal ::= | string dtlang
langcode ::= [a-z]+(-[a-z0-9]+)*
-}
literal :: N3Parser RDFLabel
literal = Lit <$> n3string <*> optionMaybe dtlang
dtlang :: N3Parser ScopedName
dtlang =
(char '@' *> langcode > "langcode")
<|> (try (string "^^") *> n3symbol)
> "dtlang"
langcode :: N3Parser ScopedName
langcode = do
h <- many1 (oneOf ['a'..'z']) > "start of langcode (a to z)"
mt <- optionMaybe ( (:) <$> char '-' <*> many1 (oneOf (['a'..'z'] ++ ['0'..'9']))) > "a to z or 0 to 9 (langcode after the hyphen)"
return $ langName $ h ++ fromMaybe "" mt
{-
decimal ::= [-+]?[0-9]+(\.[0-9]+)?
double ::= [-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)
integer ::= [-+]?[0-9]+
numericliteral ::= | decimal
| double
| integer
TODO: we could convert via something like
maybeRead value :: Double >>= Just . toRDFLabel
which would mean we store the canonical XSD value in the
label, but it is not useful for the xsd:decimal case
since we currently don't have a Haskell type that
goes with it.
-}
numericLiteral :: N3Parser RDFLabel
numericLiteral =
-- try (mkTypedLit xsd_double <$> n3double)
try (d2s <$> n3double)
<|> try (mkTypedLit xsd_decimal <$> n3decimal)
<|> mkTypedLit xsd_integer <$> n3integer
> "numericliteral"
n3sign :: N3Parser Char
n3sign = char '+' <|> char '-'
n3integer :: N3Parser String
n3integer = do
ms <- optionMaybe n3sign
ds <- many1 digit
case ms of
Just s -> return $ s : ds
_ -> return ds
n3decimal :: N3Parser String
n3decimal = (++) <$> n3integer <*> ( (:) <$> char '.' <*> many1 digit )
n3double :: N3Parser String
n3double = (++) <$> n3decimal <*> ( (:) <$> oneOf "eE" <*> n3integer )
-- convert a double, as returned by n3double, into it's
-- canonical XSD form
d2s :: String -> RDFLabel
d2s s = toRDFLabel (read s :: Double)
{-
propertylist ::= | verb object objecttail propertylisttail
| void
propertylisttail ::= | ";" propertylist
| void
-}
-- it's probably important that bNode is created *after*
-- processing the plist (mainly for the assumptions made by
-- formatting the output as N3; e.g. list/sequence ordering)
--
propertyListBNode :: N3Parser RDFLabel
propertyListBNode = do
plist <- sepEndBy ((,) <$> lexeme verb <*> objectList) semiColon
bNode <- newBlankNode
let addList ((addFunc,vrb),items) = mapM_ (addFunc bNode vrb) items
forM_ plist addList
return bNode
propertyListWith :: RDFLabel -> N3Parser ()
propertyListWith subj =
let -- term = lexeme verb >>= objectListWith subj
term = lexeme verb >>= \(addFunc, vrb) -> objectListWith (addFunc subj vrb)
in ignore $ sepEndBy term semiColon
{-
object ::= | expression
objecttail ::= | "," object objecttail
| void
We change the production rule from objecttail to objectlist for lists of
objects (may change back).
May be an optimisation needed in the case of
:s :p :o1 , .. , :o.
Is parsec creating the list of actions, using sepBy1
in objectListWith, and then evaluating them all once the list
has been created?
-}
object :: N3Parser RDFLabel
object = lexeme expression
objectList :: N3Parser [RDFLabel]
objectList = sepBy1 object comma
objectWith :: AddStatement -> N3Parser ()
objectWith addFunc = object >>= addFunc
objectListWith :: AddStatement -> N3Parser ()
objectListWith addFunc =
ignore $ sepBy1 (objectWith addFunc) comma
{-
objectList1 :: N3Parser [RDFLabel]
objectList1 = sepBy1 object comma
-}
{-
verb ::= | "<="
| "="
| "=>"
| "@a"
| "@has" expression
| "@is" expression "@of"
| expression
-}
verb :: N3Parser (RDFLabel -> RDFLabel -> AddStatement, RDFLabel)
verb =
-- we check reverse first so that <= is tried before looking for a URI via expression rule
(,) addStatementRev <$> verbReverse
<|> (,) addStatement <$> verbForward
> "verb"
-- those verbs for which subject is on the right and object on the left
verbReverse :: N3Parser RDFLabel
verbReverse =
try (string "<=") *> operatorLabel log_implies
<|> between (try (atWord "is")) (atWord "of") (lexeme expression)
-- those verbs with subject on the left and object on the right
verbForward :: N3Parser RDFLabel
verbForward =
(try (string "=>") *> operatorLabel log_implies)
<|> (string "=" *> operatorLabel owl_sameAs)
<|> (try (atWord "a") *> operatorLabel rdf_type)
<|> (atWord "has" *> lexeme expression)
<|> lexeme expression
{-
universal ::= | "@forAll" symbol_csl
TODO: what needs to be done to support universal quantification
-}
universal :: N3Parser ()
universal =
try (atWord "forAll") *>
unexpected "universal (@forAll) currently unsupported."
-- will be something like: *> symbolCsl
{-
-- OLD --
-- helper routines
isymbol :: String -> N3Parser ()
isymbol s = symbol s >> return ()
-- document = directive* statement-list
document :: N3Parser RDFGraph
document = do
whiteSpace
_ <- many directive
statements
eof
s <- getState
return $ setNamespaces (prefixUris s) (graphState s)
-- directive = "@prefix" prefix ":" uriRef2 "." // Namespace declaration
-- | "@prefix" ":" uriRef2 "." // Default namespace
-- | "@equivalence" uriRef2 "." // Alternative to daml:equivalent
-- | "@listfirst" uriRef2 "." // Alternative to n3:first
-- | "@listrest" uriRef2 "." // Alternative to n3:rest
-- | "@listnull" uriRef2 "." // Alternative to n3:null
-- | "@plus" uriRef2 "." // Alternative to operator:plus
-- | "@minus" uriRef2 "." // Alternative to operator:minus
-- | "@slash" uriRef2 "." // Alternative to operator:slash
-- | "@star" uriRef2 "." // Alternative to operator:star
-- | "@base" uriRef2 "." // Base URI for relative URIs.
directive :: N3Parser ()
directive =
(try (symbol "@prefix") >> (defaultPrefix <|> namedPrefix))
<|> (string "@" >> syntaxUri)
> "directive"
defaultPrefix :: N3Parser ()
defaultPrefix = do
u <- br ":" "." uriRef2
updateState $ setPrefix "" (getScopedNameURI u)
namedPrefix :: N3Parser ()
namedPrefix = do
n <- name
u <- br ":" "." uriRef2
updateState $ setPrefix n (getScopedNameURI u)
syntaxUri :: N3Parser ()
syntaxUri = do
s <- uriName
u <- uriRef2
isymbol "."
updateState $ setSUri s (getScopedNameURI u)
uriName :: N3Parser String
uriName =
try (symbol "equivalence")
<|> try (symbol "listfirst")
<|> try (symbol "listrest")
<|> try (symbol "listnull")
<|> try (symbol "plus")
<|> try (symbol "minus")
<|> try (symbol "slash")
<|> try (symbol "star")
<|> try (symbol "base")
> "special URI directive"
-- statements = [ statement ( "." statement )* ]
--
-- statement = subject property-list
--
-- properties = [ property ( ";" property )* ]
--
-- New statements are added to the user state graph
statements :: N3Parser ()
statements = sepEndBy1 statement (symbol ".") >> return ()
statement :: N3Parser ()
-- statement = subject >>= optional . properties -- when using Parsec's optional
statement = subject >>= optional . properties >> return () -- not sure this is exactly the same as with Parsec
properties :: RDFLabel -> N3Parser ()
properties subj = sepBy1 (property subj) (symbol ";") >> return ()
-- property = verb object-list
-- | ":-" anon-node // Creates anon-node aongside the current node
-- verb = ">-" prop "->" // has 'prop' of
-- | "<-" prop "<-" // is 'prop' of
-- | operator // has operator:'operator' of (???)
-- | prop // has 'prop' of -- shorthand
-- | "has" prop "of" // has 'prop' of
-- | "is" prop "of" // is 'prop' of
-- | "a" // has rdf:type of
-- | "=" // has daml:equivalent of
--
-- subj is the subject node for these properties.
--
-- New statements are added to the graph in the parser's user state.
property :: RDFLabel -> N3Parser ()
property subj =
(verb >>= uncurry (objects subj))
<|>
(isymbol ":-" >> anonNode subj >> return ())
verb :: N3Parser (RDFLabel,Bool)
verb =
(prop >>= \p -> return (p, False))
<|> (operator >>= \p -> return (p, False))
<|> (br ">-" "->" prop >>= \p -> return (p, False))
<|> (br "<-" "<-" prop >>= \p -> return (p, True))
<|> (br "has" "of" prop >>= \p -> return (p, False))
<|> (br "is" "of" prop >>= \p -> return (p, True))
<|> (symbol "a" >> operatorLabel rdf_type >>= \lab -> return (lab, False))
<|> (symbol "=" >> operatorLabel owl_sameAs >>= \lab -> return (lab, False))
> "property"
-- objects = object
-- | object "," object-list
--
-- subj is the subject node for the new statements,
-- prop is the property node for the new statements.
-- swap is true if the subject/object values in the resulting statement
-- are to be swapped (for "is of", etc.)
--
-- New statements are added to the graph in the parser's user state
objects :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()
objects subj ppty swap =
sepBy1 (object subj ppty swap) (symbol ",") >> return ()
-- anonNode = "[" property-list "]" // Something with given properties
-- | "{" statement-list "}" // List of statements as resource
-- | "(" node-list ")" // Construct list with
-- // rdf:first, rdf:rest, rdf:nil
--
-- subj is the subject node with which the new anonymous node is equated,
--
-- The anonymous node value is returned by this parser (which is often the same
-- as the supplied subject node, but not always).
--
-- New statements are added to the graph in the parser's user state
-- (in the case of a formula, a new graph and parser are created, and
-- the graph arcs are added to this new graph).
anonNode :: RDFLabel -> N3Parser RDFLabel
anonNode subj =
(br "[" "]" (properties subj) >> return subj)
<|> br "{" "}" (formula subj)
<|> br "(" ")" (nodeList subj)
> "anon node (\"[\", \"(\" or \"{\")"
-- This method allows a statement list to be parsed as a subgraph
-- whose value is associated with the supplied node of the current
-- graph.
formula :: RDFLabel -> N3Parser RDFLabel
formula subj = do
subgr <- subgraph subj
updateState
$ updateGraph
$ setFormula (Formula subj subgr)
return subj
subgraph :: RDFLabel -> N3Parser RDFGraph
subgraph this = do
pstate <- getState
let fstate = pstate { graphState = emptyRDFGraph, thisNode = this }
setState fstate -- switch new state into parser
statements -- parse statements of formula
fstate' <- getState
let nstate = pstate { nodeGen = nodeGen fstate' }
setState nstate -- swap back state, with updated nodeGen
return (graphState fstate')
-- prop = uri-ref2
-- | varid
--
-- Returns URI value as a Node
prop :: N3Parser RDFLabel
prop = nodeid <|> varid <|> uriNode
-- operator = "+" // >- operator:plus ->
-- | "-" // >- operator:minus ->
-- | "/" // >- operator:slash ->
-- | "*" // >- operator:star->
--
-- If matched, the operator is returned as a node value.
operator :: N3Parser RDFLabel
operator =
(symbol "+" >> operatorLabel operator_plus)
<|> (symbol "-" >> operatorLabel operator_minus)
<|> (symbol "*" >> operatorLabel operator_star)
<|> (symbol "/" >> operatorLabel operator_slash)
> ""
-- subject = node
subject :: N3Parser RDFLabel
subject = node
-- object = litNode
--
-- This production adds a new triple to the graph state,
-- using the supplied subject and property values.
-- If swap is True, the subject and object positions are
-- swapped.
object :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()
object subj ppty True = do
o <- litNode
addStatement o ppty subj
object subj ppty _ = do
o <- litNode
addStatement subj ppty o
-- nodeList = litNode*
--
-- subj is the node from which the list is linked.
--
-- Returns the supplied head of list or Nil node allocated.
--
-- Link first element of link to list head, scan rest of list,
-- and return the list head; otherwise return a node rdf_null.
--
-- This slightly convoluted pattern is to deal with two different
-- occurrences of a list node:
-- :- ( l1, l2, ... )
-- Here, (the supplied subj) is the listhead.
-- prop ( l1, l2, ... )
-- Here, the a new blank is supplied as subj to be the listhead.
-- In either case, if the list is non-empty, the supplied subj
-- is returned. But if the list is empty, a rdf_null node is returned.
-- In the second case, the invoking production must use the returned
-- value.
nodeList :: RDFLabel -> N3Parser RDFLabel
nodeList subj =
(do
val <- litNode
first <- operatorLabel rdf_first
addStatement subj first val
nodeList1 subj
return subj)
<|> operatorLabel rdf_nil
> "Node or ')'"
nodeList1 :: RDFLabel -> N3Parser ()
nodeList1 prev =
(do
val <- litNode
lnk <- newBlankNode
first <- operatorLabel rdf_first
rest <- operatorLabel rdf_rest
addStatement lnk first val
addStatement prev rest lnk
nodeList1 lnk)
<|> (do
nil <- operatorLabel rdf_nil
rest <- operatorLabel rdf_rest
addStatement prev rest nil)
> "Node or ')'"
-- lit-node = node
-- | str-node [ "@" lang ] [ "^^" uriRef2 ]
-- str-node = '"' constant-value '"'
-- | '"""' constant value '"""' // Including single or double occurences of
-- // quotes and/or newlines
--
-- Returns a new node value.
litNode :: N3Parser RDFLabel
litNode =
node
<|> liftM2 Lit strNode litTypeOrLang
> "URI, blank node or literal"
strNode :: N3Parser String
strNode =
tripleQuoteString
<|> singleQuoteString
litTypeOrLang :: N3Parser (Maybe ScopedName)
litTypeOrLang =
langTag
<|> typeUri
<|> return Nothing
> "'@tag' (language tag) or '^^name' (datatype URI)"
langTag :: N3Parser (Maybe ScopedName)
langTag =
fmap (Just . langName) (string "@" >> name)
> "'@tag' (language tag)"
typeUri :: N3Parser (Maybe ScopedName)
typeUri =
fmap Just (string "^^" >> uriRef2)
> "'^^name' (datatype URI)"
-- node = nodeid
-- | varid
-- | uri-ref2
-- | anon-node
--
-- nodeid = "_:" name
--
-- varid = "?" name
--
-- Returns a new node value.
node :: N3Parser RDFLabel
node = nodeid
<|> varid
<|> uriNode
<|> (newBlankNode >>= anonNode)
> "URI or blank node"
-- Identified blank node in input
--
-- Note that automatically generated blank node identifiers start with
-- a digit, where input node identifiers start with a letter, so there
-- can be no clash. Care is needed when serializing a graph to ensure
-- that future clashes are avoided.
nodeid :: N3Parser RDFLabel
-- nodeid = lexeme nodeid1
nodeid = fmap Blank (string "_:" >> name)
-- variable identifier
varid :: N3Parser RDFLabel
varid = fmap Var (string "?" >> name)
-- uriNode = qname
-- | "<" URI-reference ">"
-- | "this"
uriNode :: N3Parser RDFLabel
uriNode =
fmap Res uriRef2
<|> fmap thisNode (string "this" >> getState)
> "URI node"
-- uriRef2 = qname
-- | ":" local-name
-- | "<" URI-reference ">"
-- qname = prefix ":" local-name
--
-- prefix = name // Namespace prefix
--
-- local-name = name // Local name (namespace qualified)
--
-- name = alpha alphanumeric*
--
-- alpha = "a"-"z"
-- | "A"-"Z"
-- | "_"
--
-- alphanumeric = alpha
-- | "0"-"9"
--
-- URI-reference = (conforming to syntax in RFC2396)
--
-- uriRef2 returns a ScopedName.
uriRef2 :: N3Parser ScopedName
uriRef2 = lexeme (try uriRef2a)
> "URI or QName"
uriRef2a :: N3Parser ScopedName
uriRef2a =
liftM2 ScopedName prefix (colon >> localname)
<|> (colon >> liftM2 ScopedName defaultprefix localname)
<|> fmap makeUriScopedName absUriRef
> "URI or QName"
prefix :: N3Parser Namespace
prefix = do
pref <- prefixname
st <- getState
return (getPrefixNs st pref) -- map prefix to namespace
defaultprefix :: N3Parser Namespace
defaultprefix = do
st <- getState
return (getPrefixNs st "")
name :: N3Parser String
name = lexeme $ name1 identStart
prefixname :: N3Parser String
prefixname = name1 identStart
localname :: N3Parser String
localname = lexeme $ name1 identLetter
-- 'name1' is a name without following whitespace
-- initChar is a parser for the first character
name1 :: N3Parser Char -> N3Parser String
name1 initChar =
liftM2 (:) initChar (many identLetter)
> "identifier"
----------------------------------------------------------------------
-- Lexical support
----------------------------------------------------------------------
--
-- The following code adapted from ParsecToken,
-- modified to handle different escape conventions and triple-quoted strings
-- \c
-- \uhhhh
-- \Uhhhhhhhh
--
-- Regular single-quoted string -- cannot be split over line breaks
singleQuoteString :: N3Parser String
singleQuoteString =
lexeme
( between (char '"') (char '"' > "end of string (\")") anyStringChars
> "literal string" )
anyStringChars :: CharParser st String
anyStringChars =
fmap (foldr (maybe id (:)) "") (many stringChar)
-- Triple-quoted string -- may include line breaks, '"' or '""'.
tripleQuoteString :: N3Parser String
tripleQuoteString =
lexeme
(fmap (foldr (++) "") $ between (try $ string "\"\"\"")
(string "\"\"\"" > "end of string (\"\"\")")
(many tripleQuoteSubstring))
> "triple-quoted literal string"
-- Match non-quote substring or one or two quote characters
tripleQuoteSubstring :: N3Parser String
tripleQuoteSubstring =
tripleQuoteSubstring1
<|> try sqTripleQuoteSubstring1
<|> try dqTripleQuoteSubstring1
dqTripleQuoteSubstring1 :: N3Parser String
dqTripleQuoteSubstring1 =
fmap ("\"\""++) $ string "\"\"" >> tripleQuoteSubstring1
sqTripleQuoteSubstring1 :: N3Parser String
sqTripleQuoteSubstring1 =
fmap ('"':) $ char '"' >> tripleQuoteSubstring1
-- match at least one non-quote character in a triple-quoted string
tripleQuoteSubstring1 :: N3Parser String
tripleQuoteSubstring1 =
fmap (foldr (maybe id (:)) "") $ many1 tripleQuoteStringChar
tripleQuoteStringChar :: CharParser st (Maybe Char)
tripleQuoteStringChar =
stringChar <|> (string "\n" >> return (Just '\n'))
stringChar :: CharParser st (Maybe Char)
stringChar =
fmap Just stringLetter
<|> stringEscape
> "string character"
stringLetter :: CharParser st Char
stringLetter = satisfy (\c -> (c /= '"') && (c /= '\\') && (c >= '\032'))
stringEscape :: CharParser st (Maybe Char)
stringEscape =
fmap Just $ char '\\' >> escapeCode
-- escape codes
escapeCode :: CharParser st Char
escapeCode = charEsc <|> charUCS2 <|> charUCS4 > "escape code"
-- \c
charEsc :: CharParser st Char
charEsc = choice (map parseEsc escMap)
where
parseEsc (c,code) = fmap (const code) (char c)
escMap = zip "nrt\\\"\'" "\n\r\t\\\"\'"
-- \uhhhh
charUCS2 :: CharParser st Char
charUCS2 =
fmap chr $ char 'u' >> numberFW 16 hexDigit 4 0
-- \Uhhhhhhhh
charUCS4 :: CharParser st Char
charUCS4 =
fmap chr $ char 'U' >> numberFW 16 hexDigit 8 0
-- parse fixed-width number:
numberFW :: Int -> CharParser st Char -> Int -> Int -> CharParser st Int
numberFW _ _ 0 val = return val
numberFW base baseDigit width val = do
d <- baseDigit
numberFW base baseDigit (width-1) (val*base + digitToInt d)
----------------------------------------------------------------------
-- Parse a URI reference from the input
-- The result returned has absolute form; relative URIs are resolved
-- relative to the current base prefix (set using "@base").
--
-- lexeme version
lexUriRef :: N3Parser String
lexUriRef = lexeme absUriRef
-- from Swish.Utils.ProcessURI
absoluteUriPart :: String -- ^ URI base
-> String -- ^ URI reference
-> String
absoluteUriPart base rel = showURI $ fromJust $ relativeTo (fromJust (parseURIReference rel)) (fromJust (parseURI base))
absUriRef :: N3Parser String
absUriRef = do
u <- between (char '<') (char '>' > "end of URI '>'") anyUriChars
if isURI u
then return u
else if isURIReference u
then do
s <- getState
return $ absoluteUriPart (getSUri s "base") u
else fail ("Invalid URI: <"++u++">")
anyUriChars :: N3Parser String
anyUriChars = many uriChar
uriChar :: N3Parser Char
uriChar =
alphaNum
<|> oneOf "[];?:@&=+$,-_.!~*'()%//#"
> "URI character"
-}
--------------------------------------------------------------------------------
--
-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke
-- All rights reserved.
--
-- This file is part of Swish.
--
-- Swish is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- Swish is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with Swish; if not, write to:
-- The Free Software Foundation, Inc.,
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--
--------------------------------------------------------------------------------