{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE CPP                  #-}
{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Compat.Graph
-- Copyright   :  (c) Edward Z. Yang 2016
-- License     :  BSD3
--
-- Maintainer  :  cabal-dev@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- A data type representing directed graphs, backed by "Data.Graph".
-- It is strict in the node type.
--
-- This is an alternative interface to "Data.Graph".  In this interface,
-- nodes (identified by the 'IsNode' type class) are associated with a
-- key and record the keys of their neighbors.  This interface is more
-- convenient than 'Data.Graph.Graph', which requires vertices to be
-- explicitly handled by integer indexes.
--
-- The current implementation has somewhat peculiar performance
-- characteristics.  The asymptotics of all map-like operations mirror
-- their counterparts in "Data.Map".  However, to perform a graph
-- operation, we first must build the "Data.Graph" representation, an
-- operation that takes /O(V + E log V)/.  However, this operation can
-- be amortized across all queries on that particular graph.
--
-- Some nodes may be broken, i.e., refer to neighbors which are not
-- stored in the graph.  In our graph algorithms, we transparently
-- ignore such edges; however, you can easily query for the broken
-- vertices of a graph using 'broken' (and should, e.g., to ensure that
-- a closure of a graph is well-formed.)  It's possible to take a closed
-- subset of a broken graph and get a well-formed graph.
--
-----------------------------------------------------------------------------

module Distribution.Compat.Graph (
    -- * Graph type
    Graph,
    IsNode(..),
    -- * Query
    null,
    size,
    member,
    lookup,
    -- * Construction
    empty,
    insert,
    deleteKey,
    deleteLookup,
    -- * Combine
    unionLeft,
    unionRight,
    -- * Graph algorithms
    stronglyConnComp,
    SCC(..),
    cycles,
    broken,
    neighbors,
    revNeighbors,
    closure,
    revClosure,
    topSort,
    revTopSort,
    -- * Conversions
    -- ** Maps
    toMap,
    -- ** Lists
    fromDistinctList,
    toList,
    keys,
    -- ** Sets
    keysSet,
    -- ** Graphs
    toGraph,
    -- * Node type
    Node(..),
    nodeValue,
) where

import Distribution.Compat.Prelude hiding (empty, lookup, null, toList)
import Prelude ()

import Data.Array                    ((!))
import Data.Either                   (partitionEithers)
import Data.Graph                    (SCC (..))
import Distribution.Utils.Structured (Structure (..), Structured (..))

import qualified Data.Array                  as Array
import qualified Data.Foldable               as Foldable
import qualified Data.Graph                  as G
import qualified Data.Map.Strict             as Map
import qualified Data.Set                    as Set
import qualified Data.Tree                   as Tree
import qualified Distribution.Compat.Prelude as Prelude

-- | A graph of nodes @a@.  The nodes are expected to have instance
-- of class 'IsNode'.
data Graph a
    = Graph {
        Graph a -> Map (Key a) a
graphMap          :: !(Map (Key a) a),
        -- Lazily cached graph representation
        Graph a -> Graph
graphForward      :: G.Graph,
        Graph a -> Graph
graphAdjoint      :: G.Graph,
        Graph a -> Vertex -> a
graphVertexToNode :: G.Vertex -> a,
        Graph a -> Key a -> Maybe Vertex
graphKeyToVertex  :: Key a -> Maybe G.Vertex,
        Graph a -> [(a, [Key a])]
graphBroken       :: [(a, [Key a])]
    }
    deriving (Typeable)

-- NB: Not a Functor! (or Traversable), because you need
-- to restrict Key a ~ Key b.  We provide our own mapping
-- functions.

-- General strategy is most operations are deferred to the
-- Map representation.

instance Show a => Show (Graph a) where
    show :: Graph a -> String
show = [a] -> String
forall a. Show a => a -> String
External instance of the constraint type forall a. Show a => Show [a]
Evidence bound by a type signature of the constraint type Show a
show ([a] -> String) -> (Graph a -> [a]) -> Graph a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> [a]
forall a. Graph a -> [a]
toList

instance (IsNode a, Read a, Show (Key a)) => Read (Graph a) where
    readsPrec :: Vertex -> ReadS (Graph a)
readsPrec Vertex
d String
s = (([a], String) -> (Graph a, String))
-> [([a], String)] -> [(Graph a, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\([a]
a,String
r) -> ([a] -> Graph a
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Evidence bound by a type signature of the constraint type Show (Key a)
Evidence bound by a type signature of the constraint type IsNode a
fromDistinctList [a]
a, String
r)) (Vertex -> ReadS [a]
forall a. Read a => Vertex -> ReadS a
External instance of the constraint type forall a. Read a => Read [a]
Evidence bound by a type signature of the constraint type Read a
readsPrec Vertex
d String
s)

instance (IsNode a, Binary a, Show (Key a)) => Binary (Graph a) where
    put :: Graph a -> Put
put Graph a
x = [a] -> Put
forall t. Binary t => t -> Put
External instance of the constraint type forall a. Binary a => Binary [a]
Evidence bound by a type signature of the constraint type Binary a
put (Graph a -> [a]
forall a. Graph a -> [a]
toList Graph a
x)
    get :: Get (Graph a)
get = ([a] -> Graph a) -> Get [a] -> Get (Graph a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Get
fmap [a] -> Graph a
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Evidence bound by a type signature of the constraint type Show (Key a)
Evidence bound by a type signature of the constraint type IsNode a
fromDistinctList Get [a]
forall t. Binary t => Get t
External instance of the constraint type forall a. Binary a => Binary [a]
Evidence bound by a type signature of the constraint type Binary a
get

instance Structured a => Structured (Graph a) where
    structure :: Proxy (Graph a) -> Structure
structure Proxy (Graph a)
p = TypeRep -> TypeVersion -> String -> [Structure] -> Structure
Nominal (Proxy (Graph a) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
External instance of the constraint type forall a. Structured a => Typeable a
Evidence bound by a type signature of the constraint type Structured a
typeRep Proxy (Graph a)
p) TypeVersion
0 String
"Graph" [Proxy a -> Structure
forall a. Structured a => Proxy a -> Structure
Evidence bound by a type signature of the constraint type Structured a
structure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)]

instance (Eq (Key a), Eq a) => Eq (Graph a) where
    Graph a
g1 == :: Graph a -> Graph a -> Bool
== Graph a
g2 = Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap Graph a
g1 Map (Key a) a -> Map (Key a) a -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall k a. (Eq k, Eq a) => Eq (Map k a)
Evidence bound by a type signature of the constraint type Eq (Key a)
Evidence bound by a type signature of the constraint type Eq a
== Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap Graph a
g2

instance Foldable.Foldable Graph where
    fold :: Graph m -> m
fold = Map (Key m) m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Evidence bound by a type signature of the constraint type Monoid m
External instance of the constraint type forall k. Foldable (Map k)
Foldable.fold (Map (Key m) m -> m) -> (Graph m -> Map (Key m) m) -> Graph m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph m -> Map (Key m) m
forall a. Graph a -> Map (Key a) a
graphMap
    foldr :: (a -> b -> b) -> b -> Graph a -> b
foldr a -> b -> b
f b
z = (a -> b -> b) -> b -> Map (Key a) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type forall k. Foldable (Map k)
Foldable.foldr a -> b -> b
f b
z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    foldl :: (b -> a -> b) -> b -> Graph a -> b
foldl b -> a -> b
f b
z = (b -> a -> b) -> b -> Map (Key a) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type forall k. Foldable (Map k)
Foldable.foldl b -> a -> b
f b
z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    foldMap :: (a -> m) -> Graph a -> m
foldMap a -> m
f = (a -> m) -> Map (Key a) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Evidence bound by a type signature of the constraint type Monoid m
External instance of the constraint type forall k. Foldable (Map k)
Foldable.foldMap a -> m
f (Map (Key a) a -> m) -> (Graph a -> Map (Key a) a) -> Graph a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    foldl' :: (b -> a -> b) -> b -> Graph a -> b
foldl' b -> a -> b
f b
z = (b -> a -> b) -> b -> Map (Key a) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type forall k. Foldable (Map k)
Foldable.foldl' b -> a -> b
f b
z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    foldr' :: (a -> b -> b) -> b -> Graph a -> b
foldr' a -> b -> b
f b
z = (a -> b -> b) -> b -> Map (Key a) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type forall k. Foldable (Map k)
Foldable.foldr' a -> b -> b
f b
z (Map (Key a) a -> b) -> (Graph a -> Map (Key a) a) -> Graph a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
#ifdef MIN_VERSION_base
#if MIN_VERSION_base(4,8,0)
    length :: Graph a -> Vertex
length = Map (Key a) a -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
External instance of the constraint type forall k. Foldable (Map k)
Foldable.length (Map (Key a) a -> Vertex)
-> (Graph a -> Map (Key a) a) -> Graph a -> Vertex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    null :: Graph a -> Bool
null   = Map (Key a) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type forall k. Foldable (Map k)
Foldable.null   (Map (Key a) a -> Bool)
-> (Graph a -> Map (Key a) a) -> Graph a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    toList :: Graph a -> [a]
toList = Map (Key a) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
External instance of the constraint type forall k. Foldable (Map k)
Foldable.toList (Map (Key a) a -> [a])
-> (Graph a -> Map (Key a) a) -> Graph a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    elem :: a -> Graph a -> Bool
elem a
x = a -> Map (Key a) a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Evidence bound by a type signature of the constraint type Eq a
External instance of the constraint type forall k. Foldable (Map k)
Foldable.elem a
x (Map (Key a) a -> Bool)
-> (Graph a -> Map (Key a) a) -> Graph a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    maximum :: Graph a -> a
maximum = Map (Key a) a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type forall k. Foldable (Map k)
Foldable.maximum (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    minimum :: Graph a -> a
minimum = Map (Key a) a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type forall k. Foldable (Map k)
Foldable.minimum (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    sum :: Graph a -> a
sum     = Map (Key a) a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Evidence bound by a type signature of the constraint type Num a
External instance of the constraint type forall k. Foldable (Map k)
Foldable.sum     (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
    product :: Graph a -> a
product = Map (Key a) a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Evidence bound by a type signature of the constraint type Num a
External instance of the constraint type forall k. Foldable (Map k)
Foldable.product (Map (Key a) a -> a) -> (Graph a -> Map (Key a) a) -> Graph a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap
#endif
#endif

instance (NFData a, NFData (Key a)) => NFData (Graph a) where
    rnf :: Graph a -> ()
rnf Graph {
        graphMap :: forall a. Graph a -> Map (Key a) a
graphMap = Map (Key a) a
m,
        graphForward :: forall a. Graph a -> Graph
graphForward = Graph
gf,
        graphAdjoint :: forall a. Graph a -> Graph
graphAdjoint = Graph
ga,
        graphVertexToNode :: forall a. Graph a -> Vertex -> a
graphVertexToNode = Vertex -> a
vtn,
        graphKeyToVertex :: forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex = Key a -> Maybe Vertex
ktv,
        graphBroken :: forall a. Graph a -> [(a, [Key a])]
graphBroken = [(a, [Key a])]
b
    } = Graph
gf Graph -> () -> ()
`seq` Graph
ga Graph -> () -> ()
`seq` Vertex -> a
vtn (Vertex -> a) -> () -> ()
`seq` Key a -> Maybe Vertex
ktv (Key a -> Maybe Vertex) -> () -> ()
`seq` [(a, [Key a])]
b [(a, [Key a])] -> () -> ()
`seq` Map (Key a) a -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall k a. (NFData k, NFData a) => NFData (Map k a)
Evidence bound by a type signature of the constraint type NFData (Key a)
Evidence bound by a type signature of the constraint type NFData a
rnf Map (Key a) a
m

-- TODO: Data instance?

-- | The 'IsNode' class is used for datatypes which represent directed
-- graph nodes.  A node of type @a@ is associated with some unique key of
-- type @'Key' a@; given a node we can determine its key ('nodeKey')
-- and the keys of its neighbors ('nodeNeighbors').
class Ord (Key a) => IsNode a where
    type Key a
    nodeKey :: a -> Key a
    nodeNeighbors :: a -> [Key a]

instance (IsNode a, IsNode b, Key a ~ Key b) => IsNode (Either a b) where
    type Key (Either a b) = Key a
    nodeKey :: Either a b -> Key (Either a b)
nodeKey (Left a
x)  = a -> Key a
forall a. IsNode a => a -> Key a
Evidence bound by a type signature of the constraint type IsNode a
nodeKey a
x
    nodeKey (Right b
x) = b -> Key b
forall a. IsNode a => a -> Key a
Evidence bound by a type signature of the constraint type IsNode b
nodeKey b
x
    nodeNeighbors :: Either a b -> [Key (Either a b)]
nodeNeighbors (Left a
x)  = a -> [Key a]
forall a. IsNode a => a -> [Key a]
Evidence bound by a type signature of the constraint type IsNode a
nodeNeighbors a
x
    nodeNeighbors (Right b
x) = b -> [Key b]
forall a. IsNode a => a -> [Key a]
Evidence bound by a type signature of the constraint type IsNode b
nodeNeighbors b
x

-- | A simple, trivial data type which admits an 'IsNode' instance.
data Node k a = N a k [k]
    deriving (Vertex -> Node k a -> ShowS
[Node k a] -> ShowS
Node k a -> String
(Vertex -> Node k a -> ShowS)
-> (Node k a -> String) -> ([Node k a] -> ShowS) -> Show (Node k a)
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show a, Show k) => Vertex -> Node k a -> ShowS
forall k a. (Show a, Show k) => [Node k a] -> ShowS
forall k a. (Show a, Show k) => Node k a -> String
showList :: [Node k a] -> ShowS
$cshowList :: forall k a. (Show a, Show k) => [Node k a] -> ShowS
show :: Node k a -> String
$cshow :: forall k a. (Show a, Show k) => Node k a -> String
showsPrec :: Vertex -> Node k a -> ShowS
$cshowsPrec :: forall k a. (Show a, Show k) => Vertex -> Node k a -> ShowS
External instance of the constraint type Ord Vertex
External instance of the constraint type forall a. Show a => Show [a]
Evidence bound by a type signature of the constraint type Show k
Evidence bound by a type signature of the constraint type Show a
Show, Node k a -> Node k a -> Bool
(Node k a -> Node k a -> Bool)
-> (Node k a -> Node k a -> Bool) -> Eq (Node k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool
/= :: Node k a -> Node k a -> Bool
$c/= :: forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool
== :: Node k a -> Node k a -> Bool
$c== :: forall k a. (Eq a, Eq k) => Node k a -> Node k a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
Evidence bound by a type signature of the constraint type Eq k
Evidence bound by a type signature of the constraint type Eq a
Eq)

-- | Get the value from a 'Node'.
nodeValue :: Node k a -> a
nodeValue :: Node k a -> a
nodeValue (N a
a k
_ [k]
_) = a
a

instance Functor (Node k) where
    fmap :: (a -> b) -> Node k a -> Node k b
fmap a -> b
f (N a
a k
k [k]
ks) = b -> k -> [k] -> Node k b
forall k a. a -> k -> [k] -> Node k a
N (a -> b
f a
a) k
k [k]
ks

instance Ord k => IsNode (Node k a) where
    type Key (Node k a) = k
    nodeKey :: Node k a -> Key (Node k a)
nodeKey (N a
_ k
k [k]
_) = k
Key (Node k a)
k
    nodeNeighbors :: Node k a -> [Key (Node k a)]
nodeNeighbors (N a
_ k
_ [k]
ks) = [k]
[Key (Node k a)]
ks

-- TODO: Maybe introduce a typeclass for items which just
-- keys (so, Key associated type, and nodeKey method).  But
-- I didn't need it here, so I didn't introduce it.

-- Query

-- | /O(1)/. Is the graph empty?
null :: Graph a -> Bool
null :: Graph a -> Bool
null = Map (Key a) a -> Bool
forall k a. Map k a -> Bool
Map.null (Map (Key a) a -> Bool)
-> (Graph a -> Map (Key a) a) -> Graph a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap

-- | /O(1)/. The number of nodes in the graph.
size :: Graph a -> Int
size :: Graph a -> Vertex
size = Map (Key a) a -> Vertex
forall k a. Map k a -> Vertex
Map.size (Map (Key a) a -> Vertex)
-> (Graph a -> Map (Key a) a) -> Graph a -> Vertex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap

-- | /O(log V)/. Check if the key is in the graph.
member :: IsNode a => Key a -> Graph a -> Bool
member :: Key a -> Graph a -> Bool
member Key a
k Graph a
g = Key a -> Map (Key a) a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.member Key a
k (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)

-- | /O(log V)/. Lookup the node at a key in the graph.
lookup :: IsNode a => Key a -> Graph a -> Maybe a
lookup :: Key a -> Graph a -> Maybe a
lookup Key a
k Graph a
g = Key a -> Map (Key a) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.lookup Key a
k (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)

-- Construction

-- | /O(1)/. The empty graph.
empty :: IsNode a => Graph a
empty :: Graph a
empty = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
Evidence bound by a type signature of the constraint type IsNode a
fromMap Map (Key a) a
forall k a. Map k a
Map.empty

-- | /O(log V)/. Insert a node into a graph.
insert :: IsNode a => a -> Graph a -> Graph a
insert :: a -> Graph a -> Graph a
insert !a
n Graph a
g = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
Evidence bound by a type signature of the constraint type IsNode a
fromMap (Key a -> a -> Map (Key a) a -> Map (Key a) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.insert (a -> Key a
forall a. IsNode a => a -> Key a
Evidence bound by a type signature of the constraint type IsNode a
nodeKey a
n) a
n (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g))

-- | /O(log V)/. Delete the node at a key from the graph.
deleteKey :: IsNode a => Key a -> Graph a -> Graph a
deleteKey :: Key a -> Graph a -> Graph a
deleteKey Key a
k Graph a
g = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
Evidence bound by a type signature of the constraint type IsNode a
fromMap (Key a -> Map (Key a) a -> Map (Key a) a
forall k a. Ord k => k -> Map k a -> Map k a
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.delete Key a
k (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g))

-- | /O(log V)/. Lookup and delete.  This function returns the deleted
-- value if it existed.
deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a, Graph a)
deleteLookup :: Key a -> Graph a -> (Maybe a, Graph a)
deleteLookup Key a
k Graph a
g =
    let (Maybe a
r, Map (Key a) a
m') = (Key a -> a -> Maybe a)
-> Key a -> Map (Key a) a -> (Maybe a, Map (Key a) a)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.updateLookupWithKey (\Key a
_ a
_ -> Maybe a
forall a. Maybe a
Nothing) Key a
k (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)
    in (Maybe a
r, Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
Evidence bound by a type signature of the constraint type IsNode a
fromMap Map (Key a) a
m')

-- Combining

-- | /O(V + V')/. Right-biased union, preferring entries
-- from the second map when conflicts occur.
-- @'nodeKey' x = 'nodeKey' (f x)@.
unionRight :: IsNode a => Graph a -> Graph a -> Graph a
unionRight :: Graph a -> Graph a -> Graph a
unionRight Graph a
g Graph a
g' = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
Evidence bound by a type signature of the constraint type IsNode a
fromMap (Map (Key a) a -> Map (Key a) a -> Map (Key a) a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.union (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g') (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g))

-- | /O(V + V')/. Left-biased union, preferring entries from
-- the first map when conflicts occur.
unionLeft :: IsNode a => Graph a -> Graph a -> Graph a
unionLeft :: Graph a -> Graph a -> Graph a
unionLeft = (Graph a -> Graph a -> Graph a) -> Graph a -> Graph a -> Graph a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Graph a -> Graph a -> Graph a
forall a. IsNode a => Graph a -> Graph a -> Graph a
Evidence bound by a type signature of the constraint type IsNode a
unionRight

-- Graph-like operations

-- | /Ω(V + E)/. Compute the strongly connected components of a graph.
-- Requires amortized construction of graph.
stronglyConnComp :: Graph a -> [SCC a]
stronglyConnComp :: Graph a -> [SCC a]
stronglyConnComp Graph a
g = (Tree Vertex -> SCC a) -> [Tree Vertex] -> [SCC a]
forall a b. (a -> b) -> [a] -> [b]
map Tree Vertex -> SCC a
decode [Tree Vertex]
forest
  where
    forest :: [Tree Vertex]
forest = Graph -> [Tree Vertex]
G.scc (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g)
    decode :: Tree Vertex -> SCC a
decode (Tree.Node Vertex
v [])
        | Vertex -> Bool
mentions_itself Vertex
v = [a] -> SCC a
forall vertex. [vertex] -> SCC vertex
CyclicSCC  [Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g Vertex
v]
        | Bool
otherwise         = a -> SCC a
forall vertex. vertex -> SCC vertex
AcyclicSCC (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g Vertex
v)
    decode Tree Vertex
other = [a] -> SCC a
forall vertex. [vertex] -> SCC vertex
CyclicSCC (Tree Vertex -> [a] -> [a]
dec Tree Vertex
other [])
        where dec :: Tree Vertex -> [a] -> [a]
dec (Tree.Node Vertex
v [Tree Vertex]
ts) [a]
vs
                = Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g Vertex
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Tree Vertex -> [a] -> [a]) -> [a] -> [Tree Vertex] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldr Tree Vertex -> [a] -> [a]
dec [a]
vs [Tree Vertex]
ts
    mentions_itself :: Vertex -> Bool
mentions_itself Vertex
v = Vertex
v Vertex -> [Vertex] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Vertex
External instance of the constraint type Foldable []
`elem` (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
External instance of the constraint type Ix Vertex
! Vertex
v)
-- Implementation copied from 'stronglyConnCompR' in 'Data.Graph'.

-- | /Ω(V + E)/. Compute the cycles of a graph.
-- Requires amortized construction of graph.
cycles :: Graph a -> [[a]]
cycles :: Graph a -> [[a]]
cycles Graph a
g = [ [a]
vs | CyclicSCC [a]
vs <- Graph a -> [SCC a]
forall a. Graph a -> [SCC a]
stronglyConnComp Graph a
g ]

-- | /O(1)/.  Return a list of nodes paired with their broken
-- neighbors (i.e., neighbor keys which are not in the graph).
-- Requires amortized construction of graph.
broken :: Graph a -> [(a, [Key a])]
broken :: Graph a -> [(a, [Key a])]
broken Graph a
g = Graph a -> [(a, [Key a])]
forall a. Graph a -> [(a, [Key a])]
graphBroken Graph a
g

-- | Lookup the immediate neighbors from a key in the graph.
-- Requires amortized construction of graph.
neighbors :: Graph a -> Key a -> Maybe [a]
neighbors :: Graph a -> Key a -> Maybe [a]
neighbors Graph a
g Key a
k = do
    Vertex
v <- Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g Key a
k
    [a] -> Maybe [a]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return ((Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
External instance of the constraint type Ix Vertex
! Vertex
v))

-- | Lookup the immediate reverse neighbors from a key in the graph.
-- Requires amortized construction of graph.
revNeighbors :: Graph a -> Key a -> Maybe [a]
revNeighbors :: Graph a -> Key a -> Maybe [a]
revNeighbors Graph a
g Key a
k = do
    Vertex
v <- Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g Key a
k
    [a] -> Maybe [a]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return ((Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) (Graph a -> Graph
forall a. Graph a -> Graph
graphAdjoint Graph a
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
External instance of the constraint type Ix Vertex
! Vertex
v))

-- | Compute the subgraph which is the closure of some set of keys.
-- Returns @Nothing@ if one (or more) keys are not present in
-- the graph.
-- Requires amortized construction of graph.
closure :: Graph a -> [Key a] -> Maybe [a]
closure :: Graph a -> [Key a] -> Maybe [a]
closure Graph a
g [Key a]
ks = do
    [Vertex]
vs <- (Key a -> Maybe Vertex) -> [Key a] -> Maybe [Vertex]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
External instance of the constraint type Applicative Maybe
External instance of the constraint type Traversable []
traverse (Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g) [Key a]
ks
    [a] -> Maybe [a]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (Graph a -> [Tree Vertex] -> [a]
forall a. Graph a -> [Tree Vertex] -> [a]
decodeVertexForest Graph a
g (Graph -> [Vertex] -> [Tree Vertex]
G.dfs (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g) [Vertex]
vs))

-- | Compute the reverse closure of a graph from some set
-- of keys.  Returns @Nothing@ if one (or more) keys are not present in
-- the graph.
-- Requires amortized construction of graph.
revClosure :: Graph a -> [Key a] -> Maybe [a]
revClosure :: Graph a -> [Key a] -> Maybe [a]
revClosure Graph a
g [Key a]
ks = do
    [Vertex]
vs <- (Key a -> Maybe Vertex) -> [Key a] -> Maybe [Vertex]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
External instance of the constraint type Applicative Maybe
External instance of the constraint type Traversable []
traverse (Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g) [Key a]
ks
    [a] -> Maybe [a]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (Graph a -> [Tree Vertex] -> [a]
forall a. Graph a -> [Tree Vertex] -> [a]
decodeVertexForest Graph a
g (Graph -> [Vertex] -> [Tree Vertex]
G.dfs (Graph a -> Graph
forall a. Graph a -> Graph
graphAdjoint Graph a
g) [Vertex]
vs))

flattenForest :: Tree.Forest a -> [a]
flattenForest :: Forest a -> [a]
flattenForest = (Tree a -> [a]) -> Forest a -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap Tree a -> [a]
forall a. Tree a -> [a]
Tree.flatten

decodeVertexForest :: Graph a -> Tree.Forest G.Vertex -> [a]
decodeVertexForest :: Graph a -> [Tree Vertex] -> [a]
decodeVertexForest Graph a
g = (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) ([Vertex] -> [a])
-> ([Tree Vertex] -> [Vertex]) -> [Tree Vertex] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree Vertex] -> [Vertex]
forall a. Forest a -> [a]
flattenForest

-- | Topologically sort the nodes of a graph.
-- Requires amortized construction of graph.
topSort :: Graph a -> [a]
topSort :: Graph a -> [a]
topSort Graph a
g = (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) ([Vertex] -> [a]) -> [Vertex] -> [a]
forall a b. (a -> b) -> a -> b
$ Graph -> [Vertex]
G.topSort (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g)

-- | Reverse topologically sort the nodes of a graph.
-- Requires amortized construction of graph.
revTopSort :: Graph a -> [a]
revTopSort :: Graph a -> [a]
revTopSort Graph a
g = (Vertex -> a) -> [Vertex] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g) ([Vertex] -> [a]) -> [Vertex] -> [a]
forall a b. (a -> b) -> a -> b
$ Graph -> [Vertex]
G.topSort (Graph a -> Graph
forall a. Graph a -> Graph
graphAdjoint Graph a
g)

-- Conversions

-- | /O(1)/. Convert a map from keys to nodes into a graph.
-- The map must satisfy the invariant that
-- @'fromMap' m == 'fromList' ('Data.Map.elems' m)@;
-- if you can't fulfill this invariant use @'fromList' ('Data.Map.elems' m)@
-- instead.  The values of the map are assumed to already
-- be in WHNF.
fromMap :: IsNode a => Map (Key a) a -> Graph a
fromMap :: Map (Key a) a -> Graph a
fromMap Map (Key a) a
m
    = Graph :: forall a.
Map (Key a) a
-> Graph
-> Graph
-> (Vertex -> a)
-> (Key a -> Maybe Vertex)
-> [(a, [Key a])]
-> Graph a
Graph { graphMap :: Map (Key a) a
graphMap = Map (Key a) a
m
            -- These are lazily computed!
            , graphForward :: Graph
graphForward = Graph
g
            , graphAdjoint :: Graph
graphAdjoint = Graph -> Graph
G.transposeG Graph
g
            , graphVertexToNode :: Vertex -> a
graphVertexToNode = Vertex -> a
vertex_to_node
            , graphKeyToVertex :: Key a -> Maybe Vertex
graphKeyToVertex = Key a -> Maybe Vertex
key_to_vertex
            , graphBroken :: [(a, [Key a])]
graphBroken = [(a, [Key a])]
broke
            }
  where
    try_key_to_vertex :: Key a -> Either (Key a) Vertex
try_key_to_vertex Key a
k = Either (Key a) Vertex
-> (Vertex -> Either (Key a) Vertex)
-> Maybe Vertex
-> Either (Key a) Vertex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Key a -> Either (Key a) Vertex
forall a b. a -> Either a b
Left Key a
k) Vertex -> Either (Key a) Vertex
forall a b. b -> Either a b
Right (Key a -> Maybe Vertex
key_to_vertex Key a
k)

    ([[Key a]]
brokenEdges, [[Vertex]]
edges)
        = [([Key a], [Vertex])] -> ([[Key a]], [[Vertex]])
forall a b. [(a, b)] -> ([a], [b])
unzip
        ([([Key a], [Vertex])] -> ([[Key a]], [[Vertex]]))
-> [([Key a], [Vertex])] -> ([[Key a]], [[Vertex]])
forall a b. (a -> b) -> a -> b
$ [ [Either (Key a) Vertex] -> ([Key a], [Vertex])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((Key a -> Either (Key a) Vertex)
-> [Key a] -> [Either (Key a) Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Key a -> Either (Key a) Vertex
try_key_to_vertex (a -> [Key a]
forall a. IsNode a => a -> [Key a]
Evidence bound by a type signature of the constraint type IsNode a
nodeNeighbors a
n))
          | a
n <- [a]
ns ]
    broke :: [(a, [Key a])]
broke = ((a, [Key a]) -> Bool) -> [(a, [Key a])] -> [(a, [Key a])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((a, [Key a]) -> Bool) -> (a, [Key a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
Prelude.null ([Key a] -> Bool)
-> ((a, [Key a]) -> [Key a]) -> (a, [Key a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [Key a]) -> [Key a]
forall a b. (a, b) -> b
snd) ([a] -> [[Key a]] -> [(a, [Key a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ns [[Key a]]
brokenEdges)

    g :: Graph
g = (Vertex, Vertex) -> [[Vertex]] -> Graph
forall i e. Ix i => (i, i) -> [e] -> Array i e
External instance of the constraint type Ix Vertex
Array.listArray (Vertex, Vertex)
bounds [[Vertex]]
edges

    ns :: [a]
ns              = Map (Key a) a -> [a]
forall k a. Map k a -> [a]
Map.elems Map (Key a) a
m -- sorted ascending
    vertices :: [(Key a, Vertex)]
vertices        = [Key a] -> [Vertex] -> [(Key a, Vertex)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> Key a) -> [a] -> [Key a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Key a
forall a. IsNode a => a -> Key a
Evidence bound by a type signature of the constraint type IsNode a
nodeKey [a]
ns) [Vertex
0..]
    vertex_map :: Map (Key a) Vertex
vertex_map      = [(Key a, Vertex)] -> Map (Key a) Vertex
forall k a. Eq k => [(k, a)] -> Map k a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.fromAscList [(Key a, Vertex)]
vertices
    key_to_vertex :: Key a -> Maybe Vertex
key_to_vertex Key a
k = Key a -> Map (Key a) Vertex -> Maybe Vertex
forall k a. Ord k => k -> Map k a -> Maybe a
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.lookup Key a
k Map (Key a) Vertex
vertex_map

    vertex_to_node :: Vertex -> a
vertex_to_node Vertex
vertex = Array Vertex a
nodeTable Array Vertex a -> Vertex -> a
forall i e. Ix i => Array i e -> i -> e
External instance of the constraint type Ix Vertex
! Vertex
vertex

    nodeTable :: Array Vertex a
nodeTable   = (Vertex, Vertex) -> [a] -> Array Vertex a
forall i e. Ix i => (i, i) -> [e] -> Array i e
External instance of the constraint type Ix Vertex
Array.listArray (Vertex, Vertex)
bounds [a]
ns
    bounds :: (Vertex, Vertex)
bounds = (Vertex
0, Map (Key a) a -> Vertex
forall k a. Map k a -> Vertex
Map.size Map (Key a) a
m Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
External instance of the constraint type Num Vertex
- Vertex
1)

-- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph.
fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a
fromDistinctList :: [a] -> Graph a
fromDistinctList = Map (Key a) a -> Graph a
forall a. IsNode a => Map (Key a) a -> Graph a
Evidence bound by a type signature of the constraint type IsNode a
fromMap
                 (Map (Key a) a -> Graph a)
-> ([a] -> Map (Key a) a) -> [a] -> Graph a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [(Key a, a)] -> Map (Key a) a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Evidence bound by a superclass of: IsNode of the constraint type forall a. IsNode a => Ord (Key a)
Evidence bound by a type signature of the constraint type IsNode a
Map.fromListWith (\a
_ -> a -> a
forall {a} {a}. (Show (Key a), IsNode a) => a -> a
Evidence bound by a type signature of the constraint type IsNode a
Evidence bound by a type signature of the constraint type Show (Key a)
duplicateError)
                 ([(Key a, a)] -> Map (Key a) a)
-> ([a] -> [(Key a, a)]) -> [a] -> Map (Key a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (Key a, a)) -> [a] -> [(Key a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
n -> a
n a -> (Key a, a) -> (Key a, a)
`seq` (a -> Key a
forall a. IsNode a => a -> Key a
Evidence bound by a type signature of the constraint type IsNode a
nodeKey a
n, a
n))
  where
    duplicateError :: a -> a
duplicateError a
n = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Graph.fromDistinctList: duplicate key: "
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key a -> String
forall a. Show a => a -> String
Evidence bound by a type signature of the constraint type Show (Key a)
show (a -> Key a
forall a. IsNode a => a -> Key a
Evidence bound by a type signature of the constraint type IsNode a
nodeKey a
n)

-- Map-like operations

-- | /O(V)/. Convert a graph into a list of nodes.
toList :: Graph a -> [a]
toList :: Graph a -> [a]
toList Graph a
g = Map (Key a) a -> [a]
forall k a. Map k a -> [a]
Map.elems (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)

-- | /O(V)/. Convert a graph into a list of keys.
keys :: Graph a -> [Key a]
keys :: Graph a -> [Key a]
keys Graph a
g = Map (Key a) a -> [Key a]
forall k a. Map k a -> [k]
Map.keys (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)

-- | /O(V)/. Convert a graph into a set of keys.
keysSet :: Graph a -> Set.Set (Key a)
keysSet :: Graph a -> Set (Key a)
keysSet Graph a
g = Map (Key a) a -> Set (Key a)
forall k a. Map k a -> Set k
Map.keysSet (Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
toMap Graph a
g)

-- | /O(1)/. Convert a graph into a map from keys to nodes.
-- The resulting map @m@ is guaranteed to have the property that
-- @'Prelude.all' (\(k,n) -> k == 'nodeKey' n) ('Data.Map.toList' m)@.
toMap :: Graph a -> Map (Key a) a
toMap :: Graph a -> Map (Key a) a
toMap = Graph a -> Map (Key a) a
forall a. Graph a -> Map (Key a) a
graphMap

-- Graph-like operations

-- | /O(1)/. Convert a graph into a 'Data.Graph.Graph'.
-- Requires amortized construction of graph.
toGraph :: Graph a -> (G.Graph, G.Vertex -> a, Key a -> Maybe G.Vertex)
toGraph :: Graph a -> (Graph, Vertex -> a, Key a -> Maybe Vertex)
toGraph Graph a
g = (Graph a -> Graph
forall a. Graph a -> Graph
graphForward Graph a
g, Graph a -> Vertex -> a
forall a. Graph a -> Vertex -> a
graphVertexToNode Graph a
g, Graph a -> Key a -> Maybe Vertex
forall a. Graph a -> Key a -> Maybe Vertex
graphKeyToVertex Graph a
g)