{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.RDF.Query
  ( -- * Query functions
    equalSubjects,
    equalPredicates,
    equalObjects,
    subjectOf,
    predicateOf,
    objectOf,
    isEmpty,
    rdfContainsNode,
    tripleContainsNode,
    subjectsWithPredicate,
    objectsOfPredicate,
    uordered,

    -- * RDF graph functions
    isIsomorphic,
    expandTriples,
    fromEither,

    -- * expansion functions
    expandTriple,
    expandNode,
    expandURI,

    -- * absolutizing functions
    absolutizeTriple,
    absolutizeNode,
    absolutizeNodeUnsafe,
    QueryException (..),
  )
where

import Control.Applicative ((<|>))
import Control.Exception
import Data.List
import Data.Maybe (fromMaybe)
import Data.RDF.IRI
import qualified Data.RDF.Namespace as NS
import Data.RDF.Types
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif
import Data.Text (Text)
import qualified Data.Text as T
import Prelude hiding (pred)

-- | Answer the subject node of the triple.
{-# INLINE subjectOf #-}
subjectOf :: Triple -> Node
subjectOf :: Triple -> Node
subjectOf (Triple Node
s Node
_ Node
_) = Node
s

-- | Answer the predicate node of the triple.
{-# INLINE predicateOf #-}
predicateOf :: Triple -> Node
predicateOf :: Triple -> Node
predicateOf (Triple Node
_ Node
p Node
_) = Node
p

-- | Answer the object node of the triple.
{-# INLINE objectOf #-}
objectOf :: Triple -> Node
objectOf :: Triple -> Node
objectOf (Triple Node
_ Node
_ Node
o) = Node
o

-- | Answer if rdf contains node.
rdfContainsNode :: (Rdf a) => RDF a -> Node -> Bool
rdfContainsNode :: forall a. Rdf a => RDF a -> Node -> Bool
rdfContainsNode RDF a
rdf Node
node = (Triple -> Bool) -> [Triple] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Node -> Triple -> Bool
tripleContainsNode Node
node) (RDF a -> [Triple]
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
triplesOf RDF a
rdf)

-- | Answer if triple contains node.
--  Note that it doesn't perform namespace expansion!
tripleContainsNode :: Node -> Triple -> Bool
{-# INLINE tripleContainsNode #-}
tripleContainsNode :: Node -> Triple -> Bool
tripleContainsNode Node
node (Triple Node
s Node
p Node
o) = Node
s Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
node Bool -> Bool -> Bool
|| Node
p Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
node Bool -> Bool -> Bool
|| Node
o Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
node

-- | Determine whether two triples have equal subjects.
--  Note that it doesn't perform namespace expansion!
equalSubjects :: Triple -> Triple -> Bool
equalSubjects :: Triple -> Triple -> Bool
equalSubjects (Triple Node
s1 Node
_ Node
_) (Triple Node
s2 Node
_ Node
_) = Node
s1 Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
s2

-- | Determine whether two triples have equal predicates.
--  Note that it doesn't perform namespace expansion!
equalPredicates :: Triple -> Triple -> Bool
equalPredicates :: Triple -> Triple -> Bool
equalPredicates (Triple Node
_ Node
p1 Node
_) (Triple Node
_ Node
p2 Node
_) = Node
p1 Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
p2

-- | Determine whether two triples have equal objects.
--  Note that it doesn't perform namespace expansion!
equalObjects :: Triple -> Triple -> Bool
equalObjects :: Triple -> Triple -> Bool
equalObjects (Triple Node
_ Node
_ Node
o1) (Triple Node
_ Node
_ Node
o2) = Node
o1 Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
o2

-- | Determines whether the 'RDF' contains zero triples.
isEmpty :: Rdf a => RDF a -> Bool
isEmpty :: forall a. Rdf a => RDF a -> Bool
isEmpty = [Triple] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Triple] -> Bool) -> (RDF a -> [Triple]) -> RDF a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDF a -> [Triple]
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
triplesOf

-- | Lists of all subjects of triples with the given predicate.
subjectsWithPredicate :: Rdf a => RDF a -> Predicate -> [Subject]
subjectsWithPredicate :: forall a. Rdf a => RDF a -> Node -> [Node]
subjectsWithPredicate RDF a
rdf Node
pred = Triple -> Node
subjectOf (Triple -> Node) -> [Triple] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RDF a -> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
forall rdfImpl.
Rdf rdfImpl =>
RDF rdfImpl -> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
query RDF a
rdf Maybe Node
forall a. Maybe a
Nothing (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
pred) Maybe Node
forall a. Maybe a
Nothing

-- | Lists of all objects of triples with the given predicate.
objectsOfPredicate :: Rdf a => RDF a -> Predicate -> [Object]
objectsOfPredicate :: forall a. Rdf a => RDF a -> Node -> [Node]
objectsOfPredicate RDF a
rdf Node
pred = Triple -> Node
objectOf (Triple -> Node) -> [Triple] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RDF a -> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
forall rdfImpl.
Rdf rdfImpl =>
RDF rdfImpl -> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
query RDF a
rdf Maybe Node
forall a. Maybe a
Nothing (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
pred) Maybe Node
forall a. Maybe a
Nothing

-- | Convert a parse result into an RDF if it was successful
--  and error and terminate if not.
fromEither :: Either ParseFailure (RDF a) -> RDF a
fromEither :: forall a. Either ParseFailure (RDF a) -> RDF a
fromEither (Left ParseFailure
err) = [Char] -> RDF a
forall a. HasCallStack => [Char] -> a
error (ParseFailure -> [Char]
forall a. Show a => a -> [Char]
show ParseFailure
err)
fromEither (Right RDF a
rdf) = RDF a
rdf

-- | Convert a list of triples into a sorted list of unique triples.
uordered :: Triples -> Triples
uordered :: [Triple] -> [Triple]
uordered = [Triple] -> [Triple]
forall a. Ord a => [a] -> [a]
sort ([Triple] -> [Triple])
-> ([Triple] -> [Triple]) -> [Triple] -> [Triple]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Triple] -> [Triple]
forall a. Eq a => [a] -> [a]
nub

-- graphFromEdges :: Ord key => [(node, key, [key])] -> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)

