{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- [TODO] Remove when the missing NFData instance is added to Alga.

module Data.RDF.Graph.AlgebraicGraph
  ( AlgebraicGraph,
  )
where

import qualified Algebra.Graph.Labelled as G
import Control.DeepSeq (NFData (..))
import Data.Binary
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import Data.RDF.Namespace
import Data.RDF.Query
import Data.RDF.Types (BaseUrl, Node, NodeSelector, Object, Predicate, RDF, Rdf (..), Subject, Triple (..), Triples)
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif
import GHC.Generics

data AlgebraicGraph deriving ((forall x. AlgebraicGraph -> Rep AlgebraicGraph x)
-> (forall x. Rep AlgebraicGraph x -> AlgebraicGraph)
-> Generic AlgebraicGraph
forall x. Rep AlgebraicGraph x -> AlgebraicGraph
forall x. AlgebraicGraph -> Rep AlgebraicGraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AlgebraicGraph -> Rep AlgebraicGraph x
from :: forall x. AlgebraicGraph -> Rep AlgebraicGraph x
$cto :: forall x. Rep AlgebraicGraph x -> AlgebraicGraph
to :: forall x. Rep AlgebraicGraph x -> AlgebraicGraph
Generic)

instance Binary AlgebraicGraph

instance NFData AlgebraicGraph

data instance RDF AlgebraicGraph
  = AlgebraicGraph
      { RDF AlgebraicGraph -> Graph (HashSet Node) Node
_graph :: G.Graph (HashSet Node) Node,
        RDF AlgebraicGraph -> Maybe BaseUrl
_baseUrl :: Maybe BaseUrl,
        RDF AlgebraicGraph -> PrefixMappings
_prefixMappings :: PrefixMappings
      }
  deriving ((forall x. RDF AlgebraicGraph -> Rep (RDF AlgebraicGraph) x)
-> (forall x. Rep (RDF AlgebraicGraph) x -> RDF AlgebraicGraph)
-> Generic (RDF AlgebraicGraph)
forall x. Rep (RDF AlgebraicGraph) x -> RDF AlgebraicGraph
forall x. RDF AlgebraicGraph -> Rep (RDF AlgebraicGraph) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RDF AlgebraicGraph -> Rep (RDF AlgebraicGraph) x
from :: forall x. RDF AlgebraicGraph -> Rep (RDF AlgebraicGraph) x
$cto :: forall x. Rep (RDF AlgebraicGraph) x -> RDF AlgebraicGraph
to :: forall x. Rep (RDF AlgebraicGraph) x -> RDF AlgebraicGraph
Generic, RDF AlgebraicGraph -> ()
(RDF AlgebraicGraph -> ()) -> NFData (RDF AlgebraicGraph)
forall a. (a -> ()) -> NFData a
$crnf :: RDF AlgebraicGraph -> ()
rnf :: RDF AlgebraicGraph -> ()
NFData)

instance Rdf AlgebraicGraph where
  baseUrl :: RDF AlgebraicGraph -> Maybe BaseUrl
baseUrl = RDF AlgebraicGraph -> Maybe BaseUrl
_baseUrl
  prefixMappings :: RDF AlgebraicGraph -> PrefixMappings
prefixMappings = RDF AlgebraicGraph -> PrefixMappings
_prefixMappings
  addPrefixMappings :: RDF AlgebraicGraph -> PrefixMappings -> Bool -> RDF AlgebraicGraph
addPrefixMappings = RDF AlgebraicGraph -> PrefixMappings -> Bool -> RDF AlgebraicGraph
addPrefixMappings'
  empty :: RDF AlgebraicGraph
empty = RDF AlgebraicGraph
empty'
  mkRdf :: [Triple] -> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
mkRdf = [Triple] -> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
mkRdf'
  addTriple :: RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
addTriple = RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
addTriple'
  removeTriple :: RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
removeTriple = RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
removeTriple'
  triplesOf :: RDF AlgebraicGraph -> [Triple]
triplesOf = RDF AlgebraicGraph -> [Triple]
triplesOf'
  uniqTriplesOf :: RDF AlgebraicGraph -> [Triple]
uniqTriplesOf = RDF AlgebraicGraph -> [Triple]
triplesOf'
  select :: RDF AlgebraicGraph
-> NodeSelector -> NodeSelector -> NodeSelector -> [Triple]
select = RDF AlgebraicGraph
-> NodeSelector -> NodeSelector -> NodeSelector -> [Triple]
select'
  query :: RDF AlgebraicGraph
-> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
query = RDF AlgebraicGraph
-> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
query'
  showGraph :: RDF AlgebraicGraph -> String
showGraph = RDF AlgebraicGraph -> String
showGraph'

toEdge :: Triple -> (HashSet Predicate, Subject, Object)
toEdge :: Triple -> (HashSet Node, Node, Node)
toEdge (Triple Node
s Node
p Node
o) = (Node -> HashSet Node
forall a. Hashable a => a -> HashSet a
HS.singleton Node
p, Node
s, Node
o)

toTriples :: (HashSet Predicate, Subject, Object) -> Triples
toTriples :: (HashSet Node, Node, Node) -> [Triple]
toTriples (HashSet Node
ps, Node
s, Node
o) = [Node -> Node -> Node -> Triple
Triple Node
s Node
p Node
o | Node
p <- HashSet Node -> [Node]
forall a. HashSet a -> [a]
HS.toList HashSet Node
ps]

showGraph' :: RDF AlgebraicGraph -> String
showGraph' :: RDF AlgebraicGraph -> String
showGraph' RDF AlgebraicGraph
r = (Triple -> String) -> [Triple] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Triple
t -> Triple -> String
forall a. Show a => a -> String
show Triple
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") (RDF AlgebraicGraph -> [Triple]
forall a. Rdf a => RDF a -> [Triple]
expandTriples RDF AlgebraicGraph
r)

