module Reactive.Banana.Internal.DependencyGraph (
Deps,
empty, dependOn, topologicalSort,
) where
import Data.Hashable
import qualified Data.HashMap.Lazy as Map
import qualified Data.HashSet as Set
type Map = Map.HashMap
type Set = Set.HashSet
data Deps a = Deps
{ dChildren :: Map a [a]
, dParents :: Map a [a]
, dRoots :: Set a
} deriving (Eq,Show)
children deps x = maybe [] id . Map.lookup x $ dChildren deps
parents deps x = maybe [] id . Map.lookup x $ dParents deps
empty :: Hashable a => Deps a
empty = Deps
{ dChildren = Map.empty
, dParents = Map.empty
, dRoots = Set.empty
}
dependOn :: (Eq a, Hashable a) => a -> a -> Deps a -> Deps a
dependOn x y deps0 = deps1
where
deps1 = deps0
{ dChildren = Map.insertWith (++) y [x] $ dChildren deps0
, dParents = Map.insertWith (++) x [y] $ dParents deps0
, dRoots = roots
}
roots = when (null $ parents deps0 x) (Set.delete x)
. when (null $ parents deps1 y) (Set.insert y)
$ dRoots deps0
when b f = if b then f else id
topologicalSort :: (Eq a, Hashable a) => Deps a -> [a]
topologicalSort deps = go (Set.toList $ dRoots deps) Set.empty
where
go [] _ = []
go (x:xs) seen1 = x : go (adultChildren ++ xs) seen2
where
seen2 = Set.insert x seen1
adultChildren = filter isAdult (children deps x)
isAdult y = all (`Set.member` seen2) (parents deps y)
test = id
. dependOn 'D' 'C'
. dependOn 'D' 'B'
. dependOn 'C' 'B'
. dependOn 'B' 'A'
. dependOn 'B' 'a'
$ empty