diff --git a/src/Data/Graph/DirectedAcyclic/View/Tree.hs b/src/Data/Graph/DirectedAcyclic/View/Tree.hs index c7b6c70..3bce816 100644 --- a/src/Data/Graph/DirectedAcyclic/View/Tree.hs +++ b/src/Data/Graph/DirectedAcyclic/View/Tree.hs @@ -24,6 +24,7 @@ import Prelude import Control.Arrow ((***)) import Data.Function (on) +import Data.Hashable (Hashable) import Data.HashMap.Lazy (HashMap) import Data.HashSet (HashSet) import Data.List (groupBy, sortOn) @@ -32,17 +33,18 @@ import Data.Monoid (Endo (..)) import qualified Data.HashMap.Lazy as M import qualified Data.HashSet as S -type Graph a b = HashMap Int (a, [(Int, b)]) +type Graph n a b = HashMap n (a, [(n, b)]) data DagViewTree a b = FullNode a [DagViewTree a b] | LinkNode b -- | Update the map according to a choice of a full parent for a given child. -- Also specifies whether the choice was sucessfully applied. chooseParent - :: Int - -> Int - -> HashMap Int [(Int, Bool)] - -> Maybe (HashMap Int [(Int, Bool)]) + :: (Eq n, Hashable n) + => n + -> n + -> HashMap n [(n, Bool)] + -> Maybe (HashMap n [(n, Bool)]) chooseParent c p h = case M.lookup c h of Nothing -> Nothing @@ -70,28 +72,30 @@ markFst :: [a] -> [(a, Bool)] markFst [] = [] markFst (x:xs) = (x, True) : map (, False) xs -labeledDeps :: HashMap Int [(Int, b)] -> [(Int, Int, b)] +labeledDeps :: Hashable n => HashMap n [(n, b)] -> [(n, n, b)] labeledDeps = let mk c (p, full) = (c, p, full) in concatMap (\ (c, ps) -> map (mk c) ps) . M.toList edgeView - :: HashMap Int Int + :: (Eq n, Hashable n) + => HashMap n n -- ^ Full parent user choices - -> (Int, Int, Bool) + -> (n, n, Bool) -- ^ Child, parent, and whether the parent is full - -> Maybe (HashMap Int Int) + -> Maybe (HashMap n n) -- ^ New edge label. For a full edge, 'Nothing'. For a link edge, 'Just' an -- updated choice map that chooses this edge as the new full edge for the -- child. edgeView _ (_, _, False) = Nothing edgeView choices (child, parent, True) = Just $ M.insert child parent choices -reverseEdge :: (Int, Int, a) -> (Int, Int, a) +reverseEdge :: (n, n, a) -> (n, n, a) reverseEdge (x, y, l) = (y, x, l) -- | Given labeled nodes and labeled edges, prepare a hashmap. -mkGraph :: HashMap Int a -> [(Int, Int, b)] -> Graph a b +mkGraph + :: (Eq n, Ord n, Hashable n) => HashMap n a -> [(n, n, b)] -> Graph n a b mkGraph nodeMap edges = let pair23 (x, y, z) = (x, (y, z)) edgeMap = M.fromList $ groupSnd $ sortOn fst $ map pair23 edges @@ -102,7 +106,11 @@ mkGraph nodeMap edges = keySet :: HashMap k v -> HashSet k keySet = S.fromMap . M.map (const ()) -buildTree :: [(Int, Maybe b)] -> Graph a (Maybe b) -> [DagViewTree a (a, b)] +buildTree + :: (Eq n, Hashable n) + => [(n, Maybe b)] + -> Graph n a (Maybe b) + -> [DagViewTree a (a, b)] buildTree nodes graph = go nodes where go [] = [] @@ -120,15 +128,16 @@ buildTree nodes graph = go nodes in LinkNode (fst c, info) : ts dagViewTree - :: [(Int, a)] + :: (Eq n, Ord n, Hashable n) + => [(n, a)] -- ^ Nodes: Numbers and details - -> [(Int, Int)] + -> [(n, n)] -- ^ Edges: Child-parent pairs - -> [(Int, Int)] + -> [(n, n)] -- ^ Full parent choices as child-parent pairs. This is whatever user input -- has been received, even if it includes duplicates or nonexistent node -- numbers. So just pass the user input directly here. - -> [DagViewTree a (a, HashMap Int Int)] + -> [DagViewTree a (a, HashMap n n)] dagViewTree nodes deps choices = let choose ns@(c, p) acc@(h, l) = case chooseParent c p h of