summaryrefslogtreecommitdiff
path: root/lib/Dirgraph.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Dirgraph.hs')
-rw-r--r--lib/Dirgraph.hs43
1 files changed, 18 insertions, 25 deletions
diff --git a/lib/Dirgraph.hs b/lib/Dirgraph.hs
index 8d4a5f2..fe9dc96 100644
--- a/lib/Dirgraph.hs
+++ b/lib/Dirgraph.hs
@@ -1,26 +1,21 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
-- | Simple directed graphs, for dependency checking
module Dirgraph where
+import Universum
-import CheckMap (MapResult (mapresultDepends))
-import Control.Monad (forM_, unless)
-import Data.Functor ((<&>))
-import Data.Map.Strict (Map, mapMaybeWithKey, mapWithKey,
- traverseMaybeWithKey, traverseWithKey)
-import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe)
-import Data.Set (Set, (\\))
-import qualified Data.Set as S
-import Paths (normalise)
-import qualified System.FilePath as FP
-import System.FilePath.Posix (takeDirectory, (</>))
-import Text.Dot (Dot, (.->.))
-import qualified Text.Dot as D
-import Types (Dep (LocalMap))
-import Witherable (mapMaybe)
+import CheckMap (MapResult (mapresultDepends))
+import Data.Map.Strict (mapMaybeWithKey, mapWithKey, traverseWithKey)
+import qualified Data.Map.Strict as M
+import Data.Set ((\\))
+import qualified Data.Set as S
+import Paths (normalise)
+import Text.Dot (Dot, (.->.))
+import qualified Text.Dot as D
+import Types (Dep (LocalMap))
-- | a simple directed graph
type Graph a = Map a (Set a)
@@ -29,18 +24,16 @@ nodes :: Graph a -> Set a
nodes = M.keysSet
-- | simple directed graph of exits
-resultToGraph :: Map FilePath MapResult -> Graph FilePath
-resultToGraph = mapWithKey (\p r -> S.fromList
- . mapMaybe (onlyLocalMaps (takeDirectory p))
- . mapresultDepends $ r)
- where onlyLocalMaps prefix = \case
- LocalMap path -> Just (FP.normalise (prefix </> normalise "" path))
+resultToGraph :: Map FilePath (MapResult a) -> 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
+ where collectFroms to _ = S.fromList . elems . mapMaybeWithKey (select to) $ graph
select to from elems = if to `elem` elems then Just from else Nothing
-- | all nodes reachable from some entrypoint