From 9110064fe62f98dd3ecc5fb4c3915a843492b8fb Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 23 Oct 2023 23:18:34 +0200
Subject: a year went by

This does many meta-things, but changes no functionality:
 - get rid of stack, and use just cabal with a stackage snapshot instead
   (why did I ever think stack was a good idea?)
 - update the stackage snapshot to something halfway recent
 - thus making builds work on nixpkgs-23.05 (current stable)
 - separating out packages into their own cabal files
 - use the GHC2021 set of extensions as default
 - very slight code changes to make things build again
 - update readme accordingly
 - stylish-haskell run
---
 lib/Dirgraph.hs | 84 ---------------------------------------------------------
 1 file changed, 84 deletions(-)
 delete mode 100644 lib/Dirgraph.hs

(limited to 'lib/Dirgraph.hs')

diff --git a/lib/Dirgraph.hs b/lib/Dirgraph.hs
deleted file mode 100644
index cc140a3..0000000
--- a/lib/Dirgraph.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase       #-}
-{-# LANGUAGE TupleSections    #-}
-
--- | Simple directed graphs, for dependency checking
-module Dirgraph where
-
-import           Universum
-
-import           CheckMap        (MapResult (mapresultDepends))
-import           Data.Map.Strict (mapMaybeWithKey, mapWithKey)
-import qualified Data.Map.Strict as M
-import           Data.Set        ((\\))
-import qualified Data.Set        as S
-import           Paths           (normalise)
-import qualified Text.Dot        as D
-import           Text.Dot        (Dot, (.->.))
-import           Types           (Dep (LocalMap))
-
--- | 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 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 . 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
-
-takeSubGraph :: (Eq a, Ord a) => Int -> a -> Graph a -> Graph a
-takeSubGraph i start graph
-  | i <= 0 = mempty
-  | i == 1 =
-    M.singleton start reachable
-    `M.union` M.fromList ((,mempty) <$> S.toList reachable)
-  | otherwise =
-    M.singleton start reachable
-    `M.union` (M.unionsWith S.union
-               . S.map (flip (takeSubGraph (i-1)) graph)
-               $ reachable)
-  where reachable = fromMaybe mempty (M.lookup start graph)
-
-graphToDot :: Graph FilePath -> Dot ()
-graphToDot graph = do
-  main <- D.node [("label","main.json")]
-  nodes' <- M.traverseMaybeWithKey
-    (\name edges -> if name /= "main.json"
-      then D.node [("label",name)] <&> (, edges) <&> Just
-      else pure Nothing
-    )
-    graph
-
-  let reachable = fromMaybe mempty (M.lookup "main.json" graph)
-  let nodes = M.insert "main.json" (main,reachable) nodes'
-  forM_ nodes $ \(node, edges) ->
-    forM_ edges $ \key ->
-      case M.lookup key nodes of
-        Just (other,_) -> node .->. other
-        _              -> pure ()
-- 
cgit v1.2.3