    {-# language BangPatterns #-}
    {-# language NamedFieldPuns #-}
    {-# language RecordWildCards #-}
    {-# language ScopedTypeVariables #-}
    {-----------------------------------------------------------------------------
        reactive-banana
    ------------------------------------------------------------------------------}
    module Reactive.Banana.Prim.Low.Graph
        ( Graph
        , empty
        , getOutgoing
        , getIncoming
        , size
        , edgeCount
        , listConnectedVertices

        , deleteVertex
        , insertEdge
        , deleteEdge
        , clearPredecessors
        , collectGarbage

        , topologicalSort
        , Step (..)
        , walkSuccessors
        , walkSuccessors_

        -- * Internal
        , Level
        , getLevel

        -- * Debugging
        , showDot
        ) where

    import Data.Functor.Identity
        ( Identity (..) )
    import Data.Hashable
        ( Hashable )
    import Data.Maybe
        ( fromMaybe )
    import Reactive.Banana.Prim.Low.GraphTraversal
        ( reversePostOrder )

    import qualified Data.List as L
    import qualified Data.HashMap.Strict as Map
    import qualified Data.HashSet as Set
    import qualified Data.PQueue.Prio.Min as Q

    type Queue = Q.MinPQueue
    type Map = Map.HashMap
    type Set = Set.HashSet

    {-----------------------------------------------------------------------------
        Levels
    ------------------------------------------------------------------------------}
    -- | 'Level's are used to keep track of the order of vertices —
    -- Lower levels come first.
    type Level = Int

    ground :: Level
    ground :: Level
    ground = Level
    0

    {-----------------------------------------------------------------------------
        Graph
    ------------------------------------------------------------------------------}
    {- | A directed graph
    whose set of vertices is the set of all values of the type @v@
    and whose edges are associated with data of type @e@.

    Note that a 'Graph' does not have a notion of vertex membership
    — by design, /all/ values of the type @v@ are vertices of the 'Graph'.
    The main purpose of 'Graph' is to keep track of directed edges between
    vertices; a vertex with at least one edge incident on it is called
    a /connected vertex/.
    For efficiency, only the connected vertices are stored.
    -}
    data Graph v e = Graph
        { -- | Mapping from each vertex to its direct successors
          -- (possibly empty).
          forall v e. Graph v e -> Map v (Map v e)
    outgoing :: !(Map v (Map v e))

          -- | Mapping from each vertex to its direct predecessors
          -- (possibly empty).
        , forall v e. Graph v e -> Map v (Map v e)
    incoming :: !(Map v (Map v e))

          -- | Mapping from each vertex to its 'Level'.
          -- Invariant: If x precedes y, then x has a lower level than y.
        , forall v e. Graph v e -> Map v Level
    levels :: !(Map v Level)
        } deriving (Graph v e -> Graph v e -> Bool
    (Graph v e -> Graph v e -> Bool)
    -> (Graph v e -> Graph v e -> Bool) -> Eq (Graph v e)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall v e. (Eq v, Eq e) => Graph v e -> Graph v e -> Bool
    $c== :: forall v e. (Eq v, Eq e) => Graph v e -> Graph v e -> Bool
    == :: Graph v e -> Graph v e -> Bool
    $c/= :: forall v e. (Eq v, Eq e) => Graph v e -> Graph v e -> Bool
    /= :: Graph v e -> Graph v e -> Bool
    Eq, Level -> Graph v e -> ShowS
    [Graph v e] -> ShowS
    Graph v e -> String
    (Level -> Graph v e -> ShowS)
    -> (Graph v e -> String)
    -> ([Graph v e] -> ShowS)
    -> Show (Graph v e)
    forall a.
    (Level -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall v e. (Show v, Show e) => Level -> Graph v e -> ShowS
    forall v e. (Show v, Show e) => [Graph v e] -> ShowS
    forall v e. (Show v, Show e) => Graph v e -> String
    $cshowsPrec :: forall v e. (Show v, Show e) => Level -> Graph v e -> ShowS
    showsPrec :: Level -> Graph v e -> ShowS
    $cshow :: forall v e. (Show v, Show e) => Graph v e -> String
    show :: Graph v e -> String
    $cshowList :: forall v e. (Show v, Show e) => [Graph v e] -> ShowS
    showList :: [Graph v e] -> ShowS
    Show)

    -- | The graph with no edges.
    empty :: Graph v e
    empty :: forall v e. Graph v e
    empty = Graph
        { outgoing :: Map v (Map v e)
    outgoing = Map v (Map v e)
    forall k v. HashMap k v
    Map.empty
        , incoming :: Map v (Map v e)
    incoming = Map v (Map v e)
    forall k v. HashMap k v
    Map.empty
        , levels :: Map v Level
    levels = Map v Level
    forall k v. HashMap k v
    Map.empty
        }

    -- | Get all direct successors of a vertex in a 'Graph'.
    getOutgoing :: (Eq v, Hashable v) => Graph v e -> v -> [(e,v)]
    getOutgoing :: forall v e. (Eq v, Hashable v) => Graph v e -> v -> [(e, v)]
    getOutgoing Graph{Map v (Map v e)
    outgoing :: forall v e. Graph v e -> Map v (Map v e)
    outgoing :: Map v (Map v e)
    outgoing} v
    x =
        ((v, e) -> (e, v)) -> [(v, e)] -> [(e, v)]
    forall a b. (a -> b) -> [a] -> [b]
    map (v, e) -> (e, v)
    forall {b} {a}. (b, a) -> (a, b)
    shuffle ([(v, e)] -> [(e, v)]) -> [(v, e)] -> [(e, v)]
    forall a b. (a -> b) -> a -> b
    $ Map v e -> [(v, e)]
    forall k v. HashMap k v -> [(k, v)]
    Map.toList (Map v e -> [(v, e)]) -> Map v e -> [(v, e)]
    forall a b. (a -> b) -> a -> b
    $ Map v e -> Maybe (Map v e) -> Map v e
    forall a. a -> Maybe a -> a
    fromMaybe Map v e
    forall k v. HashMap k v
    Map.empty (Maybe (Map v e) -> Map v e) -> Maybe (Map v e) -> Map v e
    forall a b. (a -> b) -> a -> b
    $ v -> Map v (Map v e) -> Maybe (Map v e)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup v
    x Map v (Map v e)
    outgoing
      where
          shuffle :: (b, a) -> (a, b)
    shuffle (b
    x,a
    y) = (a
    y,b
    x)

    -- | Get all direct predecessors of a vertex in a 'Graph'.
    getIncoming :: (Eq v, Hashable v) => Graph v e -> v -> [(v,e)]
    getIncoming :: forall v e. (Eq v, Hashable v) => Graph v e -> v -> [(v, e)]
    getIncoming Graph{Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: Map v (Map v e)
    incoming} v
    x =
        Map v e -> [(v, e)]
    forall k v. HashMap k v -> [(k, v)]
    Map.toList (Map v e -> [(v, e)]) -> Map v e -> [(v, e)]
    forall a b. (a -> b) -> a -> b
    $ Map v e -> Maybe (Map v e) -> Map v e
    forall a. a -> Maybe a -> a
    fromMaybe Map v e
    forall k v. HashMap k v
    Map.empty (Maybe (Map v e) -> Map v e) -> Maybe (Map v e) -> Map v e
    forall a b. (a -> b) -> a -> b
    $ v -> Map v (Map v e) -> Maybe (Map v e)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup v
    x Map v (Map v e)
    incoming

    -- | Get the 'Level' of a vertex in a 'Graph'.
    getLevel :: (Eq v, Hashable v) => Graph v e -> v -> Level
    getLevel :: forall v e. (Eq v, Hashable v) => Graph v e -> v -> Level
    getLevel Graph{Map v Level
    levels :: forall v e. Graph v e -> Map v Level
    levels :: Map v Level
    levels} v
    x = Level -> Maybe Level -> Level
    forall a. a -> Maybe a -> a
    fromMaybe Level
    ground (Maybe Level -> Level) -> Maybe Level -> Level
    forall a b. (a -> b) -> a -> b
    $ v -> Map v Level -> Maybe Level
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup v
    x Map v Level
    levels

    -- | List all connected vertices,
    -- i.e. vertices on which at least one edge is incident.
    listConnectedVertices :: (Eq v, Hashable v) => Graph v e -> [v]
    listConnectedVertices :: forall v e. (Eq v, Hashable v) => Graph v e -> [v]
    listConnectedVertices Graph{Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: Map v (Map v e)
    incoming,Map v (Map v e)
    outgoing :: forall v e. Graph v e -> Map v (Map v e)
    outgoing :: Map v (Map v e)
    outgoing} =
        HashMap v () -> [v]
    forall k v. HashMap k v -> [k]
    Map.keys (HashMap v () -> [v]) -> HashMap v () -> [v]
    forall a b. (a -> b) -> a -> b
    $ (() () -> Map v (Map v e) -> HashMap v ()
    forall a b. a -> HashMap v b -> HashMap v a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Map v (Map v e)
    outgoing) HashMap v () -> HashMap v () -> HashMap v ()
    forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
    `Map.union` (() () -> Map v (Map v e) -> HashMap v ()
    forall a b. a -> HashMap v b -> HashMap v a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Map v (Map v e)
    incoming)

    -- | Number of connected vertices,
    -- i.e. vertices on which at least one edge is incident.
    size :: (Eq v, Hashable v) => Graph v e -> Int
    size :: forall v e. (Eq v, Hashable v) => Graph v e -> Level
    size Graph{Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: Map v (Map v e)
    incoming,Map v (Map v e)
    outgoing :: forall v e. Graph v e -> Map v (Map v e)
    outgoing :: Map v (Map v e)
    outgoing} =
        HashMap v () -> Level
    forall k v. HashMap k v -> Level
    Map.size (HashMap v () -> Level) -> HashMap v () -> Level
    forall a b. (a -> b) -> a -> b
    $ (() () -> Map v (Map v e) -> HashMap v ()
    forall a b. a -> HashMap v b -> HashMap v a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Map v (Map v e)
    outgoing) HashMap v () -> HashMap v () -> HashMap v ()
    forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
    `Map.union` (() () -> Map v (Map v e) -> HashMap v ()
    forall a b. a -> HashMap v b -> HashMap v a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Map v (Map v e)
    incoming)

    -- | Number of edges.
    edgeCount :: (Eq v, Hashable v) => Graph v e -> Int
    edgeCount :: forall v e. (Eq v, Hashable v) => Graph v e -> Level
    edgeCount Graph{Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: Map v (Map v e)
    incoming,Map v (Map v e)
    outgoing :: forall v e. Graph v e -> Map v (Map v e)
    outgoing :: Map v (Map v e)
    outgoing} =
        (Map v (Map v e) -> Level
    forall {k} {k} {v}. HashMap k (HashMap k v) -> Level
    count Map v (Map v e)
    incoming Level -> Level -> Level
    forall a. Num a => a -> a -> a
    + Map v (Map v e) -> Level
    forall {k} {k} {v}. HashMap k (HashMap k v) -> Level
    count Map v (Map v e)
    outgoing) Level -> Level -> Level
    forall a. Integral a => a -> a -> a
    `div` Level
    2
      where
        count :: HashMap k (HashMap k v) -> Level
    count = (Level -> HashMap k v -> Level)
    -> Level -> HashMap k (HashMap k v) -> Level
    forall a v k. (a -> v -> a) -> a -> HashMap k v -> a
    Map.foldl' (\Level
    a HashMap k v
    v -> HashMap k v -> Level
    forall k v. HashMap k v -> Level
    Map.size HashMap k v
    v Level -> Level -> Level
    forall a. Num a => a -> a -> a
    + Level
    a) Level
    0

    {-----------------------------------------------------------------------------
        Insertion
    ------------------------------------------------------------------------------}
    -- | Insert an edge from the first to the second vertex into the 'Graph'.
    insertEdge :: (Eq v, Hashable v) => (v,v) -> e -> Graph v e -> Graph v e
    insertEdge :: forall v e.
    (Eq v, Hashable v) =>
    (v, v) -> e -> Graph v e -> Graph v e
    insertEdge (v
    x,v
    y) e
    exy g0 :: Graph v e
    g0@Graph{Map v Level
    Map v (Map v e)
    outgoing :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    levels :: forall v e. Graph v e -> Map v Level
    outgoing :: Map v (Map v e)
    incoming :: Map v (Map v e)
    levels :: Map v Level
    ..} = Graph
        { outgoing :: Map v (Map v e)
    outgoing
            = (Map v e -> Map v e -> Map v e)
    -> v -> Map v e -> Map v (Map v e) -> Map v (Map v e)
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
    Map.insertWith (\Map v e
    new Map v e
    old -> Map v e
    new Map v e -> Map v e -> Map v e
    forall a. Semigroup a => a -> a -> a
    <> Map v e
    old) v
    x (v -> e -> Map v e
    forall k v. Hashable k => k -> v -> HashMap k v
    Map.singleton v
    y e
    exy)
            (Map v (Map v e) -> Map v (Map v e))
    -> Map v (Map v e) -> Map v (Map v e)
    forall a b. (a -> b) -> a -> b
    $ v -> Map v e -> Map v (Map v e) -> Map v (Map v e)
    forall k a. (Eq k, Hashable k) => k -> a -> Map k a -> Map k a
    insertDefaultIfNotMember v
    y Map v e
    forall k v. HashMap k v
    Map.empty
            (Map v (Map v e) -> Map v (Map v e))
    -> Map v (Map v e) -> Map v (Map v e)
    forall a b. (a -> b) -> a -> b
    $ Map v (Map v e)
    outgoing
        , incoming :: Map v (Map v e)
    incoming
            = (Map v e -> Map v e -> Map v e)
    -> v -> Map v e -> Map v (Map v e) -> Map v (Map v e)
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
    Map.insertWith (\Map v e
    new Map v e
    old -> Map v e
    new Map v e -> Map v e -> Map v e
    forall a. Semigroup a => a -> a -> a
    <> Map v e
    old) v
    y (v -> e -> Map v e
    forall k v. Hashable k => k -> v -> HashMap k v
    Map.singleton v
    x e
    exy)
            (Map v (Map v e) -> Map v (Map v e))
    -> (Map v (Map v e) -> Map v (Map v e))
    -> Map v (Map v e)
    -> Map v (Map v e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> Map v e -> Map v (Map v e) -> Map v (Map v e)
    forall k a. (Eq k, Hashable k) => k -> a -> Map k a -> Map k a
    insertDefaultIfNotMember v
    x Map v e
    forall k v. HashMap k v
    Map.empty
            (Map v (Map v e) -> Map v (Map v e))
    -> Map v (Map v e) -> Map v (Map v e)
    forall a b. (a -> b) -> a -> b
    $ Map v (Map v e)
    incoming
        , levels :: Map v Level
    levels
            = Map v Level -> Map v Level
    adjustLevels
            (Map v Level -> Map v Level) -> Map v Level -> Map v Level
    forall a b. (a -> b) -> a -> b
    $ Map v Level
    levels0
        }
      where
        getLevel :: k -> HashMap k Level -> Level
    getLevel k
    z = Level -> Maybe Level -> Level
    forall a. a -> Maybe a -> a
    fromMaybe Level
    ground (Maybe Level -> Level)
    -> (HashMap k Level -> Maybe Level) -> HashMap k Level -> Level
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . k -> HashMap k Level -> Maybe Level
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup k
    z
        levels0 :: Map v Level
    levels0
            = v -> Level -> Map v Level -> Map v Level
    forall k a. (Eq k, Hashable k) => k -> a -> Map k a -> Map k a
    insertDefaultIfNotMember v
    x (Level
    groundLevel -> Level -> Level
    forall a. Num a => a -> a -> a
    -Level
    1)
            (Map v Level -> Map v Level)
    -> (Map v Level -> Map v Level) -> Map v Level -> Map v Level
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> Level -> Map v Level -> Map v Level
    forall k a. (Eq k, Hashable k) => k -> a -> Map k a -> Map k a
    insertDefaultIfNotMember v
    y Level
    ground
            (Map v Level -> Map v Level) -> Map v Level -> Map v Level
    forall a b. (a -> b) -> a -> b
    $ Map v Level
    levels

        levelDifference :: Level
    levelDifference = v -> Map v Level -> Level
    forall {k}. Hashable k => k -> HashMap k Level -> Level
    getLevel v
    y Map v Level
    levels0 Level -> Level -> Level
    forall a. Num a => a -> a -> a
    - Level
    1 Level -> Level -> Level
    forall a. Num a => a -> a -> a
    - v -> Map v Level -> Level
    forall {k}. Hashable k => k -> HashMap k Level -> Level
    getLevel v
    x Map v Level
    levels0
        adjustLevel :: HashMap k Level -> k -> HashMap k Level
    adjustLevel HashMap k Level
    g k
    x = (Level -> Level) -> k -> HashMap k Level -> HashMap k Level
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v) -> k -> HashMap k v -> HashMap k v
    Map.adjust (Level -> Level -> Level
    forall a. Num a => a -> a -> a
    + Level
    levelDifference) k
    x HashMap k Level
    g
        adjustLevels :: Map v Level -> Map v Level
    adjustLevels Map v Level
    ls
            | Level
    levelDifference Level -> Level -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Level
    0 = Map v Level
    ls
            | Bool
    otherwise            = (Map v Level -> v -> Map v Level)
    -> Map v Level -> [v] -> Map v Level
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' Map v Level -> v -> Map v Level
    forall {k}. Hashable k => HashMap k Level -> k -> HashMap k Level
    adjustLevel Map v Level
    ls [v]
    predecessors
          where
            Identity [v]
    predecessors =
                [v] -> GraphM Identity v -> Identity [v]
    forall a (m :: * -> *).
    (Eq a, Hashable a, Monad m) =>
    [a] -> GraphM m a -> m [a]
    reversePostOrder [v
    x] ([v] -> Identity [v]
    forall a. a -> Identity a
    Identity ([v] -> Identity [v]) -> (v -> [v]) -> GraphM Identity v
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((v, e) -> v) -> [(v, e)] -> [v]
    forall a b. (a -> b) -> [a] -> [b]
    map (v, e) -> v
    forall a b. (a, b) -> a
    fst ([(v, e)] -> [v]) -> (v -> [(v, e)]) -> v -> [v]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph v e -> v -> [(v, e)]
    forall v e. (Eq v, Hashable v) => Graph v e -> v -> [(v, e)]
    getIncoming Graph v e
    g0)

    -- Helper function: Insert a default value if the key is not a member yet
    insertDefaultIfNotMember
        :: (Eq k, Hashable k)
        => k -> a -> Map k a -> Map k a
    insertDefaultIfNotMember :: forall k a. (Eq k, Hashable k) => k -> a -> Map k a -> Map k a
    insertDefaultIfNotMember k
    x a
    def = (a -> a -> a) -> k -> a -> HashMap k a -> HashMap k a
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
    Map.insertWith (\a
    _ a
    old -> a
    old) k
    x a
    def

    {-----------------------------------------------------------------------------
        Deletion
    ------------------------------------------------------------------------------}
    -- | TODO: Not implemented.
    deleteEdge :: (Eq v, Hashable v) => (v,v) -> Graph v e -> Graph v e
    deleteEdge :: forall v e. (Eq v, Hashable v) => (v, v) -> Graph v e -> Graph v e
    deleteEdge (v
    x,v
    y) Graph v e
    g = Graph
        { outgoing :: Map v (Map v e)
    outgoing = v -> Graph v e -> Map v (Map v e)
    forall a. HasCallStack => a
    undefined v
    x Graph v e
    g
        , incoming :: Map v (Map v e)
    incoming = v -> Graph v e -> Map v (Map v e)
    forall a. HasCallStack => a
    undefined v
    y Graph v e
    g
        , levels :: Map v Level
    levels = Map v Level
    forall a. HasCallStack => a
    undefined
        }

    -- | Remove all edges incident on this vertex from the 'Graph'.
    deleteVertex :: (Eq v, Hashable v) => v -> Graph v e -> Graph v e
    deleteVertex :: forall v e. (Eq v, Hashable v) => v -> Graph v e -> Graph v e
    deleteVertex v
    x = Graph v e -> Graph v e
    forall {e}. Graph v e -> Graph v e
    clearLevels (Graph v e -> Graph v e)
    -> (Graph v e -> Graph v e) -> Graph v e -> Graph v e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> Graph v e -> Graph v e
    forall v e. (Eq v, Hashable v) => v -> Graph v e -> Graph v e
    clearPredecessors v
    x (Graph v e -> Graph v e)
    -> (Graph v e -> Graph v e) -> Graph v e -> Graph v e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> Graph v e -> Graph v e
    forall v e. (Eq v, Hashable v) => v -> Graph v e -> Graph v e
    clearSuccessors v
    x
      where
        clearLevels :: Graph v e -> Graph v e
    clearLevels g :: Graph v e
    g@Graph{Map v Level
    levels :: forall v e. Graph v e -> Map v Level
    levels :: Map v Level
    levels} = Graph v e
    g{levels = Map.delete x levels}

    -- | Remove all the edges that connect the given vertex to its predecessors.
    clearPredecessors :: (Eq v, Hashable v) => v -> Graph v e -> Graph v e
    clearPredecessors :: forall v e. (Eq v, Hashable v) => v -> Graph v e -> Graph v e
    clearPredecessors v
    x g :: Graph v e
    g@Graph{Map v Level
    Map v (Map v e)
    outgoing :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    levels :: forall v e. Graph v e -> Map v Level
    outgoing :: Map v (Map v e)
    incoming :: Map v (Map v e)
    levels :: Map v Level
    ..} = Graph v e
    g
        { outgoing = foldr ($) outgoing
            [ Map.adjust (Map.delete x) z | (z,_) <- getIncoming g x ]
        , incoming = Map.delete x incoming
        }

    -- | Remove all the edges that connect the given vertex to its successors.
    clearSuccessors :: (Eq v, Hashable v) => v -> Graph v e -> Graph v e
    clearSuccessors :: forall v e. (Eq v, Hashable v) => v -> Graph v e -> Graph v e
    clearSuccessors v
    x g :: Graph v e
    g@Graph{Map v Level
    Map v (Map v e)
    outgoing :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    levels :: forall v e. Graph v e -> Map v Level
    outgoing :: Map v (Map v e)
    incoming :: Map v (Map v e)
    levels :: Map v Level
    ..} = Graph v e
    g
        { outgoing = Map.delete x outgoing
        , incoming = foldr ($) incoming
            [ Map.adjust (Map.delete x) z | (_,z) <- getOutgoing g x ]
        }

    -- | Apply `deleteVertex` to all vertices which are not predecessors
    -- of any of the vertices in the given list.
    collectGarbage :: (Eq v, Hashable v) => [v] -> Graph v e -> Graph v e
    collectGarbage :: forall v e. (Eq v, Hashable v) => [v] -> Graph v e -> Graph v e
    collectGarbage [v]
    roots g :: Graph v e
    g@Graph{Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: Map v (Map v e)
    incoming,Map v (Map v e)
    outgoing :: forall v e. Graph v e -> Map v (Map v e)
    outgoing :: Map v (Map v e)
    outgoing} = Graph v e
    g
        { incoming = Map.filterWithKey (\v
    v Map v e
    _ -> v -> Bool
    isReachable v
    v) incoming
            -- incoming edges of reachable members are reachable by definition
        , outgoing
            = Map.map (Map.filterWithKey (\v
    v e
    _ -> v -> Bool
    isReachable v
    v))
            $ Map.filterWithKey (\v
    v Map v e
    _ -> v -> Bool
    isReachable v
    v) outgoing
        }
      where
        isReachable :: v -> Bool
    isReachable v
    x = v
    x v -> HashSet v -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `Set.member` HashSet v
    reachables
        reachables :: HashSet v
    reachables
            = [v] -> HashSet v
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    Set.fromList ([v] -> HashSet v)
    -> (Identity [v] -> [v]) -> Identity [v] -> HashSet v
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Identity [v] -> [v]
    forall a. Identity a -> a
    runIdentity
            (Identity [v] -> HashSet v) -> Identity [v] -> HashSet v
    forall a b. (a -> b) -> a -> b
    $ [v] -> GraphM Identity v -> Identity [v]
    forall a (m :: * -> *).
    (Eq a, Hashable a, Monad m) =>
    [a] -> GraphM m a -> m [a]
    reversePostOrder [v]
    roots
            (GraphM Identity v -> Identity [v])
    -> GraphM Identity v -> Identity [v]
    forall a b. (a -> b) -> a -> b
    $ [v] -> Identity [v]
    forall a. a -> Identity a
    Identity ([v] -> Identity [v]) -> (v -> [v]) -> GraphM Identity v
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((v, e) -> v) -> [(v, e)] -> [v]
    forall a b. (a -> b) -> [a] -> [b]
    map (v, e) -> v
    forall a b. (a, b) -> a
    fst ([(v, e)] -> [v]) -> (v -> [(v, e)]) -> v -> [v]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph v e -> v -> [(v, e)]
    forall v e. (Eq v, Hashable v) => Graph v e -> v -> [(v, e)]
    getIncoming Graph v e
    g

    {-----------------------------------------------------------------------------
        Topological sort
    ------------------------------------------------------------------------------}
    -- | If the 'Graph' is acyclic, return a topological sort,
    -- that is a linear ordering of its connected vertices such that
    -- each vertex occurs before its successors.
    --
    -- (Vertices that are not connected are not listed in the topological sort.)
    --
    -- https://en.wikipedia.org/wiki/Topological_sorting
    topologicalSort :: (Eq v, Hashable v) => Graph v e -> [v]
    topologicalSort :: forall v e. (Eq v, Hashable v) => Graph v e -> [v]
    topologicalSort g :: Graph v e
    g@Graph{Map v (Map v e)
    incoming :: forall v e. Graph v e -> Map v (Map v e)
    incoming :: Map v (Map v e)
    incoming} =
        Identity [v] -> [v]
    forall a. Identity a -> a
    runIdentity (Identity [v] -> [v]) -> Identity [v] -> [v]
    forall a b. (a -> b) -> a -> b
    $ [v] -> GraphM Identity v -> Identity [v]
    forall a (m :: * -> *).
    (Eq a, Hashable a, Monad m) =>
    [a] -> GraphM m a -> m [a]
    reversePostOrder [v]
    roots ([v] -> Identity [v]
    forall a. a -> Identity a
    Identity ([v] -> Identity [v]) -> (v -> [v]) -> GraphM Identity v
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((e, v) -> v) -> [(e, v)] -> [v]
    forall a b. (a -> b) -> [a] -> [b]
    map (e, v) -> v
    forall a b. (a, b) -> b
    snd ([(e, v)] -> [v]) -> (v -> [(e, v)]) -> v -> [v]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph v e -> v -> [(e, v)]
    forall v e. (Eq v, Hashable v) => Graph v e -> v -> [(e, v)]
    getOutgoing Graph v e
    g)
      where
        -- all vertices that have no (direct) predecessors
        roots :: [v]
    roots = [ v
    x | (v
    x,Map v e
    preds) <- Map v (Map v e) -> [(v, Map v e)]
    forall k v. HashMap k v -> [(k, v)]
    Map.toList Map v (Map v e)
    incoming, Map v e -> Bool
    forall a. HashMap v a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Map v e
    preds ]

    data Step = Next | Stop

    -- | Starting from a list of vertices without predecessors,
    -- walk through all successors, but in such a way that every vertex
    -- is visited before its predecessors.
    -- For every vertex, if the function returns `Next`, then
    -- the successors are visited, otherwise the walk at the vertex
    -- stops prematurely.
    --
    -- > topologicalSort g =
    -- >     runIdentity $ walkSuccessors (roots g) (pure Next) g
    --
    walkSuccessors
        :: forall v e m. (Monad m, Eq v, Hashable v)
        => [v] -> (v -> m Step) -> Graph v e -> m [v]
    walkSuccessors :: forall v e (m :: * -> *).
    (Monad m, Eq v, Hashable v) =>
    [v] -> (v -> m Step) -> Graph v e -> m [v]
    walkSuccessors [v]
    xs v -> m Step
    step Graph v e
    g = Queue Level v -> Set v -> [v] -> m [v]
    go ([(Level, v)] -> Queue Level v
    forall k a. Ord k => [(k, a)] -> MinPQueue k a
    Q.fromList ([(Level, v)] -> Queue Level v) -> [(Level, v)] -> Queue Level v
    forall a b. (a -> b) -> a -> b
    $ [v] -> [(Level, v)]
    zipLevels [v]
    xs) Set v
    forall a. HashSet a
    Set.empty []
      where
        zipLevels :: [v] -> [(Level, v)]
    zipLevels [v]
    vs = [(Graph v e -> v -> Level
    forall v e. (Eq v, Hashable v) => Graph v e -> v -> Level
    getLevel Graph v e
    g v
    v, v
    v) | v
    v <- [v]
    vs]

        go :: Queue Level v -> Set v -> [v] -> m [v]
        go :: Queue Level v -> Set v -> [v] -> m [v]
    go Queue Level v
    q0 Set v
    seen [v]
    visits = case Queue Level v -> Maybe (v, Queue Level v)
    forall k a. Ord k => MinPQueue k a -> Maybe (a, MinPQueue k a)
    Q.minView Queue Level v
    q0 of
            Maybe (v, Queue Level v)
    Nothing -> [v] -> m [v]
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([v] -> m [v]) -> [v] -> m [v]
    forall a b. (a -> b) -> a -> b
    $ [v] -> [v]
    forall a. [a] -> [a]
    reverse [v]
    visits
            Just (v
    v,Queue Level v
    q1)
                | v
    v v -> Set v -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `Set.member` Set v
    seen -> Queue Level v -> Set v -> [v] -> m [v]
    go Queue Level v
    q1 Set v
    seen [v]
    visits
                | Bool
    otherwise -> do
                    next <- v -> m Step
    step v
    v
                    let q2 = case Step
    next of
                          Step
    Stop -> Queue Level v
    q1
                          Step
    Next ->
                              let successors :: [(Level, v)]
    successors = [v] -> [(Level, v)]
    zipLevels ([v] -> [(Level, v)]) -> [v] -> [(Level, v)]
    forall a b. (a -> b) -> a -> b
    $ ((e, v) -> v) -> [(e, v)] -> [v]
    forall a b. (a -> b) -> [a] -> [b]
    map (e, v) -> v
    forall a b. (a, b) -> b
    snd ([(e, v)] -> [v]) -> [(e, v)] -> [v]
    forall a b. (a -> b) -> a -> b
    $ Graph v e -> v -> [(e, v)]
    forall v e. (Eq v, Hashable v) => Graph v e -> v -> [(e, v)]
    getOutgoing Graph v e
    g v
    v
                              in  Queue Level v -> [(Level, v)] -> Queue Level v
    forall k v. Ord k => Queue k v -> [(k, v)] -> Queue k v
    insertList Queue Level v
    q1 [(Level, v)]
    successors
                    go q2 (Set.insert v seen) (v:visits)

    insertList :: Ord k => Queue k v -> [(k,v)] -> Queue k v
    insertList :: forall k v. Ord k => Queue k v -> [(k, v)] -> Queue k v
    insertList = (Queue k v -> (k, v) -> Queue k v)
    -> Queue k v -> [(k, v)] -> Queue k v
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' (\Queue k v
    q (k
    k,v
    v) -> k -> v -> Queue k v -> Queue k v
    forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
    Q.insert k
    k v
    v Queue k v
    q)

    walkSuccessors_
        :: (Monad m, Eq v, Hashable v)
        => [v] -> (v -> m Step) -> Graph v e -> m ()
    walkSuccessors_ :: forall (m :: * -> *) v e.
    (Monad m, Eq v, Hashable v) =>
    [v] -> (v -> m Step) -> Graph v e -> m ()
    walkSuccessors_ [v]
    xs v -> m Step
    step Graph v e
    g = [v] -> (v -> m Step) -> Graph v e -> m [v]
    forall v e (m :: * -> *).
    (Monad m, Eq v, Hashable v) =>
    [v] -> (v -> m Step) -> Graph v e -> m [v]
    walkSuccessors [v]
    xs v -> m Step
    step Graph v e
    g m [v] -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    {-----------------------------------------------------------------------------
        Debugging
    ------------------------------------------------------------------------------}
    -- | Map to a string in @graphviz@ dot file format.
    showDot
        :: (Eq v, Hashable v)
        => (v -> String) -> Graph v e -> String
    showDot :: forall v e.
    (Eq v, Hashable v) =>
    (v -> String) -> Graph v e -> String
    showDot v -> String
    fv Graph v e
    g = [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
        [ String
    "digraph mygraph {"
        , String
    "  node [shape=box];"
        ] [String] -> [String] -> [String]
    forall a. Semigroup a => a -> a -> a
    <> (v -> String) -> [v] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map v -> String
    showVertex (Graph v e -> [v]
    forall v e. (Eq v, Hashable v) => Graph v e -> [v]
    listConnectedVertices Graph v e
    g)
        [String] -> [String] -> [String]
    forall a. Semigroup a => a -> a -> a
    <> [String
    "}"]
      where
        showVertex :: v -> String
    showVertex v
    x =
            [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ String
    "  " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> v -> v -> String
    showEdge v
    x v
    y String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "; " | (e
    _,v
    y) <- Graph v e -> v -> [(e, v)]
    forall v e. (Eq v, Hashable v) => Graph v e -> v -> [(e, v)]
    getOutgoing Graph v e
    g v
    x ]
        showEdge :: v -> v -> String
    showEdge v
    x v
    y = v -> String
    escape v
    x String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " -> " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> v -> String
    escape v
    y
        escape :: v -> String
    escape = ShowS
    forall a. Show a => a -> String
    show ShowS -> (v -> String) -> v -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> String
    fv