From e103c8e1b5bf9bf47b94e7da443186f5703ce1bb Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 17 Dec 2021 18:21:00 +0100
Subject: simple graphviz visualisation of a repository

might be useful to have
---
 lib/CheckDir.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

(limited to 'lib/CheckDir.hs')

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
                    }
 
 
-- 
cgit v1.2.3