{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} -- | Simple directed graphs, for dependency checking module Dirgraph where import CheckMap (MapResult (mapresultDepends)) import Control.Monad (forM_) import Data.Functor ((<&>)) import Data.Map.Strict (Map, mapMaybeWithKey, mapWithKey, traverseWithKey) import qualified Data.Map.Strict as M import Data.Set (Set, (\\)) import qualified Data.Set as S import Paths (normalise) import Text.Dot (Dot, (.->.)) import qualified Text.Dot as D import Types (Dep (LocalMap)) import Witherable (mapMaybe) -- | a simple directed graph type Graph a = Map a (Set a) nodes :: Graph a -> Set a nodes = M.keysSet -- | simple directed graph of exits resultToGraph :: Map FilePath MapResult -> Graph FilePath resultToGraph = fmap (S.fromList . mapMaybe onlyLocalMaps . mapresultDepends) where onlyLocalMaps = \case LocalMap path -> Just (normalise "" path) _ -> Nothing -- | invert edges of a directed graph invertGraph :: (Eq a, Ord a) => Graph a -> Graph a invertGraph graph = mapWithKey collectFroms graph where collectFroms to _ = S.fromList . M.elems . mapMaybeWithKey (select to) $ graph select to from elems = if to `elem` elems then Just from else Nothing -- | all nodes reachable from some entrypoint reachableFrom :: Ord a => a -> Graph a -> Set a reachableFrom entrypoint graph = recursive mempty (S.singleton entrypoint) where recursive seen current | null current = seen | otherwise = recursive (S.union seen current) (next \\ seen) where next = S.unions . S.fromList -- for some reason set is not filterable? . mapMaybe (`M.lookup` graph) . S.toList $ current unreachableFrom :: Ord a => a -> Graph a -> Set a unreachableFrom entrypoint graph = nodes graph \\ reachableFrom entrypoint graph graphToDot :: Graph FilePath -> Dot () graphToDot graph = do nodes <- traverseWithKey (\name edges -> D.node [("label",name)] <&> (,edges)) graph forM_ nodes $ \(node, edges) -> forM_ edges $ \key -> case M.lookup key nodes of Just (other,_) -> node .->. other _ -> pure ()