module Data.RDF.Query (
equalSubjects, equalPredicates, equalObjects,
subjectOf, predicateOf, objectOf, isEmpty,
rdfContainsNode, tripleContainsNode,
listSubjectsWithPredicate, listObjectsOfPredicate,
isIsomorphic, 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 (toPMList, uriOf, rdf)
import qualified Data.Text as T
import Data.Maybe (catMaybes)
subjectOf :: Triple -> Node
subjectOf (Triple s _ _) = s
predicateOf :: Triple -> Node
predicateOf (Triple _ p _) = p
objectOf :: Triple -> Node
objectOf (Triple _ _ o) = o
rdfContainsNode :: forall rdf. (RDF rdf) => rdf -> Node -> Bool
rdfContainsNode rdf node =
let ts = triplesOf rdf
xs = map (tripleContainsNode node) ts
in elem True xs
tripleContainsNode :: Node -> Triple -> Bool
tripleContainsNode node t =
subjectOf t == node || predicateOf t == node || objectOf t == 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 rdf => rdf -> Bool
isEmpty rdf =
let ts = triplesOf rdf
in null ts
listSubjectsWithPredicate :: RDF rdf => rdf -> Predicate -> [Subject]
listSubjectsWithPredicate rdf pred =
listNodesWithPredicate rdf pred subjectOf
listObjectsOfPredicate :: RDF rdf => rdf -> Predicate -> [Object]
listObjectsOfPredicate rdf pred =
listNodesWithPredicate rdf pred objectOf
listNodesWithPredicate :: RDF rdf => rdf -> Predicate -> (Triple -> Node) -> [Node]
listNodesWithPredicate rdf pred f =
let ts = triplesOf rdf
xs = filter (\t -> predicateOf t == pred) ts
in map f xs
fromEither :: RDF rdf => Either ParseFailure rdf -> rdf
fromEither res =
case res of
(Left err) -> error (show err)
(Right rdf) -> rdf
isIsomorphic :: forall rdf1 rdf2. (RDF rdf1, RDF rdf2) => rdf1 -> rdf2 -> 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 :: forall rdf. (RDF rdf) => rdf -> Triples
normalize = sort . nub . expandTriples
expandTriples :: (RDF rdf) => rdf -> Triples
expandTriples rdf = expandTriples' [] (baseUrl rdf) (prefixMappings rdf) (triplesOf rdf)
expandTriples' :: Triples -> Maybe BaseUrl -> PrefixMappings -> Triples -> Triples
expandTriples' acc _ _ [] = acc
expandTriples' acc baseURL prefixMaps (t:rest) = expandTriples' (normalize baseURL prefixMaps t : acc) baseURL prefixMaps rest
where normalize baseURL' prefixMaps' = absolutizeTriple baseURL' . expandTriple prefixMaps'
expandTriple :: PrefixMappings -> Triple -> Triple
expandTriple pms t = triple (expandNode pms $ subjectOf t) (expandNode pms $ predicateOf t) (expandNode pms $ objectOf t)
expandNode :: PrefixMappings -> Node -> Node
expandNode pms (UNode n) = unode $ expandURI pms n
expandNode _ n' = n'
expandURI :: PrefixMappings -> T.Text -> T.Text
expandURI _ "a" = T.append (NS.uriOf NS.rdf) "type"
expandURI pms' x = firstExpandedOrOriginal x $ catMaybes $ map (resourceTail x) (NS.toPMList pms')
where resourceTail :: T.Text -> (T.Text, T.Text) -> Maybe T.Text
resourceTail x' (p', u') = T.stripPrefix (T.append p' ":") x' >>= Just . T.append u'
firstExpandedOrOriginal :: a -> [a] -> a
firstExpandedOrOriginal orig' [] = orig'
firstExpandedOrOriginal _ (e:_) = e
absolutizeTriple :: Maybe BaseUrl -> Triple -> Triple
absolutizeTriple base t = triple (absolutizeNode base $ subjectOf t) (absolutizeNode base $ predicateOf t) (absolutizeNode base $ objectOf t)
absolutizeNode :: Maybe BaseUrl -> Node -> Node
absolutizeNode (Just (BaseUrl b')) (UNode u') = unode $ mkAbsoluteUrl b' u'
absolutizeNode _ n = n