    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    {-# 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.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
      { forall a. Graph a -> Map (Key a) a
    graphMap :: !(Map (Key a) a)
      , -- Lazily cached graph representation
        forall a. Graph a -> Graph
    graphForward :: G.Graph
      , forall a. Graph a -> Graph
    graphAdjoint :: G.Graph
      , forall a. Graph a -> Vertex -> a
    graphVertexToNode :: G.Vertex -> a
      , forall a. Graph a -> Key a -> Maybe Vertex
    graphKeyToVertex :: Key a -> Maybe G.Vertex
      , forall a. Graph a -> [(a, [Key a])]
    graphBroken :: [(a, [Key a])]
      }

    -- 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
    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
    fromDistinctList [a]
    a, String
    r)) (Vertex -> ReadS [a]
    forall a. Read a => Vertex -> ReadS 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
    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 a b. (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [a] -> Graph a
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    fromDistinctList Get [a]
    forall t. Binary t => Get t
    get

    instance Structured a => Structured (Graph a) where
      structure :: Proxy (Graph a) -> Structure
    structure Proxy (Graph a)
    p = TypeRep -> Word32 -> String -> [Structure] -> Structure
    Nominal (Proxy (Graph a) -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep Proxy (Graph a)
    p) Word32
    0 String
    "Graph" [Proxy a -> Structure
    forall a. Structured a => Proxy a -> Structure
    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
    == Graph a -> Map (Key a) a
    forall a. Graph a -> Map (Key a) a
    graphMap Graph a
    g2

    instance Foldable.Foldable Graph where
      elem :: forall a. Eq a => a -> Graph a -> Bool
    elem a
    x = a -> Map (Key a) a -> Bool
    forall a. Eq a => a -> Map (Key a) a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    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
      fold :: forall m. Monoid m => Graph m -> m
    fold = Map (Key m) m -> m
    forall m. Monoid m => Map (Key m) m -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    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
      foldl :: forall b a. (b -> a -> b) -> b -> Graph a -> b
    foldl b -> a -> b
    f b
    z = (b -> a -> b) -> b -> Map (Key a) a -> b
    forall b a. (b -> a -> b) -> b -> Map (Key a) a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    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
      foldl' :: forall b a. (b -> a -> b) -> b -> Graph a -> b
    foldl' b -> a -> b
    f b
    z = (b -> a -> b) -> b -> Map (Key a) a -> b
    forall b a. (b -> a -> b) -> b -> Map (Key a) a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    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 :: forall a b. (a -> b -> b) -> b -> Graph a -> b
    foldr a -> b -> b
    f b
    z = (a -> b -> b) -> b -> Map (Key a) a -> b
    forall a b. (a -> b -> b) -> b -> Map (Key a) a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    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
      foldr' :: forall a b. (a -> b -> b) -> b -> Graph a -> b
    foldr' a -> b -> b
    f b
    z = (a -> b -> b) -> b -> Map (Key a) a -> b
    forall a b. (a -> b -> b) -> b -> Map (Key a) a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    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
      foldMap :: forall m a. Monoid m => (a -> m) -> Graph a -> m
    foldMap a -> m
    f = (a -> m) -> Map (Key a) a -> m
    forall m a. Monoid m => (a -> m) -> Map (Key a) a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    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
      length :: forall a. Graph a -> Vertex
    length = Map (Key a) a -> Vertex
    forall a. Map (Key a) a -> Vertex
    forall (t :: * -> *) a. Foldable t => t a -> Vertex
    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
      maximum :: forall a. Ord a => Graph a -> a
    maximum = Map (Key a) a -> a
    forall a. Ord a => Map (Key a) a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    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 :: forall a. Ord a => Graph a -> a
    minimum = Map (Key a) a -> a
    forall a. Ord a => Map (Key a) a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    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
      null :: forall a. Graph a -> Bool
    null = Map (Key a) a -> Bool
    forall a. Map (Key a) a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    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
      product :: forall a. Num a => Graph a -> a
    product = Map (Key a) a -> a
    forall a. Num a => Map (Key a) a -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    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
      sum :: forall a. Num a => Graph a -> a
    sum = Map (Key a) a -> a
    forall a. Num a => Map (Key a) a -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    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
      toList :: forall a. Graph a -> [a]
    toList = Map (Key a) a -> [a]
    forall a. Map (Key a) a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    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

    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 -> () -> ()
    forall a b. a -> b -> b
    `seq` Graph
    ga Graph -> () -> ()
    forall a b. a -> b -> b
    `seq` Vertex -> a
    vtn (Vertex -> a) -> () -> ()
    forall a b. a -> b -> b
    `seq` Key a -> Maybe Vertex
    ktv (Key a -> Maybe Vertex) -> () -> ()
    forall a b. a -> b -> b
    `seq` [(a, [Key a])]
    b [(a, [Key a])] -> () -> ()
    forall a b. a -> b -> b
    `seq` Map (Key a) a -> ()
    forall a. NFData a => 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
    nodeKey a
    x
      nodeKey (Right b
    x) = b -> Key b
    forall a. IsNode a => a -> Key a
    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]
    nodeNeighbors a
    x
      nodeNeighbors (Right b
    x) = b -> [Key b]
    forall a. IsNode a => a -> [Key a]
    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
    $cshowsPrec :: forall k a. (Show a, Show k) => Vertex -> Node k a -> ShowS
    showsPrec :: Vertex -> Node k a -> ShowS
    $cshow :: forall k a. (Show a, Show k) => Node k a -> String
    show :: Node k a -> String
    $cshowList :: forall k a. (Show a, Show k) => [Node k a] -> ShowS
    showList :: [Node k a] -> ShowS
    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
    $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
    /= :: Node k a -> Node k a -> Bool
    Eq)

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

    instance Functor (Node k) where
      fmap :: forall a b. (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 :: forall a. 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 :: forall a. 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 :: forall a. IsNode a => 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
    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 :: forall a. IsNode a => 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
    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 :: forall a. IsNode a => Graph a
    empty = Map (Key a) a -> Graph a
    forall a. IsNode a => Map (Key a) a -> Graph 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 :: forall a. IsNode a => 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
    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
    Map.insert (a -> Key a
    forall a. IsNode a => a -> Key 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 :: forall a. IsNode a => 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
    fromMap (Key a -> Map (Key a) a -> Map (Key a) a
    forall k a. Ord k => k -> Map k a -> Map k 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 :: forall a. IsNode a => 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)
    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
    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 :: forall a. IsNode a => 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
    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
    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 :: forall a. IsNode a => 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
    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 :: forall a. 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 a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    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 a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `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
    ! 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 :: forall a. 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 :: forall a. 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 :: forall a. Graph a -> Key a -> Maybe [a]
    neighbors Graph a
    g Key a
    k = do
      v <- Graph a -> Key a -> Maybe Vertex
    forall a. Graph a -> Key a -> Maybe Vertex
    graphKeyToVertex Graph a
    g Key a
    k
      return (map (graphVertexToNode g) (graphForward g ! 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 :: forall a. Graph a -> Key a -> Maybe [a]
    revNeighbors Graph a
    g Key a
    k = do
      v <- Graph a -> Key a -> Maybe Vertex
    forall a. Graph a -> Key a -> Maybe Vertex
    graphKeyToVertex Graph a
    g Key a
    k
      return (map (graphVertexToNode g) (graphAdjoint g ! 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 :: forall a. Graph a -> [Key a] -> Maybe [a]
    closure Graph a
    g [Key a]
    ks = do
      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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse (Graph a -> Key a -> Maybe Vertex
    forall a. Graph a -> Key a -> Maybe Vertex
    graphKeyToVertex Graph a
    g) [Key a]
    ks
      return (decodeVertexForest g (G.dfs (graphForward g) 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 :: forall a. Graph a -> [Key a] -> Maybe [a]
    revClosure Graph a
    g [Key a]
    ks = do
      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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse (Graph a -> Key a -> Maybe Vertex
    forall a. Graph a -> Key a -> Maybe Vertex
    graphKeyToVertex Graph a
    g) [Key a]
    ks
      return (decodeVertexForest g (G.dfs (graphAdjoint g) vs))

    flattenForest :: Tree.Forest a -> [a]
    flattenForest :: forall a. Forest a -> [a]
    flattenForest = (Tree a -> [a]) -> [Tree a] -> [a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Tree a -> [a]
    forall a. Tree a -> [a]
    Tree.flatten

    decodeVertexForest :: Graph a -> Tree.Forest G.Vertex -> [a]
    decodeVertexForest :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. IsNode a => Map (Key a) a -> Graph a
    fromMap Map (Key a) a
    m =
      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]
    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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    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
    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
    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
    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
    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
    ! Vertex
    vertex

        nodeTable :: Array Vertex a
    nodeTable = (Vertex, Vertex) -> [a] -> Array Vertex a
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    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
    - 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 :: forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    fromDistinctList =
      Map (Key a) a -> Graph a
    forall a. IsNode a => Map (Key a) a -> Graph 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
    Map.fromListWith (\a
    _ -> a -> a
    forall {a} {b}. (Show (Key a), IsNode a) => a -> b
    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)
    forall a b. a -> b -> b
    `seq` (a -> Key a
    forall a. IsNode a => a -> Key a
    nodeKey a
    n, a
    n))
      where
        duplicateError :: a -> b
    duplicateError a
    n =
          String -> b
    forall a. HasCallStack => String -> a
    error (String -> b) -> String -> b
    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
    show (a -> Key a
    forall a. IsNode a => a -> Key a
    nodeKey a
    n)

    -- Map-like operations

    -- | /O(V)/. Convert a graph into a list of nodes.
    toList :: Graph a -> [a]
    toList :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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)