diff --git a/Changelog.md b/Changelog.md
index b6441c6a2..10d4545ea 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -1,5 +1,9 @@
 # Spectrometer Changelog
 
+## v2.14.4
+
+- Gradle: Fixes an issue where all dependencies would appear as direct ([#319](https://github.com/fossas/spectrometer/pull/319))
+
 ## v2.14.3
 
 - Monorepo: archive expansion now respects `--exclude-path` and `--only-path`. ([#320](https://github.com/fossas/spectrometer/pull/320))
diff --git a/src/Algebra/Graph/AdjacencyMap/Extra.hs b/src/Algebra/Graph/AdjacencyMap/Extra.hs
index c156caa1a..a57d59a9c 100644
--- a/src/Algebra/Graph/AdjacencyMap/Extra.hs
+++ b/src/Algebra/Graph/AdjacencyMap/Extra.hs
@@ -1,5 +1,7 @@
 module Algebra.Graph.AdjacencyMap.Extra (
   gtraverse,
+  shrink,
+  shrinkSingle,
 ) where
 
 import Algebra.Graph.AdjacencyMap qualified as AM
@@ -17,3 +19,27 @@ gtraverse f = fmap mkAdjacencyMap . traverse (\(a, xs) -> (,) <$> f a <*> traver
   where
     mkAdjacencyMap :: Ord c => [(c, [c])] -> AM.AdjacencyMap c
     mkAdjacencyMap = AM.fromAdjacencySets . fmap (fmap Set.fromList)
+
+-- | Filter vertices in an AdjacencyMap, preserving the overall structure by rewiring edges through deleted vertices.
+--
+-- For example, given the graph @1 -> 2 -> 3 -> 4@ and applying @shrink (/= 3)@, we return the graph
+-- @1 -> 2 -> 4@
+shrink :: Ord a => (a -> Bool) -> AM.AdjacencyMap a -> AM.AdjacencyMap a
+shrink f gr = foldr shrinkSingle gr filteredOutVertices
+  where
+    filteredOutVertices = filter (not . f) (AM.vertexList gr)
+
+-- | Delete a vertex in an AdjacencyMap, preserving the overall structure by rewiring edges through the delted vertex.
+--
+-- For example, given the graph @1 -> 2 -> 3 -> 4@ and applying @shrinkSingle 3@, we return the graph
+-- @1 -> 2 -> 4@
+shrinkSingle :: forall a. Ord a => a -> AM.AdjacencyMap a -> AM.AdjacencyMap a
+shrinkSingle vert gr = AM.overlay (AM.removeVertex vert gr) inducedEdges
+  where
+    inducedEdges :: AM.AdjacencyMap a
+    inducedEdges =
+      AM.edges
+        [ (pre, post)
+        | pre <- Set.toList (AM.preSet vert gr)
+        , post <- Set.toList (AM.postSet vert gr)
+        ]
diff --git a/src/App/Fossa/Analyze/GraphMangler.hs b/src/App/Fossa/Analyze/GraphMangler.hs
index ba52f6c49..7ecc46290 100644
--- a/src/App/Fossa/Analyze/GraphMangler.hs
+++ b/src/App/Fossa/Analyze/GraphMangler.hs
@@ -14,12 +14,13 @@ import Data.Set qualified as Set
 import App.Fossa.Analyze.Graph qualified as G
 import App.Fossa.Analyze.GraphBuilder
 import DepTypes
-import Graphing (Graphing (..))
+import Graphing (Graphing)
+import Graphing qualified
 
 graphingToGraph :: Graphing Dependency -> G.Graph
 graphingToGraph graphing = run . evalGraphBuilder G.empty $ do
-  let depAmap = graphingAdjacent graphing
-      depDirect = Set.toList (graphingDirect graphing)
+  let depAmap = Graphing.toAdjacencyMap graphing
+      depDirect = Graphing.directList graphing
 
       nodes = dfs depDirect depAmap
 
diff --git a/src/App/Fossa/Analyze/Project.hs b/src/App/Fossa/Analyze/Project.hs
index 5c7d36ce8..0f02bad85 100644
--- a/src/App/Fossa/Analyze/Project.hs
+++ b/src/App/Fossa/Analyze/Project.hs
@@ -3,7 +3,6 @@ module App.Fossa.Analyze.Project (
   mkResult,
 ) where
 
-import Data.Set qualified as Set
 import Data.Text (Text)
 import DepTypes
 import Graphing (Graphing)
@@ -22,7 +21,7 @@ mkResult project graphResults =
         -- their dependencies would be filtered out. The real fix to this is to
         -- have a separate designation for "reachable" vs "direct" on nodes in a
         -- Graphing, where direct deps are inherently reachable.
-        if Set.null (Graphing.graphingDirect graph)
+        if null (Graphing.directList graph)
           then graph
           else Graphing.pruneUnreachable graph
     , projectResultGraphBreadth = graphBreadth
diff --git a/src/Effect/Grapher.hs b/src/Effect/Grapher.hs
index 4f9219ec7..8c009ccc9 100644
--- a/src/Effect/Grapher.hs
+++ b/src/Effect/Grapher.hs
@@ -9,7 +9,7 @@ module Effect.Grapher (
   Grapher (..),
   direct,
   edge,
-  addNode,
+  deep,
   evalGrapher,
   runGrapher,
 
@@ -48,16 +48,16 @@ import Prettyprinter (pretty)
 data Grapher ty (m :: Type -> Type) k where
   Direct :: ty -> Grapher ty m ()
   Edge :: ty -> ty -> Grapher ty m ()
-  Node :: ty -> Grapher ty m ()
+  Deep :: ty -> Grapher ty m ()
 
 direct :: Has (Grapher ty) sig m => ty -> m ()
-direct ty = send (Direct ty)
+direct = send . Direct
 
 edge :: Has (Grapher ty) sig m => ty -> ty -> m ()
 edge parent child = send (Edge parent child)
 
-addNode :: Has (Grapher ty) sig m => ty -> m ()
-addNode v = send (Node v)
+deep :: Has (Grapher ty) sig m => ty -> m ()
+deep = send . Deep
 
 evalGrapher :: (Ord ty, Algebra sig m) => GrapherC ty m a -> m (G.Graphing ty)
 evalGrapher = fmap fst . runGrapher
@@ -66,9 +66,9 @@ type GrapherC ty m = SimpleStateC (G.Graphing ty) (Grapher ty) m
 
 runGrapher :: (Ord ty, Algebra sig m) => GrapherC ty m a -> m (G.Graphing ty, a)
 runGrapher = interpretState G.empty $ \case
-  Direct ty -> modify (G.direct ty)
-  Edge parent child -> modify (G.edge parent child)
-  Node n -> modify (G.deep n)
+  Direct ty -> modify (G.direct ty <>)
+  Edge parent child -> modify (G.edge parent child <>)
+  Deep n -> modify (G.deep n <>)
 
 ----- Labeling
 
diff --git a/src/Graphing.hs b/src/Graphing.hs
index 572de5dac..4b7c0018b 100644
--- a/src/Graphing.hs
+++ b/src/Graphing.hs
@@ -1,24 +1,42 @@
--- | A graph augmented with a set of "direct" vertices
+-- | A graph (Algebra.Graph.AdjacencyMap) augmented with the notion of "direct" vertices.
 --
--- Graphings can be built with the 'direct' and 'edge' primitives.
+-- Graphings can be built with the 'direct', 'edge', 'deep', 'directs', ... primitives.
 --
 -- For simple (non-cyclic) graphs, try 'unfold'. For graphs with only direct dependencies, try 'fromList'
 --
+-- Most commonly, Graphings are built by combining sub-graphs with (<>), e.g.,
+--
+-- @
+--     myCoolGraph = directs myListOfDirectNodes <> edges myListOfEdges
+-- @
+--
 -- For describing complex graphs, see the 'Effect.Grapher' effect.
 module Graphing (
   -- * Graphing type
   Graphing (..),
+  Node (..),
   empty,
   size,
   direct,
+  directs,
   edge,
+  edges,
   deep,
+  deeps,
+
+  -- * Accessing graph elements
+  directList,
+  vertexList,
+  toAdjacencyMap,
 
   -- * Manipulating a Graphing
   gmap,
   gtraverse,
+  induce,
   induceJust,
-  Graphing.filter,
+  filter,
+  shrink,
+  shrinkSingle,
   pruneUnreachable,
   stripRoot,
   promoteToDirect,
@@ -34,10 +52,10 @@ import Algebra.Graph.AdjacencyMap (AdjacencyMap)
 import Algebra.Graph.AdjacencyMap qualified as AM
 import Algebra.Graph.AdjacencyMap.Algorithm qualified as AMA
 import Algebra.Graph.AdjacencyMap.Extra qualified as AME
-import Data.List qualified as List
-import Data.Maybe (catMaybes)
-import Data.Set (Set)
+import Data.Bifunctor (bimap)
 import Data.Set qualified as Set
+import Prelude hiding (filter)
+import Prelude qualified
 
 -- | A @Graphing ty@ is a graph of nodes with type @ty@.
 --
@@ -45,100 +63,150 @@ import Data.Set qualified as Set
 -- automatically deduplicated using the 'Ord' instance of @ty@.
 --
 -- Typically, when consuming a Graphing, we only care about nodes in the graph
--- reachable from 'graphingDirect'
-data Graphing ty = Graphing
-  { graphingDirect :: Set ty
-  , graphingAdjacent :: AdjacencyMap ty
-  }
+-- reachable from 'directList'
+newtype Graphing ty = Graphing {unGraphing :: AdjacencyMap (Node ty)}
+  deriving (Eq, Ord, Show)
+
+data Node a = Root | Node a
   deriving (Eq, Ord, Show)
 
+instance Functor Node where
+  fmap _ Root = Root
+  fmap f (Node a) = Node (f a)
+
+instance Foldable Node where
+  foldMap _ Root = mempty
+  foldMap f (Node a) = f a
+
+instance Traversable Node where
+  traverse _ Root = pure Root
+  traverse f (Node a) = Node <$> f a
+
 instance Ord ty => Semigroup (Graphing ty) where
-  graphing <> graphing' =
-    Graphing
-      (graphingDirect graphing `Set.union` graphingDirect graphing')
-      (graphingAdjacent graphing `AM.overlay` graphingAdjacent graphing')
+  Graphing graphing <> Graphing graphing' = Graphing (AM.overlay graphing graphing')
 
 instance Ord ty => Monoid (Graphing ty) where
-  mempty = Graphing Set.empty AM.empty
+  mempty = Graphing AM.empty
 
 -- | Transform a Graphing by applying a function to each of its vertices.
 --
 -- Graphing isn't a lawful 'Functor', so we don't provide an instance.
 gmap :: (Ord ty, Ord ty') => (ty -> ty') -> Graphing ty -> Graphing ty'
-gmap f gr = gr{graphingDirect = direct', graphingAdjacent = adjacent'}
-  where
-    direct' = Set.map f (graphingDirect gr)
-    adjacent' = AM.gmap f (graphingAdjacent gr)
+gmap f = Graphing . AM.gmap (fmap f) . unGraphing
 
 -- | Map each element of the Graphing to an action, evaluate the actions, and
 -- collect the results.
 --
 -- Graphing isn't a lawful 'Traversable', so we don't provide an instance.
 gtraverse :: (Ord b, Applicative f) => (a -> f b) -> Graphing a -> f (Graphing b)
-gtraverse f Graphing{graphingDirect, graphingAdjacent} = Graphing <$> newSet <*> newAdjacent
-  where
-    -- newSet :: f (Set b)
-    newSet = fmap Set.fromList . traverse f . Set.toList $ graphingDirect
+gtraverse f = fmap Graphing . AME.gtraverse (traverse f) . unGraphing
 
-    -- newAdjacent :: f (AM.AdjacencyMap b)
-    newAdjacent = AME.gtraverse f graphingAdjacent
+-- | Filter Graphing elements. Alias for 'filter' to match the AdjacencyMap naming
+induce :: (ty -> Bool) -> Graphing ty -> Graphing ty
+induce = filter
 
 -- | Like 'AM.induceJust', but for Graphings
 induceJust :: Ord a => Graphing (Maybe a) -> Graphing a
-induceJust gr = gr{graphingDirect = direct', graphingAdjacent = adjacent'}
-  where
-    direct' = Set.fromList . catMaybes . Set.toList $ graphingDirect gr
-    adjacent' = AM.induceJust (graphingAdjacent gr)
+induceJust = Graphing . AM.induceJust . AM.gmap sequenceA . unGraphing
 
 -- | Filter Graphing elements
-filter :: (ty -> Bool) -> Graphing ty -> Graphing ty
-filter f gr = gr{graphingDirect = direct', graphingAdjacent = adjacent'}
+filter :: forall ty. (ty -> Bool) -> Graphing ty -> Graphing ty
+filter f = Graphing . AM.induce f' . unGraphing
+  where
+    f' :: Node ty -> Bool
+    f' Root = True
+    f' (Node a) = f a
+
+-- | Filter vertices in a Graphing, preserving the overall structure by rewiring edges through deleted vertices.
+--
+-- For example, given the graph @1 -> 2 -> 3 -> 4@ and applying @shrink (/= 3)@, we return the graph
+-- @1 -> 2 -> 4@
+shrink :: forall a. Ord a => (a -> Bool) -> Graphing a -> Graphing a
+shrink f = Graphing . AME.shrink f' . unGraphing
   where
-    direct' = Set.filter f (graphingDirect gr)
-    adjacent' = AM.induce f (graphingAdjacent gr)
+    f' :: Node a -> Bool
+    f' Root = True
+    f' (Node a) = f a
+
+-- | Delete a vertex in a Grahing, preserving the overall structure by rewiring edges through the delted vertex.
+--
+-- For example, given the graph @1 -> 2 -> 3 -> 4@ and applying @shrinkSingle 3@, we return the graph
+-- @1 -> 2 -> 4@
+shrinkSingle :: Ord a => a -> Graphing a -> Graphing a
+shrinkSingle vert = Graphing . AME.shrinkSingle (Node vert) . unGraphing
 
 -- | The empty Graphing
 empty :: Graphing ty
-empty = Graphing Set.empty AM.empty
+empty = Graphing AM.empty
 
 -- | Determines the number of nodes in the graph ("reachable" or not)
 size :: Graphing ty -> Int
-size = AM.vertexCount . graphingAdjacent
+size = length . Set.filter ignoreRoot . AM.vertexSet . unGraphing
+  where
+    ignoreRoot :: Node a -> Bool
+    ignoreRoot Root = False
+    ignoreRoot _ = True
 
 -- | Strip all items from the direct set, promote their immediate children to direct items
-stripRoot :: Ord ty => Graphing ty -> Graphing ty
-stripRoot gr = gr{graphingDirect = direct'}
+stripRoot :: forall ty. Ord ty => Graphing ty -> Graphing ty
+stripRoot (Graphing gr) = Graphing $ AM.overlay newDirectEdges (AM.removeVertex Root gr)
   where
-    roots = Set.toList $ graphingDirect gr
-    edgeSet root = AM.postSet root $ graphingAdjacent gr
-    direct' = Set.unions $ map edgeSet roots
+    currentDirect :: [Node ty]
+    currentDirect = Set.toList $ AM.postSet Root gr
 
--- | Add a direct dependency to this Graphing
-direct :: Ord ty => ty -> Graphing ty -> Graphing ty
-direct dep gr = gr{graphingDirect = direct', graphingAdjacent = adjacent'}
-  where
-    direct' = Set.insert dep (graphingDirect gr)
-    adjacent' = AM.overlay (AM.vertex dep) (graphingAdjacent gr)
+    newDirect :: [Node ty]
+    newDirect = Set.toList . Set.unions $ map (`AM.postSet` gr) currentDirect
+
+    newDirectEdges :: AM.AdjacencyMap (Node ty)
+    newDirectEdges = AM.edges $ map (Root,) newDirect
+
+-- | Add a direct node to this Graphing
+direct :: Ord ty => ty -> Graphing ty
+direct node = Graphing (AM.edge Root (Node node))
+
+-- | Add several direct nodes to this Graphing
+directs :: Ord ty => [ty] -> Graphing ty
+directs nodes = Graphing (AM.edges [(Root, Node node) | node <- nodes])
 
 -- | Mark dependencies that pass a predicate as direct dependencies.
 -- Dependencies that are already marked as "direct" are unaffected.
-promoteToDirect :: Ord ty => (ty -> Bool) -> Graphing ty -> Graphing ty
-promoteToDirect f gr = gr{graphingDirect = direct'}
+promoteToDirect :: forall ty. Ord ty => (ty -> Bool) -> Graphing ty -> Graphing ty
+promoteToDirect f gr = gr <> directs matchingVertices
   where
-    direct' = foldr Set.insert (graphingDirect gr) vertices
-    vertices = List.filter f $ AM.vertexList (graphingAdjacent gr)
+    matchingVertices :: [ty]
+    matchingVertices = Prelude.filter f (vertexList gr)
 
--- | Add an edge between two nodes in this Graphing
-edge :: Ord ty => ty -> ty -> Graphing ty -> Graphing ty
-edge parent child gr = gr{graphingAdjacent = adjacent'}
-  where
-    adjacent' = AM.overlay (AM.edge parent child) (graphingAdjacent gr)
+-- | Get a list of direct vertices in the Graphing
+directList :: Ord ty => Graphing ty -> [ty]
+directList (Graphing gr) = [node | Node node <- Set.toList (AM.postSet Root gr)]
 
--- | Adds a node to this graph as a deep dependency.
-deep :: Ord ty => ty -> Graphing ty -> Graphing ty
-deep dep gr = gr{graphingAdjacent = adjacent'}
+-- | Get a list of vertices in the Graphing
+vertexList :: Graphing ty -> [ty]
+vertexList gr = [node | Node node <- AM.vertexList (unGraphing gr)]
+
+-- | Convert to the underlying AdjacencyMap (without the Root element)
+toAdjacencyMap :: Ord ty => Graphing ty -> AM.AdjacencyMap ty
+toAdjacencyMap = AM.induceJust . AM.gmap convert . unGraphing
   where
-    adjacent' = AM.overlay (AM.vertex dep) (graphingAdjacent gr)
+    convert :: Node ty -> Maybe ty
+    convert Root = Nothing
+    convert (Node a) = Just a
+
+-- | Build a Graphing containing a single edge between two nodes
+edge :: Ord ty => ty -> ty -> Graphing ty
+edge parent child = Graphing (AM.edge (Node parent) (Node child))
+
+-- | Build a Graphing containing several edges
+edges :: Ord ty => [(ty, ty)] -> Graphing ty
+edges = Graphing . AM.edges . map (bimap Node Node)
+
+-- | Add a single deep node to the graphing
+deep :: ty -> Graphing ty
+deep = Graphing . AM.vertex . Node
+
+-- | Add several deep nodes to the graphing.
+deeps :: Ord ty => [ty] -> Graphing ty
+deeps = Graphing . AM.vertices . map Node
 
 -- | @unfold direct getDeps toDependency@ unfolds a graph, given:
 --
@@ -150,12 +218,14 @@ deep dep gr = gr{graphingAdjacent = adjacent'}
 --
 -- __Unfold does not work for recursive inputs__
 unfold :: forall dep res. Ord res => [dep] -> (dep -> [dep]) -> (dep -> res) -> Graphing res
-unfold seed getDeps toDependency =
-  Graphing
-    { graphingDirect = Set.fromList (map toDependency seed)
-    , graphingAdjacent = AM.vertices (map toDependency seed) `AM.overlay` AM.edges [(toDependency parentDep, toDependency childDep) | (parentDep, childDep) <- edgesFrom seed]
-    }
+unfold seed getDeps toDependency = directs directNodes <> edges builtEdges
   where
+    directNodes :: [res]
+    directNodes = map toDependency seed
+
+    builtEdges :: [(res, res)]
+    builtEdges = map (bimap toDependency toDependency) (edgesFrom seed)
+
     edgesFrom :: [dep] -> [(dep, dep)]
     edgesFrom nodes = do
       node <- nodes
@@ -165,20 +235,34 @@ unfold seed getDeps toDependency =
 -- | Remove unreachable vertices from the graph
 --
 -- A vertex is reachable if there's a path from the "direct" vertices to that vertex
-pruneUnreachable :: Ord ty => Graphing ty -> Graphing ty
-pruneUnreachable gr = gr{graphingAdjacent = AM.induce (`Set.member` reachable) (graphingAdjacent gr)}
+pruneUnreachable :: forall ty. Ord ty => Graphing ty -> Graphing ty
+pruneUnreachable (Graphing gr) = Graphing (AM.induce keepPredicate gr)
   where
-    reachable = Set.fromList $ AMA.dfs (Set.toList (graphingDirect gr)) (graphingAdjacent gr)
+    directNodes :: [Node ty]
+    directNodes = Set.toList $ AM.postSet Root gr
+
+    reachableNodes :: Set.Set (Node ty)
+    reachableNodes = Set.fromList $ AMA.dfs directNodes gr
+
+    keepPredicate :: Node ty -> Bool
+    keepPredicate Root = True
+    keepPredicate (Node ty) = Set.member (Node ty) reachableNodes
 
 -- | Build a graphing from a list, where all list elements are treated as direct
 -- dependencies
+--
+-- Alias for 'directs'
 fromList :: Ord ty => [ty] -> Graphing ty
-fromList nodes = Graphing (Set.fromList nodes) (AM.vertices nodes)
+fromList = directs
 
 -- | Wrap an AdjacencyMap as a Graphing
-fromAdjacencyMap :: AM.AdjacencyMap ty -> Graphing ty
-fromAdjacencyMap = Graphing Set.empty
+--
+-- All nodes in the resulting Graphing are considered indirect/"deep"
+fromAdjacencyMap :: Ord ty => AM.AdjacencyMap ty -> Graphing ty
+fromAdjacencyMap = Graphing . AM.gmap Node
 
 -- | Get the list of nodes in the Graphing.
+--
+-- Alias for 'vertexList'
 toList :: Graphing ty -> [ty]
-toList Graphing{graphingAdjacent} = AM.vertexList graphingAdjacent
+toList = vertexList
diff --git a/src/Srclib/Converter.hs b/src/Srclib/Converter.hs
index 1572d18a8..709bf5239 100644
--- a/src/Srclib/Converter.hs
+++ b/src/Srclib/Converter.hs
@@ -40,19 +40,19 @@ toSourceUnit ProjectResult{..} =
     renderedPath = toText (toFilePath projectResultPath)
 
     filteredGraph :: Graphing Dependency
-    filteredGraph = Graphing.filter (\d -> shouldPublishDep d && isSupportedType d) projectResultGraph
+    filteredGraph = Graphing.shrink (\d -> shouldPublishDep d && isSupportedType d) projectResultGraph
 
     locatorGraph :: Graphing Locator
     locatorGraph = Graphing.gmap toLocator filteredGraph
 
     locatorAdjacent :: AM.AdjacencyMap Locator
-    locatorAdjacent = Graphing.graphingAdjacent locatorGraph
+    locatorAdjacent = Graphing.toAdjacencyMap locatorGraph
 
     deps :: [SourceUnitDependency]
     deps = map (mkSourceUnitDependency locatorAdjacent) (AM.vertexList locatorAdjacent)
 
     imports :: [Locator]
-    imports = Set.toList $ Graphing.graphingDirect locatorGraph
+    imports = Graphing.directList locatorGraph
 
 mkSourceUnitDependency :: AM.AdjacencyMap Locator -> Locator -> SourceUnitDependency
 mkSourceUnitDependency gr locator =
diff --git a/src/Strategy/Python/Poetry.hs b/src/Strategy/Python/Poetry.hs
index 3ee94c7da..b86931d76 100644
--- a/src/Strategy/Python/Poetry.hs
+++ b/src/Strategy/Python/Poetry.hs
@@ -22,7 +22,8 @@ import Discovery.Walk (
  )
 import Effect.Logger (Logger (..), Pretty (pretty), logDebug)
 import Effect.ReadFS (ReadFS, readContentsToml)
-import Graphing (Graphing, deep, edge, empty, fromList, gmap, promoteToDirect)
+import Graphing (Graphing)
+import Graphing qualified
 import Path (Abs, Dir, File, Path)
 import Strategy.Python.Poetry.Common (getPoetryBuildBackend, logIgnoredDeps, pyProjectDeps, toCanonicalName, toMap)
 import Strategy.Python.Poetry.PoetryLock (PackageName (..), PoetryLock (..), PoetryLockPackage (..), poetryLockCodec)
@@ -125,7 +126,7 @@ analyze PoetryProject{pyProjectToml, poetryLock} = do
 
 -- | Use a `pyproject.toml` to set the direct dependencies of a graph created from `poetry.lock`.
 setGraphDirectsFromPyproject :: Graphing Dependency -> PyProject -> Graphing Dependency
-setGraphDirectsFromPyproject graph pyproject = promoteToDirect isDirect graph
+setGraphDirectsFromPyproject graph pyproject = Graphing.promoteToDirect isDirect graph
   where
     -- Dependencies in `poetry.lock` are direct if they're specified in `pyproject.toml`.
     -- `pyproject.toml` may use non canonical naming, when naming dependencies.
@@ -138,7 +139,7 @@ setGraphDirectsFromPyproject graph pyproject = promoteToDirect isDirect graph
 -- The resulting graph contains edges, but does not distinguish between direct and deep dependencies,
 -- since `poetry.lock` does not indicate which dependencies are direct.
 graphFromLockFile :: PoetryLock -> Graphing Dependency
-graphFromLockFile poetryLock = gmap pkgNameToDependency (foldr deep edges pkgsNoDeps)
+graphFromLockFile poetryLock = Graphing.gmap pkgNameToDependency (edges <> Graphing.deeps pkgsNoDeps)
   where
     pkgs :: [PoetryLockPackage]
     pkgs = poetryLockPackages poetryLock
@@ -156,7 +157,7 @@ graphFromLockFile poetryLock = gmap pkgNameToDependency (foldr deep edges pkgsNo
         tuplify x = (poetryLockPackageName p, PackageName x)
 
     edges :: Graphing PackageName
-    edges = foldr (uncurry edge) empty (concatMap edgeOf depsWithEdges)
+    edges = Graphing.edges (concatMap edgeOf depsWithEdges)
 
     canonicalPkgName :: PackageName -> PackageName
     canonicalPkgName name = PackageName . toCanonicalName $ unPackageName name
diff --git a/src/Strategy/Yarn/V1/YarnLock.hs b/src/Strategy/Yarn/V1/YarnLock.hs
index be166914e..0fb72065c 100644
--- a/src/Strategy/Yarn/V1/YarnLock.hs
+++ b/src/Strategy/Yarn/V1/YarnLock.hs
@@ -5,14 +5,13 @@ module Strategy.Yarn.V1.YarnLock (
 
 import Control.Effect.Diagnostics
 import Data.Bifunctor (first)
-import Data.Foldable (for_)
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict qualified as Map
 import Data.MultiKeyedMap qualified as MKM
 import DepTypes
-import Effect.Grapher
 import Effect.ReadFS
 import Graphing (Graphing)
+import Graphing qualified
 import Path
 import Yarn.Lock qualified as YL
 import Yarn.Lock.Types qualified as YL
@@ -27,16 +26,15 @@ analyze lockfile = context "Lockfile V1 analysis" $ do
     Right parsed -> context "Building dependency graph" $ pure (buildGraph parsed)
 
 buildGraph :: YL.Lockfile -> Graphing Dependency
-buildGraph lockfile =
-  run . evalGrapher $
-    traverse (add . first NE.head) (MKM.toList lockfile)
+buildGraph lockfile = Graphing.edges (concatMap (edgesForPackage . first NE.head) (MKM.toList lockfile))
   where
-    add :: Has (Grapher Dependency) sig m => (YL.PackageKey, YL.Package) -> m ()
-    add parentPkg@(_, package) =
-      for_ (YL.dependencies package) $ \childKey -> do
-        let childPkg = (childKey, MKM.at lockfile childKey)
-        edge (toDependency parentPkg) (toDependency childPkg)
+    edgesForPackage :: (YL.PackageKey, YL.Package) -> [(Dependency, Dependency)]
+    edgesForPackage parentPkg@(_, package) = do
+      childKey <- YL.dependencies package
+      let childPkg = (childKey, MKM.at lockfile childKey)
+      pure (toDependency parentPkg, toDependency childPkg)
 
+    toDependency :: (YL.PackageKey, YL.Package) -> Dependency
     toDependency (key, package) =
       Dependency
         { dependencyType = NodeJSType
diff --git a/test/Go/GoListSpec.hs b/test/Go/GoListSpec.hs
index 0c94168e1..182163bda 100644
--- a/test/Go/GoListSpec.hs
+++ b/test/Go/GoListSpec.hs
@@ -15,7 +15,8 @@ import Data.Map.Strict qualified as Map
 import DepTypes
 import Effect.Exec
 import Effect.Grapher
-import Graphing (Graphing (..))
+import Graphing (Graphing)
+import Graphing qualified
 import Path.IO (getCurrentDir)
 import Strategy.Go.GoList
 import Test.Hspec
@@ -80,4 +81,4 @@ spec = do
 
       case result of
         Left err -> fail $ "failed to build graph" <> show (renderFailureBundle err)
-        Right (graph, _) -> length (graphingDirect graph) `shouldBe` 12
+        Right (graph, _) -> length (Graphing.directList graph) `shouldBe` 12
diff --git a/test/GraphUtil.hs b/test/GraphUtil.hs
index 4fbb42243..22771a420 100644
--- a/test/GraphUtil.hs
+++ b/test/GraphUtil.hs
@@ -6,9 +6,9 @@ module GraphUtil (
 ) where
 
 import Algebra.Graph.AdjacencyMap qualified as AM
-import Algebra.Graph.ToGraph (vertexSet)
-import Data.Foldable (toList, traverse_)
-import Graphing (Graphing (..))
+import Data.Foldable (traverse_)
+import Graphing (Graphing)
+import Graphing qualified
 import Test.Hspec (
   Expectation,
   shouldBe,
@@ -21,20 +21,20 @@ import Test.Hspec (
 
 -- | Expect the given dependencies to be the deps in the graph
 expectDeps :: (Ord a, Show a) => [a] -> Graphing a -> Expectation
-expectDeps deps graph = toList (vertexSet (graphingAdjacent graph)) `shouldMatchList` deps
+expectDeps deps graph = Graphing.vertexList graph `shouldMatchList` deps
 
 -- | Expects the given `a` to exist in the `Graphing`
 expectDep :: (Ord a, Show a) => a -> Graphing a -> Expectation
-expectDep dep graph = toList (vertexSet (graphingAdjacent graph)) `shouldContain` [dep]
+expectDep dep graph = Graphing.vertexList graph `shouldContain` [dep]
 
 -- TODO: I expect the shouldSatisfy will produce poor test failure messages
 
 -- | Expect only the given edges between @[(parent,child)]@ dependencies to be present in the graph
 expectEdges :: (Ord a, Show a) => [(a, a)] -> Graphing a -> Expectation
 expectEdges edges graph =
-  (length edges `shouldBe` AM.edgeCount (graphingAdjacent graph))
-    *> traverse_ (`shouldSatisfy` \(from, to) -> AM.hasEdge from to (graphingAdjacent graph)) edges
+  (length edges `shouldBe` AM.edgeCount (Graphing.toAdjacencyMap graph))
+    *> traverse_ (`shouldSatisfy` \(from, to) -> AM.hasEdge from to (Graphing.toAdjacencyMap graph)) edges
 
 -- | Expect the given dependencies to be the direct deps in the graph
-expectDirect :: (Eq a, Show a) => [a] -> Graphing a -> Expectation
-expectDirect expected graph = toList (graphingDirect graph) `shouldMatchList` expected
+expectDirect :: (Ord a, Show a) => [a] -> Graphing a -> Expectation
+expectDirect expected graph = Graphing.directList graph `shouldMatchList` expected
diff --git a/test/GraphingSpec.hs b/test/GraphingSpec.hs
index 02d002872..02039fee2 100644
--- a/test/GraphingSpec.hs
+++ b/test/GraphingSpec.hs
@@ -21,7 +21,7 @@ spec = do
   describe "deep" $ do
     it "should add deep node to graphing" $ do
       let graph :: Graphing Int
-          graph = Graphing.deep 5 $ Graphing.edge 2 3 (Graphing.empty)
+          graph = Graphing.deep 5 <> Graphing.edge 2 3
       expectDirect [] graph
       expectDeps [5, 2, 3] graph
       expectEdges [(2, 3)] graph
@@ -33,3 +33,50 @@ spec = do
       expectDirect [0, 2, 4, 10] graph
       expectDeps [10, 8, 6, 4, 2, 0] graph
       expectEdges [(10, 8), (8, 6), (6, 4), (4, 2), (2, 0)] graph
+
+  describe "shrinkSingle" $ do
+    it "should preserve root node relationships" $ do
+      -- 1 -> 2 -> 3 -> 4 with 1 and 2 as direct
+      --
+      -- -> shrinkSingle 2
+      --
+      -- 1 -> 3 -> 4 with 1 and 3 as direct
+      let graph :: Graphing Int
+          graph = Graphing.directs [1, 2] <> Graphing.edges (zip [1 .. 3] [2 .. 4])
+
+          graph' :: Graphing Int
+          graph' = Graphing.shrinkSingle 2 graph
+
+      expectDirect [1, 3] graph'
+      expectDeps [1, 3, 4] graph'
+      expectEdges [(1, 3), (3, 4)] graph'
+
+    it "should preserve multiple outgoing edges" $ do
+      -- 1 -> 2 -> 3 --> 4
+      --             \-> 5
+      --
+      -- -> shrinkSingle 3
+      --
+      -- 1 -> 2 --> 4
+      --        \-> 5
+      let graph :: Graphing Int
+          graph = Graphing.edges [(1, 2), (2, 3), (3, 4), (3, 5)]
+
+          graph' :: Graphing Int
+          graph' = Graphing.shrinkSingle 3 graph
+
+      expectDirect [] graph'
+      expectDeps [1, 2, 4, 5] graph'
+      expectEdges [(1, 2), (2, 4), (2, 5)] graph'
+
+  describe "shrink" $ do
+    it "should collapse edges through several nodes" $ do
+      let graph :: Graphing Int
+          graph = Graphing.edges (zip [1 .. 4] [2 .. 5])
+
+          graph' :: Graphing Int
+          graph' = Graphing.shrink (\x -> x /= 2 && x /= 3) graph
+
+      expectDirect [] graph'
+      expectDeps [1, 4, 5] graph'
+      expectEdges [(1, 4), (4, 5)] graph'
diff --git a/test/Python/PoetrySpec.hs b/test/Python/PoetrySpec.hs
index 2076c2a3e..468178efd 100644
--- a/test/Python/PoetrySpec.hs
+++ b/test/Python/PoetrySpec.hs
@@ -4,8 +4,8 @@ module Python.PoetrySpec (
 
 import Data.Map qualified as Map
 import DepTypes (DepEnvironment (..), DepType (..), Dependency (..), VerConstraint (..))
-import Effect.Grapher (addNode, direct, edge, evalGrapher, run)
 import Graphing (Graphing)
+import Graphing qualified
 import Strategy.Python.Poetry (graphFromLockFile, setGraphDirectsFromPyproject)
 import Strategy.Python.Poetry.PoetryLock (
   PackageName (..),
@@ -51,19 +51,18 @@ candidatePoetryLock =
     ]
 
 expectedGraph :: Graphing Dependency
-expectedGraph = run . evalGrapher $ do
-  edge
+expectedGraph =
+  Graphing.edge
     (Dependency PipType "flow_pipes" (Just $ CEq "1.21.0") [] [EnvProduction] Map.empty)
     (Dependency PipType "flow_pipes_gravity" (Just $ CEq "1.1.1") [] [EnvProduction] Map.empty)
-  direct (Dependency PipType "flow_pipes" (Just $ CEq "1.21.0") [] [EnvProduction] Map.empty)
+    <> Graphing.direct (Dependency PipType "flow_pipes" (Just $ CEq "1.21.0") [] [EnvProduction] Map.empty)
 
 expectedGraphWithNoDeps :: Graphing Dependency
-expectedGraphWithNoDeps = run . evalGrapher $ do
-  addNode (Dependency PipType "somePkg" (Just $ CEq "1.21.0") [] [EnvProduction] Map.empty)
+expectedGraphWithNoDeps = Graphing.deep (Dependency PipType "somePkg" (Just $ CEq "1.21.0") [] [EnvProduction] Map.empty)
 
 expectedGraphWithDeps :: Graphing Dependency
-expectedGraphWithDeps = run . evalGrapher $ do
-  edge
+expectedGraphWithDeps =
+  Graphing.edge
     (Dependency PipType "somePkg" (Just $ CEq "1.21.0") [] [EnvProduction] Map.empty)
     (Dependency PipType "pkgOneChildOne" (Just $ CEq "1.22.0") [] [EnvProduction] Map.empty)