{-# LANGUAGE OverloadedStrings #-}
module Data.RDF.Query (
equalSubjects, equalPredicates, equalObjects,
subjectOf, predicateOf, objectOf, isEmpty,
rdfContainsNode, tripleContainsNode,
subjectsWithPredicate, objectsOfPredicate, uordered,
isIsomorphic, isGraphIsomorphic, expandTriples, fromEither,
expandTriple, expandNode, expandURI,
absolutizeTriple, absolutizeNode
) where
import Prelude hiding (pred)
import Data.List
import Data.RDF.Types
import qualified Data.RDF.Namespace as NS
import Data.Text (Text)
import qualified Data.Text as T
import Data.Graph (Graph,graphFromEdges)
import qualified Data.Graph.Automorphism as Automorphism
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)
import Control.Applicative ((<|>))
{-# INLINE subjectOf #-}
subjectOf :: Triple -> Node
subjectOf (Triple s _ _) = s
{-# INLINE predicateOf #-}
predicateOf :: Triple -> Node
predicateOf (Triple _ p _) = p
{-# INLINE objectOf #-}
objectOf :: Triple -> Node
objectOf (Triple _ _ o) = o
rdfContainsNode :: (Rdf a) => RDF a -> Node -> Bool
rdfContainsNode rdf node = any (tripleContainsNode node) (triplesOf rdf)
tripleContainsNode :: Node -> Triple -> Bool
{-# INLINE tripleContainsNode #-}
tripleContainsNode node (Triple s p o) = s == node || p == node || o == node
equalSubjects :: Triple -> Triple -> Bool
equalSubjects (Triple s1 _ _) (Triple s2 _ _) = s1 == s2
equalPredicates :: Triple -> Triple -> Bool
equalPredicates (Triple _ p1 _) (Triple _ p2 _) = p1 == p2
equalObjects :: Triple -> Triple -> Bool
equalObjects (Triple _ _ o1) (Triple _ _ o2) = o1 == o2
isEmpty :: Rdf a => RDF a -> Bool
isEmpty = null . triplesOf
subjectsWithPredicate :: Rdf a => RDF a -> Predicate -> [Subject]
subjectsWithPredicate rdf pred = subjectOf <$> query rdf Nothing (Just pred) Nothing
objectsOfPredicate :: Rdf a => RDF a -> Predicate -> [Object]
objectsOfPredicate rdf pred = objectOf <$> query rdf Nothing (Just pred) Nothing
fromEither :: Rdf a => Either ParseFailure (RDF a) -> RDF a
fromEither (Left err) = error (show err)
fromEither (Right rdf) = rdf
uordered :: Triples -> Triples
uordered = sort . nub
isIsomorphic :: (Rdf a, Rdf b) => RDF a -> RDF b -> Bool
isIsomorphic g1 g2 = and $ zipWith compareTripleUnlessBlank (normalize g1) (normalize g2)
where
compareNodeUnlessBlank :: Node -> Node -> Bool
compareNodeUnlessBlank (BNode _) (BNode _) = True
compareNodeUnlessBlank (UNode n1) (UNode n2) = n1 == n2
compareNodeUnlessBlank (BNodeGen i1) (BNodeGen i2) = i1 == i2
compareNodeUnlessBlank (LNode l1) (LNode l2) = l1 == l2
compareNodeUnlessBlank (BNodeGen _) (BNode _) = True
compareNodeUnlessBlank (BNode _) (BNodeGen _) = True
compareNodeUnlessBlank _ _ = False
compareTripleUnlessBlank :: Triple -> Triple -> Bool
compareTripleUnlessBlank (Triple s1 p1 o1) (Triple s2 p2 o2) =
compareNodeUnlessBlank s1 s2 &&
compareNodeUnlessBlank p1 p2 &&
compareNodeUnlessBlank o1 o2
normalize :: (Rdf a) => RDF a -> Triples
normalize = sort . nub . expandTriples
isGraphIsomorphic :: (Rdf a, Rdf b) => RDF a -> RDF b -> Bool
isGraphIsomorphic g1 g2 = Automorphism.isIsomorphic g1' g2'
where
g1' = rdfGraphToDataGraph g1
g2' = rdfGraphToDataGraph g2
rdfGraphToDataGraph :: Rdf c => RDF c -> Graph
rdfGraphToDataGraph g = dataGraph
where
triples = expandTriples g
triplesHashMap :: HashMap (Subject,Predicate) [Object]
triplesHashMap = HashMap.fromListWith (++) [((s,p), [o]) | Triple s p o <- triples]
triplesGrouped :: [((Subject,Predicate),[Object])]
triplesGrouped = HashMap.toList triplesHashMap
(dataGraph,_,_) = (graphFromEdges . fmap (\((s,p),os) -> (s,p,os))) triplesGrouped
expandTriples :: (Rdf a) => RDF a -> Triples
expandTriples rdf = normalize <$> triplesOf rdf
where normalize = absolutizeTriple (baseUrl rdf) . expandTriple (prefixMappings rdf)
expandTriple :: PrefixMappings -> Triple -> Triple
expandTriple pms (Triple s p o) = triple (expandNode pms s) (expandNode pms p) (expandNode pms o)
expandNode :: PrefixMappings -> Node -> Node
expandNode pms (UNode u) = unode $ expandURI pms u
expandNode _ n = n
expandURI :: PrefixMappings -> Text -> Text
expandURI _ "a" = NS.mkUri NS.rdf "type"
expandURI pms iri = maybe iri id $ foldl' f Nothing (NS.toPMList pms)
where f :: Maybe Text -> (Text, Text) -> Maybe Text
f x (p, u) = x <|> (T.append u <$> T.stripPrefix (T.append p ":") iri)
absolutizeTriple :: Maybe BaseUrl -> Triple -> Triple
absolutizeTriple base (Triple s p o) = triple (absolutizeNode base s) (absolutizeNode base p) (absolutizeNode base o)
absolutizeNode :: Maybe BaseUrl -> Node -> Node
absolutizeNode (Just (BaseUrl b)) (UNode u) = unode $ mkAbsoluteUrl b u
absolutizeNode _ n = n