addPrefixMappings' :: RDF AlgebraicGraph -> PrefixMappings -> Bool -> RDF AlgebraicGraph
addPrefixMappings' :: RDF AlgebraicGraph -> PrefixMappings -> Bool -> RDF AlgebraicGraph
addPrefixMappings' (AlgebraicGraph Graph (HashSet Node) Node
g Maybe BaseUrl
baseURL PrefixMappings
pms) PrefixMappings
pms' Bool
replace =
  let merge :: PrefixMappings -> PrefixMappings -> PrefixMappings
merge = if Bool
replace then (PrefixMappings -> PrefixMappings -> PrefixMappings)
-> PrefixMappings -> PrefixMappings -> PrefixMappings
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrefixMappings -> PrefixMappings -> PrefixMappings
forall a. Semigroup a => a -> a -> a
(<>) else PrefixMappings -> PrefixMappings -> PrefixMappings
forall a. Semigroup a => a -> a -> a
(<>)
   in Graph (HashSet Node) Node
-> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
AlgebraicGraph Graph (HashSet Node) Node
g Maybe BaseUrl
baseURL (PrefixMappings -> PrefixMappings -> PrefixMappings
merge PrefixMappings
pms PrefixMappings
pms')

empty' :: RDF AlgebraicGraph
empty' :: RDF AlgebraicGraph
empty' = Graph (HashSet Node) Node
-> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
AlgebraicGraph Graph (HashSet Node) Node
forall e a. Graph e a
G.empty Maybe BaseUrl
forall a. Monoid a => a
mempty (Map Text Text -> PrefixMappings
PrefixMappings Map Text Text
forall a. Monoid a => a
mempty)

mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
mkRdf' :: [Triple] -> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
mkRdf' [Triple]
ts Maybe BaseUrl
baseURL PrefixMappings
pms =
  let g :: Graph (HashSet Node) Node
g = [(HashSet Node, Node, Node)] -> Graph (HashSet Node) Node
forall e a. Monoid e => [(e, a, a)] -> Graph e a
G.edges ([(HashSet Node, Node, Node)] -> Graph (HashSet Node) Node)
-> ([Triple] -> [(HashSet Node, Node, Node)])
-> [Triple]
-> Graph (HashSet Node) Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Triple -> (HashSet Node, Node, Node))
-> [Triple] -> [(HashSet Node, Node, Node)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple -> (HashSet Node, Node, Node)
toEdge ([Triple] -> Graph (HashSet Node) Node)
-> [Triple] -> Graph (HashSet Node) Node
forall a b. (a -> b) -> a -> b
$ [Triple]
ts
   in Graph (HashSet Node) Node
-> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
AlgebraicGraph Graph (HashSet Node) Node
g Maybe BaseUrl
baseURL PrefixMappings
pms

addTriple' :: RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
addTriple' :: RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
addTriple' (AlgebraicGraph Graph (HashSet Node) Node
g Maybe BaseUrl
baseURL PrefixMappings
pms) (Triple Node
s Node
p Node
o) =
  let g' :: Graph (HashSet Node) Node
g' = HashSet Node -> Node -> Node -> Graph (HashSet Node) Node
forall e a. e -> a -> a -> Graph e a
G.edge (Node -> HashSet Node
forall a. Hashable a => a -> HashSet a
HS.singleton Node
p) Node
s Node
o
   in Graph (HashSet Node) Node
-> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
AlgebraicGraph (Graph (HashSet Node) Node
-> Graph (HashSet Node) Node -> Graph (HashSet Node) Node
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
G.overlay Graph (HashSet Node) Node
g Graph (HashSet Node) Node
g') Maybe BaseUrl
baseURL PrefixMappings
pms

removeTriple' :: RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
removeTriple' :: RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
removeTriple' (AlgebraicGraph Graph (HashSet Node) Node
g Maybe BaseUrl
baseURL PrefixMappings
pms) (Triple Node
s Node
p Node
o) =
  let ps :: HashSet Node
ps = Node -> Node -> Graph (HashSet Node) Node -> HashSet Node
forall a e. (Eq a, Monoid e) => a -> a -> Graph e a -> e
G.edgeLabel Node
s Node
o Graph (HashSet Node) Node
g
      g' :: Graph (HashSet Node) Node
g'
        | HashSet Node -> Bool
forall a. HashSet a -> Bool
HS.null HashSet Node
ps = Graph (HashSet Node) Node
g
        | Node -> HashSet Node -> Bool
forall a. Eq a => a -> HashSet a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Node
p HashSet Node
ps = HashSet Node
-> Node
-> Node
-> Graph (HashSet Node) Node
-> Graph (HashSet Node) Node
forall e a.
(Eq e, Monoid e, Ord a) =>
e -> a -> a -> Graph e a -> Graph e a
G.replaceEdge (Node -> HashSet Node -> HashSet Node
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.delete Node
p HashSet Node
ps) Node
s Node
o Graph (HashSet Node) Node
g
        | Bool
otherwise = Graph (HashSet Node) Node
g
   in Graph (HashSet Node) Node
-> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
AlgebraicGraph Graph (HashSet Node) Node
g' Maybe BaseUrl
baseURL PrefixMappings
pms

triplesOf' :: RDF AlgebraicGraph -> Triples
triplesOf' :: RDF AlgebraicGraph -> [Triple]
triplesOf' (AlgebraicGraph Graph (HashSet Node) Node
g Maybe BaseUrl
_ PrefixMappings
_) = [[Triple]] -> [Triple]
forall a. Monoid a => [a] -> a
mconcat ([[Triple]] -> [Triple]) -> [[Triple]] -> [Triple]
forall a b. (a -> b) -> a -> b
$ (HashSet Node, Node, Node) -> [Triple]
toTriples ((HashSet Node, Node, Node) -> [Triple])
-> [(HashSet Node, Node, Node)] -> [[Triple]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Graph (HashSet Node) Node -> [(HashSet Node, Node, Node)]
forall e a. (Eq e, Monoid e, Ord a) => Graph e a -> [(e, a, a)]
G.edgeList Graph (HashSet Node) Node
g

select' :: RDF AlgebraicGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples
select' :: RDF AlgebraicGraph
-> NodeSelector -> NodeSelector -> NodeSelector -> [Triple]
select' RDF AlgebraicGraph
r NodeSelector
Nothing NodeSelector
Nothing NodeSelector
Nothing = RDF AlgebraicGraph -> [Triple]
forall a. Rdf a => RDF a -> [Triple]
triplesOf RDF AlgebraicGraph
r
select' (AlgebraicGraph Graph (HashSet Node) Node
g Maybe BaseUrl
_ PrefixMappings
_) NodeSelector
s NodeSelector
p NodeSelector
o = let ([Triple]
res, HashSet Node
_, HashSet Node
_) = ([Triple], HashSet Node, HashSet Node)
-> (Node -> ([Triple], HashSet Node, HashSet Node))
-> (HashSet Node
    -> ([Triple], HashSet Node, HashSet Node)
    -> ([Triple], HashSet Node, HashSet Node)
    -> ([Triple], HashSet Node, HashSet Node))
-> Graph (HashSet Node) Node
-> ([Triple], HashSet Node, HashSet Node)
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
G.foldg ([Triple], HashSet Node, HashSet Node)
e Node -> ([Triple], HashSet Node, HashSet Node)
v HashSet Node
-> ([Triple], HashSet Node, HashSet Node)
-> ([Triple], HashSet Node, HashSet Node)
-> ([Triple], HashSet Node, HashSet Node)
c Graph (HashSet Node) Node
g in [Triple]
res
  where
    e :: ([Triple], HashSet Node, HashSet Node)
