{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedLists     #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE DoAndIfThenElse     #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}

-- |An parser for the RDF/XML format
-- <http://www.w3.org/TR/REC-rdf-syntax/>.

module Text.RDF.RDF4H.XmlParser
  ( XmlParser(..)
  , parseXmlDebug
  ) where

import           Data.RDF.Types hiding (empty, resolveQName)
import qualified Data.RDF.Types as RDF
import           Data.RDF.IRI
import           Data.RDF.Graph.TList
import           Text.RDF.RDF4H.ParserUtils hiding (Parser)
import           Text.RDF.RDF4H.XmlParser.Identifiers
import           Text.RDF.RDF4H.XmlParser.Xmlbf hiding (Node)
import qualified Text.RDF.RDF4H.XmlParser.Xeno as Xeno

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
import           Data.Set (Set)
import qualified Data.Set as S
import qualified Data.Map as Map
import           Data.Maybe
#if MIN_VERSION_base(4,10,0)
import           Data.Either
#else
#endif
import           Data.Bifunctor
import           Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as T
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Builder as BB
-- import           Xmlbf hiding (Node, State)
-- import qualified Xmlbf.Xeno as Xeno

instance RdfParser XmlParser where
  parseString :: XmlParser -> Text -> Either ParseFailure (RDF a)
parseString (XmlParser Maybe BaseUrl
bUrl Maybe Text
dUrl) = Maybe BaseUrl -> Maybe Text -> Text -> Either ParseFailure (RDF a)
forall a.
Rdf a =>
Maybe BaseUrl -> Maybe Text -> Text -> Either ParseFailure (RDF a)
parseXmlRDF Maybe BaseUrl
bUrl Maybe Text
dUrl
  parseFile :: XmlParser -> String -> IO (Either ParseFailure (RDF a))
parseFile   (XmlParser Maybe BaseUrl
bUrl Maybe Text
dUrl) = Maybe BaseUrl
-> Maybe Text -> String -> IO (Either ParseFailure (RDF a))
forall a.
Rdf a =>
Maybe BaseUrl
-> Maybe Text -> String -> IO (Either ParseFailure (RDF a))
parseFile'  Maybe BaseUrl
bUrl Maybe Text
dUrl
  parseURL :: XmlParser -> String -> IO (Either ParseFailure (RDF a))
parseURL    (XmlParser Maybe BaseUrl
bUrl Maybe Text
dUrl) = Maybe BaseUrl
-> Maybe Text -> String -> IO (Either ParseFailure (RDF a))
forall a.
Rdf a =>
Maybe BaseUrl
-> Maybe Text -> String -> IO (Either ParseFailure (RDF a))
parseURL'   Maybe BaseUrl
bUrl Maybe Text
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' :: Maybe BaseUrl
-> Maybe Text -> String -> IO (Either ParseFailure (RDF a))
parseFile' Maybe BaseUrl
bUrl Maybe Text
dUrl String
fpath = Maybe BaseUrl -> Maybe Text -> Text -> Either ParseFailure (RDF a)
forall a.
Rdf a =>
Maybe BaseUrl -> Maybe Text -> Text -> Either ParseFailure (RDF a)
parseXmlRDF Maybe BaseUrl
bUrl Maybe Text
dUrl (Text -> Either ParseFailure (RDF a))
-> IO Text -> IO (Either ParseFailure (RDF a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
TIO.readFile String
fpath

parseURL' :: (Rdf a)
  => Maybe BaseUrl
  -- ^ The optional base URI of the document.
  -> Maybe Text
  -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI.
  -> String
  -- ^ The location URI from which to retrieve the XML document.
  -> IO (Either ParseFailure (RDF a))
  -- ^ The parse result, which is either a @ParseFailure@ or the RDF
  --   corresponding to the XML document.
parseURL' :: Maybe BaseUrl
-> Maybe Text -> String -> IO (Either ParseFailure (RDF a))
parseURL' Maybe BaseUrl
bUrl Maybe Text
docUrl = (Text -> Either ParseFailure (RDF a))
-> String -> IO (Either ParseFailure (RDF a))
forall rdfImpl.
(Text -> Either ParseFailure (RDF rdfImpl))
-> String -> IO (Either ParseFailure (RDF rdfImpl))
parseFromURL (Maybe BaseUrl -> Maybe Text -> Text -> Either ParseFailure (RDF a)
forall a.
Rdf a =>
Maybe BaseUrl -> Maybe Text -> Text -> Either ParseFailure (RDF a)
parseXmlRDF Maybe BaseUrl
bUrl Maybe Text
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
  { ParseState -> Maybe BaseUrl
stateBaseUri :: Maybe BaseUrl
  -- ^ The local base URI.
  , ParseState -> Set Text
stateIdSet :: Set Text
  -- ^ The set of @rdf:ID@ found in the scope of the current base URI.
  , ParseState -> PrefixMappings
statePrefixMapping :: PrefixMappings
  -- ^ The namespace mapping.
  , ParseState -> Maybe Text
stateLang :: Maybe Text
  -- ^ The local @xml:lang@
  , ParseState -> HashMap Text Text
stateNodeAttrs :: HashMap Text Text
  -- ^ Current node RDF attributes.
  , ParseState -> Maybe Subject
stateSubject :: Maybe Subject
  -- ^ Current subject for triple construction.
  , ParseState -> Int
stateCollectionIndex :: Int
  -- ^ Current collection index.
  , ParseState -> Int
stateGenId :: Int
  } deriving(Int -> ParseState -> ShowS
[ParseState] -> ShowS
ParseState -> String
(Int -> ParseState -> ShowS)
-> (ParseState -> String)
-> ([ParseState] -> ShowS)
-> Show ParseState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseState] -> ShowS
$cshowList :: [ParseState] -> ShowS
show :: ParseState -> String
$cshow :: ParseState -> String
showsPrec :: Int -> ParseState -> ShowS
$cshowsPrec :: Int -> ParseState -> ShowS
Show)

-- |Parse a xml Text to an RDF representation
parseXmlRDF :: (Rdf a)
  => Maybe BaseUrl
  -- ^ The base URI for the RDF if required
  -> Maybe Text
  -- ^ The request URI for the document to  if available
  -> Text
  -- ^ The contents to parse
  -> Either ParseFailure (RDF a)
  -- ^ The RDF representation of the triples or ParseFailure
parseXmlRDF :: Maybe BaseUrl -> Maybe Text -> Text -> Either ParseFailure (RDF a)
parseXmlRDF Maybe BaseUrl
bUrl Maybe Text
dUrl = Either String [Node] -> Either ParseFailure (RDF a)
parseRdf (Either String [Node] -> Either ParseFailure (RDF a))
-> (Text -> Either String [Node])
-> Text
-> Either ParseFailure (RDF a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String [Node]
parseXml
  where
    bUrl' :: Maybe BaseUrl
bUrl' = Text -> BaseUrl
BaseUrl (Text -> BaseUrl) -> Maybe Text -> Maybe BaseUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
dUrl Maybe BaseUrl -> Maybe BaseUrl -> Maybe BaseUrl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe BaseUrl
bUrl
    parseXml :: Text -> Either String [Node]
parseXml = ByteString -> Either String [Node]
Xeno.fromRawXml (ByteString -> Either String [Node])
-> (Text -> ByteString) -> Text -> Either String [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
    parseRdf :: Either String [Node] -> Either ParseFailure (RDF a)
parseRdf = (String -> ParseFailure)
-> Either String (RDF a) -> Either ParseFailure (RDF a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ParseFailure
ParseFailure (Either String (RDF a) -> Either ParseFailure (RDF a))
-> (Either String [Node] -> Either String (RDF a))
-> Either String [Node]
-> Either ParseFailure (RDF a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String (Either String (RDF a)) -> Either String (RDF a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either String (Either String (RDF a)) -> Either String (RDF a))
-> (Either String [Node] -> Either String (Either String (RDF a)))
-> Either String [Node]
-> Either String (RDF a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Node] -> Either String (RDF a))
-> Either String [Node] -> Either String (Either String (RDF a))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [Node] -> Either String (RDF a)
forall a. Rdf a => [Node] -> Either String (RDF a)
parseRdf'
    parseRdf' :: [Node] -> Either String (RDF a)
parseRdf' [Node]
ns = Either String (Either String (RDF a)) -> Either String (RDF a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either String (Either String (RDF a)) -> Either String (RDF a))
-> Either String (Either String (RDF a)) -> Either String (RDF a)
forall a b. (a -> b) -> a -> b
$ State ParseState (Either String (Either String (RDF a)))
-> ParseState -> Either String (Either String (RDF a))
forall s a. State s a -> s -> a
evalState (ExceptT String (State ParseState) (Either String (RDF a))
-> State ParseState (Either String (Either String (RDF a)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ParserT (ExceptT String (State ParseState)) (RDF a)
-> [Node]
-> ExceptT String (State ParseState) (Either String (RDF a))
forall (m :: * -> *) a.
Applicative m =>
ParserT m a -> [Node] -> m (Either String a)
parseM ParserT (ExceptT String (State ParseState)) (RDF a)
forall a. Rdf a => Parser (RDF a)
rdfParser [Node]
ns)) ParseState
initState
    initState :: ParseState
initState = Maybe BaseUrl
-> Set Text
-> PrefixMappings
-> Maybe Text
-> HashMap Text Text
-> Maybe Subject
-> Int
-> Int
-> ParseState
ParseState Maybe BaseUrl
bUrl' Set Text
forall a. Monoid a => a
mempty PrefixMappings
forall a. Monoid a => a
mempty Maybe Text
forall (f :: * -> *) a. Alternative f => f a
empty HashMap Text Text
forall a. Monoid a => a
mempty Maybe Subject
forall (f :: * -> *) a. Alternative f => f a
empty Int
0 Int
0

-- |A parser for debugging purposes.
parseXmlDebug
  :: FilePath
  -- ^ Path of the file to parse.
  -> IO (RDF TList)
parseXmlDebug :: String -> IO (RDF TList)
parseXmlDebug String
f = RDF TList -> Either ParseFailure (RDF TList) -> RDF TList
forall b a. b -> Either a b -> b
fromRight RDF TList
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl
RDF.empty (Either ParseFailure (RDF TList) -> RDF TList)
-> IO (Either ParseFailure (RDF TList)) -> IO (RDF TList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XmlParser -> String -> IO (Either ParseFailure (RDF TList))
forall p a.
(RdfParser p, Rdf a) =>
p -> String -> IO (Either ParseFailure (RDF a))
parseFile (Maybe BaseUrl -> Maybe Text -> XmlParser
XmlParser (BaseUrl -> Maybe BaseUrl
forall a. a -> Maybe a
Just (BaseUrl -> Maybe BaseUrl)
-> (Text -> BaseUrl) -> Text -> Maybe BaseUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BaseUrl
BaseUrl (Text -> Maybe BaseUrl) -> Text -> Maybe BaseUrl
forall a b. (a -> b) -> a -> b
$ Text
"http://base-url.com/") (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://doc-url.com/")) String
f

-- |Document parser
rdfParser :: Rdf a => Parser (RDF a)
rdfParser :: Parser (RDF a)
rdfParser = do
  Maybe BaseUrl
bUri <- Parser (Maybe BaseUrl)
currentBaseUri
  Triples
triples <- (Parser Triples
pRdf Parser Triples
-> ParserT (ExceptT String (State ParseState)) () -> Parser Triples
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT (ExceptT String (State ParseState)) ()
pWs) Parser Triples -> Parser Triples -> Parser Triples
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Triples
pNodeElementList
  ParserT (ExceptT String (State ParseState)) ()
forall (m :: * -> *). Applicative m => ParserT m ()
pEndOfInput
  Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a
forall rdfImpl.
Rdf rdfImpl =>
Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdfImpl
mkRdf Triples
triples Maybe BaseUrl
bUri (PrefixMappings -> RDF a)
-> ParserT (ExceptT String (State ParseState)) PrefixMappings
-> Parser (RDF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) PrefixMappings
currentPrefixMappings

-- |Parser for @rdf:RDF@, if present.
-- See: https://www.w3.org/TR/rdf-syntax-grammar/#RDF
pRdf :: Parser Triples
pRdf :: Parser Triples
pRdf = Parser Triples -> Parser Triples
forall (m :: * -> *) a. Monad m => ParserT m a -> ParserT m a
pAnyElement (Parser Triples -> Parser Triples)
-> Parser Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ do
  HashMap Text Text
attrs <- Parser (HashMap Text Text)
pRDFAttrs
  Text
uri <- ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *). Applicative m => ParserT m Text
pName ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParserT (ExceptT String (State ParseState)) Text
pQName
  Bool -> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rdfTag)
  Bool
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashMap Text Text -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text Text
attrs) (ParserT (ExceptT String (State ParseState)) ()
 -> ParserT (ExceptT String (State ParseState)) ())
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) ()
forall a b. (a -> b) -> a -> b
$ String -> ParserT (ExceptT String (State ParseState)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"rdf:RDF: The set of attributes should be empty."
  Parser Triples
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 :: Text -> ParserT (ExceptT String (State ParseState)) Text
pQName Text
qn = do
  PrefixMappings
pm <- ParserT (ExceptT String (State ParseState)) PrefixMappings
currentPrefixMappings
  let qn' :: Either String Text
qn' = PrefixMappings -> Text -> Either String Text
resolveQName PrefixMappings
pm Text
qn Either String Text
-> (Text -> Either String Text) -> Either String Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either String Text
validateIRI
  (String -> ParserT (ExceptT String (State ParseState)) Text)
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> Either String Text
-> ParserT (ExceptT String (State ParseState)) Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParserT (ExceptT String (State ParseState)) Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text -> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Text
qn'

-- |Process the attributes of an XML element.
--
--  To be called __once__ per XML element.
pRDFAttrs :: Parser (HashMap Text Text)
pRDFAttrs :: Parser (HashMap Text Text)
pRDFAttrs = do
  -- Language (xml:lang)
  (Maybe Text -> Maybe Text -> Maybe Text)
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) ParserT (ExceptT String (State ParseState)) (Maybe Text)
pLang ParserT (ExceptT String (State ParseState)) (Maybe Text)
currentLang ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> (Maybe Text -> ParserT (ExceptT String (State ParseState)) ())
-> ParserT (ExceptT String (State ParseState)) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> ParserT (ExceptT String (State ParseState)) ()
setLang
  -- Base URI (xml:base)
  (Maybe BaseUrl -> Maybe BaseUrl -> Maybe BaseUrl)
-> Parser (Maybe BaseUrl)
-> Parser (Maybe BaseUrl)
-> Parser (Maybe BaseUrl)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Maybe BaseUrl -> Maybe BaseUrl -> Maybe BaseUrl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Parser (Maybe BaseUrl)
pBase Parser (Maybe BaseUrl)
currentBaseUri Parser (Maybe BaseUrl)
-> (Maybe BaseUrl
    -> ParserT (ExceptT String (State ParseState)) ())
-> ParserT (ExceptT String (State ParseState)) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe BaseUrl -> ParserT (ExceptT String (State ParseState)) ()
setBaseUri
  Maybe BaseUrl
bUri <- Parser (Maybe BaseUrl)
currentBaseUri
  -- Process the rest of the attributes
  HashMap Text Text
attrs <- Parser (HashMap Text Text)
forall (m :: * -> *).
Applicative m =>
ParserT m (HashMap Text Text)
pAttrs
  -- Get the namespace definitions (xmlns:)
  PrefixMappings
pm <- PrefixMappings
-> ParserT (ExceptT String (State ParseState)) PrefixMappings
updatePrefixMappings (Map Text Text -> PrefixMappings
PrefixMappings (Map Text Text -> PrefixMappings)
-> Map Text Text -> PrefixMappings
forall a b. (a -> b) -> a -> b
$ (Map Text Text -> Text -> Text -> Map Text Text)
-> Map Text Text -> HashMap Text Text -> Map Text Text
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' Map Text Text -> Text -> Text -> Map Text Text
mkNameSpace Map Text Text
forall a. Monoid a => a
mempty HashMap Text Text
attrs)
  -- Filter and resolve RDF attributes
  let as :: HashMap Text Text
as = (HashMap Text Text -> Text -> Text -> HashMap Text Text)
-> HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' (PrefixMappings
-> Maybe BaseUrl
-> HashMap Text Text
-> Text
-> Text
-> HashMap Text Text
mkRdfAttribute PrefixMappings
pm Maybe BaseUrl
bUri) HashMap Text Text
forall a. Monoid a => a
mempty HashMap Text Text
attrs
  HashMap Text Text -> ParserT (ExceptT String (State ParseState)) ()
setNodeAttrs HashMap Text Text
as
  HashMap Text Text -> Parser (HashMap Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Text
as
  where
    -- |Check if an XML attribute is a namespace definition
    --  and if so add it to the mapping.
    mkNameSpace
      :: Map.Map Text Text
      -- ^ Current namespace mapping
      -> Text
      -- ^ XML attribute to process
      -> Text
      -- ^ Value of the attribute
      -> Map.Map Text Text
    mkNameSpace :: Map Text Text -> Text -> Text -> Map Text Text
mkNameSpace Map Text Text
ns Text
qn Text
iri =
      let qn' :: Either String (Maybe Text, Text)
qn' = Text -> Either String (Maybe Text, Text)
parseQName Text
qn
          ns' :: Either String (Map Text Text)
ns' = (Maybe Text, Text) -> Text -> Map Text Text
forall a.
(Eq a, IsString a) =>
(Maybe a, Text) -> Text -> Map Text Text
f ((Maybe Text, Text) -> Text -> Map Text Text)
-> Either String (Maybe Text, Text)
-> Either String (Text -> Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Text, Text)
qn' Either String (Text -> Map Text Text)
-> Either String Text -> Either String (Map Text Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either String Text
validateIRI Text
iri
          f :: (Maybe a, Text) -> Text -> Map Text Text
f (Maybe a
Nothing     , Text
"xmlns") Text
iri' = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
forall a. Monoid a => a
mempty Text
iri' Map Text Text
ns
          f (Just a
"xmlns", Text
prefix ) Text
iri' = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
prefix Text
iri' Map Text Text
ns
          f (Maybe a, Text)
_                       Text
_    = Map Text Text
ns
      in (String -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Either String (Map Text Text)
-> Map Text Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Map Text Text -> String -> Map Text Text
forall a b. a -> b -> a
const Map Text Text
ns) Map Text Text -> Map Text Text
forall a. a -> a
id Either String (Map Text Text)
ns'
    -- |Check if an XML attribute is an RDF attribute
    --  and if so resolve its URI and keep it.
    mkRdfAttribute
      :: PrefixMappings
      -- ^ Namespace mapping
      -> Maybe BaseUrl
      -- ^ Base URI
      -> HM.HashMap Text Text
      -- ^ Current set of RDF attributes
      -> Text
      -- ^ XML attribute to process
      -> Text
      -- ^ Value of the attribute
      -> HM.HashMap Text Text
    mkRdfAttribute :: PrefixMappings
-> Maybe BaseUrl
-> HashMap Text Text
-> Text
-> Text
-> HashMap Text Text
mkRdfAttribute PrefixMappings
pm Maybe BaseUrl
bUri HashMap Text Text
as Text
qn Text
v =
      let as' :: Either String (HashMap Text Text)
as' = Text -> Either String (Maybe Text, Text)
parseQName Text
qn Either String (Maybe Text, Text)
-> ((Maybe Text, Text) -> Either String (HashMap Text Text))
-> Either String (HashMap Text Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Text, Text) -> Either String (HashMap Text Text)
f
          -- [NOTE] Ignore XML reserved names
          f :: (Maybe Text, Text) -> Either String (HashMap Text Text)
f (Maybe Text
Nothing, Text
n)
            | Text -> Text -> Bool
T.isPrefixOf Text
"xml" Text
n = HashMap Text Text -> Either String (HashMap Text Text)
forall a b. b -> Either a b
Right HashMap Text Text
as
            | Bool
otherwise            = case Maybe BaseUrl
bUri of
                Maybe BaseUrl
Nothing -> HashMap Text Text -> Either String (HashMap Text Text)
forall a b. b -> Either a b
Right HashMap Text Text
as -- [FIXME] manage missing base URI
                Just (BaseUrl Text
bUri') -> (\Text
a -> Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
a Text
v HashMap Text Text
as) (Text -> HashMap Text Text)
-> Either String Text -> Either String (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Either String Text
resolveIRI Text
bUri' Text
n
          f qn' :: (Maybe Text, Text)
qn'@(Just Text
prefix, Text
_)
            | Text -> Text -> Bool
T.isPrefixOf Text
"xml" Text
prefix = HashMap Text Text -> Either String (HashMap Text Text)
forall a b. b -> Either a b
Right HashMap Text Text
as
            | Bool
otherwise = (\Text
a -> Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
a Text
v HashMap Text Text
as) (Text -> HashMap Text Text)
-> Either String Text -> Either String (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrefixMappings -> (Maybe Text, Text) -> Either String Text
resolveQName' PrefixMappings
pm (Maybe Text, Text)
qn'
      in (String -> HashMap Text Text)
-> (HashMap Text Text -> HashMap Text Text)
-> Either String (HashMap Text Text)
-> HashMap Text Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (HashMap Text Text -> String -> HashMap Text Text
forall a b. a -> b -> a
const HashMap Text Text
as) HashMap Text Text -> HashMap Text Text
forall a. a -> a
id Either String (HashMap Text Text)
as'

-- |Return the value of the requested RDF attribute using its URI.
--
--  Fails if the attribute is not defined.
pRDFAttr :: Text -> Parser Text
pRDFAttr :: Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
a = do
  HashMap Text Text
as <- Parser (HashMap Text Text)
currentNodeAttrs
  ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> Maybe Text
-> ParserT (ExceptT String (State ParseState)) Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParserT (ExceptT String (State ParseState)) Text)
-> ([String] -> String)
-> [String]
-> ParserT (ExceptT String (State ParseState)) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> ParserT (ExceptT String (State ParseState)) Text)
-> [String] -> ParserT (ExceptT String (State ParseState)) Text
forall a b. (a -> b) -> a -> b
$ [Item [String]
"Attribute \"", Text -> String
T.unpack Text
a, Item [String]
"\" not found."])
    Text -> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
a HashMap Text Text
as)

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#nodeElementList
pNodeElementList :: Parser Triples
pNodeElementList :: Parser Triples
pNodeElementList = ParserT (ExceptT String (State ParseState)) ()
pWs ParserT (ExceptT String (State ParseState)) ()
-> Parser Triples -> Parser Triples
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Triples] -> Triples
forall a. Monoid a => [a] -> a
mconcat ([Triples] -> Triples)
-> ParserT (ExceptT String (State ParseState)) [Triples]
-> Parser Triples
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Triples
-> ParserT (ExceptT String (State ParseState)) [Triples]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser Triples -> Parser Triples
forall a. Parser a -> Parser a
keepState Parser Triples
pNodeElement Parser Triples
-> ParserT (ExceptT String (State ParseState)) () -> Parser Triples
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT (ExceptT String (State ParseState)) ()
pWs))

-- |White spaces parser
--  See: https://www.w3.org/TR/rdf-syntax-grammar/#ws
pWs :: Parser ()
pWs :: ParserT (ExceptT String (State ParseState)) ()
pWs = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
ws (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict) (Maybe Text -> Bool)
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *). Applicative m => ParserT m Text
pText ParserT (ExceptT String (State ParseState)) Bool
-> (Bool -> ParserT (ExceptT String (State ParseState)) ())
-> ParserT (ExceptT String (State ParseState)) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
  where
    -- See: https://www.w3.org/TR/2000/REC-xml-20001006#NT-S
    ws :: Char -> Bool
