rdf4h-4.0.2: src/Text/RDF/RDF4H/XmlParser.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | An parser for the RDF/XML format
-- <http://www.w3.org/TR/REC-rdf-syntax/>.
module Text.RDF.RDF4H.XmlParser
( XmlParser (..),
parseXmlDebug,
)
where
import Control.Applicative
import Control.Monad
import Control.Monad.Except
import Control.Monad.State.Strict
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif
#if MIN_VERSION_base(4,10,0)
import Data.Either
#else
#endif
import Data.Bifunctor
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BL
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import qualified Data.Map as Map
import Data.Maybe
import Data.RDF.Graph.TList
import Data.RDF.IRI
import Data.RDF.Types hiding (empty, resolveQName)
import qualified Data.RDF.Types as RDF
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as TIO
import qualified Data.Text.Lazy as TL
import Text.RDF.RDF4H.ParserUtils hiding (Parser)
import Text.RDF.RDF4H.XmlParser.Identifiers
import qualified Text.RDF.RDF4H.XmlParser.Xeno as Xeno
import Text.RDF.RDF4H.XmlParser.Xmlbf hiding (Node)
-- import Xmlbf hiding (Node, State)
-- import qualified Xmlbf.Xeno as Xeno
instance RdfParser XmlParser where
parseString (XmlParser bUrl dUrl) = parseXmlRDF bUrl dUrl
parseFile (XmlParser bUrl dUrl) = parseFile' bUrl dUrl
parseURL (XmlParser bUrl dUrl) = parseURL' bUrl dUrl
-- | Configuration for the XML parser
data XmlParser
= XmlParser
(Maybe BaseUrl)
-- ^ The /default/ base URI to parse the document.
(Maybe Text)
-- ^ The /retrieval URI/ of the XML document.
parseFile' ::
(Rdf a) =>
Maybe BaseUrl ->
Maybe Text ->
FilePath ->
IO (Either ParseFailure (RDF a))
parseFile' bUrl dUrl fpath = parseXmlRDF bUrl dUrl <$> TIO.readFile fpath
parseURL' ::
(Rdf a) =>
-- | The optional base URI of the document.
Maybe BaseUrl ->
-- | The document URI (i.e., the URI of the document itself); if Nothing, use location URI.
Maybe Text ->
-- | The location URI from which to retrieve the XML document.
String ->
-- | The parse result, which is either a @ParseFailure@ or the RDF
-- corresponding to the XML document.
IO (Either ParseFailure (RDF a))
parseURL' bUrl docUrl = parseFromURL (parseXmlRDF bUrl docUrl)
-- | The parser monad.
type Parser = ParserT (ExceptT String (State ParseState))
-- | Local state for the parser (dependant on the parent xml elements)
data ParseState = ParseState
{ -- | The local base URI.
stateBaseUri :: Maybe BaseUrl,
-- | The set of @rdf:ID@ found in the scope of the current base URI.
stateIdSet :: Set Text,
-- | The namespace mapping.
statePrefixMapping :: PrefixMappings,
-- | The local @xml:lang@
stateLang :: Maybe Text,
-- | Current node RDF attributes.
stateNodeAttrs :: HashMap Text Text,
-- | Current subject for triple construction.
stateSubject :: Maybe Subject,
-- | Current collection index.
stateCollectionIndex :: Int,
stateGenId :: Int
}
deriving (Show)
-- | Parse a xml Text to an RDF representation
parseXmlRDF ::
(Rdf a) =>
-- | The base URI for the RDF if required
Maybe BaseUrl ->
-- | The request URI for the document to if available
Maybe Text ->
-- | The contents to parse
Text ->
-- | The RDF representation of the triples or ParseFailure
Either ParseFailure (RDF a)
parseXmlRDF bUrl dUrl = parseRdf . parseXml
where
bUrl' = BaseUrl <$> dUrl <|> bUrl
parseXml = Xeno.fromRawXml . T.encodeUtf8
parseRdf = first ParseFailure . join . second parseRdf'
parseRdf' ns = join $ evalState (runExceptT (parseM rdfParser ns)) initState
initState = ParseState bUrl' mempty mempty empty mempty empty 0 0
-- | A parser for debugging purposes.
parseXmlDebug ::
-- | Path of the file to parse.
FilePath ->
IO (RDF TList)
parseXmlDebug f = fromRight RDF.empty <$> parseFile (XmlParser (Just . BaseUrl $ "http://base-url.com/") (Just "http://doc-url.com/")) f
-- | Document parser
rdfParser :: Rdf a => Parser (RDF a)
rdfParser = do
bUri <- currentBaseUri
triples <- (pRdf <* pWs) <|> pNodeElementList
pEndOfInput
mkRdf triples bUri <$> currentPrefixMappings
-- | Parser for @rdf:RDF@, if present.
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#RDF
pRdf :: Parser Triples
pRdf = pAnyElement $ do
attrs <- pRDFAttrs
uri <- pName >>= pQName
guard (uri == rdfTag)
unless (null attrs) $ throwError "rdf:RDF: The set of attributes should be empty."
pNodeElementList
-- | Parser for XML QName: resolve the namespace with the mapping in context.
--
-- Throws an error if the namespace is not defined.
pQName :: Text -> Parser Text
pQName qn = do
pm <- currentPrefixMappings
let qn' = resolveQName pm qn >>= validateIRI
either throwError pure qn'
-- | Process the attributes of an XML element.
--
-- To be called __once__ per XML element.
pRDFAttrs :: Parser (HashMap Text Text)
pRDFAttrs = do
-- Language (xml:lang)
liftA2 (<|>) pLang currentLang >>= setLang
-- Base URI (xml:base)
liftA2 (<|>) pBase currentBaseUri >>= setBaseUri
bUri <- currentBaseUri
-- Process the rest of the attributes
attrs <- pAttrs
-- Get the namespace definitions (xmlns:)
pm <- updatePrefixMappings (PrefixMappings $ HM.foldlWithKey' mkNameSpace mempty attrs)
-- Filter and resolve RDF attributes
let as = HM.foldlWithKey' (mkRdfAttribute pm bUri) mempty attrs
setNodeAttrs as
pure as
where
mkNameSpace ::
-- | Current namespace mapping
Map.Map Text Text ->
-- | XML attribute to process
Text ->
-- | Value of the attribute
Text ->
Map.Map Text Text
mkNameSpace ns qn iri =
let qn' = parseQName qn
ns' = f <$> qn' <*> validateIRI iri
f (Nothing, "xmlns") iri' = Map.insert mempty iri' ns
f (Just "xmlns", prefix) iri' = Map.insert prefix iri' ns
f _ _ = ns
in either (const ns) id ns'
mkRdfAttribute ::
-- | Namespace mapping
PrefixMappings ->
-- | Base URI
Maybe BaseUrl ->
-- | Current set of RDF attributes
HM.HashMap Text Text ->
-- | XML attribute to process
Text ->
-- | Value of the attribute
Text ->
HM.HashMap Text Text
mkRdfAttribute pm bUri as qn v =
let as' = parseQName qn >>= f
-- [NOTE] Ignore XML reserved names
f (Nothing, n)
| T.isPrefixOf "xml" n = Right as
| otherwise = case bUri of
Nothing -> Right as -- [FIXME] manage missing base URI
Just (BaseUrl bUri') -> (\a -> HM.insert a v as) <$> resolveIRI bUri' n
f qn'@(Just prefix, _)
| T.isPrefixOf "xml" prefix = Right as
| otherwise = (\a -> HM.insert a v as) <$> resolveQName' pm qn'
in either (const as) id as'
-- | Return the value of the requested RDF attribute using its URI.
--
-- Fails if the attribute is not defined.
pRDFAttr :: Text -> Parser Text
pRDFAttr a = do
as <- currentNodeAttrs
maybe
(fail . mconcat $ ["Attribute \"", T.unpack a, "\" not found."])
pure
(HM.lookup a as)
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#nodeElementList
pNodeElementList :: Parser Triples
pNodeElementList = pWs *> (mconcat <$> some (keepState pNodeElement <* pWs))
-- | White spaces parser
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#ws
pWs :: Parser ()
pWs = maybe True (T.all ws . TL.toStrict) <$> optional pText >>= guard
where
-- See: https://www.w3.org/TR/2000/REC-xml-20001006#NT-S
ws c = c == '\x20' || c == '\x09' || c == '\x0d' || c == '\x0a'
-- https://www.w3.org/TR/rdf-syntax-grammar/#nodeElement
pNodeElement :: Parser Triples
pNodeElement = pAnyElement $ do
-- Process attributes
void pRDFAttrs
-- Process URI, subject and @rdf:type@.
(s, mt) <- pSubject
ts1 <- pPropertyAttrs s
-- Process propertyEltList
ts2 <- keepState pPropertyEltList
setSubject (Just s)
let ts = ts1 <> ts2
pure $ maybe ts (: ts) mt
-- | Process the following parts of a @nodeElement@: URI, subject and @rdf:type@.
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#nodeElement
pSubject :: Parser (Node, Maybe Triple)
pSubject = do
-- Create the subject
-- [TODO] check the attributes that only one of the following may work
s <- pUnodeId <|> pBnode <|> pUnode <|> pBnodeGen
setSubject (Just s)
-- Resolve URI
uri <- pName >>= pQName
-- Check that the URI is allowed
unless (checkNodeUri uri) (throwError $ "URI not allowed: " <> T.unpack uri)
-- Optional rdf:type triple
mtype <- optional (pType1 s uri)
pure (s, mtype)
where
checkNodeUri uri = isNotCoreSyntaxTerm uri && uri /= rdfLi && isNotOldTerm uri
pUnodeId = (pIdAttr >>= mkUNodeID) <* removeNodeAttr rdfID
pBnode = (BNode <$> pNodeIdAttr) <* removeNodeAttr rdfNodeID
pUnode = (unode <$> pAboutAttr) <* removeNodeAttr rdfAbout
-- Default subject: a new blank node
pBnodeGen = newBNode
pType1 n uri =
if uri /= rdfDescription
then pure $ Triple n rdfTypeNode (unode uri)
else empty
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#propertyAttr
pPropertyAttrs :: Node -> Parser Triples
pPropertyAttrs s = do
attrs <- currentNodeAttrs
-- HM.elems <$> HM.traverseWithKey f attrs
HM.elems <$> HM.traverseWithKey f (HM.delete rdfID attrs)
where
f attr value
| not (isPropertyAttrURI attr) = throwError $ "URI not allowed for attribute: " <> T.unpack attr
| attr == rdfType = pure $ Triple s rdfTypeNode (unode value)
| otherwise = do
lang <- currentLang
pure $
let mkLiteral = maybe plainL (flip plainLL) lang
in Triple s (unode attr) (lnode (mkLiteral value))
pLang :: Parser (Maybe Text)
pLang = optional (pAttr "xml:lang")
-- [TODO] resolve base uri in context
pBase :: Parser (Maybe BaseUrl)
pBase = optional $ do
uri <- pAttr "xml:base"
-- Parse and remove fragment
BaseUrl
<$> either
throwError
(pure . serializeIRI . removeIRIFragment)
(parseIRI uri)
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#propertyEltList
pPropertyEltList :: Parser Triples
pPropertyEltList =
pWs
*> resetCollectionIndex
*> fmap mconcat (many (pPropertyElt <* pWs))
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#propertyElt
pPropertyElt :: Parser Triples
pPropertyElt = pAnyElement $ do
-- Process attributes
void pRDFAttrs
-- Process the predicate from the URI
uri <- pName >>= pQName >>= listExpansion
unless (isPropertyAttrURI uri) (throwError $ "URI not allowed for propertyElt: " <> T.unpack uri)
let p = unode uri
-- Process 'propertyElt'
pParseTypeLiteralPropertyElt p
<|> pParseTypeResourcePropertyElt p
<|> pParseTypeCollectionPropertyElt p
<|> pParseTypeOtherPropertyElt p
<|> pResourcePropertyElt p
<|> pLiteralPropertyElt p
<|> pEmptyPropertyElt p
where
listExpansion u
| u == rdfLi = nextCollectionIndex
| otherwise = pure u
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#resourcePropertyElt
pResourcePropertyElt :: Node -> Parser Triples
pResourcePropertyElt p = do
pWs
-- [NOTE] We need to restore part of the state after exploring the element' children.
(ts1, o) <- keepState $ liftA2 (,) pNodeElement currentSubject
pWs
mi <- optional pIdAttr <* removeNodeAttr rdfID
-- No other attribute is allowed.
checkAllowedAttributes []
-- Generated triple
s <- currentSubject
let mt = flip Triple p <$> s <*> o
-- Reify the triple
ts2 <- maybe (pure mempty) (uncurry reifyTriple) (liftA2 (,) mi mt)
pure $ maybe (ts1 <> ts2) (: (ts1 <> ts2)) mt
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#literalPropertyElt
pLiteralPropertyElt :: Node -> Parser Triples
pLiteralPropertyElt p = do
l <- pText
-- No children
pChildren >>= guard . null
mi <- optional pIdAttr <* removeNodeAttr rdfID
checkAllowedAttributes [rdfDatatype]
dt <- optional pDatatypeAttr
s <- currentSubject
lang <- currentLang
-- Generated triple
let l' = TL.toStrict l
o = lnode . fromMaybe (plainL l') $ (typedL l' <$> dt) <|> (plainLL l' <$> lang)
mt = (\s' -> Triple s' p o) <$> s
-- Reify the triple
ts <- maybe (pure mempty) (uncurry reifyTriple) (liftA2 (,) mi mt)
pure $ maybe ts (: ts) mt
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#parseTypeLiteralPropertyElt
pParseTypeLiteralPropertyElt :: Node -> Parser Triples
pParseTypeLiteralPropertyElt p = do
pt <- pRDFAttr rdfParseType
guard (pt == "Literal")
mi <- optional pIdAttr <* removeNodeAttr rdfID
checkAllowedAttributes [rdfParseType]
l <- pXMLLiteral
-- Generated triple
s <- currentSubject
let o = lnode (typedL l rdfXmlLiteral)
mt = (\s' -> Triple s' p o) <$> s
-- Reify the triple
ts <- maybe (pure mempty) (uncurry reifyTriple) (liftA2 (,) mi mt)
pure $ maybe ts (: ts) mt
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#parseTypeResourcePropertyElt
pParseTypeResourcePropertyElt :: Node -> Parser Triples
pParseTypeResourcePropertyElt p = do
pt <- pRDFAttr rdfParseType
guard (pt == "Resource")
mi <- optional pIdAttr <* removeNodeAttr rdfID
checkAllowedAttributes [rdfParseType]
-- Generated triple
s <- currentSubject
o <- newBNode
let mt = (\s' -> Triple s' p o) <$> s
-- Reify the triple
ts1 <- maybe (pure mempty) (uncurry reifyTriple) (liftA2 (,) mi mt)
setSubject (Just o)
-- Explore children
ts2 <- keepCollectionIndex pPropertyEltList
--setSubject s
pure $ maybe (ts1 <> ts2) ((<> ts2) . (: ts1)) mt
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#parseTypeCollectionPropertyElt
pParseTypeCollectionPropertyElt :: Node -> Parser Triples
pParseTypeCollectionPropertyElt p = do
pt <- pRDFAttr rdfParseType
guard (pt == "Collection")
mi <- optional pIdAttr <* removeNodeAttr rdfID
checkAllowedAttributes [rdfParseType]
s <- currentSubject
case s of
Nothing -> pure mempty
Just s' -> do
r <- optional pNodeElement
case r of
Nothing ->
-- Empty collection
let t = Triple s' p rdfNilNode
in ([t] <>) <$> maybe (pure mempty) (`reifyTriple` t) mi
Just ts1 -> do
-- Non empty collection
s'' <- currentSubject
n <- newBNode
-- Triples corresping to the first item
let t = Triple s' p n
ts2 = maybe mempty (\s''' -> [t, Triple n rdfFirstNode s''']) s''
-- Process next item
ts3 <- go n
-- Reify triple
ts4 <- maybe (pure mempty) (`reifyTriple` t) mi
pure $ mconcat [ts1, ts2, ts3, ts4]
where
go s = do
-- Generate the triples of the current item.
r <- optional pNodeElement
case r of
-- End of the collection
Nothing -> pure [Triple s rdfRestNode rdfNilNode]
-- Add the item to the collection and process the next item
Just ts1 -> do
s' <- currentSubject
n <- newBNode
let ts2 = maybe mempty (\s'' -> [Triple s rdfRestNode n, Triple n rdfFirstNode s'']) s'
-- Next item
ts3 <- go n
pure $ mconcat [ts1, ts2, ts3]
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#parseTypeOtherPropertyElt
pParseTypeOtherPropertyElt :: Node -> Parser Triples
pParseTypeOtherPropertyElt _p = do
pt <- pRDFAttr rdfParseType
guard (pt /= "Resource" && pt /= "Literal" && pt /= "Collection")
checkAllowedAttributes [rdfParseType]
_mi <- optional pIdAttr <* removeNodeAttr rdfID
-- [FIXME] Implement 'parseTypeOtherPropertyElt'
throwError "Not implemented: rdf:parseType = other"
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#emptyPropertyElt
pEmptyPropertyElt :: Node -> Parser Triples
pEmptyPropertyElt p = do
s <- currentSubject
case s of
Nothing -> pure mempty
Just s' -> do
-- mi <- optional pIdAttr -- <* removeNodeAttr rdfID
--
notNodeIdAndResource
o <- pResourceAttr' <|> pNodeIdAttr' <|> rdfIdAttr' <|> newBNode
let t = Triple s' p o
-- Reify triple
ts1 <- -- maybe (pure mempty) (`reifyTriple` t) mi
do
x <- optional pIdAttr
case x of
Nothing -> mempty
rdfIdSub -> maybe (pure mempty) (`reifyTriple` t) rdfIdSub
-- ts2 <- mempty
--
-- attrs <- currentNodeAttrs
--
ts2 <-
case o of
(LNode _) -> mempty
_ -> pPropertyAttrs o
--
pure (t : ts1 <> ts2)
where
-- pure (t : ts1)
pResourceAttr' = unode <$> pResourceAttr <* removeNodeAttr rdfResource
pNodeIdAttr' = BNode <$> pNodeIdAttr <* removeNodeAttr rdfNodeID
rdfIdAttr' = pure (lnode (plainL "")) <* (void (pIdAttr <* removeNodeAttr rdfID) <|> noNodeAttrs)
checkAllowedAttributes :: HashSet Text -> Parser ()
checkAllowedAttributes as = do
attrs <- currentNodeAttrs
let diffAttrs = HS.difference (HM.keysSet attrs) as
unless (null diffAttrs) (throwError $ "Attributes not allowed: " <> show diffAttrs)
-- See: https://www.w3.org/TR/rdf11-concepts/#dfn-rdf-xmlliteral,
-- https://www.w3.org/TR/rdf-syntax-grammar/#literal
pXMLLiteral :: Parser Text
pXMLLiteral =
T.decodeUtf8 . BL.toStrict . BB.toLazyByteString . encode <$> pChildren
pIdAttr :: Parser Text
pIdAttr = do
i <- pRDFAttr rdfID
i' <- either throwError pure (checkRdfId i)
-- Check the uniqueness of the ID in the context of the current base URI.
checkIdIsUnique i'
pure i'
checkIdIsUnique :: Text -> Parser ()
checkIdIsUnique i = do
notUnique <- S.member i <$> currentIdSet
when notUnique (throwError $ "rdf:ID already used in this context: " <> T.unpack i)
updateIdSet i
-- Cannot have rdf:nodeID and rdf:resource
notNodeIdAndResource :: Parser ()
notNodeIdAndResource = do
attrs <- currentNodeAttrs
guard
( (HM.member rdfNodeID attrs && not (HM.member rdfResource attrs))
|| (not (HM.member rdfNodeID attrs) && (HM.member rdfResource attrs))
|| (not (HM.member rdfNodeID attrs) && not (HM.member rdfResource attrs))
)
pNodeIdAttr :: Parser Text
pNodeIdAttr = do
i <- pRDFAttr rdfNodeID
either throwError pure (checkRdfId i)
pAboutAttr :: Parser Text
pAboutAttr = pRDFAttr rdfAbout >>= checkIRI "rdf:about"
pResourceAttr :: Parser Text
pResourceAttr = pRDFAttr rdfResource >>= checkIRI "rdf:resource"
pDatatypeAttr :: Parser Text
pDatatypeAttr = pRDFAttr rdfDatatype >>= checkIRI "rdf:datatype"
reifyTriple :: Text -> Triple -> Parser Triples
reifyTriple i (Triple s p' o) = do
n <- mkUNodeID i
pure
[ Triple n rdfTypeNode rdfStatementNode,
Triple n rdfSubjectNode s,
Triple n rdfPredicateNode p',
Triple n rdfObjectNode o
]
--------------------------------------------------------------------------------
-- URI checks
checkIRI :: String -> Text -> Parser Text
checkIRI msg iri = do
bUri <- maybe mempty unBaseUrl <$> currentBaseUri
case uriValidate iri of
Nothing -> throwError $ mconcat ["Malformed IRI for \"", msg, "\": ", T.unpack iri]
Just iri' -> either throwError pure (resolveIRI bUri iri')
-- https://www.w3.org/TR/rdf-syntax-grammar/#propertyAttributeURIs
isPropertyAttrURI :: Text -> Bool
isPropertyAttrURI uri =
isNotCoreSyntaxTerm uri
&& uri /= rdfDescription
&& uri /= rdfLi
&& isNotOldTerm uri
-- https://www.w3.org/TR/rdf-syntax-grammar/#coreSyntaxTerms
isNotCoreSyntaxTerm :: Text -> Bool
isNotCoreSyntaxTerm uri =
uri /= rdfTag && uri /= rdfID && uri /= rdfAbout
&& uri /= rdfParseType
&& uri /= rdfResource
&& uri /= rdfNodeID
&& uri /= rdfDatatype
-- https://www.w3.org/TR/rdf-syntax-grammar/#oldTerms
isNotOldTerm :: Text -> Bool
isNotOldTerm uri =
uri /= rdfAboutEach
&& uri /= rdfAboutEachPrefix
&& uri /= rdfBagID
--------------------------------------------------------------------------------
-- Parser's state utils
-- | Create a new unique blank node
newBNode :: Parser Node
newBNode = do
modify $ \st -> st {stateGenId = stateGenId st + 1}
BNodeGen . stateGenId <$> get
-- | Process a parser, restoring the state except for stateGenId and stateIdSet
keepState :: Parser a -> Parser a
keepState p = do
st <- get
let bUri = stateBaseUri st
is = stateIdSet st
p <* do
st' <- get
let i = stateGenId st'
bUri' = stateBaseUri st'
is' = stateIdSet st'
-- Update the set of ID if necessary
if bUri /= bUri'
then put (st {stateGenId = i})
else put (st {stateGenId = i, stateIdSet = is <> is'})
currentIdSet :: Parser (Set Text)
currentIdSet = stateIdSet <$> get
updateIdSet :: Text -> Parser ()
updateIdSet i = do
is <- currentIdSet
modify (\st -> st {stateIdSet = S.insert i is})
noNodeAttrs :: Parser ()
noNodeAttrs = do
atts <- currentNodeAttrs
guard (HM.null atts)
currentNodeAttrs :: Parser (HashMap Text Text)
currentNodeAttrs = stateNodeAttrs <$> get
setNodeAttrs :: HashMap Text Text -> Parser ()
setNodeAttrs as = modify (\st -> st {stateNodeAttrs = as})
removeNodeAttr :: Text -> Parser ()
removeNodeAttr a = HM.delete a <$> currentNodeAttrs >>= setNodeAttrs
currentPrefixMappings :: Parser PrefixMappings
currentPrefixMappings = statePrefixMapping <$> get
updatePrefixMappings :: PrefixMappings -> Parser PrefixMappings
updatePrefixMappings pm = do
pm' <- (<> pm) <$> currentPrefixMappings
modify (\st -> st {statePrefixMapping = pm'})
pure pm'
currentCollectionIndex :: Parser Int
currentCollectionIndex = stateCollectionIndex <$> get
setCollectionIndex :: Int -> Parser ()
setCollectionIndex i = modify (\st -> st {stateCollectionIndex = i})
keepCollectionIndex :: Parser a -> Parser a
keepCollectionIndex p = do
i <- currentCollectionIndex
p <* setCollectionIndex i
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#section-List-Expand
nextCollectionIndex :: Parser Text
nextCollectionIndex = do
modify $ \st -> st {stateCollectionIndex = stateCollectionIndex st + 1}
(rdfListIndex <>) . T.pack . show . stateCollectionIndex <$> get
resetCollectionIndex :: Parser ()
resetCollectionIndex = modify $ \st -> st {stateCollectionIndex = 0}
currentBaseUri :: Parser (Maybe BaseUrl)
currentBaseUri = stateBaseUri <$> get
setBaseUri :: (Maybe BaseUrl) -> Parser ()
setBaseUri u = modify (\st -> st {stateBaseUri = u})
mkUNodeID :: Text -> Parser Node
mkUNodeID t = mkUnode <$> currentBaseUri
where
mkUnode =
unode . \case
Nothing -> t
Just (BaseUrl u) -> mconcat [u, "#", t]
currentSubject :: Parser (Maybe Subject)
currentSubject = stateSubject <$> get
setSubject :: (Maybe Subject) -> Parser ()
setSubject s = modify (\st -> st {stateSubject = s})
currentLang :: Parser (Maybe Text)
currentLang = stateLang <$> get
setLang :: (Maybe Text) -> Parser ()
setLang lang = modify (\st -> st {stateLang = lang})