Overlays without the empty leaf at the end

src/Algebra/Graph.hs

@@ -236,7 +236,10 @@ vertex = Vertex
 -- 'vertexCount' (edge 1 2) == 2
 -- @
 edge :: a -> a -> Graph a
-edge x y = connect (vertex x) (vertex y)
+edge = curry edge'
+
+edge' :: (a,a) -> Graph a
+edge' (x,y) = connect (vertex x) (vertex y)
 
 -- | /Overlay/ two graphs. An alias for the constructor 'Overlay'. This is a
 -- commutative, associative and idempotent operation with the identity 'empty'.
@@ -303,7 +306,7 @@ vertices = overlays . map vertex
 -- 'edgeCount' . edges == 'length' . 'Data.List.nub'
 -- @
 edges :: [(a, a)] -> Graph a
-edges = overlays . map (uncurry edge)
+edges = overlays . map edge'
 
 -- | Overlay a given list of graphs.
 -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length
@@ -317,7 +320,18 @@ edges = overlays . map (uncurry edge)
 -- 'isEmpty' . overlays == 'all' 'isEmpty'
 -- @
 overlays :: [Graph a] -> Graph a
-overlays = foldr overlay empty
+overlays [] = empty
+overlays (x:xs) = foldr1fId overlay x xs
+{-# INLINE [0] overlays #-}
+
+{-# RULES
+"overlays/map"
+  forall f xs.
+    overlays (map f xs) =
+      case xs of
+        [] -> empty
+        (y:ys) -> foldr1f overlay f y ys
+ #-}
 
 -- | Connect a given list of graphs.
 -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length
@@ -331,7 +345,18 @@ overlays = foldr overlay empty
 -- 'isEmpty' . connects == 'all' 'isEmpty'
 -- @
 connects :: [Graph a] -> Graph a
-connects = foldr connect empty
+connects [] = empty
+connects (x:xs) = foldr1fId connect x xs
+{-# INLINE [0] connects #-}
+
+{-# RULES
+"connects/map"
+  forall f xs.
+    connects (map f xs) =
+      case xs of
+        [] -> empty
+        (y:ys) -> foldr1f connect f y ys
+ #-}
 
 -- | Generalised 'Graph' folding: recursively collapse a 'Graph' by applying
 -- the provided functions to the leaves and internal nodes of the expression.

src/Algebra/Graph/Internal.hs

@@ -20,7 +20,10 @@ module Algebra.Graph.Internal (
     List (..),
 
     -- * Data structures for graph traversal
-    Focus (..), emptyFocus, vertexFocus, overlayFoci, connectFoci, Hit (..)
+    Focus (..), emptyFocus, vertexFocus, overlayFoci, connectFoci, Hit (..),
+
+    -- Special fold
+    foldr1f, foldr1fId
   ) where
 
 import Prelude ()
@@ -107,3 +110,14 @@ connectFoci x y = Focus (ok x || ok y) (xs <> is y) (os x <> ys) (vs x <> vs y)
 -- | An auxiliary data type for 'hasEdge': when searching for an edge, we can hit
 -- its 'Tail', i.e. the source vertex, the whole 'Edge', or 'Miss' it entirely.
 data Hit = Miss | Tail | Edge deriving (Eq, Ord)
+
+foldr1f :: (a -> a -> a) -> (b -> a) -> b -> [b] -> a
+foldr1f k f = go
+  where
+    go y ys =
+      case ys of
+        []     -> f y
+        (x:xs) -> f y `k` go x xs
+
+foldr1fId :: (a -> a -> a) -> a -> [a] -> a
+foldr1fId k = foldr1f k id