ws Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x20' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0d' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0a'

-- https://www.w3.org/TR/rdf-syntax-grammar/#nodeElement
pNodeElement :: Parser Triples
pNodeElement :: Parser Triples
pNodeElement = Parser Triples -> Parser Triples
forall (m :: * -> *) a. Monad m => ParserT m a -> ParserT m a
pAnyElement (Parser Triples -> Parser Triples)
-> Parser Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ do
  -- Process attributes
  Parser (HashMap Text Text)
-> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser (HashMap Text Text)
pRDFAttrs
  -- Process URI, subject and @rdf:type@.
  (Subject
s, Maybe Triple
mt) <- Parser (Subject, Maybe Triple)
pSubject
  Triples
ts1 <- Subject -> Parser Triples
pPropertyAttrs Subject
s
  -- Process propertyEltList
  Triples
ts2 <- Parser Triples -> Parser Triples
forall a. Parser a -> Parser a
keepState Parser Triples
pPropertyEltList
  Maybe Subject -> ParserT (ExceptT String (State ParseState)) ()
setSubject (Subject -> Maybe Subject
forall a. a -> Maybe a
Just Subject
s)
  let ts :: Triples
ts = Triples
ts1 Triples -> Triples -> Triples
forall a. Semigroup a => a -> a -> a
<> Triples
ts2
  Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triples -> Parser Triples) -> Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ Triples -> (Triple -> Triples) -> Maybe Triple -> Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Triples