-- | This determines if two RDF representations are equal regardless
--  of blank node names, triple order and prefixes. In math terms,
--  this is the \simeq latex operator, or ~= . Unsafe because it
--  assumes IRI resolution will succeed, may throw an
--  'IRIResolutionException` exception.
isIsomorphic :: (Rdf a, Rdf b) => RDF a -> RDF b -> Bool
isIsomorphic :: forall a b. (Rdf a, Rdf b) => RDF a -> RDF b -> Bool
isIsomorphic RDF a
g1 RDF b
g2 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Triple -> Triple -> Bool) -> [Triple] -> [Triple] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Triple -> Triple -> Bool
compareTripleUnlessBlank (RDF a -> [Triple]
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
normalize RDF a
g1) (RDF b -> [Triple]
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
normalize RDF b
g2)
  where
    compareNodeUnlessBlank :: Node -> Node -> Bool
    compareNodeUnlessBlank :: Node -> Node -> Bool
compareNodeUnlessBlank (BNode Text
_) (BNode Text
_) = Bool
True
    compareNodeUnlessBlank (UNode Text
n1) (UNode Text
n2) = Text
n1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n2
    compareNodeUnlessBlank (BNodeGen Int
i1) (BNodeGen Int
i2) = Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2
    compareNodeUnlessBlank (LNode LValue
l1) (LNode LValue
l2) = LValue
l1 LValue -> LValue -> Bool
forall a. Eq a => a -> a -> Bool
== LValue
l2
    compareNodeUnlessBlank (BNodeGen Int
_) (BNode Text
_) = Bool
True
    compareNodeUnlessBlank (BNode Text
_) (BNodeGen Int
_) = Bool
True
    compareNodeUnlessBlank Node
_ Node
_ = Bool
False -- isn't this exhaustive already?
    compareTripleUnlessBlank :: Triple -> Triple -> Bool
    compareTripleUnlessBlank :: Triple -> Triple -> Bool
compareTripleUnlessBlank (Triple Node
s1 Node
p1 Node
o1) (Triple Node
s2 Node
p2 Node
o2) =
      Node -> Node -> Bool
compareNodeUnlessBlank Node
s1 Node
s2
        Bool -> Bool -> Bool
&& Node -> Node -> Bool
compareNodeUnlessBlank Node
p1 Node
p2
        Bool -> Bool -> Bool
&& Node -> Node -> Bool
compareNodeUnlessBlank Node
o1 Node
o2
    normalize :: (Rdf a) => RDF a -> Triples
    normalize :: forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
normalize = [Triple] -> [Triple]
forall a. Ord a => [a] -> [a]
sort ([Triple] -> [Triple]) -> (RDF a -> [Triple]) -> RDF a -> [Triple]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Triple] -> [Triple]
forall a. Eq a => [a] -> [a]
nub ([Triple] -> [Triple]) -> (RDF a -> [Triple]) -> RDF a -> [Triple]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDF a -> [Triple]
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
expandTriples

-- | Expand the triples in a graph with the prefix map and base URL
-- for that graph. Unsafe because it assumes IRI resolution will
-- succeed, may throw an 'IRIResolutionException` exception.
expandTriples :: (Rdf a) => RDF a -> Triples
expandTriples :: forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
expandTriples RDF a
rdf = Triple -> Triple
normalize (Triple -> Triple) -> [Triple] -> [Triple]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RDF a -> [Triple]
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
triplesOf RDF a
rdf
  where
    normalize :: Triple -> Triple
normalize = Maybe BaseUrl -> Triple -> Triple
absolutizeTriple (RDF a -> Maybe BaseUrl
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> Maybe BaseUrl
baseUrl RDF a
rdf) (Triple -> Triple) -> (Triple -> Triple) -> Triple -> Triple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixMappings -> Triple -> Triple
expandTriple (RDF a -> PrefixMappings
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> PrefixMappings
prefixMappings RDF a
rdf)

