rdf4h-5.2.0: src/Data/RDF/Graph/AdjHashMap.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | A graph implementation mapping hashed S to a mapping of
--   hashed P to hashed O, backed by 'Data.HashMap'.
module Data.RDF.Graph.AdjHashMap (AdjHashMap) where

import Prelude hiding (pred)
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif
import Control.DeepSeq (NFData)
import Control.Monad (mfilter)
import Data.Binary (Binary)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as Set
import Data.Hashable ()
import qualified Data.List as List
import Data.RDF.Query
import Data.RDF.Types
import GHC.Generics

-- | A map-based graph implementation.
--
--  This instance of 'RDF' is an adjacency map with each subject
--  mapping to a mapping from a predicate node to the adjacent nodes
--  via that predicate.
--
--  Given the following triples graph::
--
--  @
--    (http:\/\/example.com\/s1,http:\/\/example.com\/p1,http:\/\/example.com\/o1)
--    (http:\/\/example.com\/s1,http:\/\/example.com\/p1,http:\/\/example.com\/o2)
--    (http:\/\/example.com\/s1,http:\/\/example.com\/p2,http:\/\/example.com\/o1)
--    (http:\/\/example.com\/s2,http:\/\/example.com\/p3,http:\/\/example.com\/o3)
--  @
--
--  where
--
--  > hash "http://example.com/s1" = 1600134414
--  > hash "http://example.com/s2" = 1600134413
--  > hash "http://example.com/p1" = 1616912099
--  > hash "http://example.com/p2" = 1616912096
--  > hash "http://example.com/p3" = 1616912097
--  > hash "http://example.com/o1" = 1935686794
--  > hash "http://example.com/o2" = 1935686793
--  > hash "http://example.com/o3" = 1935686792
--
--  the in-memory hashmap representation of the triples graph is:
--
--  @
--  key:1600134414, value:(key:1616912099, value:[1935686794    -- (..\/s1,..\/p1,..\/o1)
--                                               ,1935686793];  -- (..\/s1,..\/p1,..\/o2)
--                         key:1616912096, value:[1935686794]); -- (..\/s1,..\/p2,..\/o1)
--  key:1600134413, value:(key:1616912097, value:[1935686792])  -- (..\/s1,..\/p3,..\/o3)
--  @
--
--  Worst-case time complexity of the graph functions, with respect
--  to the number of triples, are:
--
--   * 'empty'    : O(1)
--
--   * 'mkRdf'  : O(n)
--
--   * 'triplesOf': O(n)
--
--   * 'select'   : O(n)
--
--   * 'query'    : O(log n)
--  newtype HashS = HashS (TMaps, Maybe BaseUrl, PrefixMappings)
--                   deriving (NFData)
data AdjHashMap deriving (Generic)

instance Binary AdjHashMap

instance NFData AdjHashMap

newtype 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'

-- instance Show (AdjHashMap) where
--   show (AdjHashMap ((spoMap, _), _, _)) =
--     let ts = concatMap (uncurry tripsSubj) subjPredMaps
--           where subjPredMaps = HashMap.toList spoMap
--     in concatMap (\t -> show t <> "\n") ts

showGraph' :: RDF AdjHashMap -> String
showGraph' ((AdjHashMap ((spoMap, _), _, _))) =
  let ts = concatMap (uncurry tripsSubj) subjPredMaps
        where
          subjPredMaps = HashMap.toList spoMap
   in concatMap (\t -> show t <> "\n") ts

-- instance Show (RDF AdjHashMap) where
--   show gr = concatMap (\t -> show t <> "\n")  (triplesOf gr)

-- some convenience type alias for readability

-- An adjacency map for a subject, mapping from a predicate node to
-- to the adjacent nodes via that predicate.
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 (<>) else (<>)
   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 = List.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

-- 3 following functions support triplesOf
triplesOf' :: RDF AdjHashMap -> Triples
triplesOf' (AdjHashMap ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps
  where
    subjPredMaps = HashMap.toList spoMap

-- naive implementation for now
uniqTriplesOf' :: RDF AdjHashMap -> Triples
uniqTriplesOf' = List.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

-- supports select
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

-- support query
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