ts (Triple -> Triples -> Triples
forall a. a -> [a] -> [a]
:Triples
ts) Maybe Triple
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 :: Parser (Subject, Maybe Triple)
pSubject = do
  -- Create the subject
  -- [TODO] check the attributes that only one of the following may work
  Subject
s <- ParserT (ExceptT String (State ParseState)) Subject
pUnodeId ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT (ExceptT String (State ParseState)) Subject
pBnode ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT (ExceptT String (State ParseState)) Subject
pUnode ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT (ExceptT String (State ParseState)) Subject
pBnodeGen
  Maybe Subject -> ParserT (ExceptT String (State ParseState)) ()
setSubject (Subject -> Maybe Subject
forall a. a -> Maybe a
Just Subject
s)
  -- Resolve URI
  Text
uri <- ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *). Applicative m => ParserT m Text
pName ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParserT (ExceptT String (State ParseState)) Text
pQName
  -- Check that the URI is allowed
  Bool
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
checkNodeUri Text
uri) (String -> ParserT (ExceptT String (State ParseState)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ParserT (ExceptT String (State ParseState)) ())
-> String -> ParserT (ExceptT String (State ParseState)) ()
forall a b. (a -> b) -> a -> b
$ String
"URI not allowed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
uri)
  -- Optional rdf:type triple
  Maybe Triple