-- | Expand the triple with the prefix map.
expandTriple :: PrefixMappings -> Triple -> Triple
expandTriple :: PrefixMappings -> Triple -> Triple
expandTriple PrefixMappings
pms (Triple Node
s Node
p Node
o) = Node -> Node -> Node -> Triple
triple (PrefixMappings -> Node -> Node
expandNode PrefixMappings
pms Node
s) (PrefixMappings -> Node -> Node
expandNode PrefixMappings
pms Node
p) (PrefixMappings -> Node -> Node
expandNode PrefixMappings
pms Node
o)

-- | Expand the node with the prefix map.
--  Only UNodes are expanded, other kinds of nodes are returned as-is.
expandNode :: PrefixMappings -> Node -> Node
expandNode :: PrefixMappings -> Node -> Node
expandNode PrefixMappings
pms (UNode Text
u) = Text -> Node
unode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ PrefixMappings -> Text -> Text
expandURI PrefixMappings
pms Text
u
expandNode PrefixMappings
_ Node
n = Node
n

-- | Expand the URI with the prefix map.
--  Also expands "a" to "http://www.w3.org/1999/02/22-rdf-syntax-ns#type".
expandURI :: PrefixMappings -> Text -> Text
expandURI :: PrefixMappings -> Text -> Text
expandURI PrefixMappings
_ Text
"a" = Namespace -> Text -> Text
NS.mkUri Namespace
NS.rdf Text
"type"
expandURI PrefixMappings
pms Text
iri = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
iri (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> (Text, Text) -> Maybe Text)
-> Maybe Text -> [(Text, Text)] -> Maybe Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe Text -> (Text, Text) -> Maybe Text
f Maybe Text
forall a. Maybe a
Nothing (PrefixMappings -> [(Text, Text)]
NS.toPMList PrefixMappings
pms)
  where
    f :: Maybe Text -> (Text, Text) -> Maybe Text
    f :: Maybe Text -> (Text, Text) -> Maybe Text
f Maybe Text
x (Text
p, Text
u) = Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Text -> Text
T.append Text
u (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripPrefix (Text -> Text -> Text
T.append Text
p Text
":") Text
iri)

-- | Prefixes relative URIs in the triple with BaseUrl. Unsafe because
-- it assumes IRI resolution will succeed, may throw an
-- 'IRIResolutionException` exception.
absolutizeTriple :: Maybe BaseUrl -> Triple -> Triple
absolutizeTriple :: Maybe BaseUrl -> Triple -> Triple
absolutizeTriple Maybe BaseUrl
base (Triple Node
s Node
p Node
o) = Node -> Node -> Node -> Triple
triple (Maybe BaseUrl -> Node -> Node
absolutizeNodeUnsafe Maybe BaseUrl
base Node
s) (Maybe BaseUrl -> Node -> Node
absolutizeNodeUnsafe Maybe BaseUrl
base Node
p) (Maybe BaseUrl -> Node -> Node
absolutizeNodeUnsafe Maybe BaseUrl
base Node
o)

-- | Prepends BaseUrl to UNodes with relative URIs.
absolutizeNode :: Maybe BaseUrl -> Node -> Either String Node
absolutizeNode :: Maybe BaseUrl -> Node -> Either [Char] Node
absolutizeNode (Just (BaseUrl Text
b)) (UNode Text
u) =
  case Text -> Text -> Either [Char] Text
resolveIRI Text
b Text
u of
    Left [Char]
iriErr -> [Char] -> Either [Char] Node
forall a b. a -> Either a b
Left [Char]
iriErr
    Right Text
t -> Node -> Either [Char] Node
forall a b. b -> Either a b
Right (Text -> Node
unode Text
t)
absolutizeNode Maybe BaseUrl
_ Node
n = Node -> Either [Char] Node
forall a b. b -> Either a b
Right Node
n

data QueryException
  = IRIResolutionException String
  deriving (Int -> QueryException -> ShowS
[QueryException] -> ShowS
QueryException -> [Char]
(Int -> QueryException -> ShowS)
-> (QueryException -> [Char])
-> ([QueryException] -> ShowS)
-> Show QueryException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryException -> ShowS
showsPrec :: Int -> QueryException -> ShowS
$cshow :: QueryException -> [Char]
show :: QueryException -> [Char]
$cshowList :: [QueryException] -> ShowS
showList :: [QueryException] -> ShowS
Show)

instance Exception QueryException

-- | Prepends BaseUrl to UNodes with relative URIs. Unsafe because it
-- assumes IRI resolution will succeed, may throw an
-- 'IRIResolutionException` exception.
absolutizeNodeUnsafe :: Maybe BaseUrl -> Node -> Node
absolutizeNodeUnsafe :: Maybe BaseUrl -> Node -> Node
absolutizeNodeUnsafe (Just (BaseUrl Text
b)) (UNode Text
u) =
  case Text -> Text -> Either [Char] Text
resolveIRI Text
b Text
u of
    Left [Char]
iriErr -> QueryException -> Node
forall a e. Exception e => e -> a
throw ([Char] -> QueryException
IRIResolutionException [Char]
iriErr)
    Right Text
t -> Text -> Node
unode Text
t
absolutizeNodeUnsafe Maybe BaseUrl
_ Node
n = Node
n