From e103c8e1b5bf9bf47b94e7da443186f5703ce1bb Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Fri, 17 Dec 2021 18:21:00 +0100
Subject: [PATCH] simple graphviz visualisation of a repository
might be useful to have
---
lib/CheckDir.hs | 10 +++++++---
lib/Dirgraph.hs | 22 ++++++++++++++++++++--
walint.cabal | 3 ++-
3 files changed, 29 insertions(+), 6 deletions(-)
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 0011857..1cfd753 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -23,7 +23,7 @@ import Data.Map.Strict (mapKeys, (\\))
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
-import Dirgraph (invertGraph, resultToGraph,
+import Dirgraph (graphToDot, invertGraph, resultToGraph,
unreachableFrom)
import GHC.Generics (Generic)
import LintConfig (LintConfig', configMaxLintLevel)
@@ -32,6 +32,7 @@ import System.Directory.Extra (doesFileExist)
import System.FilePath (splitPath, (</>))
import qualified System.FilePath as FP
import System.FilePath.Posix (takeDirectory)
+import Text.Dot (Dot, showDot)
import Types (Dep (Local, LocalMap), Hint (Hint),
Level (..), hintLevel)
import Util (PrettyPrint (prettyprint))
@@ -53,6 +54,7 @@ data DirResult = DirResult
-- ^ all dependencies to things outside this repository
, dirresultMissingAssets :: [MissingAsset]
-- ^ entrypoints of maps which are referred to but missing
+ , dirresultGraph :: Dot ()
} deriving (Generic)
data MissingDep = MissingDep
@@ -96,6 +98,7 @@ instance ToJSON DirResult where
[ "missingDeps" .= dirresultDeps res
, "missingAssets" .= dirresultMissingAssets res
, "mapLints" .= dirresultMaps res
+ , "exitGraph" .= showDot (dirresultGraph res)
]
, "resultText" .= prettyprint (Suggestion, res)
, "severity" .= maximumLintLevel res
@@ -145,12 +148,12 @@ recursiveCheckDir
recursiveCheckDir config prefix root = do
maps <- recursiveCheckDir' config prefix [root] mempty
+ let exitGraph = resultToGraph maps
-- maps that don't have (local) ways back to the main entrypoint
let nowayback =
unreachableFrom root
. invertGraph
- . resultToGraph
- $ maps
+ $ exitGraph
-- inject warnings for maps that have no way back to the entrypoint
let maps' = flip mapWithKey maps $ \path res ->
@@ -165,6 +168,7 @@ recursiveCheckDir config prefix root = do
pure $ DirResult { dirresultDeps = missingDeps root maps'
, dirresultMissingAssets = mAssets
, dirresultMaps = maps'
+ , dirresultGraph = graphToDot exitGraph
}
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 ()
diff --git a/walint.cabal b/walint.cabal
index 98ba654..c189dda 100644
--- a/walint.cabal
+++ b/walint.cabal
@@ -54,7 +54,8 @@ library
getopt-generics,
regex-tdfa,
extra,
- witherable
+ witherable,
+ dotgen
-- TODO: move more stuff into lib, these dependencies are silly
executable walint
--
GitLab