mtype <- ParserT (ExceptT String (State ParseState)) Triple
-> ParserT (ExceptT String (State ParseState)) (Maybe Triple)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Subject
-> Text -> ParserT (ExceptT String (State ParseState)) Triple
forall (f :: * -> *). Alternative f => Subject -> Text -> f Triple
pType1 Subject
s Text
uri)
  (Subject, Maybe Triple) -> Parser (Subject, Maybe Triple)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Subject
s, Maybe Triple
mtype)
  where
    checkNodeUri :: Text -> Bool
checkNodeUri Text
uri = Text -> Bool
isNotCoreSyntaxTerm Text
uri Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfLi Bool -> Bool -> Bool
&& Text -> Bool
isNotOldTerm Text
uri
    pUnodeId :: ParserT (ExceptT String (State ParseState)) Subject
pUnodeId = (ParserT (ExceptT String (State ParseState)) Text
pIdAttr ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Subject)
-> ParserT (ExceptT String (State ParseState)) Subject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParserT (ExceptT String (State ParseState)) Subject
mkUNodeID) ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfID
    pBnode :: ParserT (ExceptT String (State ParseState)) Subject
pBnode = (Text -> Subject
BNode (Text -> Subject)
-> ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) Text
pNodeIdAttr) ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfNodeID
    pUnode :: ParserT (ExceptT String (State ParseState)) Subject
pUnode = (Text -> Subject
unode (Text -> Subject)
-> ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) Text
pAboutAttr) ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfAbout
    -- Default subject: a new blank node
    pBnodeGen :: ParserT (ExceptT String (State ParseState)) Subject
pBnodeGen = ParserT (ExceptT String (State ParseState)) Subject
newBNode
    pType1 :: Subject -> Text -> f Triple
pType1 Subject
n Text
uri =
      if Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfDescription
        then Triple -> f Triple
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triple -> f Triple) -> Triple -> f Triple
forall a b. (a -> b) -> a -> b
$ Subject -> Subject -> Subject -> Triple
Triple Subject
n Subject
rdfTypeNode (Text -> Subject
unode Text
uri)
        else f Triple
forall (f :: * -> *) a. Alternative f => f a
empty

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#propertyAttr
pPropertyAttrs :: Node -> Parser Triples
pPropertyAttrs :: Subject -> Parser Triples
pPropertyAttrs Subject
s = do
  HashMap Text Text
attrs <- Parser (HashMap Text Text)
currentNodeAttrs
  HashMap Text Triple -> Triples
forall k v. HashMap k v -> [v]
HM.elems (HashMap Text Triple -> Triples)
-> ParserT
     (ExceptT String (State ParseState)) (HashMap Text Triple)
-> Parser Triples
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
 -> Text -> ParserT (ExceptT String (State ParseState)) Triple)
-> HashMap Text Text
-> ParserT
     (ExceptT String (State ParseState)) (HashMap Text Triple)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HM.traverseWithKey Text -> Text -> ParserT (ExceptT String (State ParseState)) Triple
f HashMap Text Text
attrs
  where
    f :: Text -> Text -> ParserT (ExceptT String (State ParseState)) Triple
f Text
attr Text
value
      | Bool -> Bool
not (Text -> Bool
isPropertyAttrURI Text
attr) = String -> ParserT (ExceptT String (State ParseState)) Triple
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ParserT (ExceptT String (State ParseState)) Triple)
-> String -> ParserT (ExceptT String (State ParseState)) Triple
forall a b. (a -> b) -> a -> b
$ String
"URI not allowed for attribute: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
attr
      | Text
attr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rdfType = Triple -> ParserT (ExceptT String (State ParseState)) Triple
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triple -> ParserT (ExceptT String (State ParseState)) Triple)
-> Triple -> ParserT (ExceptT String (State ParseState)) Triple
forall a b. (a -> b) -> a -> b
$ Subject -> Subject -> Subject -> Triple
Triple Subject
s Subject
rdfTypeNode (Text -> Subject
unode Text
value)
      | Bool
otherwise = do
          Maybe Text
lang <- ParserT (ExceptT String (State ParseState)) (Maybe Text)
currentLang
          Triple -> ParserT (ExceptT String (State ParseState)) Triple
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triple -> ParserT (ExceptT String (State ParseState)) Triple)
-> Triple -> ParserT (ExceptT String (State ParseState)) Triple
forall a b. (a -> b) -> a -> b
$ let mkLiteral :: Text -> LValue
mkLiteral = (Text -> LValue)
-> (Text -> Text -> LValue) -> Maybe Text -> Text -> LValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> LValue
plainL ((Text -> Text -> LValue) -> Text -> Text -> LValue
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> LValue
plainLL) Maybe Text
lang
                 in Subject -> Subject -> Subject -> Triple
Triple Subject
s (Text -> Subject
unode Text
attr) (LValue -> Subject
lnode (Text -> LValue
mkLiteral Text
value))

pLang :: Parser (Maybe Text)
pLang :: ParserT (ExceptT String (State ParseState)) (Maybe Text)
pLang = ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *). Applicative m => Text -> ParserT m Text
pAttr Text
"xml:lang")

-- [TODO] resolve base uri in context
pBase :: Parser (Maybe BaseUrl)
pBase :: Parser (Maybe BaseUrl)
pBase = ParserT (ExceptT String (State ParseState)) BaseUrl
-> Parser (Maybe BaseUrl)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParserT (ExceptT String (State ParseState)) BaseUrl
 -> Parser (Maybe BaseUrl))
-> ParserT (ExceptT String (State ParseState)) BaseUrl
-> Parser (Maybe BaseUrl)
forall a b. (a -> b) -> a -> b
$ do
  Text
uri <- Text -> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *). Applicative m => Text -> ParserT m Text
pAttr Text
"xml:base"
  -- Parse and remove fragment
  Text -> BaseUrl
BaseUrl (Text -> BaseUrl)
-> ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) BaseUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParserT (ExceptT String (State ParseState)) Text)
-> (IRIRef -> ParserT (ExceptT String (State ParseState)) Text)
-> Either String IRIRef
-> ParserT (ExceptT String (State ParseState)) Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    String -> ParserT (ExceptT String (State ParseState)) Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    (Text -> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> (IRIRef -> Text)
-> IRIRef
-> ParserT (ExceptT String (State ParseState)) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRIRef -> Text
serializeIRI (IRIRef -> Text) -> (IRIRef -> IRIRef) -> IRIRef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRIRef -> IRIRef
removeIRIFragment)
    (Text -> Either String IRIRef
parseIRI Text
uri)

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#propertyEltList
pPropertyEltList :: Parser Triples
pPropertyEltList :: Parser Triples
pPropertyEltList =  ParserT (ExceptT String (State ParseState)) ()
pWs
                 ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT (ExceptT String (State ParseState)) ()
resetCollectionIndex
                 ParserT (ExceptT String (State ParseState)) ()
-> Parser Triples -> Parser Triples
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Triples] -> Triples)
-> ParserT (ExceptT String (State ParseState)) [Triples]
-> Parser Triples
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Triples] -> Triples
forall a. Monoid a => [a] -> a
mconcat (Parser Triples
-> ParserT (ExceptT String (State ParseState)) [Triples]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Triples
pPropertyElt Parser Triples
-> ParserT (ExceptT String (State ParseState)) () -> Parser Triples
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT (ExceptT String (State ParseState)) ()
pWs))

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#propertyElt
pPropertyElt :: Parser Triples
pPropertyElt :: Parser Triples
pPropertyElt = Parser Triples -> Parser Triples
forall (m :: * -> *) a. Monad m => ParserT m a -> ParserT m a
pAnyElement (Parser Triples -> Parser Triples)
-> Parser Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ do
  -- Process attributes
  Parser (HashMap Text Text)
-> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser (HashMap Text Text)
pRDFAttrs
  -- Process the predicate from the URI
  Text
uri <- ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *). Applicative m => ParserT m Text
pName ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParserT (ExceptT String (State ParseState)) Text
pQName ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParserT (ExceptT String (State ParseState)) Text
listExpansion
  Bool
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
isPropertyAttrURI Text
uri) (String -> ParserT (ExceptT String (State ParseState)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ParserT (ExceptT String (State ParseState)) ())
-> String -> ParserT (ExceptT String (State ParseState)) ()
forall a b. (a -> b) -> a -> b
$ String
"URI not allowed for propertyElt: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
uri)
  let p :: Subject
p = Text -> Subject
unode Text
uri
  -- Process 'propertyElt'
  Subject -> Parser Triples
pParseTypeLiteralPropertyElt Subject
p
    Parser Triples -> Parser Triples -> Parser Triples
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Subject -> Parser Triples
pParseTypeResourcePropertyElt Subject
p
    Parser Triples -> Parser Triples -> Parser Triples
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Subject -> Parser Triples
pParseTypeCollectionPropertyElt Subject
p
    Parser Triples -> Parser Triples -> Parser Triples
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Subject -> Parser Triples
pParseTypeOtherPropertyElt Subject
p
    Parser Triples -> Parser Triples -> Parser Triples
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Subject -> Parser Triples
pResourcePropertyElt Subject
p
    Parser Triples -> Parser Triples -> Parser Triples
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Subject -> Parser Triples
pLiteralPropertyElt Subject
p
    Parser Triples -> Parser Triples -> Parser Triples
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Subject -> Parser Triples
pEmptyPropertyElt Subject
p
  where
    listExpansion :: Text -> ParserT (ExceptT String (State ParseState)) Text
