From d979ce7d19245cab10a2effdb6d6a8c7ed791adc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:27:37 -0500
Subject: [PATCH] Define a foldMapDefault1 function usable as a default
 definition of foldMap.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 08ec098f3..46a9cb0ed 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -20,6 +20,7 @@ module Tags.Tagging.Precise
 , Traversable1(..)
 , for1
 , foldMap1
+, foldMapDefault1
 , GTraversable1(..)
 , Generics(..)
 ) where
@@ -103,6 +104,11 @@ foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall
 foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g)
 
 
+-- | This function may be used as a value for 'foldMap' in a 'Foldable' instance.
+foldMapDefault1 :: (Traversable1 Foldable t, Monoid b) => (a -> b) -> t a -> b
+foldMapDefault1 f = foldMap1 @Foldable f (foldMap f)
+
+
 -- FIXME: move GTraversable1 into semantic-ast.
 class GTraversable1 c t where
   -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context.