e = ([Triple]
forall a. Monoid a => a
mempty, HashSet Node
forall a. Monoid a => a
mempty, HashSet Node
forall a. Monoid a => a
mempty)
    v :: Node -> ([Triple], HashSet Node, HashSet Node)
v Node
x = ([Triple]
forall a. Monoid a => a
mempty, NodeSelector
s NodeSelector -> Node -> HashSet Node
forall {a}. Hashable a => Maybe (a -> Bool) -> a -> HashSet a
?? Node
x, NodeSelector
o NodeSelector -> Node -> HashSet Node
forall {a}. Hashable a => Maybe (a -> Bool) -> a -> HashSet a
?? Node
x)
    ?? :: Maybe (a -> Bool) -> a -> HashSet a
(??) Maybe (a -> Bool)
f a
x' = let xs :: HashSet a
xs = a -> HashSet a
forall a. Hashable a => a -> HashSet a
HS.singleton a
x' in HashSet a
-> ((a -> Bool) -> HashSet a) -> Maybe (a -> Bool) -> HashSet a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashSet a
xs ((a -> Bool) -> HashSet a -> HashSet a
forall a. (a -> Bool) -> HashSet a -> HashSet a
`HS.filter` HashSet a
xs) Maybe (a -> Bool)
f
    c :: HashSet Node
-> ([Triple], HashSet Node, HashSet Node)
-> ([Triple], HashSet Node, HashSet Node)
-> ([Triple], HashSet Node, HashSet Node)
c HashSet Node
ps ([Triple]
ts1, HashSet Node
ss1, HashSet Node
os1) ([Triple]
ts2, HashSet Node
ss2, HashSet Node
os2) = ([Triple]
ts3, HashSet Node
ss3, HashSet Node
os3)
      where
        ss3 :: HashSet Node
ss3 = HashSet Node
ss1 HashSet Node -> HashSet Node -> HashSet Node
forall a. Semigroup a => a -> a -> a
<> HashSet Node
ss2
        os3 :: HashSet Node
os3 = HashSet Node
os1 HashSet Node -> HashSet Node -> HashSet Node
forall a. Semigroup a => a -> a -> a
<> HashSet Node
os2
        ts3 :: [Triple]
ts3
          | HashSet Node -> Bool
forall a. HashSet a -> Bool
HS.null HashSet Node
ps' = [Triple]
ts1 [Triple] -> [Triple] -> [Triple]
forall a. Semigroup a => a -> a -> a
<> [Triple]
ts2
          | Bool
otherwise = [Triple]
ts1 [Triple] -> [Triple] -> [Triple]
forall a. Semigroup a => a -> a -> a
<> [Triple]
ts2 [Triple] -> [Triple] -> [Triple]
forall a. Semigroup a => a -> a -> a
<> [Node -> Node -> Node -> Triple
Triple Node
s' Node
p' Node
o' | Node
s' <- HashSet Node -> [Node]
forall a. HashSet a -> [a]
HS.toList HashSet Node
ss3, Node
p' <- HashSet Node -> [Node]
forall a. HashSet a -> [a]
HS.toList HashSet Node
ps', Node
o' <- HashSet Node -> [Node]
forall a. HashSet a -> [a]
HS.toList HashSet Node
os3]
        ps' :: HashSet Node
ps' = HashSet Node
-> ((Node -> Bool) -> HashSet Node) -> NodeSelector -> HashSet Node
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashSet Node
ps ((Node -> Bool) -> HashSet Node -> HashSet Node
forall a. (a -> Bool) -> HashSet a -> HashSet a
`HS.filter` HashSet Node
ps) NodeSelector
p

query' :: RDF AlgebraicGraph -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples
query' :: RDF AlgebraicGraph
-> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
query' RDF AlgebraicGraph
r Maybe Node
Nothing Maybe Node
Nothing Maybe Node
Nothing = RDF AlgebraicGraph -> [Triple]
forall a. Rdf a => RDF a -> [Triple]
triplesOf RDF AlgebraicGraph
r
query' RDF AlgebraicGraph
r Maybe Node
s Maybe Node
p Maybe Node
o = RDF AlgebraicGraph
-> NodeSelector -> NodeSelector -> NodeSelector -> [Triple]
forall rdfImpl.
Rdf rdfImpl =>
RDF rdfImpl
-> NodeSelector -> NodeSelector -> NodeSelector -> [Triple]
select RDF AlgebraicGraph
r (Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Node -> Node -> Bool) -> Maybe Node -> NodeSelector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Node
s) (Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Node -> Node -> Bool) -> Maybe Node -> NodeSelector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Node
p) (Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Node -> Node -> Bool) -> Maybe Node -> NodeSelector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Node
o)