listExpansion Text
u
      | Text
u Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rdfLi = ParserT (ExceptT String (State ParseState)) Text
nextCollectionIndex
      | Bool
otherwise  = Text -> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
u

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#resourcePropertyElt
pResourcePropertyElt :: Node -> Parser Triples
pResourcePropertyElt :: Subject -> Parser Triples
pResourcePropertyElt Subject
p = do
  ParserT (ExceptT String (State ParseState)) ()
pWs
  -- [NOTE] We need to restore part of the state after exploring the element' children.
  (Triples
ts1, Maybe Subject
o) <- Parser (Triples, Maybe Subject) -> Parser (Triples, Maybe Subject)
forall a. Parser a -> Parser a
keepState (Parser (Triples, Maybe Subject)
 -> Parser (Triples, Maybe Subject))
-> Parser (Triples, Maybe Subject)
-> Parser (Triples, Maybe Subject)
forall a b. (a -> b) -> a -> b
$ (Triples -> Maybe Subject -> (Triples, Maybe Subject))
-> Parser Triples
-> ParserT (ExceptT String (State ParseState)) (Maybe Subject)
-> Parser (Triples, Maybe Subject)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Parser Triples
pNodeElement ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
  ParserT (ExceptT String (State ParseState)) ()
pWs
  Maybe Text
mi <- ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
pIdAttr ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfID
  -- No other attribute is allowed.
  HashSet Text -> ParserT (ExceptT String (State ParseState)) ()
checkAllowedAttributes []
  -- Generated triple
  Maybe Subject
s <- ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
  let mt :: Maybe Triple
mt = (Subject -> Subject -> Subject -> Triple)
-> Subject -> Subject -> Subject -> Triple
forall a b c. (a -> b -> c) -> b -> a -> c
flip Subject -> Subject -> Subject -> Triple
Triple Subject
p (Subject -> Subject -> Triple)
-> Maybe Subject -> Maybe (Subject -> Triple)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Subject
s Maybe (Subject -> Triple) -> Maybe Subject -> Maybe Triple
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Subject
o
  -- Reify the triple
  Triples
ts2 <- Parser Triples
-> ((Text, Triple) -> Parser Triples)
-> Maybe (Text, Triple)
-> Parser Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty) ((Text -> Triple -> Parser Triples)
-> (Text, Triple) -> Parser Triples
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Triple -> Parser Triples
reifyTriple) ((Text -> Triple -> (Text, Triple))
-> Maybe Text -> Maybe Triple -> Maybe (Text, Triple)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Maybe Text
mi Maybe Triple
mt)
  Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triples -> Parser Triples) -> Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ Triples -> (Triple -> Triples) -> Maybe Triple -> Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples
ts1 Triples -> Triples -> Triples
forall a. Semigroup a => a -> a -> a
<> Triples
ts2) (Triple -> Triples -> Triples
forall a. a -> [a] -> [a]
:(Triples
ts1 Triples -> Triples -> Triples
forall a. Semigroup a => a -> a -> a
<> Triples
ts2)) Maybe Triple
mt

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#literalPropertyElt
pLiteralPropertyElt :: Node -> Parser Triples
pLiteralPropertyElt :: Subject -> Parser Triples
pLiteralPropertyElt Subject
p = do
  Text
l <- ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *). Applicative m => ParserT m Text
pText
  -- No children
  ParserT (ExceptT String (State ParseState)) [Node]
forall (m :: * -> *). Applicative m => ParserT m [Node]
pChildren ParserT (ExceptT String (State ParseState)) [Node]
-> ([Node] -> ParserT (ExceptT String (State ParseState)) ())
-> ParserT (ExceptT String (State ParseState)) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParserT (ExceptT String (State ParseState)) ())
-> ([Node] -> Bool)
-> [Node]
-> ParserT (ExceptT String (State ParseState)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  Maybe Text
mi <- ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
pIdAttr ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfID
  HashSet Text -> ParserT (ExceptT String (State ParseState)) ()
checkAllowedAttributes [Text
Item (HashSet Text)
rdfDatatype]
  Maybe Text
dt <- ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
pDatatypeAttr
  Maybe Subject
s <- ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
  Maybe Text
lang <- ParserT (ExceptT String (State ParseState)) (Maybe Text)
currentLang
  -- Generated triple
  let l' :: Text
l' = Text -> Text
TL.toStrict Text
l
      o :: Subject
o = LValue -> Subject
lnode (LValue -> Subject)
-> (Maybe LValue -> LValue) -> Maybe LValue -> Subject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LValue -> Maybe LValue -> LValue
forall a. a -> Maybe a -> a
fromMaybe (Text -> LValue
plainL Text
l') (Maybe LValue -> Subject) -> Maybe LValue -> Subject
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> LValue
typedL Text
l' (Text -> LValue) -> Maybe Text -> Maybe LValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
dt) Maybe LValue -> Maybe LValue -> Maybe LValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Text -> LValue
plainLL Text
l' (Text -> LValue) -> Maybe Text -> Maybe LValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
lang)
      mt :: Maybe Triple
mt = (\Subject
s' -> Subject -> Subject -> Subject -> Triple
Triple Subject
s' Subject
p Subject
o) (Subject -> Triple) -> Maybe Subject -> Maybe Triple
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Subject
s
  -- Reify the triple
  Triples
ts <- Parser Triples
-> ((Text, Triple) -> Parser Triples)
-> Maybe (Text, Triple)
-> Parser Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty) ((Text -> Triple -> Parser Triples)
-> (Text, Triple) -> Parser Triples
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Triple -> Parser Triples
reifyTriple) ((Text -> Triple -> (Text, Triple))
-> Maybe Text -> Maybe Triple -> Maybe (Text, Triple)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Maybe Text
mi Maybe Triple
mt)
  Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triples -> Parser Triples) -> Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ Triples -> (Triple -> Triples) -> Maybe Triple -> Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Triples
ts (Triple -> Triples -> Triples
forall a. a -> [a] -> [a]
:Triples
ts) Maybe Triple
mt

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#parseTypeLiteralPropertyElt
pParseTypeLiteralPropertyElt :: Node -> Parser Triples
pParseTypeLiteralPropertyElt :: Subject -> Parser Triples
pParseTypeLiteralPropertyElt Subject
p = do
  Text
pt <- Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfParseType
  Bool -> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
pt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Literal")
  Maybe Text
mi <- ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
pIdAttr ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfID
  HashSet Text -> ParserT (ExceptT String (State ParseState)) ()
checkAllowedAttributes [Text
Item (HashSet Text)
rdfParseType]
  Text
l <- ParserT (ExceptT String (State ParseState)) Text
pXMLLiteral
  -- Generated triple
  Maybe Subject
s <- ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
  let o :: Subject
o = LValue -> Subject
lnode (Text -> Text -> LValue
typedL Text
l Text
rdfXmlLiteral)
      mt :: Maybe Triple
mt = (\Subject
s' -> Subject -> Subject -> Subject -> Triple
Triple Subject
s' Subject
p Subject
o) (Subject -> Triple) -> Maybe Subject -> Maybe Triple
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Subject
s
  -- Reify the triple
  Triples
ts <- Parser Triples
-> ((Text, Triple) -> Parser Triples)
-> Maybe (Text, Triple)
-> Parser Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty) ((Text -> Triple -> Parser Triples)
-> (Text, Triple) -> Parser Triples
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Triple -> Parser Triples
reifyTriple) ((Text -> Triple -> (Text, Triple))
-> Maybe Text -> Maybe Triple -> Maybe (Text, Triple)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Maybe Text
mi Maybe Triple
mt)
  Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triples -> Parser Triples) -> Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ Triples -> (Triple -> Triples) -> Maybe Triple -> Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Triples
ts (Triple -> Triples -> Triples
forall a. a -> [a] -> [a]
:Triples
ts) Maybe Triple
mt

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#parseTypeResourcePropertyElt
pParseTypeResourcePropertyElt :: Node -> Parser Triples
pParseTypeResourcePropertyElt :: Subject -> Parser Triples
pParseTypeResourcePropertyElt Subject
p = do
  Text
pt <- Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfParseType
  Bool -> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
pt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Resource")
  Maybe Text
mi <- ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
pIdAttr ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfID
  HashSet Text -> ParserT (ExceptT String (State ParseState)) ()
checkAllowedAttributes [Text
Item (HashSet Text)
rdfParseType]
  -- Generated triple
  Maybe Subject
s <- ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
  Subject
o <- ParserT (ExceptT String (State ParseState)) Subject
newBNode
  let mt :: Maybe Triple
