{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DoAndIfThenElse #-}
module Text.RDF.RDF4H.TurtleParser
( TurtleParser(TurtleParser)
, TurtleParserCustom(TurtleParserCustom)
, parseTurtleDebug
) 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.Either
import Data.Semigroup ((<>))
import Data.RDF.Types
import Data.RDF.IRI
import Data.RDF.Graph.TList
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 Data.Functor (($>))
import qualified Data.Foldable as F
import Control.Monad
import Text.Parser.Char
import Text.Parser.Combinators
import Text.Parser.LookAhead
import Control.Applicative hiding (empty)
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 )
parseTurtleDebug :: String -> IO (RDF TList)
parseTurtleDebug f = fromRight empty <$> parseFile (TurtleParserCustom (Just . BaseUrl $ "http://base-url.com/") (Just "http://doc-url.com/") Attoparsec) f
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' $> 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 $> "."))
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 $> 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 ')') $> 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
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) $> 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 = parseFromURL (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 = parseFromURL (parseStringAttoparsec bUrl docUrl)
initialState :: Maybe BaseUrl -> Maybe T.Text -> ParseState
initialState bUrl docUrl = (BaseUrl <$> 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 $ mconcat ["Cannot resolve IRI: ", m, " ", show (mbUrl, mdUrl, iriFrag)]