{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.RDF.Graph.AdjHashMap (AdjHashMap) where
import Prelude hiding (pred)
import Data.List
import Data.Binary (Binary)
import Data.RDF.Types
import Data.RDF.Query
import Data.RDF.Namespace
import Data.Hashable ()
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as Set
import Control.Monad (mfilter)
import Control.DeepSeq (NFData)
import GHC.Generics
data AdjHashMap deriving (Generic)
instance Binary AdjHashMap
instance NFData AdjHashMap
data instance RDF AdjHashMap = AdjHashMap (TMaps, Maybe BaseUrl, PrefixMappings)
deriving (NFData,Generic)
instance Rdf AdjHashMap where
baseUrl = baseUrl'
prefixMappings = prefixMappings'
addPrefixMappings = addPrefixMappings'
empty = empty'
mkRdf = mkRdf'
triplesOf = triplesOf'
uniqTriplesOf = uniqTriplesOf'
select = select'
query = query'
showGraph = showGraph'
addTriple = addTriple'
removeTriple = removeTriple'
showGraph' :: RDF AdjHashMap -> [Char]
showGraph' ((AdjHashMap ((spoMap, _), _, _))) =
let ts = concatMap (uncurry tripsSubj) subjPredMaps
where subjPredMaps = HashMap.toList spoMap
in concatMap (\t -> show t ++ "\n") ts
type AdjacencyMap = HashMap Predicate Adjacencies
type Adjacencies = HashSet Node
type TMap = HashMap Node AdjacencyMap
type TMaps = (TMap, TMap)
baseUrl' :: RDF AdjHashMap -> Maybe BaseUrl
baseUrl' (AdjHashMap (_, baseURL, _)) = baseURL
prefixMappings' :: RDF AdjHashMap -> PrefixMappings
prefixMappings' (AdjHashMap (_, _, pms)) = pms
addPrefixMappings' :: RDF AdjHashMap -> PrefixMappings -> Bool -> RDF AdjHashMap
addPrefixMappings' (AdjHashMap (ts, baseURL, pms)) pms' replace =
let merge = if replace then flip mergePrefixMappings else mergePrefixMappings
in AdjHashMap (ts, baseURL, merge pms pms')
empty' :: RDF AdjHashMap
empty' = AdjHashMap ((mempty, mempty), Nothing, PrefixMappings mempty)
mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AdjHashMap
mkRdf' ts baseURL pms = AdjHashMap (mergeTs (mempty, mempty) ts, baseURL, pms)
addTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap
addTriple' (AdjHashMap (tmaps, baseURL, pms)) t =
let newTMaps = mergeTs tmaps [t]
in AdjHashMap (newTMaps, baseURL, pms)
removeTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap
removeTriple' (AdjHashMap ((spo, ops), baseURL, pms)) (Triple s p o) =
AdjHashMap (new_tmaps, baseURL, pms)
where
new_tmaps = (removeT s p o spo, removeT o p s ops)
removeT s' p' o' = HashMap.alter (removePO p' o') s'
removePO p' o' po = mfilter (not . null) $ HashMap.alter (removeO o') p' <$> po
removeO o' os = mfilter (not . null) $ Set.delete o' <$> os
mergeTs :: TMaps -> Triples -> TMaps
mergeTs = foldl' mergeT
where
mergeT :: TMaps -> Triple -> TMaps
mergeT (spo, ops) (Triple s p o) = (insertT s p o spo, insertT o p s ops)
insertT :: Node -> Predicate -> Node -> TMap -> TMap
insertT s p o = let newPO = HashMap.singleton p (Set.singleton o)
in HashMap.insertWith (HashMap.unionWith mappend) s newPO
triplesOf' :: RDF AdjHashMap -> Triples
triplesOf' (AdjHashMap ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps
where subjPredMaps = HashMap.toList spoMap
uniqTriplesOf' :: RDF AdjHashMap -> Triples
uniqTriplesOf' = nub . expandTriples
tripsSubj :: Subject -> AdjacencyMap -> Triples
tripsSubj s adjMap = concatMap (tfsp s) (HashMap.toList adjMap)
where tfsp s' (p, m) = Triple s' p <$> Set.toList m
select' :: RDF AdjHashMap -> NodeSelector -> NodeSelector -> NodeSelector -> Triples
select' r Nothing Nothing Nothing = triplesOf r
select' (AdjHashMap ((_, ops),_,_)) Nothing p o = selectSPO o p Nothing (\a b c -> Triple c b a) ops
select' (AdjHashMap ((spo, _),_,_)) s p o = selectSPO s p o Triple spo
selectSPO :: NodeSelector -> NodeSelector -> NodeSelector -> (Node -> Node -> Node -> Triple) -> TMap -> Triples
selectSPO Nothing p o t = concatMap (selectPO p o t) . HashMap.toList
selectSPO (Just s) p o t = concatMap (selectPO p o t) . filter (s . fst) . HashMap.toList
selectPO :: NodeSelector -> NodeSelector -> (Node -> Node -> Node -> Triple) -> (Node, AdjacencyMap) -> Triples
selectPO Nothing o t (s, po) = concatMap (selectO o t s) . HashMap.toList $ po
selectPO (Just p) o t (s, po) = concatMap (selectO o t s) . filter (p . fst) . HashMap.toList $ po
selectO :: NodeSelector -> (Node -> Node -> Node -> Triple) -> Node -> (Node, Adjacencies) -> Triples
selectO o t s (p, os) = t s p <$> Set.toList os'
where os' = maybe os (`Set.filter` os) o
query' :: RDF AdjHashMap -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples
query' r Nothing Nothing Nothing = triplesOf r
query' (AdjHashMap ((_, ops), _, _)) Nothing p o = querySPO o p Nothing (\a b c -> Triple c b a) ops
query' (AdjHashMap ((spo, _), _, _)) s p o = querySPO s p o Triple spo
querySPO :: Maybe Node -> Maybe Node -> Maybe Node -> (Node -> Node -> Node -> Triple) -> TMap -> Triples
querySPO Nothing p o t = concatMap (uncurry $ queryPO p o t) . HashMap.toList
querySPO (Just s) p o t = maybe mempty (queryPO p o t s) . HashMap.lookup s
queryPO :: Maybe Node -> Maybe Node -> (Node -> Node -> Node -> Triple) -> Node -> AdjacencyMap -> Triples
queryPO Nothing o t s po = concatMap (uncurry $ queryO o t s) . HashMap.toList $ po
queryPO (Just p) o t s po = maybe mempty (queryO o t s p) $ HashMap.lookup p po
queryO :: Maybe Node -> (Node -> Node -> Node -> Triple) -> Node -> Node -> Adjacencies -> Triples
queryO Nothing t s p os = t s p <$> Set.toList os
queryO (Just o) t s p os
| o `Set.member` os = [t s p o]
| otherwise = mempty