mt = (\Subject
s' -> Subject -> Subject -> Subject -> Triple
Triple Subject
s' Subject
p Subject
o) (Subject -> Triple) -> Maybe Subject -> Maybe Triple
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Subject
s
  -- Reify the triple
  Triples
ts1 <- Parser Triples
-> ((Text, Triple) -> Parser Triples)
-> Maybe (Text, Triple)
-> Parser Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty) ((Text -> Triple -> Parser Triples)
-> (Text, Triple) -> Parser Triples
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Triple -> Parser Triples
reifyTriple) ((Text -> Triple -> (Text, Triple))
-> Maybe Text -> Maybe Triple -> Maybe (Text, Triple)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Maybe Text
mi Maybe Triple
mt)
  Maybe Subject -> ParserT (ExceptT String (State ParseState)) ()
setSubject (Subject -> Maybe Subject
forall a. a -> Maybe a
Just Subject
o)
  -- Explore children
  Triples
ts2 <- Parser Triples -> Parser Triples
forall a. Parser a -> Parser a
keepCollectionIndex Parser Triples
pPropertyEltList
  --setSubject s
  Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triples -> Parser Triples) -> Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ Triples -> (Triple -> Triples) -> Maybe Triple -> Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples
ts1 Triples -> Triples -> Triples
forall a. Semigroup a => a -> a -> a
<> Triples
ts2) ((Triples -> Triples -> Triples
forall a. Semigroup a => a -> a -> a
<> Triples
ts2) (Triples -> Triples) -> (Triple -> Triples) -> Triple -> Triples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Triple -> Triples -> Triples
forall a. a -> [a] -> [a]
:Triples
ts1)) Maybe Triple
mt

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#parseTypeCollectionPropertyElt
pParseTypeCollectionPropertyElt :: Node -> Parser Triples
pParseTypeCollectionPropertyElt :: Subject -> Parser Triples
pParseTypeCollectionPropertyElt Subject
p = do
  Text
pt <- Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfParseType
  Bool -> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
pt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Collection")
  Maybe Text
mi <- ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
pIdAttr ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfID
  HashSet Text -> ParserT (ExceptT String (State ParseState)) ()
checkAllowedAttributes [Text
Item (HashSet Text)
rdfParseType]
  Maybe Subject
s <- ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
  case Maybe Subject
s of
    Maybe Subject
Nothing -> Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty
    Just Subject
s' -> do
      Maybe Triples
r <- Parser Triples
-> ParserT (ExceptT String (State ParseState)) (Maybe Triples)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Triples
pNodeElement
      case Maybe Triples
r of
        Maybe Triples
Nothing ->
          -- Empty collection
          let t :: Triple
t = Subject -> Subject -> Subject -> Triple
Triple Subject
s' Subject
p Subject
rdfNilNode
          in ([Item Triples
Triple
t] Triples -> Triples -> Triples
forall a. Semigroup a => a -> a -> a
<>) (Triples -> Triples) -> Parser Triples -> Parser Triples
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Triples
-> (Text -> Parser Triples) -> Maybe Text -> Parser Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty) (Text -> Triple -> Parser Triples
`reifyTriple` Triple
t) Maybe Text
mi
        Just Triples
ts1 -> do
          -- Non empty collection
          Maybe Subject
s'' <- ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
          Subject
n <- ParserT (ExceptT String (State ParseState)) Subject
newBNode
          -- Triples corresping to the first item
          let t :: Triple
t = Subject -> Subject -> Subject -> Triple
Triple Subject
s' Subject
p Subject
n
              ts2 :: Triples
ts2 = Triples -> (Subject -> Triples) -> Maybe Subject -> Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Triples
forall a. Monoid a => a
mempty (\Subject
s''' -> [Item Triples
Triple
t, Subject -> Subject -> Subject -> Triple
Triple Subject
n Subject
rdfFirstNode Subject
s''']) Maybe Subject
s''
          -- Process next item
          Triples
ts3 <- Subject -> Parser Triples
go Subject
n
          -- Reify triple
          Triples
ts4 <- Parser Triples
-> (Text -> Parser Triples) -> Maybe Text -> Parser Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty) (Text -> Triple -> Parser Triples
`reifyTriple` Triple
t) Maybe Text
mi
          Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triples -> Parser Triples) -> Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ [Triples] -> Triples
forall a. Monoid a => [a] -> a
mconcat [Triples
Item [Triples]
ts1, Triples
Item [Triples]
ts2, Triples
Item [Triples]
ts3, Triples
Item [Triples]
ts4]
  where
    go :: Subject -> Parser Triples
go Subject
s = do
      -- Generate the triples of the current item.
      Maybe Triples
r <- Parser Triples
-> ParserT (ExceptT String (State ParseState)) (Maybe Triples)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Triples
pNodeElement
      case Maybe Triples
r of
        -- End of the collection
        Maybe Triples
Nothing -> Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Subject -> Subject -> Subject -> Triple
Triple Subject
s Subject
rdfRestNode Subject
rdfNilNode]
        -- Add the item to the collection and process the next item
        Just Triples
ts1 -> do
          Maybe Subject
s' <- ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
          Subject
n <- ParserT (ExceptT String (State ParseState)) Subject
newBNode
          let ts2 :: Triples
ts2 = Triples -> (Subject -> Triples) -> Maybe Subject -> Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Triples
forall a. Monoid a => a
mempty (\Subject
s'' -> [Subject -> Subject -> Subject -> Triple
Triple Subject
s Subject
rdfRestNode Subject
n, Subject -> Subject -> Subject -> Triple
Triple Subject
n Subject
rdfFirstNode Subject
s'']) Maybe Subject
s'
          -- Next item
          Triples
ts3 <- Subject -> Parser Triples
go Subject
n
          Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triples -> Parser Triples) -> Triples -> Parser Triples
forall a b. (a -> b) -> a -> b
$ [Triples] -> Triples
forall a. Monoid a => [a] -> a
mconcat [Triples
Item [Triples]
ts1, Triples
Item [Triples]
ts2, Triples
Item [Triples]
ts3]

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#parseTypeOtherPropertyElt
pParseTypeOtherPropertyElt :: Node -> Parser Triples
pParseTypeOtherPropertyElt :: Subject -> Parser Triples
pParseTypeOtherPropertyElt Subject
_p = do
  Text
pt <- Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfParseType
  Bool -> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
pt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"Resource" Bool -> Bool -> Bool
&& Text
pt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"Literal" Bool -> Bool -> Bool
&& Text
pt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"Collection")
  HashSet Text -> ParserT (ExceptT String (State ParseState)) ()
checkAllowedAttributes [Text
Item (HashSet Text)
rdfParseType]
  Maybe Text
_mi <- ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
pIdAttr ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfID
  -- [FIXME] Implement 'parseTypeOtherPropertyElt'
  String -> Parser Triples
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Not implemented: rdf:parseType = other"

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#emptyPropertyElt
pEmptyPropertyElt :: Node -> Parser Triples
pEmptyPropertyElt :: Subject -> Parser Triples
pEmptyPropertyElt Subject
p = do
  Maybe Subject
s <- ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject
  case Maybe Subject
s of
    Maybe Subject
Nothing -> Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty
    Just Subject
s' -> do
      Maybe Text
mi <- ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParserT (ExceptT String (State ParseState)) Text
pIdAttr ParserT (ExceptT String (State ParseState)) (Maybe Text)
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfID
      Subject
o <- ParserT (ExceptT String (State ParseState)) Subject
pResourceAttr' ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT (ExceptT String (State ParseState)) Subject
pNodeIdAttr' ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT (ExceptT String (State ParseState)) Subject
newBNode
      let t :: Triple
t = Subject -> Subject -> Subject -> Triple
Triple Subject
s' Subject
p Subject
o
      -- Reify triple
      Triples
ts1 <- Parser Triples
-> (Text -> Parser Triples) -> Maybe Text -> Parser Triples
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure Triples
forall a. Monoid a => a
mempty) (Text -> Triple -> Parser Triples
`reifyTriple` Triple
t) Maybe Text
mi
      Triples
ts2 <- Subject -> Parser Triples
pPropertyAttrs Subject
o
      Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Triple
tTriple -> Triples -> Triples
forall a. a -> [a] -> [a]
:Triples
ts1 Triples -> Triples -> Triples
forall a. Semigroup a => a -> a -> a
<> Triples
ts2)
  where
    pResourceAttr' :: ParserT (ExceptT String (State ParseState)) Subject
pResourceAttr' = Text -> Subject
unode (Text -> Subject)
-> ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) Text
pResourceAttr ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfResource
    pNodeIdAttr' :: ParserT (ExceptT String (State ParseState)) Subject
pNodeIdAttr' = Text -> Subject
BNode (Text -> Subject)
-> ParserT (ExceptT String (State ParseState)) Text
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) Text
pNodeIdAttr ParserT (ExceptT String (State ParseState)) Subject
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
rdfNodeID

