{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DoAndIfThenElse #-}
module Text.RDF.RDF4H.TurtleParser
( TurtleParser(TurtleParser)
, TurtleParserCustom(TurtleParserCustom)
) where
import Prelude hiding (readFile)
import Data.Attoparsec.Text (parse,IResult(..))
import Data.Char (toLower, toUpper, isDigit, isHexDigit)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe
import Data.RDF.Types
import Data.RDF.IRI
import Data.RDF.Namespace
import Text.RDF.RDF4H.ParserUtils
import Text.RDF.RDF4H.NTriplesParser
import Text.Parsec (runParser, ParseError)
import qualified Data.Text as T
import Data.Sequence (Seq, (|>))
import qualified Data.Foldable as F
import Control.Monad
import Text.Parser.Char
import Text.Parser.Combinators
import Text.Parser.LookAhead
import Control.Applicative
import Control.Monad.State.Class
import Control.Monad.State.Strict
data TurtleParser = TurtleParser (Maybe BaseUrl) (Maybe T.Text)
data TurtleParserCustom = TurtleParserCustom (Maybe BaseUrl) (Maybe T.Text) Parser
instance RdfParser TurtleParser where
parseString (TurtleParser bUrl dUrl) = parseStringParsec bUrl dUrl
parseFile (TurtleParser bUrl dUrl) = parseFileParsec bUrl dUrl
parseURL (TurtleParser bUrl dUrl) = parseURLParsec bUrl dUrl
instance RdfParser TurtleParserCustom where
parseString (TurtleParserCustom bUrl dUrl Parsec) = parseStringParsec bUrl dUrl
parseString (TurtleParserCustom bUrl dUrl Attoparsec) = parseStringAttoparsec bUrl dUrl
parseFile (TurtleParserCustom bUrl dUrl Parsec) = parseFileParsec bUrl dUrl
parseFile (TurtleParserCustom bUrl dUrl Attoparsec) = parseFileAttoparsec bUrl dUrl
parseURL (TurtleParserCustom bUrl dUrl Parsec) = parseURLParsec bUrl dUrl
parseURL (TurtleParserCustom bUrl dUrl Attoparsec) = parseURLAttoparsec bUrl dUrl
type ParseState =
( Maybe BaseUrl
, Maybe T.Text
, Integer
, PrefixMappings
, Maybe Subject
, Maybe Predicate
, Seq Triple
, Map String Integer )
t_turtleDoc :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m (Seq Triple, PrefixMappings)
t_turtleDoc =
many t_statement *> (eof <?> "eof") *> gets (\(_, _, _, pms, _, _, ts,_) -> (ts, pms))
t_statement :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()
t_statement = directive <|> triples <|> void (some t_ws <?> "blankline-whitespace")
where
directive = void
(try t_directive
*> (many t_ws <?> "directive-whitespace2"))
triples = void
(try t_triples
*> (many t_ws <?> "triple-whitespace1")
*> (char '.' <?> "end-of-triple-period")
*> (many t_ws <?> "triple-whitespace2"))
t_triples :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()
t_triples = try subjectWithPOL <|> blankNodePropertyListWithPOL
where
subjectWithPOL = t_subject *> many t_ws *> t_predicateObjectList *> resetSubjectPredicate
blankNodePropertyListWithPOL = t_blankNodePropertyList >>= \bn
-> many t_ws
*> setSubjectPredicate (Just bn) Nothing
*> optional t_predicateObjectList
*> resetSubjectPredicate
t_blankNodePropertyList :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node
t_blankNodePropertyList = withConstantSubjectPredicate $
between (char '[') (char ']') $ do
bn <- nextBlankNode
setSubjectPredicate (Just bn) Nothing
void (many t_ws *> t_predicateObjectList *> many t_ws)
return bn
t_directive :: (CharParsing m, MonadState ParseState m) => m ()
t_directive = t_prefixID <|> t_base <|> t_sparql_prefix <|> t_sparql_base
t_iri :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m T.Text
t_iri = try t_iriref <|> t_prefixedName
t_prefixedName :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m T.Text
t_prefixedName = try t_pname_ln <|> t_pname_ns
t_prefixID :: (CharParsing m, MonadState ParseState m) => m ()
t_prefixID = do
void (try (string "@prefix" <?> "@prefix-directive"))
void (some t_ws <?> "whitespace-after-@prefix")
pre <- option mempty (try t_pn_prefix) <* char ':'
void (some t_ws <?> "whitespace-after-@prefix-colon")
iriFrag <- t_iriref
void (many t_ws <?> "prefixID-whitespace")
void (char '.' <?> "end-of-prefixID-period")
(bUrl, dUrl, _, PrefixMappings pms, _, _, _, _) <- get
iri <- tryIriResolution bUrl dUrl iriFrag
updatePMs $ Just (PrefixMappings $ Map.insert pre iri pms)
t_sparql_prefix :: (CharParsing m, MonadState ParseState m) => m ()
t_sparql_prefix = do
void (try (caseInsensitiveString "PREFIX" <?> "@prefix-directive"))
void (some t_ws <?> "whitespace-after-PREFIX")
pre <- option mempty (try t_pn_prefix) <* char ':'
void (some t_ws <?> "whitespace-after-PREFIX-colon")
iriFrag <- t_iriref
(bUrl, dUrl, _, PrefixMappings pms, _, _, _, _) <- get
iri <- tryIriResolution bUrl dUrl iriFrag
updatePMs $ Just (PrefixMappings $ Map.insert pre iri pms)
t_base :: (CharParsing m, MonadState ParseState m) => m ()
t_base = do
void (try (string "@base" <?> "@base-directive"))
void (some t_ws <?> "whitespace-after-@base")
iriFrag <- t_iriref
void (many t_ws <?> "base-whitespace")
void (char '.') <?> "end-of-base-period"
bUrl <- currBaseUrl
dUrl <- currDocUrl
newBaseIri <- BaseUrl <$> tryIriResolution bUrl dUrl iriFrag
updateBaseUrl (Just $ Just newBaseIri)
t_sparql_base :: (CharParsing m, MonadState ParseState m) => m ()
t_sparql_base = do
void (try (caseInsensitiveString "BASE" <?> "@sparql-base-directive"))
void (some t_ws <?> "whitespace-after-BASE")
iriFrag <- t_iriref
bUrl <- currBaseUrl
dUrl <- currDocUrl
newBaseIri <- BaseUrl <$> tryIriResolution bUrl dUrl iriFrag
updateBaseUrl (Just $ Just newBaseIri)
t_verb :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()
t_verb = try t_predicate <|> (char 'a' *> pure rdfTypeNode) >>= setPredicate
t_predicate :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node
t_predicate = UNode <$> (t_iri <?> "resource")
t_pname_ns :: (CharParsing m, MonadState ParseState m) => m T.Text
t_pname_ns = do
pre <- option mempty (try t_pn_prefix) <* char ':'
(_, _, _, pms, _, _, _, _) <- get
case resolveQName pre pms of
Just n -> pure n
Nothing -> unexpected ("Cannot resolve QName prefix: " ++ T.unpack pre)
t_pn_local :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m T.Text
t_pn_local = do
x <- t_pn_chars_u_str <|> string ":" <|> satisfy_str <|> t_plx
xs <- option "" $ try $ do
let recsve = (t_pn_chars_str <|> string ":" <|> t_plx) <|>
(t_pn_chars_str <|> string ":" <|> t_plx <|> try (string "." <* lookAhead (try recsve))) <|>
(t_pn_chars_str <|> string ":" <|> t_plx <|> try (string "." *> notFollowedBy t_ws *> pure "."))
concat <$> many recsve
pure (T.pack (x ++ xs))
where
satisfy_str = pure <$> satisfy isDigit
t_pn_chars_str = pure <$> t_pn_chars
t_pn_chars_u_str = pure <$> t_pn_chars_u
t_plx :: (CharParsing m, Monad m) => m String
t_plx = t_percent <|> t_pn_local_esc_str
where t_pn_local_esc_str = pure <$> t_pn_local_esc
t_percent :: (CharParsing m, Monad m) => m String
t_percent = sequence [char '%', t_hex, t_hex]
t_pn_local_esc :: CharParsing m => m Char
t_pn_local_esc = char '\\' *> oneOf "_~.-!$&'()*+,;=/?#@%"
t_pname_ln :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m T.Text
t_pname_ln = T.append <$> t_pname_ns <*> t_pn_local
t_subject :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()
t_subject = iri <|> t_blankNode <|> t_collection >>= setSubject
where iri = unode <$> (try t_iri <?> "subject resource")
t_blankNode :: (CharParsing m, MonadState ParseState m) => m Node
t_blankNode = do
genID <- try t_blank_node_label <|> (t_anon *> pure mempty)
mp <- currGenIdLookup
maybe (newBN genID) getExistingBN (Map.lookup genID mp)
where
newBN genID = do
i <- nextIdCounter
when (genID /= mempty) (addGenIdLookup genID i)
return $ BNodeGen (fromIntegral i)
getExistingBN = return . BNodeGen . fromIntegral
t_blank_node_label :: (CharParsing m, MonadState ParseState m) => m String
t_blank_node_label = do
void (string "_:")
firstChar <- t_pn_chars_u <|> satisfy isDigit
try $ (firstChar:) <$> otherChars
where
otherChars = option "" $ do
xs <- many (t_pn_chars <|> char '.')
if null xs
then pure xs
else if last xs == '.'
then unexpected "'.' at the end of a blank node label"
else pure xs
t_anon :: CharParsing m => m ()
t_anon = void (between (char '[') (char ']') (many t_ws))
t_predicateObjectList :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()
t_predicateObjectList = void $ sepEndBy1 (try verbObjectList) (try separator)
where verbObjectList = t_verb *> some t_ws *> t_objectList
separator = some (many t_ws *> char ';' *> many t_ws)
t_objectList :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()
t_objectList = do
(t_object <?> "object") >>= addTripleForObject
void $ many (try (many t_ws *> char ',' *> many t_ws *> t_object >>= addTripleForObject))
t_object :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node
t_object = try (UNode <$> t_iri)
<|> try t_blankNode
<|> try t_collection
<|> try t_blankNodePropertyList
<|> t_literal
t_collection :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node
t_collection = withConstantSubjectPredicate $
between (char '(') (char ')') $ do
void (many t_ws)
root <- try empty_list <|> non_empty_list
void (many t_ws)
return root
where
empty_list = lookAhead (char ')') *> return rdfNilNode
non_empty_list = do
ns <- sepEndBy1 element (some t_ws)
addTripleForObject rdfNilNode
return (head ns)
element = do
o <- t_object
bn <- nextBlankNode
s <- getSubject
when (isJust s) (addTripleForObject bn)
setSubjectPredicate (Just bn) (Just rdfFirstNode)
addTripleForObject o
setPredicate rdfRestNode
return bn
getSubject = get >>= \(_, _, _, _, s, _, _, _) -> pure s
rdfTypeNode, rdfNilNode, rdfFirstNode, rdfRestNode :: Node
rdfTypeNode = UNode $ mkUri rdf "type"
rdfNilNode = UNode $ mkUri rdf "nil"
rdfFirstNode = UNode $ mkUri rdf "first"
rdfRestNode = UNode $ mkUri rdf "rest"
xsdIntUri, xsdDoubleUri, xsdDecimalUri, xsdBooleanUri :: T.Text
xsdIntUri = mkUri xsd "integer"
xsdDoubleUri = mkUri xsd "double"
xsdDecimalUri = mkUri xsd "decimal"
xsdBooleanUri = mkUri xsd "boolean"
t_literal :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node
t_literal =
LNode <$> try t_rdf_literal <|>
(`mkLNode` xsdDoubleUri) <$> try t_double <|>
(`mkLNode` xsdDecimalUri) <$> try t_decimal <|>
(`mkLNode` xsdIntUri) <$> try t_integer <|>
(`mkLNode` xsdBooleanUri) <$> t_boolean
where
mkLNode :: T.Text -> T.Text -> Node
mkLNode bsType bs' = LNode (typedL bsType bs')
t_rdf_literal :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m LValue
t_rdf_literal = do
str <- t_string
option (plainL str) (langTag str <|> typeIRI str)
where
langTag str = plainLL str <$> try t_langtag
typeIRI str = typedL str <$> try (count 2 (char '^') *> t_iri)
t_string :: (CharParsing m, Monad m) => m T.Text
t_string = try t_string_literal_long_double_quote
<|> try t_string_literal_long_single_quote
<|> try t_string_literal_double_quote
<|> t_string_literal_single_quote
t_string_literal_double_quote :: (CharParsing m, Monad m) => m T.Text
t_string_literal_double_quote = nt_string_literal_quote
t_string_literal_single_quote :: (CharParsing m, Monad m) => m T.Text
t_string_literal_single_quote = string_literal_quote '\''
t_string_literal_long_single_quote :: (CharParsing m, Monad m) => m T.Text
t_string_literal_long_single_quote = between (string "'''") (string "'''") $ do
ss <- many $ try $ do
s1 <- T.pack <$> option "" (try (string "''") <|> string "'")
s2 <- T.singleton <$> (noneOf ['\'','\\'] <|> t_echar <|> t_uchar)
pure (s1 `T.append` s2)
pure (T.concat ss)
t_string_literal_long_double_quote :: (CharParsing m, Monad m) => m T.Text
t_string_literal_long_double_quote = between (string "\"\"\"") (string "\"\"\"") $ do
ss <- many $ try $ do
s1 <- T.pack <$> option "" (try (string "\"\"") <|> string "\"")
s2 <- T.singleton <$> (noneOf ['"','\\'] <|> t_echar <|> t_uchar)
pure (s1 `T.append` s2)
pure (T.concat ss)
t_langtag :: (CharParsing m, Monad m) => m T.Text
t_langtag = nt_langtag
t_echar :: (CharParsing m, Monad m) => m Char
t_echar = nt_echar
t_uchar :: (CharParsing m, Monad m) => m Char
t_uchar = nt_uchar
t_integer :: (CharParsing m, Monad m) => m T.Text
t_integer = try $ do
sign <- sign_parser <?> "+-"
ds <- some (satisfy isDigit <?> "digit")
pure $! ( T.pack sign `T.append` T.pack ds)
t_double :: (CharParsing m, Monad m) => m T.Text
t_double = do
sign <- sign_parser <?> "+-"
rest <- try (do { ds <- (some (satisfy isDigit) <?> "digit") <* char '.';
ds' <- many (satisfy isDigit) <?> "digit";
e <- t_exponent <?> "exponent";
pure ( T.pack ds `T.snoc` '.' `T.append` T.pack ds' `T.append` e) }) <|>
try (do { ds <- char '.' *> some (satisfy isDigit) <?> "digit";
e <- t_exponent <?> "exponent";
pure ('.' `T.cons` T.pack ds `T.append` e) }) <|>
(do { ds <- some (satisfy isDigit) <?> "digit";
e <- t_exponent <?> "exponent";
pure ( T.pack ds `T.append` e) })
pure $! T.pack sign `T.append` rest
sign_parser :: CharParsing m => m String
sign_parser = option "" (pure <$> oneOf "-+")
t_decimal :: (CharParsing m, Monad m) => m T.Text
t_decimal = try $ do
sign <- sign_parser
dig1 <- many (satisfy isDigit) <* char '.'
dig2 <- some (satisfy isDigit)
pure (T.pack sign `T.append` T.pack dig1 `T.append` T.pack "." `T.append` T.pack dig2)
t_exponent :: (CharParsing m, Monad m) => m T.Text
t_exponent = do e <- oneOf "eE"
s <- option "" (pure <$> oneOf "-+")
ds <- some digit
pure $! (e `T.cons` ( T.pack s `T.append` T.pack ds))
t_boolean :: CharParsing m => m T.Text
t_boolean = T.pack <$> try (string "true" <|> string "false")
t_comment :: CharParsing m => m ()
t_comment = void (char '#' *> many (noneOf "\n\r"))
t_ws :: CharParsing m => m ()
t_ws = (void (try (oneOf "\t\n\r "))) <|> try t_comment
<?> "whitespace-or-comment"
t_pn_prefix :: (CharParsing m, MonadState ParseState m) => m T.Text
t_pn_prefix = do
i <- try t_pn_chars_base
r <- option "" (many (try t_pn_chars <|> char '.'))
pure (T.pack (i:r))
t_iriref :: (CharParsing m, MonadState ParseState m) => m T.Text
t_iriref = between (char '<') (char '>') $ do
iriFrag <- iriFragment
bUrl <- currBaseUrl
dUrl <- currDocUrl
tryIriResolution bUrl dUrl iriFrag
t_pn_chars_base :: CharParsing m => m Char
t_pn_chars_base = nt_pn_chars_base
t_pn_chars_u :: CharParsing m => m Char
t_pn_chars_u = t_pn_chars_base <|> char '_'
t_pn_chars :: CharParsing m => m Char
t_pn_chars = t_pn_chars_u <|> char '-' <|> char '\x00B7' <|> satisfy f
where f = flip in_range [('0', '9'), ('\x0300', '\x036F'), ('\x203F', '\x2040')]
t_hex :: CharParsing m => m Char
t_hex = satisfy isHexDigit <?> "hexadecimal digit"
{-# INLINE in_range #-}
in_range :: Char -> [(Char, Char)] -> Bool
in_range c = any (\(c1, c2) -> c >= c1 && c <= c2)
currGenIdLookup :: MonadState ParseState m => m (Map String Integer)
currGenIdLookup = gets $ \(_, _, _, _, _, _, _,genMap) -> genMap
addGenIdLookup :: MonadState ParseState m => String -> Integer -> m ()
addGenIdLookup genId counter =
modify $ \(bUrl, dUrl, i, pms, s, p, ts, genMap) ->
(bUrl, dUrl, i, pms, s, p, ts, Map.insert genId counter genMap)
currBaseUrl :: MonadState ParseState m => m (Maybe BaseUrl)
currBaseUrl = gets $ \(bUrl, _, _, _, _, _, _,_) -> bUrl
currDocUrl :: MonadState ParseState m => m (Maybe T.Text)
currDocUrl = gets $ \(_, dUrl, _, _, _, _, _,_) -> dUrl
updateBaseUrl :: MonadState ParseState m => Maybe (Maybe BaseUrl) -> m ()
updateBaseUrl val = _modifyState val no no no no no
nextIdCounter :: MonadState ParseState m => m Integer
nextIdCounter = get >>= \(bUrl, dUrl, i, pms, s, p, ts, genMap) ->
put (bUrl, dUrl, i+1, pms, s, p, ts, genMap) *> pure i
nextBlankNode :: MonadState ParseState m => m Node
nextBlankNode = BNodeGen . fromIntegral <$> nextIdCounter
updatePMs :: MonadState ParseState m => Maybe PrefixMappings -> m ()
updatePMs val = _modifyState no no val no no no
no :: Maybe a
no = Nothing
withConstantSubjectPredicate :: MonadState ParseState m => m a -> m a
withConstantSubjectPredicate a = do
(_, _, _, _, s, p, _, _) <- get
a' <- a
(bUrl, dUrl, n, pms, _, _, ts, genMap) <- get
put (bUrl, dUrl, n, pms, s, p, ts, genMap)
return a'
setSubjectPredicate :: MonadState ParseState m => Maybe Subject -> Maybe Predicate -> m ()
setSubjectPredicate s p =
modify $ \(bUrl, dUrl, n, pms, _, _, ts, genMap) ->
(bUrl, dUrl, n, pms, s, p, ts, genMap)
setSubject :: MonadState ParseState m => Subject -> m ()
setSubject s =
modify $ \(bUrl, dUrl, n, pms, _, p, ts, genMap) ->
(bUrl, dUrl, n, pms, Just s, p, ts, genMap)
setPredicate :: MonadState ParseState m => Predicate -> m ()
setPredicate p =
modify $ \(bUrl, dUrl, n, pms, s, _, ts, genMap) ->
(bUrl, dUrl, n, pms, s, Just p, ts, genMap)
resetSubjectPredicate :: MonadState ParseState m => m ()
resetSubjectPredicate = setSubjectPredicate Nothing Nothing
_modifyState :: MonadState ParseState m =>
Maybe (Maybe BaseUrl) -> Maybe (Integer -> Integer) -> Maybe PrefixMappings ->
Maybe (Maybe Subject) -> Maybe (Maybe Predicate) -> Maybe (Seq Triple) ->
m ()
_modifyState mb_bUrl mb_n mb_pms mb_subj mb_pred mb_trps = do
(_bUrl, _dUrl, _n, _pms, _s, _p, _ts, genMap) <- get
put ( fromMaybe _bUrl mb_bUrl
, _dUrl
, maybe _n (const _n) mb_n
, fromMaybe _pms mb_pms
, maybe _s (const _s) mb_subj
, maybe _p (const _p) mb_pred
, fromMaybe _ts mb_trps, genMap )
addTripleForObject :: (CharParsing m, MonadState ParseState m) => Object -> m ()
addTripleForObject obj = do
(bUrl, dUrl, i, pms, s, p, ts, genMap) <- get
t <- getTriple s p
put (bUrl, dUrl, i, pms, s, p, ts |> t, genMap)
where
getTriple Nothing _ = unexpected $ "No Subject with which to create triple for: " ++ show obj
getTriple _ Nothing = unexpected $ "No Predicate with which to create triple for: " ++ show obj
getTriple (Just s') (Just p') = pure $ Triple s' p' obj
parseURLParsec :: (Rdf a) =>
Maybe BaseUrl
-> Maybe T.Text
-> String
-> IO (Either ParseFailure (RDF a))
parseURLParsec bUrl docUrl = _parseURL (parseStringParsec bUrl docUrl)
parseFileParsec :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure (RDF a))
parseFileParsec bUrl docUrl fpath =
readFile fpath >>= \c -> pure $ handleResult bUrl (runParser (evalStateT t_turtleDoc (initialState bUrl docUrl)) () (maybe "" T.unpack docUrl) c)
parseStringParsec :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> Either ParseFailure (RDF a)
parseStringParsec bUrl docUrl ttlStr = handleResult bUrl (runParser (evalStateT t_turtleDoc (initialState bUrl docUrl)) () "" ttlStr)
parseStringAttoparsec :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> Either ParseFailure (RDF a)
parseStringAttoparsec bUrl docUrl t = handleResult' $ parse (evalStateT t_turtleDoc (initialState bUrl docUrl)) t
where
handleResult' res = case res of
Fail _ _ err ->
Left $ ParseFailure $ "Parse failure: \n" ++ show err
Partial f -> handleResult' (f mempty)
Done _ (ts,pms) -> Right $! mkRdf (F.toList ts) bUrl pms
parseFileAttoparsec :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure (RDF a))
parseFileAttoparsec bUrl docUrl path = parseStringAttoparsec bUrl docUrl <$> readFile path
parseURLAttoparsec :: (Rdf a) =>
Maybe BaseUrl
-> Maybe T.Text
-> String
-> IO (Either ParseFailure (RDF a))
parseURLAttoparsec bUrl docUrl = _parseURL (parseStringAttoparsec bUrl docUrl)
initialState :: Maybe BaseUrl -> Maybe T.Text -> ParseState
initialState bUrl docUrl = (bUrl, docUrl, 1, PrefixMappings mempty, Nothing, Nothing, mempty, mempty)
handleResult :: Rdf a => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure (RDF a)
handleResult bUrl result = case result of
(Left err) -> Left (ParseFailure $ "Parse failure: \n" ++ show err)
(Right (ts, pms)) -> Right $! mkRdf (F.toList ts) bUrl pms
caseInsensitiveChar :: CharParsing m => Char -> m Char
caseInsensitiveChar c = char (toLower c) <|> char (toUpper c)
caseInsensitiveString :: (CharParsing m, Monad m) => String -> m String
caseInsensitiveString s = try (mapM caseInsensitiveChar s) <?> "\"" ++ s ++ "\""
tryIriResolution :: (CharParsing m, Monad m) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> m T.Text
tryIriResolution mbUrl mdUrl iriFrag = tryIriResolution' mbUrl mdUrl
where
tryIriResolution' (Just (BaseUrl bIri)) _ = either err pure (resolveIRI bIri iriFrag)
tryIriResolution' _ (Just dIri) = either err pure (resolveIRI dIri iriFrag)
tryIriResolution' _ _ = either err pure (resolveIRI mempty iriFrag)
err m = unexpected $ "Cannot resolve IRI: " ++ m ++ " " ++ show (mbUrl, mdUrl, iriFrag)