some simple graph algorithms

this just checks for maps from which it's impossible to reach
`main.json`, and then gives a warning. Properly it should check if these
maps have an exit to outside the repository (in which case it may give a
suggestion, and an error otherwise).

Also, redid some of the CheckDir code. No idea what that mess was, but
it's marginally nicer now.

1 files changed, 49 insertions, 0 deletions

diff --git a/lib/Dirgraph.hs b/lib/Dirgraph.hs
new file mode 100644
index 0000000..0931ea0
--- /dev/null
+++ b/lib/Dirgraph.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE LambdaCase #-}
+
+-- | Simple directed graphs, for dependency checking
+module Dirgraph where
+
+
+import           CheckMap        (MapResult (mapresultDepends))
+import           Data.Map.Strict (Map, mapMaybeWithKey, mapWithKey)
+import qualified Data.Map.Strict as M
+import           Data.Set        (Set, (\\))
+import qualified Data.Set        as S
+import           Paths           (normalise)
+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