checkAllowedAttributes :: HashSet Text -> Parser ()
checkAllowedAttributes :: HashSet Text -> ParserT (ExceptT String (State ParseState)) ()
checkAllowedAttributes HashSet Text
as = do
  HashMap Text Text
attrs <- Parser (HashMap Text Text)
currentNodeAttrs
  let diffAttrs :: HashSet Text
diffAttrs = HashSet Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.difference (HashMap Text Text -> HashSet Text
forall k a. HashMap k a -> HashSet k
HM.keysSet HashMap Text Text
attrs) HashSet Text
as
  Bool
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet Text -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet Text
diffAttrs) (String -> ParserT (ExceptT String (State ParseState)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ParserT (ExceptT String (State ParseState)) ())
-> String -> ParserT (ExceptT String (State ParseState)) ()
forall a b. (a -> b) -> a -> b
$ String
"Attributes not allowed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HashSet Text -> String
forall a. Show a => a -> String
show HashSet Text
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 :: ParserT (ExceptT String (State ParseState)) Text
pXMLLiteral =
  ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ([Node] -> ByteString) -> [Node] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> ([Node] -> ByteString) -> [Node] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> ([Node] -> Builder) -> [Node] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> Builder
encode ([Node] -> Text)
-> ParserT (ExceptT String (State ParseState)) [Node]
-> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) [Node]
forall (m :: * -> *). Applicative m => ParserT m [Node]
pChildren

pIdAttr :: Parser Text
pIdAttr :: ParserT (ExceptT String (State ParseState)) Text
pIdAttr = do
  Text
i <- Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfID
  Text
i' <- (String -> ParserT (ExceptT String (State ParseState)) Text)
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> Either String Text
-> ParserT (ExceptT String (State ParseState)) Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParserT (ExceptT String (State ParseState)) Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text -> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either String Text
checkRdfId Text
i)
  -- Check the uniqueness of the ID in the context of the current base URI.
  Text -> ParserT (ExceptT String (State ParseState)) ()
checkIdIsUnique Text
i'
  Text -> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
i'

checkIdIsUnique :: Text -> Parser ()
checkIdIsUnique :: Text -> ParserT (ExceptT String (State ParseState)) ()
checkIdIsUnique Text
i = do
  Bool
notUnique <- Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Text
i (Set Text -> Bool)
-> ParserT (ExceptT String (State ParseState)) (Set Text)
-> ParserT (ExceptT String (State ParseState)) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) (Set Text)
currentIdSet
  Bool
-> ParserT (ExceptT String (State ParseState)) ()
-> ParserT (ExceptT String (State ParseState)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
notUnique (String -> ParserT (ExceptT String (State ParseState)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ParserT (ExceptT String (State ParseState)) ())
-> String -> ParserT (ExceptT String (State ParseState)) ()
forall a b. (a -> b) -> a -> b
$ String
"rdf:ID already used in this context: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
i)
  Text -> ParserT (ExceptT String (State ParseState)) ()
updateIdSet Text
i

pNodeIdAttr :: Parser Text
pNodeIdAttr :: ParserT (ExceptT String (State ParseState)) Text
pNodeIdAttr = do
  Text
i <- Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfNodeID
  (String -> ParserT (ExceptT String (State ParseState)) Text)
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> Either String Text
-> ParserT (ExceptT String (State ParseState)) Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParserT (ExceptT String (State ParseState)) Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text -> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either String Text
checkRdfId Text
i)

pAboutAttr :: Parser Text
pAboutAttr :: ParserT (ExceptT String (State ParseState)) Text
pAboutAttr = Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfAbout ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Text -> ParserT (ExceptT String (State ParseState)) Text
checkIRI String
"rdf:about"

pResourceAttr :: Parser Text
pResourceAttr :: ParserT (ExceptT String (State ParseState)) Text
pResourceAttr = Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfResource ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Text -> ParserT (ExceptT String (State ParseState)) Text
checkIRI String
"rdf:resource"

pDatatypeAttr :: Parser Text
pDatatypeAttr :: ParserT (ExceptT String (State ParseState)) Text
pDatatypeAttr = Text -> ParserT (ExceptT String (State ParseState)) Text
pRDFAttr Text
rdfDatatype ParserT (ExceptT String (State ParseState)) Text
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> ParserT (ExceptT String (State ParseState)) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Text -> ParserT (ExceptT String (State ParseState)) Text
checkIRI String
"rdf:datatype"

reifyTriple :: Text -> Triple -> Parser Triples
reifyTriple :: Text -> Triple -> Parser Triples
reifyTriple Text
i (Triple Subject
s Subject
p' Subject
o) = do
  Subject
n <- Text -> ParserT (ExceptT String (State ParseState)) Subject
mkUNodeID Text
i
  Triples -> Parser Triples
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ Subject -> Subject -> Subject -> Triple
Triple Subject
n Subject
rdfTypeNode Subject
rdfStatementNode
       , Subject -> Subject -> Subject -> Triple
Triple Subject
n Subject
rdfSubjectNode Subject
s
       , Subject -> Subject -> Subject -> Triple
Triple Subject
n Subject
rdfPredicateNode Subject
p'
       , Subject -> Subject -> Subject -> Triple
Triple Subject
n Subject
rdfObjectNode Subject
o ]

--------------------------------------------------------------------------------
-- URI checks

checkIRI :: String -> Text -> Parser Text
checkIRI :: String -> Text -> ParserT (ExceptT String (State ParseState)) Text
checkIRI String
msg Text
iri = do
  Text
bUri <- Text -> (BaseUrl -> Text) -> Maybe BaseUrl -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty BaseUrl -> Text
unBaseUrl (Maybe BaseUrl -> Text)
-> Parser (Maybe BaseUrl)
-> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe BaseUrl)
currentBaseUri
  case Text -> Maybe Text
uriValidate Text
iri of
    Maybe Text
Nothing   -> String -> ParserT (ExceptT String (State ParseState)) Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ParserT (ExceptT String (State ParseState)) Text)
-> String -> ParserT (ExceptT String (State ParseState)) Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Item [String]
"Malformed IRI for \"", String
Item [String]
msg, Item [String]
"\": ", Text -> String
T.unpack Text
iri]
    Just Text
iri' -> (String -> ParserT (ExceptT String (State ParseState)) Text)
-> (Text -> ParserT (ExceptT String (State ParseState)) Text)
-> Either String Text
-> ParserT (ExceptT String (State ParseState)) Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParserT (ExceptT String (State ParseState)) Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text -> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text -> Either String Text
resolveIRI Text
bUri Text
iri')

-- https://www.w3.org/TR/rdf-syntax-grammar/#propertyAttributeURIs
isPropertyAttrURI :: Text -> Bool
isPropertyAttrURI :: Text -> Bool
isPropertyAttrURI Text
uri
  =  Text -> Bool
isNotCoreSyntaxTerm Text
uri
  Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfDescription
  Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfLi
  Bool -> Bool -> Bool
&& Text -> Bool
isNotOldTerm Text
uri

-- https://www.w3.org/TR/rdf-syntax-grammar/#coreSyntaxTerms
isNotCoreSyntaxTerm :: Text -> Bool
isNotCoreSyntaxTerm :: Text -> Bool
isNotCoreSyntaxTerm Text
uri
  =  Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfTag Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfID Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfAbout
  Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfParseType Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfResource
  Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfNodeID Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfDatatype

-- https://www.w3.org/TR/rdf-syntax-grammar/#oldTerms
isNotOldTerm :: Text -> Bool
isNotOldTerm :: Text -> Bool
isNotOldTerm Text
uri =  Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfAboutEach
                 Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfAboutEachPrefix
                 Bool -> Bool -> Bool
&& Text
uri Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rdfBagID

--------------------------------------------------------------------------------
-- Parser's state utils

-- |Create a new unique blank node
newBNode :: Parser Node
newBNode :: ParserT (ExceptT String (State ParseState)) Subject
newBNode = do
  (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ParseState -> ParseState)
 -> ParserT (ExceptT String (State ParseState)) ())
