{-----------------------------------------------------------------------------
    reactive-banana
------------------------------------------------------------------------------}
module Reactive.Banana.Prim.Low.GraphTraversal
    ( GraphM
    , reversePostOrder1
    , reversePostOrder
    ) where

import Data.Hashable
import qualified Data.HashSet as Set

{-----------------------------------------------------------------------------
    Graph traversal
------------------------------------------------------------------------------}
-- | Graph represented as map from a vertex to its direct successors.
type GraphM m a = a -> m [a]

-- | Computes the reverse post-order,
-- listing all (transitive) successor of a node.
--
-- Each vertex is listed *before* all its direct successors have been listed.
reversePostOrder1 :: (Eq a, Hashable a, Monad m) => a -> GraphM m a -> m [a]
reversePostOrder1 :: forall a (m :: * -> *).
(Eq a, Hashable a, Monad m) =>
a -> GraphM m a -> m [a]
reversePostOrder1 a
x = forall a (m :: * -> *).
(Eq a, Hashable a, Monad m) =>
[a] -> GraphM m a -> m [a]
reversePostOrder [a
x]

-- | Reverse post-order from multiple vertices.
--
-- INVARIANT: For this to be a valid topological order,
-- none of the vertices may have a direct predecessor.
reversePostOrder :: (Eq a, Hashable a, Monad m) => [a] -> GraphM m a -> m [a]
reversePostOrder :: forall a (m :: * -> *).
(Eq a, Hashable a, Monad m) =>
[a] -> GraphM m a -> m [a]
reversePostOrder [a]
xs GraphM m a
successors = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a] -> HashSet a -> m ([a], HashSet a)
go [a]
xs [] forall a. HashSet a
Set.empty
    where
    go :: [a] -> [a] -> HashSet a -> m ([a], HashSet a)
go []     [a]
rpo HashSet a
visited        = forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
rpo, HashSet a
visited)
    go (a
x:[a]
xs) [a]
rpo HashSet a
visited
        | a
x forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet a
visited = [a] -> [a] -> HashSet a -> m ([a], HashSet a)
go [a]
xs [a]
rpo HashSet a
visited
        | Bool
otherwise              = do
            [a]
xs' <- GraphM m a
successors a
x
            -- visit all direct successors
            ([a]
rpo', HashSet a
visited') <- [a] -> [a] -> HashSet a -> m ([a], HashSet a)
go [a]
xs' [a]
rpo (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert a
x HashSet a
visited)
            -- prepend this vertex as all direct successors have been visited
            [a] -> [a] -> HashSet a -> m ([a], HashSet a)
go [a]
xs (a
xforall a. a -> [a] -> [a]
:[a]
rpo') HashSet a
visited'