{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveTraversable #-}

#if (__GLASGOW_HASKELL__ >= 802)
{-# LANGUAGE DerivingStrategies #-}
#endif

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  GraphClass
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012, 2016, 2020, 2022 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, DeriveTraversable, DerivingStrategies, MultiParamTypeClasses
--
--  This module defines a Labelled Directed Graph and Label classes,
--  and the Arc datatype.
--
--------------------------------------------------------------------------------

------------------------------------------------------------
-- Define LDGraph, arc and related classes and types
------------------------------------------------------------

module Swish.GraphClass
    ( LDGraph(..)
    , Label(..)
    , Arc(..)
    , ArcSet
    , Selector
    , arc, arcToTriple, arcFromTriple
    , hasLabel, arcLabels -- , arcNodes
    , getComponents
    )
where

import Data.Hashable (Hashable(..))
import Data.List (foldl')
import Data.Ord (comparing)

import qualified Data.Foldable as F
import qualified Data.Set as S
import qualified Data.Traversable as T

--  NOTE:  I wanted to declare this as a subclass of Functor, but
--  the constraint on the label type seems to prevent that.
--  So I've just declared specific instances to be Functors.
--

{-|
Labelled Directed Graph class.

Minimum required implementation: 
'emptyGraph', 'setArcs', and 'getArcs'.
-}

class LDGraph lg lb where

    -- | Create the empty graph.
    emptyGraph  :: lg lb
      
    -- | Replace the existing arcs in the graph.
    setArcs     :: lg lb -> ArcSet lb -> lg lb
    
    -- | Extract all the arcs from a graph
    getArcs     :: lg lb -> ArcSet lb
    
    -- | Extract those arcs that match the given `Selector`.
    extract     :: (Ord lb) => Selector lb -> lg lb -> lg lb
    extract Selector lb
sel = forall (lg :: * -> *) lb.
LDGraph lg lb =>
(ArcSet lb -> ArcSet lb) -> lg lb -> lg lb
update (forall a. (a -> Bool) -> Set a -> Set a
S.filter Selector lb
sel)
    
    -- | Add the two graphs
    addGraphs         :: (Ord lb) => lg lb -> lg lb -> lg lb
    addGraphs    lg lb
addg = forall (lg :: * -> *) lb.
LDGraph lg lb =>
(ArcSet lb -> ArcSet lb) -> lg lb -> lg lb
update (forall a. Ord a => Set a -> Set a -> Set a
S.union (forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs lg lb
addg))
    
    -- | Remove those arcs in the first graph from the second
    -- graph
    delete :: 
        (Ord lb) =>
        lg lb    -- ^ g1
        -> lg lb -- ^ g2
        -> lg lb -- ^ g2 - g1 -> g3
    delete lg lb
g1 lg lb
g2 = forall (lg :: * -> *) lb.
LDGraph lg lb =>
lg lb -> ArcSet lb -> lg lb
setArcs lg lb
g2 (forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs lg lb
g2 forall a. Ord a => Set a -> Set a -> Set a
`S.difference` forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs lg lb
g1)
    
    -- | Enumerate the distinct labels contained in a graph;
    -- that is, any label that appears in the subject,
    -- predicate or object position of an `Arc`.
    labels      :: (Ord lb) => lg lb -> S.Set lb
    labels = forall b a. Ord b => (a -> [b]) -> Set a -> Set b
getComponents forall lb. Arc lb -> [lb]
arcLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs
    
    -- | Enumerate the distinct nodes contained in a graph;
    -- that is, any label that appears in the subject
    -- or object position of an `Arc`.
    nodes       :: (Ord lb) => lg lb -> S.Set lb
    nodes = forall b a. Ord b => (a -> [b]) -> Set a -> Set b
getComponents forall lb. Arc lb -> [lb]
arcNodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs
    
    -- | Update the arcs in a graph using a supplied function.
    update      :: (ArcSet lb -> ArcSet lb) -> lg lb -> lg lb
    update ArcSet lb -> ArcSet lb
f lg lb
g  = forall (lg :: * -> *) lb.
LDGraph lg lb =>
lg lb -> ArcSet lb -> lg lb
setArcs lg lb
g ( ArcSet lb -> ArcSet lb
f (forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs lg lb
g) )

-- | Extract components from a set.
getComponents :: Ord b => (a -> [b]) -> S.Set a -> S.Set b
getComponents :: forall b a. Ord b => (a -> [b]) -> Set a -> Set b
getComponents a -> [b]
f = 
    let ins :: Set b -> a -> Set b
ins Set b
sgr = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
S.insert) Set b
sgr forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [b]
f
    in forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' Set b -> a -> Set b
ins forall a. Set a
S.empty 

-- | Label class.
--
--  A label may have a fixed binding, which means that the label identifies (is) a
--  particular graph node, and different such labels are always distinct nodes.
--  Alternatively, a label may be unbound (variable), which means that it is a
--  placeholder for an unknown node label.  Unbound node labels are used as
--  graph-local identifiers for indicating when the same node appears in
--  several arcs.
--
--  For the purposes of graph-isomorphism testing, fixed labels are matched when they
--  are the same.  Variable labels may be matched with any other variable label.
--  Our definition of isomorphism (for RDF graphs) does not match variable labels
--  with fixed labels.
--

-- We do not need Ord/Show constraints here, but it means we can just use
-- Label as a short-form for Ord/Show in code

class (Ord lb, Show lb) => Label lb where
  
  -- | Does this node have a variable binding?
  labelIsVar  :: lb -> Bool           
    
  -- | Calculate the hash of the label using the supplied seed.
  labelHash   :: Int -> lb -> Int     
  
  -- could provide a default of 
  --   labelHash = hashWithSalt
  -- but this would then force a Hashable constraint
    
  -- | Extract the local id from a variable node.                 
  getLocal    :: lb -> String
    
  -- | Make a label value from a local id.  
  makeLabel   :: String -> lb
    
-- | Arc type.
--
-- Prior to @0.7.0.0@ you could also use @asubj@, @apred@ and @aobj@
-- to access the elements of the arc.
--
data Arc lb = Arc 
              { forall lb. Arc lb -> lb
arcSubj :: lb  -- ^ The subject of the arc.
              , forall lb. Arc lb -> lb
arcPred :: lb  -- ^ The predicate (property) of the arc.
              , forall lb. Arc lb -> lb
arcObj :: lb   -- ^ The object of the arc.
              }
            deriving
#if (__GLASGOW_HASKELL__ >= 802)
               stock
#endif
               (Arc lb -> Arc lb -> Bool
forall lb. Eq lb => Arc lb -> Arc lb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arc lb -> Arc lb -> Bool
$c/= :: forall lb. Eq lb => Arc lb -> Arc lb -> Bool
== :: Arc lb -> Arc lb -> Bool
$c== :: forall lb. Eq lb => Arc lb -> Arc lb -> Bool
Eq, forall a b. a -> Arc b -> Arc a
forall a b. (a -> b) -> Arc a -> Arc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Arc b -> Arc a
$c<$ :: forall a b. a -> Arc b -> Arc a
fmap :: forall a b. (a -> b) -> Arc a -> Arc b
$cfmap :: forall a b. (a -> b) -> Arc a -> Arc b
Functor, forall a. Eq a => a -> Arc a -> Bool
forall a. Num a => Arc a -> a
forall a. Ord a => Arc a -> a
forall m. Monoid m => Arc m -> m
forall a. Arc a -> Bool
forall a. Arc a -> Int
forall lb. Arc lb -> [lb]
forall a. (a -> a -> a) -> Arc a -> a
forall m a. Monoid m => (a -> m) -> Arc a -> m
forall b a. (b -> a -> b) -> b -> Arc a -> b
forall a b. (a -> b -> b) -> b -> Arc a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Arc a -> a
$cproduct :: forall a. Num a => Arc a -> a
sum :: forall a. Num a => Arc a -> a
$csum :: forall a. Num a => Arc a -> a
minimum :: forall a. Ord a => Arc a -> a
$cminimum :: forall a. Ord a => Arc a -> a
maximum :: forall a. Ord a => Arc a -> a
$cmaximum :: forall a. Ord a => Arc a -> a
elem :: forall a. Eq a => a -> Arc a -> Bool
$celem :: forall a. Eq a => a -> Arc a -> Bool
length :: forall a. Arc a -> Int
$clength :: forall a. Arc a -> Int
null :: forall a. Arc a -> Bool
$cnull :: forall a. Arc a -> Bool
toList :: forall lb. Arc lb -> [lb]
$ctoList :: forall lb. Arc lb -> [lb]
foldl1 :: forall a. (a -> a -> a) -> Arc a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Arc a -> a
foldr1 :: forall a. (a -> a -> a) -> Arc a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Arc a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Arc a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Arc a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Arc a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Arc a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Arc a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Arc a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Arc a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Arc a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Arc a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Arc a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Arc a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Arc a -> m
fold :: forall m. Monoid m => Arc m -> m
$cfold :: forall m. Monoid m => Arc m -> m
F.Foldable, Functor Arc
Foldable Arc
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Arc (m a) -> m (Arc a)
forall (f :: * -> *) a. Applicative f => Arc (f a) -> f (Arc a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Arc a -> m (Arc b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arc a -> f (Arc b)
sequence :: forall (m :: * -> *) a. Monad m => Arc (m a) -> m (Arc a)
$csequence :: forall (m :: * -> *) a. Monad m => Arc (m a) -> m (Arc a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Arc a -> m (Arc b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Arc a -> m (Arc b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Arc (f a) -> f (Arc a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Arc (f a) -> f (Arc a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arc a -> f (Arc b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arc a -> f (Arc b)
T.Traversable)

-- | A set - or graph - of arcs.
type ArcSet lb = S.Set (Arc lb)

instance (Hashable lb) => Hashable (Arc lb) where
#if MIN_VERSION_hashable(1,2,0) 
#else
  hash (Arc s p o) = hash s `hashWithSalt` p `hashWithSalt` o
#endif
  hashWithSalt :: Int -> Arc lb -> Int
hashWithSalt Int
salt (Arc lb
s lb
p lb
o) = Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` lb
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` lb
p forall a. Hashable a => Int -> a -> Int
`hashWithSalt` lb
o

-- | Create an arc.
arc :: lb      -- ^ The subject of the arc.
       -> lb   -- ^ The predicate of the arc.
       -> lb   -- ^ The object of the arc.
       -> Arc lb
arc :: forall lb. lb -> lb -> lb -> Arc lb
arc = forall lb. lb -> lb -> lb -> Arc lb
Arc

-- | Convert an Arc into a tuple.
arcToTriple :: Arc lb -> (lb,lb,lb)
arcToTriple :: forall lb. Arc lb -> (lb, lb, lb)
arcToTriple (Arc lb
s lb
p lb
o) = (lb
s, lb
p, lb
o)

-- | Create an Arc from a tuple.
arcFromTriple :: (lb,lb,lb) -> Arc lb
arcFromTriple :: forall lb. (lb, lb, lb) -> Arc lb
arcFromTriple (lb
s,lb
p,lb
o) = forall lb. lb -> lb -> lb -> Arc lb
Arc lb
s lb
p lb
o

instance Ord lb => Ord (Arc lb) where
    compare :: Arc lb -> Arc lb -> Ordering
compare = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall lb. Arc lb -> (lb, lb, lb)
arcToTriple

instance (Show lb) => Show (Arc lb) where
    show :: Arc lb -> String
show (Arc lb
lb1 lb
lb2 lb
lb3) =
        String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show lb
lb1 forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show lb
lb2 forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show lb
lb3 forall a. [a] -> [a] -> [a]
++ String
")"

-- | Identify arcs.
type Selector lb = Arc lb -> Bool

-- | Does the arc contain the label in any position (subject, predicate, or object)?
hasLabel :: (Eq lb) => lb -> Arc lb -> Bool
hasLabel :: forall a. Eq a => a -> Arc a -> Bool
hasLabel lb
lbv Arc lb
lb = lb
lbv forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall lb. Arc lb -> [lb]
arcLabels Arc lb
lb

-- | Return all the labels in an arc.
arcLabels :: Arc lb -> [lb]
arcLabels :: forall lb. Arc lb -> [lb]
arcLabels (Arc lb
lb1 lb
lb2 lb
lb3) = [lb
lb1,lb
lb2,lb
lb3]

-- | Return just the subject and object labels in the arc.
arcNodes :: Arc lb -> [lb]
arcNodes :: forall lb. Arc lb -> [lb]
arcNodes (Arc lb
lb1 lb
_ lb
lb3) = [lb
lb1,lb
lb3]

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2016, 2020, 2022 Douglas Burke
--  All rights reserved.
--
--  This file is part of Swish.
--
--  Swish is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  Swish is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with Swish; if not, write to:
--    The Free Software Foundation, Inc.,
--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--------------------------------------------------------------------------------