-> (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall a b. (a -> b) -> a -> b
$ \ParseState
st -> ParseState
st { stateGenId :: Int
stateGenId = ParseState -> Int
stateGenId ParseState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
  Int -> Subject
BNodeGen (Int -> Subject) -> (ParseState -> Int) -> ParseState -> Subject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseState -> Int
stateGenId (ParseState -> Subject)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

-- |Process a parser, restoring the state except for stateGenId and stateIdSet
keepState :: Parser a -> Parser a
keepState :: Parser a -> Parser a
keepState Parser a
p = do
  ParseState
st <- ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get
  let bUri :: Maybe BaseUrl
bUri = ParseState -> Maybe BaseUrl
stateBaseUri ParseState
st
      is :: Set Text
is = ParseState -> Set Text
stateIdSet ParseState
st
  Parser a
p Parser a
-> ParserT (ExceptT String (State ParseState)) () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* do
    ParseState
st' <- ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get
    let i :: Int
i = ParseState -> Int
stateGenId ParseState
st'
        bUri' :: Maybe BaseUrl
bUri' = ParseState -> Maybe BaseUrl
stateBaseUri ParseState
st'
        is' :: Set Text
is' = ParseState -> Set Text
stateIdSet ParseState
st'
    -- Update the set of ID if necessary
    if Maybe BaseUrl
bUri Maybe BaseUrl -> Maybe BaseUrl -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe BaseUrl
bUri'
      then ParseState -> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParseState
st { stateGenId :: Int
stateGenId = Int
i })
      else ParseState -> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParseState
st { stateGenId :: Int
stateGenId = Int
i, stateIdSet :: Set Text
stateIdSet = Set Text
is Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> Set Text
is' })

currentIdSet :: Parser (Set Text)
currentIdSet :: ParserT (ExceptT String (State ParseState)) (Set Text)
currentIdSet = ParseState -> Set Text
stateIdSet (ParseState -> Set Text)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> ParserT (ExceptT String (State ParseState)) (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

updateIdSet :: Text -> Parser ()
updateIdSet :: Text -> ParserT (ExceptT String (State ParseState)) ()
updateIdSet Text
i = do
  Set Text
is <- ParserT (ExceptT String (State ParseState)) (Set Text)
currentIdSet
  (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParseState
st -> ParseState
st { stateIdSet :: Set Text
stateIdSet = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
S.insert Text
i Set Text
is })

currentNodeAttrs :: Parser (HashMap Text Text)
currentNodeAttrs :: Parser (HashMap Text Text)
currentNodeAttrs = ParseState -> HashMap Text Text
stateNodeAttrs (ParseState -> HashMap Text Text)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> Parser (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

setNodeAttrs :: HashMap Text Text -> Parser ()
setNodeAttrs :: HashMap Text Text -> ParserT (ExceptT String (State ParseState)) ()
setNodeAttrs HashMap Text Text
as = (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParseState
st -> ParseState
st { stateNodeAttrs :: HashMap Text Text
stateNodeAttrs = HashMap Text Text
as })

removeNodeAttr :: Text -> Parser ()
removeNodeAttr :: Text -> ParserT (ExceptT String (State ParseState)) ()
removeNodeAttr Text
a = Text -> HashMap Text Text -> HashMap Text Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
a (HashMap Text Text -> HashMap Text Text)
-> Parser (HashMap Text Text) -> Parser (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (HashMap Text Text)
currentNodeAttrs Parser (HashMap Text Text)
-> (HashMap Text Text
    -> ParserT (ExceptT String (State ParseState)) ())
-> ParserT (ExceptT String (State ParseState)) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashMap Text Text -> ParserT (ExceptT String (State ParseState)) ()
setNodeAttrs

currentPrefixMappings :: Parser PrefixMappings
currentPrefixMappings :: ParserT (ExceptT String (State ParseState)) PrefixMappings
currentPrefixMappings = ParseState -> PrefixMappings
statePrefixMapping (ParseState -> PrefixMappings)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> ParserT (ExceptT String (State ParseState)) PrefixMappings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

updatePrefixMappings :: PrefixMappings -> Parser PrefixMappings
updatePrefixMappings :: PrefixMappings
-> ParserT (ExceptT String (State ParseState)) PrefixMappings
updatePrefixMappings PrefixMappings
pm = do
  PrefixMappings
pm' <- (PrefixMappings -> PrefixMappings -> PrefixMappings
forall a. Semigroup a => a -> a -> a
<> PrefixMappings
pm) (PrefixMappings -> PrefixMappings)
-> ParserT (ExceptT String (State ParseState)) PrefixMappings
-> ParserT (ExceptT String (State ParseState)) PrefixMappings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) PrefixMappings
currentPrefixMappings
  (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParseState
st -> ParseState
st { statePrefixMapping :: PrefixMappings
statePrefixMapping = PrefixMappings
pm' })
  PrefixMappings
-> ParserT (ExceptT String (State ParseState)) PrefixMappings
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrefixMappings
pm'

currentCollectionIndex :: Parser Int
currentCollectionIndex :: Parser Int
currentCollectionIndex = ParseState -> Int
stateCollectionIndex (ParseState -> Int)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

setCollectionIndex :: Int -> Parser ()
setCollectionIndex :: Int -> ParserT (ExceptT String (State ParseState)) ()
setCollectionIndex Int
i = (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParseState
st -> ParseState
st { stateCollectionIndex :: Int
stateCollectionIndex = Int
i })

keepCollectionIndex :: Parser a -> Parser a
keepCollectionIndex :: Parser a -> Parser a
keepCollectionIndex Parser a
p = do
  Int
i <- Parser Int
currentCollectionIndex
  Parser a
p Parser a
-> ParserT (ExceptT String (State ParseState)) () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> ParserT (ExceptT String (State ParseState)) ()
setCollectionIndex Int
i

-- See: https://www.w3.org/TR/rdf-syntax-grammar/#section-List-Expand
nextCollectionIndex :: Parser Text
nextCollectionIndex :: ParserT (ExceptT String (State ParseState)) Text
nextCollectionIndex = do
  (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ParseState -> ParseState)
 -> ParserT (ExceptT String (State ParseState)) ())
-> (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall a b. (a -> b) -> a -> b
$ \ParseState
st -> ParseState
st { stateCollectionIndex :: Int
stateCollectionIndex = ParseState -> Int
stateCollectionIndex ParseState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
  (Text
rdfListIndex Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (ParseState -> Text) -> ParseState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ParseState -> String) -> ParseState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (ParseState -> Int) -> ParseState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseState -> Int
stateCollectionIndex (ParseState -> Text)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> ParserT (ExceptT String (State ParseState)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

resetCollectionIndex :: Parser ()
resetCollectionIndex :: ParserT (ExceptT String (State ParseState)) ()
resetCollectionIndex = (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ParseState -> ParseState)
 -> ParserT (ExceptT String (State ParseState)) ())
-> (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall a b. (a -> b) -> a -> b
$ \ParseState
st -> ParseState
st { stateCollectionIndex :: Int
stateCollectionIndex = Int
0 }

currentBaseUri :: Parser (Maybe BaseUrl)
currentBaseUri :: Parser (Maybe BaseUrl)
currentBaseUri = ParseState -> Maybe BaseUrl
stateBaseUri (ParseState -> Maybe BaseUrl)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> Parser (Maybe BaseUrl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

setBaseUri :: (Maybe BaseUrl) -> Parser ()
setBaseUri :: Maybe BaseUrl -> ParserT (ExceptT String (State ParseState)) ()
setBaseUri Maybe BaseUrl
u = (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParseState
st -> ParseState
st { stateBaseUri :: Maybe BaseUrl
stateBaseUri = Maybe BaseUrl
u })

mkUNodeID :: Text -> Parser Node
mkUNodeID :: Text -> ParserT (ExceptT String (State ParseState)) Subject
mkUNodeID Text
t = Maybe BaseUrl -> Subject
mkUnode (Maybe BaseUrl -> Subject)
-> Parser (Maybe BaseUrl)
-> ParserT (ExceptT String (State ParseState)) Subject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe BaseUrl)
currentBaseUri
  where
    mkUnode :: Maybe BaseUrl -> Subject
mkUnode = Text -> Subject
unode (Text -> Subject)
-> (Maybe BaseUrl -> Text) -> Maybe BaseUrl -> Subject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Maybe BaseUrl
Nothing          -> Text
t
      Just (BaseUrl Text
u) -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
Item [Text]
u, Item [Text]
"#", Text
Item [Text]
t]

currentSubject :: Parser (Maybe Subject)
currentSubject :: ParserT (ExceptT String (State ParseState)) (Maybe Subject)
currentSubject = ParseState -> Maybe Subject
stateSubject (ParseState -> Maybe Subject)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> ParserT (ExceptT String (State ParseState)) (Maybe Subject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

setSubject :: (Maybe Subject) -> Parser ()
setSubject :: Maybe Subject -> ParserT (ExceptT String (State ParseState)) ()
setSubject Maybe Subject
s = (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParseState
st -> ParseState
st { stateSubject :: Maybe Subject
stateSubject = Maybe Subject
s })

currentLang :: Parser (Maybe Text)
currentLang :: ParserT (ExceptT String (State ParseState)) (Maybe Text)
currentLang = ParseState -> Maybe Text
stateLang (ParseState -> Maybe Text)
-> ParserT (ExceptT String (State ParseState)) ParseState
-> ParserT (ExceptT String (State ParseState)) (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT (ExceptT String (State ParseState)) ParseState
forall s (m :: * -> *). MonadState s m => m s
get

setLang :: (Maybe Text) -> Parser ()
setLang :: Maybe Text -> ParserT (ExceptT String (State ParseState)) ()
setLang Maybe Text
lang = (ParseState -> ParseState)
-> ParserT (ExceptT String (State ParseState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ParseState
st -> ParseState
st { stateLang :: Maybe Text
stateLang = Maybe Text
lang })