diff options
author | stuebinm | 2021-12-17 18:21:00 +0100 |
---|---|---|
committer | stuebinm | 2021-12-17 18:21:00 +0100 |
commit | e103c8e1b5bf9bf47b94e7da443186f5703ce1bb (patch) | |
tree | 32e3076918905db463f469a86ac8da31a7610bee /lib/Dirgraph.hs | |
parent | 1c90b43172d14a8132711f8ec252de7b936ea6e1 (diff) |
simple graphviz visualisation of a repository
might be useful to have
Diffstat (limited to '')
-rw-r--r-- | lib/Dirgraph.hs | 22 |
1 files changed, 20 insertions, 2 deletions
diff --git a/lib/Dirgraph.hs b/lib/Dirgraph.hs index 0931ea0..b97a644 100644 --- a/lib/Dirgraph.hs +++ b/lib/Dirgraph.hs @@ -1,15 +1,21 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} -- | Simple directed graphs, for dependency checking module Dirgraph where import CheckMap (MapResult (mapresultDepends)) -import Data.Map.Strict (Map, mapMaybeWithKey, mapWithKey) +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) @@ -47,3 +53,15 @@ reachableFrom entrypoint graph = recursive mempty (S.singleton entrypoint) 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 () |