Overlays without the empty leaf at the end

src/Algebra/Graph.hs

@@ -73,6 +73,8 @@ import qualified Data.IntSet                   as IntSet
 import qualified Data.Set                      as Set
 import qualified Data.Tree                     as Tree
 
+import Data.List.NonEmpty (nonEmpty)
+
 {-| The 'Graph' data type is a deep embedding of the core graph construction
 primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a 'Num'
 instance as a convenient notation for working with graphs:
@@ -317,7 +319,7 @@ edges = overlays . map (uncurry edge)
 -- 'isEmpty' . overlays == 'all' 'isEmpty'
 -- @
 overlays :: [Graph a] -> Graph a
-overlays = foldr overlay empty
+overlays = concatg overlay
 
 -- | Connect a given list of graphs.
 -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length
@@ -331,7 +333,21 @@ overlays = foldr overlay empty
 -- 'isEmpty' . connects == 'all' 'isEmpty'
 -- @
 connects :: [Graph a] -> Graph a
-connects = foldr connect empty
+connects = concatg connect
+
+concatg :: (Graph a -> Graph a -> Graph a) -> [Graph a] -> Graph a
+concatg combine = maybe empty (foldr1fId combine) . nonEmpty
+{-# INLINE [0] concatg #-}
+
+{-# RULES
+ "concatg/map"
+  forall c f xs.
+    concatg c (map f xs) = concatgMap c f xs
+  #-}
+
+-- | Utilitary function for rewrite rules of 'overlays' and 'connects'
+concatgMap :: (Graph a -> Graph a -> Graph a) -> (b -> Graph a) -> [b] -> Graph a
+concatgMap combine f = maybe empty (foldr1f combine f) . nonEmpty
 
 -- | 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 ()
@@ -31,6 +34,8 @@ import Data.Semigroup
 
 import qualified GHC.Exts as Exts
 
+import Data.List.NonEmpty (NonEmpty (..))
+
 -- | An abstract list data type with /O(1)/ time concatenation (the current
 -- implementation uses difference lists). Here @a@ is the type of list elements.
 -- 'List' @a@ is a 'Monoid': 'mempty' corresponds to the empty list and two lists
@@ -107,3 +112,15 @@ 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) -> NonEmpty b -> a
+foldr1f k f = go
+  where
+    go (y :| ys) =
+      case ys of
+        []     -> f y
+        (x:xs) -> f y `k` go (x :| xs)
+{-# INLINE foldr1f #-}
+
+foldr1fId :: (a -> a -> a) -> NonEmpty a -> a
+foldr1fId k = foldr1f k id