    {-# 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, 2024 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 qualified Data.Foldable as F
    import qualified Data.Set as S
    import qualified Data.Traversable as T

    import Data.Foldable (Foldable(..))
    import Data.Hashable (Hashable(..))
    import Data.Ord (comparing)

    -- Avoid messages added in GHC 9.10 about foldl' import from Data.List
    -- being redundant.
    import Prelude hiding (Foldable(..))

    --  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 = (ArcSet lb -> ArcSet lb) -> lg lb -> lg lb
    forall (lg :: * -> *) lb.
    LDGraph lg lb =>
    (ArcSet lb -> ArcSet lb) -> lg lb -> lg lb
    update (Selector lb -> ArcSet lb -> ArcSet lb
    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 = (ArcSet lb -> ArcSet lb) -> lg lb -> lg lb
    forall (lg :: * -> *) lb.
    LDGraph lg lb =>
    (ArcSet lb -> ArcSet lb) -> lg lb -> lg lb
    update (ArcSet lb -> ArcSet lb -> ArcSet lb
    forall a. Ord a => Set a -> Set a -> Set a
    S.union (lg lb -> ArcSet lb
    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 = lg lb -> ArcSet lb -> lg lb
    forall (lg :: * -> *) lb.
    LDGraph lg lb =>
    lg lb -> ArcSet lb -> lg lb
    setArcs lg lb
    g2 (lg lb -> ArcSet lb
    forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
    getArcs lg lb
    g2 ArcSet lb -> ArcSet lb -> ArcSet lb
    forall a. Ord a => Set a -> Set a -> Set a
    `S.difference` lg lb -> ArcSet lb
    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 = (Arc lb -> [lb]) -> ArcSet lb -> Set lb
    forall b a. Ord b => (a -> [b]) -> Set a -> Set b
    getComponents Arc lb -> [lb]
    forall lb. Arc lb -> [lb]
    arcLabels (ArcSet lb -> Set lb) -> (lg lb -> ArcSet lb) -> lg lb -> Set lb
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . lg lb -> ArcSet lb
    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 = (Arc lb -> [lb]) -> ArcSet lb -> Set lb
    forall b a. Ord b => (a -> [b]) -> Set a -> Set b
    getComponents Arc lb -> [lb]
    forall lb. Arc lb -> [lb]
    arcNodes (ArcSet lb -> Set lb) -> (lg lb -> ArcSet lb) -> lg lb -> Set lb
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . lg lb -> ArcSet lb
    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  = lg lb -> ArcSet lb -> lg lb
    forall (lg :: * -> *) lb.
    LDGraph lg lb =>
    lg lb -> ArcSet lb -> lg lb
    setArcs lg lb
    g ( ArcSet lb -> ArcSet lb
    f (lg lb -> ArcSet lb
    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 = (Set b -> b -> Set b) -> Set b -> [b] -> Set b
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ((b -> Set b -> Set b) -> Set b -> b -> Set b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip b -> Set b -> Set b
    forall a. Ord a => a -> Set a -> Set a
    S.insert) Set b
    sgr ([b] -> Set b) -> (a -> [b]) -> a -> Set b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> [b]
    f
        in (Set b -> a -> Set b) -> Set b -> Set a -> Set b
    forall a b. (a -> b -> a) -> a -> Set b -> a
    S.foldl' Set b -> a -> Set b
    ins Set b
    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
    (Arc lb -> Arc lb -> Bool)
    -> (Arc lb -> Arc lb -> Bool) -> Eq (Arc lb)
    forall lb. Eq lb => Arc lb -> Arc lb -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $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
    /= :: Arc lb -> Arc lb -> Bool
    Eq, (forall a b. (a -> b) -> Arc a -> Arc b)
    -> (forall a b. a -> Arc b -> Arc a) -> Functor Arc
    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
    $cfmap :: forall a b. (a -> b) -> Arc a -> Arc b
    fmap :: forall a b. (a -> b) -> Arc a -> Arc b
    $c<$ :: forall a b. a -> Arc b -> Arc a
    <$ :: forall a b. a -> Arc b -> Arc a
    Functor, (forall m. Monoid m => Arc m -> m)
    -> (forall m a. Monoid m => (a -> m) -> Arc a -> m)
    -> (forall m a. Monoid m => (a -> m) -> Arc a -> m)
    -> (forall a b. (a -> b -> b) -> b -> Arc a -> b)
    -> (forall a b. (a -> b -> b) -> b -> Arc a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Arc a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Arc a -> b)
    -> (forall a. (a -> a -> a) -> Arc a -> a)
    -> (forall a. (a -> a -> a) -> Arc a -> a)
    -> (forall lb. Arc lb -> [lb])
    -> (forall a. Arc a -> Bool)
    -> (forall a. Arc a -> Int)
    -> (forall a. Eq a => a -> Arc a -> Bool)
    -> (forall a. Ord a => Arc a -> a)
    -> (forall a. Ord a => Arc a -> a)
    -> (forall a. Num a => Arc a -> a)
    -> (forall a. Num a => Arc a -> a)
    -> Foldable Arc
    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
    $cfold :: forall m. Monoid m => Arc m -> m
    fold :: forall m. Monoid m => Arc m -> 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
    foldMap' :: forall m a. Monoid m => (a -> m) -> Arc a -> m
    $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
    foldr' :: forall a b. (a -> b -> 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
    foldl' :: forall b a. (b -> a -> b) -> b -> Arc a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> Arc a -> a
    foldr1 :: forall a. (a -> a -> a) -> Arc a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> Arc a -> a
    foldl1 :: forall a. (a -> a -> a) -> Arc a -> a
    $ctoList :: forall lb. Arc lb -> [lb]
    toList :: forall lb. Arc lb -> [lb]
    $cnull :: forall a. Arc a -> Bool
    null :: forall a. Arc a -> Bool
    $clength :: forall a. Arc a -> Int
    length :: forall a. Arc a -> Int
    $celem :: forall a. Eq a => a -> Arc a -> Bool
    elem :: forall a. Eq a => a -> Arc a -> Bool
    $cmaximum :: forall a. Ord a => Arc a -> a
    maximum :: forall a. Ord a => Arc a -> a
    $cminimum :: forall a. Ord a => Arc a -> a
    minimum :: forall a. Ord a => Arc a -> a
    $csum :: forall a. Num a => Arc a -> a
    sum :: forall a. Num a => Arc a -> a
    $cproduct :: forall a. Num a => Arc a -> a
    product :: forall a. Num a => Arc a -> a
    F.Foldable, Functor Arc
    Foldable Arc
    (Functor Arc, Foldable Arc) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> Arc a -> f (Arc b))
    -> (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 (m :: * -> *) a. Monad m => Arc (m a) -> m (Arc a))
    -> Traversable 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)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Arc a -> f (Arc b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Arc a -> f (Arc b)
    $csequenceA :: forall (f :: * -> *) a. Applicative f => Arc (f a) -> f (Arc a)
    sequenceA :: forall (f :: * -> *) a. Applicative f => Arc (f a) -> f (Arc a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Arc a -> m (Arc b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Arc a -> m (Arc b)
    $csequence :: forall (m :: * -> *) a. Monad m => Arc (m a) -> m (Arc a)
    sequence :: forall (m :: * -> *) a. Monad m => Arc (m a) -> m (Arc a)
    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 Int -> lb -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` lb
    s Int -> lb -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` lb
    p Int -> lb -> Int
    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 = lb -> lb -> lb -> Arc lb
    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) = lb -> lb -> lb -> Arc lb
    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 = (Arc lb -> (lb, lb, lb)) -> Arc lb -> Arc lb -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing Arc lb -> (lb, lb, lb)
    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
    "(" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ lb -> String
    forall a. Show a => a -> String
    show lb
    lb1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "," String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ lb -> String
    forall a. Show a => a -> String
    show lb
    lb2 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "," String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ lb -> String
    forall a. Show a => a -> String
    show lb
    lb3 String -> ShowS
    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 lb -> [lb] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Arc lb -> [lb]
    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
    --
    --------------------------------------------------------------------------------