From fcd024cb01e484dc3c92212f4317b254bbd7580b Mon Sep 17 00:00:00 2001
From: Greg Brown <greg.brown01@ed.ac.uk>
Date: Tue, 6 Dec 2022 16:18:29 +0000
Subject: Add smart constructor for first-order algebras.

---
 src/Data/Setoid/Product.idr | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'src/Data/Setoid/Product.idr')

diff --git a/src/Data/Setoid/Product.idr b/src/Data/Setoid/Product.idr
index 6693d40..b1e8ce3 100644
--- a/src/Data/Setoid/Product.idr
+++ b/src/Data/Setoid/Product.idr
@@ -100,6 +100,11 @@ wrapIntro : forall f . {0 rel : (i : a) -> Rel (x i)} -> {0 xs, ys : (x . f) ^ i
 wrapIntro []        = []
 wrapIntro (r :: rs) = r :: wrapIntro rs
 
+public export
+wrapFunc : (0 x : IndexedSetoid b) -> (0 f : a -> b)
+  -> Product (reindex f x) ~> reindex (map f) (Product x)
+wrapFunc x f = MkIndexedSetoidHomomorphism (\_ => wrap f) (\_, _, _ => wrapIntro)
+
 public export
 unwrapIntro : forall f . {0 rel : (i : b) -> Rel (x i)} -> {is : _} -> {0 xs, ys : x ^ map f is}
   -> Pointwise rel xs ys -> Pointwise (\i => rel (f i)) {is = is} (unwrap f xs) (unwrap f ys)
-- 
cgit v1.2.3