-- import topology.sheaves.sheaf
-- import topology.sheaves.sheaf_condition.unique_gluing
-- import sort
-- import oc
-- import lemmas.lemmas
-- import data.nat.parity
-- import algebra.category.Group.limits
-- import algebra.category.Group.abelian
-- import simplex
-- import tactic

-- section

-- open category_theory Top Top.sheaf topological_space finset simplex
-- open opposite

-- open_locale big_operators

-- universe u
-- variable (X : Top.{u})

-- variable {X}
-- variable (𝓕 : sheaf Ab X)
-- variable (𝔘 : oc X)

-- local notation `ι ` := 𝔘.ι
-- local notation `𝓕.obj` := 𝓕.1.obj
-- local notation `𝓕.map` := 𝓕.1.map

-- namespace Cech

-- def carrier (n : ℕ) : Type* :=
-- Π σ : simplex 𝔘 n, 𝓕.obj (op $ σ.face)

-- instance (n : ℕ) : has_zero (carrier 𝓕 𝔘 n) :=
-- { zero := λ σ, 0 }

-- instance (n : ℕ) : has_add (carrier 𝓕 𝔘 n) :=
-- { add := λ f g σ, f σ + g σ }

-- lemma add_assoc' {n : ℕ} (f g h : carrier 𝓕 𝔘 n) : f + g + h = f + (g + h) :=
-- funext $ λ σ, add_assoc _ _ _

-- lemma zero_add' {n : ℕ} (f : carrier 𝓕 𝔘 n) : 0 + f = f :=
-- funext $ λ σ, zero_add _

-- lemma add_zero' {n : ℕ} (f : carrier 𝓕 𝔘 n) : f + 0 = f :=
-- funext $ λ σ, add_zero _

-- @[simp] lemma zero_apply {n : ℕ} (σ : simplex 𝔘 n) :
--   (0 : carrier 𝓕 𝔘 n) σ = 0 :=
-- pi.zero_apply _

-- @[simp] lemma add_apply {n : ℕ} (x y : carrier 𝓕 𝔘 n) (σ : simplex 𝔘 n) :
--   (x + y) σ = x σ + y σ :=
-- pi.add_apply _ _ _

-- section smul

-- variables (α : Type*) [Π U : (opens X)ᵒᵖ, has_scalar α (𝓕.obj U)]

-- instance (n : ℕ) : has_scalar α (carrier 𝓕 𝔘 n) :=
-- { smul := λ a f σ, a • f σ }

-- end smul

-- instance (n : ℕ) : add_monoid (carrier 𝓕 𝔘 n) :=
-- { add := (+),
--   add_assoc := add_assoc' _ _,
--   zero := 0,
--   zero_add := zero_add' _ _,
--   add_zero := add_zero' _ _,
--   nsmul := (•),
--   nsmul_zero' := λ f, funext $ λ σ, by simp,
--   nsmul_succ' := λ m f, funext $ λ σ, by simp [nat.succ_eq_add_one, add_nsmul, one_nsmul, add_comm] }

-- instance (n : ℕ) : has_neg (carrier 𝓕 𝔘 n) :=
-- { neg := λ f σ, - f σ }

-- instance (n : ℕ) : add_comm_group (carrier 𝓕 𝔘 n) :=
-- { neg := has_neg.neg,
--   add_left_neg := λ f, funext $ λ σ, by simp,
--   add_comm := λ f g, funext $ λ σ, by simp [add_comm],
--   ..(_ : add_monoid (carrier 𝓕 𝔘 n))}

-- end Cech

-- section

-- variable {X}
-- def C (n : ℕ) : Ab :=
-- ⟨Cech.carrier 𝓕 𝔘 n⟩

-- lemma Cech.finset_sum_apply (n : ℕ) {α : Type*} [decidable_eq α]
--   (f : α → C 𝓕 𝔘 n) (s : finset α) (σ : simplex 𝔘 n) :
--   (∑ i in s, f i) σ = ∑ i in s, f i σ :=
-- begin
--   induction s using finset.induction_on with a s ha ih,
--   { simp, },
--   { rw [finset.sum_insert ha, finset.sum_insert ha, pi.add_apply, ih] },
-- end

-- section d0

-- variables {𝓕 𝔘}
-- def d0 : C 𝓕 𝔘 0 ⟶ C 𝓕 𝔘 1 :=
-- { to_fun := λ f σ,
--     𝓕.map (σ.der (nat.zero_lt_succ 0) ⟨0, _⟩).op (f (σ.ignore (nat.zero_lt_succ 0) 0)) -
--     𝓕.map (σ.der (nat.zero_lt_succ 0) ⟨1, _⟩).op (f (σ.ignore (nat.zero_lt_succ 0) 1)),
--   map_zero' := funext $ λ σ , begin
--     rw [Cech.zero_apply, Cech.zero_apply, map_zero, map_zero, sub_zero, Cech.zero_apply],
--   end,
--   map_add' := λ x y, funext $ λ σ, begin
--     rw [Cech.add_apply, map_add, Cech.add_apply, map_add, Cech.add_apply],
--     dsimp only,
--     abel,
--   end }

-- end d0

-- namespace d_pos_def

-- variables {n : ℕ} (hn : 0 < n)

-- def to_fun.component (m : fin n.succ) : C 𝓕 𝔘 n.pred → C 𝓕 𝔘 n := λ f σ,
-- ite (even m.1) id has_neg.neg (𝓕.map (σ.der hn m).op (f (σ.ignore hn m)))

-- def to_fun : C 𝓕 𝔘 n.pred → C 𝓕 𝔘 n := λ f,
-- ∑ i in (range n.succ).attach, d_pos_def.to_fun.component 𝓕 𝔘 hn ⟨i.1, mem_range.mp i.2⟩ f

-- def map_zero' : to_fun 𝓕 𝔘 hn 0 = 0 := finset.sum_eq_zero $ λ ⟨m, hm⟩ h,
-- begin
--   rw mem_range at hm,
--   unfold to_fun.component,
--   split_ifs;
--   ext σ;
--   simp,
-- end

-- def map_add' (x y : C 𝓕 𝔘 n.pred) :
--   to_fun 𝓕 𝔘 hn (x + y) = to_fun 𝓕 𝔘 hn x + to_fun 𝓕 𝔘 hn y :=
-- begin
--   unfold to_fun,
--   rw ← sum_add_distrib,
--   apply sum_congr rfl,
--   rintros m hm,
--   unfold to_fun.component,
--   split_ifs,
--   { ext σ, simp only [Cech.add_apply, map_add, id], },
--   { ext σ,
--     change - _ = - _ + - _,
--     rw [neg_eq_iff_neg_eq, neg_add, neg_neg, neg_neg, Cech.add_apply, map_add] },
-- end

-- end d_pos_def

-- variables {𝓕 𝔘}
-- def d_pos {n : ℕ} (hn : 0 < n) : C 𝓕 𝔘 n.pred ⟶ C 𝓕 𝔘 n :=
-- { to_fun := d_pos_def.to_fun 𝓕 𝔘 hn,
--   map_zero' := d_pos_def.map_zero' _ _ _,
--   map_add' := d_pos_def.map_add' _ _ _ }

-- lemma d_pos.def {n : ℕ} (hn : 0 < n) (f : C 𝓕 𝔘 n.pred) (σ : simplex 𝔘 n) :
--   d_pos hn f σ =
--   ∑ i in (range n.succ).attach,
--     ite (even i.1) id has_neg.neg
--       (𝓕.map (σ.der hn ⟨i.1, mem_range.mp i.2⟩).op (f (σ.ignore hn ⟨i.1, mem_range.mp i.2⟩))) :=
-- begin
--   dsimp only [d_pos],
--   -- unfold d_pos d_pos.to_fun,
--   rw [add_monoid_hom.coe_mk],
--   dsimp only [d_pos_def.to_fun],
--   rw [Cech.finset_sum_apply],
--   refine finset.sum_congr rfl (λ m hm, _),
--   refl,
-- end

-- lemma d_pos_01 : @d_pos X 𝓕 𝔘 1 (nat.zero_lt_succ 0) = d0 :=
-- begin
--   ext f σ,
--   rw d_pos.def,
--   change _ = _ - _,
--   generalize_proofs h1 h2,
--   transitivity ∑ i in finset.attach {0, 1}, ite (even i.1) id has_neg.neg
--     (𝓕.map (σ.der h2 ⟨i.1, mem_range.mp i.2⟩).op (f (σ.ignore h2 ⟨i.1, mem_range.mp i.2⟩))),
--   { apply sum_congr,
--     refl,
--     intros x hx,
--     refl, },
--   { rw [finset.attach_insert, finset.sum_insert],
--     dsimp only,
--     rw [if_pos even_zero, id],
--     rw [finset.sum_image, sub_eq_add_neg],
--     apply congr_arg2 (+),
--     { refl, },
--     { dsimp only,
--       transitivity ∑ (i : ℕ) in {1}, - (𝓕.val.map (der h2 σ ⟨1, _x⟩).op) (f (ignore h2 σ 1)),
--       { conv_rhs { rw ← finset.sum_attach },
--         apply finset.sum_congr rfl,
--         rintros ⟨x, h⟩ hx,
--         rw mem_singleton at h,
--         rw if_neg,
--         dsimp only,
--         subst h,
--         refl,
--         subst h,
--         exact nat.not_even_one, },
--       rw finset.sum_singleton },
--     { rintros ⟨x, ⟨h1⟩⟩ trivial ⟨y, ⟨h2⟩⟩ trivial h3,
--       subst h1,
--       subst h2,
--       rw subtype.ext_iff_val at h3 ⊢,
--       exact h3,

--       rw subtype.ext_iff_val at h3 ⊢,
--       exact h3,

--       rw subtype.ext_iff_val at h3 ⊢,
--       exact h3, },
--     { intros r,
--       rw finset.mem_image at r,
--       rcases r with ⟨x, h1, h2⟩,
--       have := x.2,
--       simp only [mem_singleton] at this,
--       simp only [this] at h2,
--       linarith, } },
-- end

-- abbreviation dd_pos {n : ℕ} (hn : 0 < n) (f : C 𝓕 𝔘 n.pred) : C 𝓕 𝔘 n.succ := d_pos (nat.zero_lt_succ _) (d_pos hn f)

-- section lemmas

-- variables {n : ℕ} (hn : 0 < n) (f : C 𝓕 𝔘 n.pred) (σ : simplex 𝔘 n.succ)

-- lemma dd_pos.eq1 :
--   dd_pos hn f σ =
--   d_pos (nat.zero_lt_succ _) (d_pos hn f) σ := rfl

-- lemma dd_pos.eq2 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     (ite (even i.1) id has_neg.neg)
--       (𝓕.map (σ.der (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).op
--         ((d_pos hn f) (σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩))) :=
-- by rw [dd_pos.eq1, d_pos.def]

-- lemma dd_pos.eq3 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ite (even i.1) id has_neg.neg
--       (𝓕.map (σ.der (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).op
--         (∑ j in (range n.succ).attach,
--           ite (even j.1) id has_neg.neg
--             (𝓕.map ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).der hn ⟨j.1, mem_range.mp j.2⟩).op
--               (f ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).ignore hn ⟨j.1, mem_range.mp j.2⟩))))) :=
-- begin
--   rw dd_pos.eq2,
--   apply sum_congr rfl (λ m hm, _),
--   apply congr_arg,
--   congr' 1,
--   rw d_pos.def,
-- end

-- lemma dd_pos.eq4 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ite (even i.1) id has_neg.neg
--       (∑ j in (range n.succ).attach,
--         𝓕.map (σ.der (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).op
--         (ite (even j.1) id has_neg.neg
--           (𝓕.map ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).der hn ⟨j.1, mem_range.mp j.2⟩).op
--             (f ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).ignore hn ⟨j.1, mem_range.mp j.2⟩))))) :=
-- begin
--   rw dd_pos.eq3,
--   apply sum_congr rfl (λ m hm, _),
--   apply congr_arg,
--   rw add_monoid_hom.map_sum,
-- end

-- lemma dd_pos.eq5 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ite (even i.1) id has_neg.neg
--       (∑ j in (range n.succ).attach,
--         ite (even j.1) id has_neg.neg
--           (𝓕.map (σ.der (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).op
--             (𝓕.map ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).der hn ⟨j.1, mem_range.mp j.2⟩).op
--               (f ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).ignore hn ⟨j.1, mem_range.mp j.2⟩))))) :=
-- begin
--   rw dd_pos.eq4,
--   apply sum_congr rfl (λ m hm, _),
--   apply congr_arg,
--   apply sum_congr rfl (λ m' hm', _),
--   by_cases e' : even m'.1,
--   { conv_rhs { rw [if_pos e', id] },
--     congr' 1,
--     rw [if_pos e', id],
--    },
--   { conv_rhs { rw [if_neg e', ← map_neg] },
--     congr' 1,
--     rw [if_neg e'], },
-- end

-- lemma dd_pos.eq6₀ :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ite (even i.1) id has_neg.neg
--       (∑ j in (range n.succ).attach,
--         ite (even j.1) id has_neg.neg
--           (𝓕.map (((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).der hn ⟨j.1, mem_range.mp j.2⟩).op ≫ (σ.der (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).op)
--             (f ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).ignore hn ⟨j.1, mem_range.mp j.2⟩)))) :=
-- begin
--   rw dd_pos.eq5,
--   apply sum_congr rfl (λ m hm, _),
--   apply congr_arg,
--   apply sum_congr rfl (λ m' hm', _),
--   apply congr_arg,
--   rw category_theory.functor.map_comp,
--   refl,
-- end

-- lemma dd_pos.eq6₁ :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ite (even i.1) id has_neg.neg
--       (∑ j in (range n.succ).attach,
--         ite (even j.1) id has_neg.neg
--           (𝓕.map ((σ.der (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩) ≫ ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).der hn ⟨j.1, mem_range.mp j.2⟩)).op
--             (f ((σ.ignore (nat.zero_lt_succ _) ⟨i.1, mem_range.mp i.2⟩).ignore hn ⟨j.1, mem_range.mp j.2⟩)))) :=
-- begin
--   rw dd_pos.eq6₀,
--   apply sum_congr rfl (λ m hm, _),
--   apply congr_arg,
--   apply sum_congr rfl (λ m' hm', _),
--   congr,
-- end

-- lemma dd_pos.eq6₂ :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ite (even i.1) id has_neg.neg
--       (∑ j in (range n.succ).attach,
--         ite (even j.1) id has_neg.neg
--           (𝓕.map (σ.dder hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩).op
--             (f (σ.ignore₂ hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩)))) :=
-- begin
--   rw dd_pos.eq6₁,
--   apply sum_congr rfl (λ m hm, _),
--   apply congr_arg,
--   apply sum_congr rfl (λ m' hm', _),
--   apply congr_arg,
--   unfold dder simplex.ignore₂,
--   refl,
-- end

-- lemma dd_pos.eq7 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (range n.succ).attach,
--       ite (even i.1) id has_neg.neg
--         (ite (even j.1) id has_neg.neg
--           (𝓕.map (σ.dder hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩).op
--             (f (σ.ignore₂ hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩)))) :=
-- begin
--   rw dd_pos.eq6₂,
--   apply sum_congr rfl (λ m hm, _),
--   by_cases e : even m.1,
--   { rw [if_pos e, id],
--     simp_rw [id], },
--   { rw [if_neg e, neg_sum], },
-- end

-- lemma dd_pos.eq8 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (range n.succ).attach,
--       ite (even (i.1 + j.1)) id has_neg.neg
--         (𝓕.map (σ.dder hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩).op
--             (f (σ.ignore₂ hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩))) :=
-- begin
--   rw dd_pos.eq7,
--   apply sum_congr rfl (λ m hm, _),
--   apply sum_congr rfl (λ m' hm', _),
--   by_cases e : even m.1;
--   by_cases e' : even m'.1,
--   { rw [if_pos e, id, if_pos e', id, if_pos (even.add_even e e'), id] },
--   { rw [if_pos e, id, if_neg e', if_neg],
--     contrapose! e',
--     convert nat.even.sub_even e' e,
--     rw [add_comm, nat.add_sub_cancel], },
--   { rw [if_neg e, if_pos e', id, if_neg],
--     contrapose! e,
--     convert nat.even.sub_even e e',
--     rw nat.add_sub_cancel },
--   { rw [if_neg e, if_neg e', neg_neg, if_pos, id],
--     rw [nat.even_add', nat.odd_iff_not_even, nat.odd_iff_not_even],
--     exact ⟨λ _, e', λ _, e⟩, },
-- end

-- lemma dd_pos.eq9 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     (∑ j in (range n.succ).attach.filter (λ n, i.1 ≤ n.1),
--       ite (even (i.1 + j.1)) id has_neg.neg
--         (𝓕.map (σ.dder hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩).op
--             (f (σ.ignore₂ hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩))) +
--     ∑ j in (range n.succ).attach.filter (λ n, n.1 < i.1),
--       ite (even (i.1 + j.1)) id has_neg.neg
--         (𝓕.map (σ.dder hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩).op
--             (f (σ.ignore₂ hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩)))) :=
-- begin
--   rw dd_pos.eq8,
--   apply sum_congr rfl (λ i hi, _),
--   have set_eq : (range n.succ).attach =
--     (range n.succ).attach.filter (λ n, i.1 ≤ n.1) ∪ (range n.succ).attach.filter (λ n, n.1 < i.1),
--   { have := filter_union_filter_neg_eq (λ n : (range n.succ), i.1 ≤ n.1) (range n.succ).attach,
--     conv_lhs { rw ← this },
--     congr' 2,
--     ext,
--     dsimp only,
--     rw not_le },
--   conv_lhs { rw [set_eq] },
--   rw sum_union,
--   rintros ⟨k, hk⟩ h,
--   simp only [inf_eq_inter, mem_inter, mem_filter, mem_attach, subtype.coe_mk, true_and] at h,
--   linarith,
-- end

-- lemma dd_pos.eq10 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     (∑ j in ((range n.succ).filter (λ n, i.1 ≤ n)).attach,
--       ite (even (i.1 + j.1)) id has_neg.neg
--         (𝓕.map (σ.dder hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp (mem_filter.mp j.2).1⟩).op
--             (f (σ.ignore₂ hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp (mem_filter.mp j.2).1⟩))) +
--     ∑ j in (range n.succ).attach.filter (λ n, n.1 < i.1),
--       ite (even (i.1 + j.1)) id has_neg.neg
--         (𝓕.map (σ.dder hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩).op
--             (f (σ.ignore₂ hn ⟨i.1, mem_range.mp i.2⟩ ⟨j.1, mem_range.mp j.2⟩)))) :=
-- begin
--   rw dd_pos.eq9,
--   apply sum_congr rfl (λ i hi, _),
--   congr' 1,
--   apply sum_bij',
--   work_on_goal 4 { intros a ha, refine ⟨a.1, mem_filter.mpr ⟨a.2, (mem_filter.mp ha).2⟩⟩ },
--   work_on_goal 5 { intros a ha, refine ⟨a.1, (mem_filter.mp a.2).1⟩ },
--   { intros a ha, rw mem_filter at ha, },
--   { intros a ha, rw subtype.ext_iff_val, },
--   { intros a ha, rw subtype.ext_iff_val, },
--   { intros a ha, simp only [mem_attach], },
--   { intros a ha,
--     simp only [mem_filter, mem_attach, subtype.coe_mk, true_and],
--     exact (mem_filter.mp a.2).2, }
-- end

-- lemma dd_pos.eq11 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (range n.succ).attach.filter (λ m, i.val ≤ m.val),
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, mem_range.mp j.2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (range n.succ).attach.filter (λ m, m.val < i.val),
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, mem_range.mp j.2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw [dd_pos.eq9, sum_add_distrib],
-- end

-- lemma dd_pos.eq12 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (range n.succ).attach.filter (λ m, i.val ≤ m.val),
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, mem_range.mp j.2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (range n.succ).attach.filter (λ m, m.val < i.val),
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, mem_range.mp j.2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw [dd_pos.eq11],
-- end

-- lemma dd_pos.eq13 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (range n.succ).attach.filter (λ m, m.val < i.val),
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, mem_range.mp j.2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw [dd_pos.eq12],
--   apply congr_arg2 (+) _ rfl,
--   apply sum_congr rfl (λ i hi, _),
--   apply sum_bij',
--   work_on_goal 4
--   { refine λ a ha, ⟨a.1, mem_Ico.mpr ⟨_, _⟩⟩,
--     { rcases mem_filter.mp ha with ⟨h1, h2⟩,
--       exact h2 },
--     { exact mem_range.mp a.2 }, },
--   work_on_goal 5
--   { refine λ a ha, ⟨a.1, mem_range.mpr _⟩,
--     exact (mem_Ico.mp a.2).2, },
--   { intros a ha, refl, },
--   { intros a ha, rw subtype.ext_iff_val, },
--   { intros a ha, rw subtype.ext_iff_val, },
--   { intros a ha, apply mem_attach },
--   { intros a ha,
--     simp only [mem_attach, mem_filter, subtype.coe_mk, true_and],
--     exact (mem_Ico.mp a.2).1, },
-- end

-- lemma dd_pos.eq14 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (range i.1).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, lt_of_lt_of_le (mem_range.mp j.2) (nat.le_of_lt_succ (mem_range.mp i.2))⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw [dd_pos.eq13],
--   apply congr_arg2 (+) rfl _,
--   apply sum_congr rfl (λ j hj, _),
--   apply sum_bij',
--   work_on_goal 4
--   { refine λ a ha, ⟨a.1, mem_range.mpr _⟩,
--     rcases mem_filter.mp ha with ⟨h1, h2⟩,
--     exact h2 },
--   work_on_goal 5
--   { refine λ a ha, ⟨a.1, mem_range.mpr _⟩,
--     refine lt_of_lt_of_le (mem_range.mp a.2) _,
--     apply nat.le_of_lt_succ,
--     exact mem_range.mp j.2 },
--   { intros a ha, refl, },
--   { intros a ha, rw subtype.ext_iff_val, },
--   { intros a ha, rw subtype.ext_iff_val, },
--   { intros a ha, apply mem_attach },
--   { intros a ha,
--     simp only [mem_filter, mem_attach, subtype.coe_mk, true_and],
--     exact mem_range.mp a.2, },
-- end

-- lemma dd_pos.eq15 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ j in (range n.succ).attach,
--     ∑ i in (Ico j.1.succ n.succ.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, (mem_Ico.mp i.2).2⟩ ⟨j.val, mem_range.mp j.2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw [dd_pos.eq14],
--   apply congr_arg2 (+) rfl _,
--   rw [finset.sum_sigma', finset.sum_sigma'],
--   apply sum_bij',
--   work_on_goal 4
--   { refine λ ⟨a, b⟩ h, ⟨⟨b.1, mem_range.mpr begin
--       refine lt_of_lt_of_le (mem_range.mp b.2) _,
--       apply nat.le_of_lt_succ,
--       exact mem_range.mp a.2,
--     end⟩, ⟨a.1, mem_Ico.mpr ⟨begin
--       apply nat.le_of_lt_succ,
--       apply nat.succ_lt_succ,
--       exact mem_range.mp b.2,
--     end, begin
--       exact mem_range.mp a.2,
--     end⟩⟩⟩, },
--   work_on_goal 5
--   { refine λ ⟨a, b⟩ h, ⟨⟨b.1, mem_range.mpr begin
--       exact (mem_Ico.mp b.2).2,
--     end⟩, ⟨a.1, mem_range.mpr begin
--       have := (mem_Ico.mp b.2).1,
--       omega,
--     end⟩⟩ },
--   { rintros ⟨a, b⟩ h, refl, },
--   { rintros ⟨a, b⟩ h, simp only [subtype.val_eq_coe, subtype.coe_eta, sigma.mk.inj_iff, eq_self_iff_true, heq_iff_eq, and_self], },
--   { rintros ⟨a, b⟩ h, simp only [subtype.val_eq_coe, subtype.coe_eta, sigma.mk.inj_iff, eq_self_iff_true, heq_iff_eq, and_self], },
--   { rintros ⟨a, b⟩ h, simp only [mem_sigma, mem_attach, and_self], },
--   { rintros ⟨a, b⟩ h, simp only [mem_sigma, mem_attach, and_self], },
-- end

-- lemma dd_pos.eq16 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ).attach,
--     ∑ j in (Ico i.1.succ n.succ.succ).attach,
--       ite (even (j.val + i.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨j.val, (mem_Ico.mp j.2).2⟩ ⟨i.val, mem_range.mp i.2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨j.val, _⟩ ⟨i.val, _⟩))) := dd_pos.eq15 _ _ _

-- lemma 𝓕_map_congr (σ1 σ2 : simplex 𝔘 n.pred) (h : σ1 = σ2) (f : C 𝓕 𝔘 n.pred)
--   (i1 : σ.face ⟶ σ1.face) (i2 : σ.face ⟶ σ2.face) :
--   𝓕.map i1.op (f σ1) = 𝓕.map i2.op (f σ2) :=
-- begin
--   subst h,
--   congr,
-- end

-- lemma dd_pos.eq17 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (j.1.succ + i.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨j.1.succ, nat.succ_lt_succ (mem_Ico.mp j.2).2⟩ ⟨i.val, mem_range.mp i.2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨j.1.succ, _⟩ ⟨i.val, _⟩))) :=
-- begin
--   rw dd_pos.eq16,
--   apply congr_arg2 (+) rfl,
--   apply sum_congr rfl (λ i hi, _),
--   apply sum_bij',
--   work_on_goal 4
--   { refine λ a ha, ⟨a.1.pred, mem_Ico.mpr _⟩,
--     rcases mem_Ico.mp a.2 with ⟨h1, h2⟩,
--     have ineq1 : 0 < a.1,
--     { have := (mem_Ico.mp a.2).1,
--       omega },
--     have eq2 : a.1.pred.succ = a.1 := nat.succ_pred_eq_of_pos ineq1,
--     split,
--     { rwa [← eq2, nat.succ_le_succ_iff] at h1 },
--     { rwa [← eq2, nat.succ_lt_succ_iff] at h2 } },
--   work_on_goal 5
--   { refine λ a ha, ⟨a.1.succ, mem_Ico.mpr ⟨_, _⟩⟩,
--     { apply nat.succ_le_succ,
--       exact (mem_Ico.mp a.2).1, },
--     { apply nat.succ_lt_succ,
--       exact (mem_Ico.mp a.2).2, }, },
--   { intros a ha,
--     have ineq1 : 0 < a.1,
--     { have := (mem_Ico.mp a.2).1,
--       omega },
--     have eq2 : a.1.pred.succ = a.1 := nat.succ_pred_eq_of_pos ineq1,
--     by_cases e : even (a.1 + i.1),
--     { rw [if_pos e, id, if_pos, id],
--       dsimp only,
--       apply 𝓕_map_congr,
--       simp only [eq2],
--       dsimp only,
--       rwa eq2, },
--     { rw [if_neg e, if_neg],
--       apply congr_arg,
--       apply 𝓕_map_congr,
--       simp only [eq2],
--       simp only [eq2],
--       exact e, }, },
--   { intros a ha,
--     have ineq1 : 0 < a.1,
--     { have := (mem_Ico.mp a.2).1,
--       omega },
--     have eq2 : a.1.pred.succ = a.1 := nat.succ_pred_eq_of_pos ineq1,
--     rw subtype.ext_iff_val,
--     dsimp only,
--     rw eq2, },
--   { intros a ha,
--     rw subtype.ext_iff_val,
--     dsimp only,
--     rw nat.pred_succ, },
--   { intros a ha,
--     apply mem_attach, },
--   { intros a ha,
--     apply mem_attach, },
-- end

-- lemma dd_pos.eq18 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (j.1.succ + i.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.1, lt_trans (mem_range.mp i.2) (lt_add_one _)⟩ ⟨j.1, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.1, _⟩ ⟨j.1, _⟩))) :=
-- begin
--   rw dd_pos.eq17,
--   apply congr_arg2 (+) rfl,
--   apply sum_congr rfl (λ i hi, _),
--   apply sum_congr rfl (λ j hj, _),
--   by_cases e : even (j.val.succ + i.val),
--   { rw [if_pos e, id, id],
--     apply 𝓕_map_congr,
--     symmetry,
--     apply simplex.ignore₂_eq_ignore₂ hn σ,
--     exact (mem_Ico.mp j.2).1 },
--   { rw [if_neg e],
--     apply congr_arg,
--     apply 𝓕_map_congr,
--     symmetry,
--     apply simplex.ignore₂_eq_ignore₂ hn σ,
--     exact (mem_Ico.mp j.2).1 },
-- end

-- lemma dd_pos.eq19 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ).attach,
--     -∑ j in (Ico i.1 n.succ).attach,
--       ite (even (j.1 + i.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.1, lt_trans (mem_range.mp i.2) (lt_add_one _)⟩ ⟨j.1, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.1, _⟩ ⟨j.1, _⟩))) :=
-- begin
--   rw dd_pos.eq18,
--   apply congr_arg2 (+) rfl,
--   apply sum_congr rfl (λ i hi, _),
--   rw neg_sum,
--   apply sum_congr rfl (λ j hj, _),
--   by_cases e : even (j.val.succ + i.val),
--   { rw [if_pos e, id, if_neg, neg_neg],
--     intro r,
--     have r' := nat.even.sub_even e r,
--     have eq1 : j.val.succ + i.val = (j.1 + i.1).succ := by omega,
--     rw [eq1, nat.succ_sub, nat.sub_self] at r',
--     apply nat.not_even_one,
--     exact r',
--     exact le_refl _, },
--   { rw [if_neg e, if_pos, id],
--     by_contra r,
--     rw ← nat.odd_iff_not_even at e r,
--     have r' := nat.odd.sub_odd e r,
--     have eq1 : j.val.succ + i.val = (j.1 + i.1).succ := by omega,
--     rw [eq1, nat.succ_sub, nat.sub_self] at r',
--     apply nat.not_even_one,
--     exact r',
--     exact le_refl _, },
-- end

-- lemma dd_pos.eq20 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, lt_trans (mem_range.mp i.2) (lt_add_one _)⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ j in (Ico n.succ n.succ).attach,
--     ite (even (n.succ + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨n.succ, lt_add_one _⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨n.succ, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ).attach,
--     -∑ j in (Ico i.1 n.succ).attach,
--       ite (even (j.1 + i.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.1, lt_trans (mem_range.mp i.2) (lt_add_one _)⟩ ⟨j.1, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.1, _⟩ ⟨j.1, _⟩))) :=
-- have eq0 : ∑ i in (range n.succ.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, mem_range.mp i.2⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) =
-- ∑ i in (insert n.succ (range n.succ)).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, begin
--           have h := i.2,
--           simp only [← range_succ] at h,
--           rwa mem_range at h,
--         end⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))),
-- begin
--   apply sum_bij',
--   work_on_goal 4
--   { refine λ a ha, ⟨a.1, _⟩,
--     rw ← range_succ,
--     exact a.2 },
--   work_on_goal 5
--   { refine λ a ha, ⟨a.1, _⟩,
--     convert a.2,
--     rw ← range_succ, },
--   { intros a ha, refl, },
--   { intros a ha, rw subtype.ext_iff_val, },
--   { intros a ha, rw subtype.ext_iff_val, },
--   { intros a ha, apply mem_attach },
--   { intros a ha, apply mem_attach },
-- end,
-- begin
--   rw dd_pos.eq19,
--   apply congr_arg2 (+) _ rfl,
--   rw [eq0, attach_insert, sum_insert, add_comm],
--   apply congr_arg2 (+),
--   { apply sum_bij',
--     work_on_goal 4
--     { refine λ a ha, ⟨a.1, mem_range.mpr _⟩,
--       rw mem_image at ha,
--       rcases ha with ⟨x, hx1, hx2⟩,
--       rw ← hx2,
--       dsimp only,
--       exact mem_range.mp x.2, },
--     work_on_goal 5
--     { refine λ a ha, ⟨a.1, _⟩,
--       rw mem_insert,
--       right,
--       exact a.2 },
--     { intros a ha, dsimp only, refl, },
--     { intros a ha, rw subtype.ext_iff_val, },
--     { intros a ha, rw subtype.ext_iff_val, },
--     { intros a ha, apply mem_attach },
--     { intros a ha, rw mem_image, use a.1, exact a.2,
--       refine ⟨_, _⟩, apply mem_attach, rw subtype.ext_iff_val, }, },
--   { refl, },
--   { intro r,
--     rw mem_image at r,
--     rcases r with ⟨⟨a, ha⟩, h1, h2⟩,
--     rw subtype.ext_iff_val at h2,
--     dsimp only at h2,
--     rw h2 at ha,
--     rw mem_range at ha,
--     linarith only [ha], },
-- end

-- lemma dd_pos.eq21 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ).attach,
--     ∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, lt_trans (mem_range.mp i.2) (lt_add_one _)⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--   ∑ i in (range n.succ).attach,
--     -∑ j in (Ico i.1 n.succ).attach,
--       ite (even (j.1 + i.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.1, lt_trans (mem_range.mp i.2) (lt_add_one _)⟩ ⟨j.1, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.1, _⟩ ⟨j.1, _⟩))) +
--   ∑ j in (Ico n.succ n.succ).attach,
--     ite (even (n.succ + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨n.succ, lt_add_one _⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨n.succ, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw dd_pos.eq20,
--   abel,
-- end

-- lemma dd_pos.eq22 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ).attach,
--     (∑ j in (Ico i.1 n.succ).attach,
--       ite (even (i.val + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.val, lt_trans (mem_range.mp i.2) (lt_add_one _)⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.val, _⟩ ⟨j.val, _⟩))) +
--     -∑ j in (Ico i.1 n.succ).attach,
--       ite (even (j.1 + i.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨i.1, lt_trans (mem_range.mp i.2) (lt_add_one _)⟩ ⟨j.1, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨i.1, _⟩ ⟨j.1, _⟩)))) +
--   ∑ j in (Ico n.succ n.succ).attach,
--     ite (even (n.succ + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨n.succ, lt_add_one _⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨n.succ, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw [dd_pos.eq21, sum_add_distrib],
-- end

-- lemma dd_pos.eq23 :
--   dd_pos hn f σ =
--   ∑ i in (range n.succ).attach, 0 +
--   ∑ j in (Ico n.succ n.succ).attach,
--     ite (even (n.succ + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨n.succ, lt_add_one _⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨n.succ, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw [dd_pos.eq22],
--   apply congr_arg2 (+) _ rfl,
--   apply sum_congr rfl (λ i hi, _),
--   rw [← sub_eq_add_neg, sub_eq_zero],
--   apply sum_congr rfl (λ j hj, _),
--   rw add_comm,
-- end

-- lemma dd_pos.eq24 :
--   dd_pos hn f σ =
--   0 + ∑ j in (Ico n.succ n.succ).attach,
--     ite (even (n.succ + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨n.succ, lt_add_one _⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨n.succ, _⟩ ⟨j.val, _⟩))) :=
-- begin
--   rw [dd_pos.eq23],
--   apply congr_arg2 (+) _ rfl,
--   apply finset.sum_eq_zero,
--   intros,
--   refl,
-- end

-- lemma dd_pos.eq25 :
--   dd_pos hn f σ =
--   ∑ j in (Ico n.succ n.succ).attach,
--     ite (even (n.succ + j.val)) id has_neg.neg
--         ((𝓕.val.map (σ.dder hn ⟨n.succ, lt_add_one _⟩ ⟨j.val, (mem_Ico.mp j.2).2⟩).op)
--            (f (simplex.ignore₂ hn σ ⟨n.succ, _⟩ ⟨j.val, _⟩))) :=
-- by rw [dd_pos.eq24, zero_add]

-- lemma dd_pos_eq_zero :
--   dd_pos hn f σ = 0 :=
-- begin
--   rw [dd_pos.eq25],
--   convert sum_empty,
--   rw Ico_self,
--   refl,
-- end

-- end lemmas

-- lemma dd_pos.eq0 {n : ℕ} (hn : 0 < n) : (d_pos hn : C 𝓕 𝔘 _ ⟶ _) ≫ d_pos (nat.zero_lt_succ _) = 0 :=
-- begin
--   ext f σ,
--   convert dd_pos_eq_zero hn f σ,
-- end

-- end

-- end


import algebra.group order.basic ..logic
  .rev .form .dnf .reify ..expr_of_unsat

namespace int

open tactic

run_cmd mk_simp_attr `sugar
attribute [sugar]
  not_le not_lt
  int.lt_iff_add_one_le
  or_false false_or
  and_true true_and
  ge gt mul_add add_mul
  mul_comm sub_eq_add_neg
  classical.imp_iff_not_or
  classical.iff_iff

meta def desugar := `[try {simp only with sugar}]

lemma uniclo_of_unsat_clausify (m : nat) (p : form) :
  clauses.unsat (dnf (¬*p)) → uniclo p (λ x, 0) m | h1 :=
begin
  apply uniclo_of_valid,
  apply valid_of_unsat_not,
  apply unsat_of_clauses_unsat,
  exact h1
end

/- Given a p : form, return the expr of a term t : p.uniclo -/
meta def expr_of_uniclo (m : nat) (p : form) : tactic expr :=
do x ← expr_of_unsats (dnf (¬*p)),
   return `(uniclo_of_unsat_clausify %%`(m) %%`(p) %%x)

--meta def expr_of_lia : tactic expr :=
--target >>= to_form >>= expr_of_uniclo

meta def expr_of_lia : tactic expr :=
do (p,m) ← target >>= to_form 0,
   expr_of_uniclo m p

meta def omega : tactic unit :=
do rev, desugar,
   expr_of_lia >>= apply,
   skip

end int


/-
Copyright (c) 2018 Michael Jendrusch. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Jendrusch, Scott Morrison, Bhavik Mehta
-/
import category_theory.monoidal.category
import category_theory.adjunction.basic
import category_theory.products.basic

/-!
# (Lax) monoidal functors

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

A lax monoidal functor `F` between monoidal categories `C` and `D`
is a functor between the underlying categories equipped with morphisms
* `ε : 𝟙_ D ⟶ F.obj (𝟙_ C)` (called the unit morphism)
* `μ X Y : (F.obj X) ⊗ (F.obj Y) ⟶ F.obj (X ⊗ Y)` (called the tensorator, or strength).
satisfying various axioms.

A monoidal functor is a lax monoidal functor for which `ε` and `μ` are isomorphisms.

We show that the composition of (lax) monoidal functors gives a (lax) monoidal functor.

See also `category_theory.monoidal.functorial` for a typeclass decorating an object-level
function with the additional data of a monoidal functor.
This is useful when stating that a pre-existing functor is monoidal.

See `category_theory.monoidal.natural_transformation` for monoidal natural transformations.

We show in `category_theory.monoidal.Mon_` that lax monoidal functors take monoid objects
to monoid objects.

## Future work
* Oplax monoidal functors.

## References

See <https://stacks.math.columbia.edu/tag/0FFL>.
-/

open category_theory

universes v₁ v₂ v₃ u₁ u₂ u₃

open category_theory.category
open category_theory.functor

namespace category_theory

section

open monoidal_category

variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C]
          (D : Type u₂) [category.{v₂} D] [monoidal_category.{v₂} D]

/-- A lax monoidal functor is a functor `F : C ⥤ D` between monoidal categories,
equipped with morphisms `ε : 𝟙 _D ⟶ F.obj (𝟙_ C)` and `μ X Y : F.obj X ⊗ F.obj Y ⟶ F.obj (X ⊗ Y)`,
satisfying the appropriate coherences. -/
-- The direction of `left_unitality` and `right_unitality` as simp lemmas may look strange:
-- remember the rule of thumb that component indices of natural transformations
-- "weigh more" than structural maps.
-- (However by this argument `associativity` is currently stated backwards!)
structure lax_monoidal_functor extends C ⥤ D :=
-- unit morphism
(ε               : 𝟙_ D ⟶ obj (𝟙_ C))
-- tensorator
(μ                : Π X Y : C, (obj X) ⊗ (obj Y) ⟶ obj (X ⊗ Y))
(μ_natural'       : ∀ {X Y X' Y' : C}
  (f : X ⟶ Y) (g : X' ⟶ Y'),
  ((map f) ⊗ (map g)) ≫ μ Y Y' = μ X X' ≫ map (f ⊗ g)
  . obviously)
-- associativity of the tensorator
(associativity'   : ∀ (X Y Z : C),
    (μ X Y ⊗ 𝟙 (obj Z)) ≫ μ (X ⊗ Y) Z ≫ map (α_ X Y Z).hom
  = (α_ (obj X) (obj Y) (obj Z)).hom ≫ (𝟙 (obj X) ⊗ μ Y Z) ≫ μ X (Y ⊗ Z)
  . obviously)
-- unitality
(left_unitality'  : ∀ X : C,
    (λ_ (obj X)).hom
  = (ε ⊗ 𝟙 (obj X)) ≫ μ (𝟙_ C) X ≫ map (λ_ X).hom
  . obviously)
(right_unitality' : ∀ X : C,
    (ρ_ (obj X)).hom
  = (𝟙 (obj X) ⊗ ε) ≫ μ X (𝟙_ C) ≫ map (ρ_ X).hom
  . obviously)

restate_axiom lax_monoidal_functor.μ_natural'
attribute [simp, reassoc] lax_monoidal_functor.μ_natural
restate_axiom lax_monoidal_functor.left_unitality'
attribute [simp] lax_monoidal_functor.left_unitality
restate_axiom lax_monoidal_functor.right_unitality'
attribute [simp] lax_monoidal_functor.right_unitality
restate_axiom lax_monoidal_functor.associativity'
attribute [simp, reassoc] lax_monoidal_functor.associativity

-- When `rewrite_search` lands, add @[search] attributes to
-- lax_monoidal_functor.μ_natural lax_monoidal_functor.left_unitality
-- lax_monoidal_functor.right_unitality lax_monoidal_functor.associativity

section
variables {C D}

@[simp, reassoc]
lemma lax_monoidal_functor.left_unitality_inv (F : lax_monoidal_functor C D) (X : C) :
  (λ_ (F.obj X)).inv ≫ (F.ε ⊗ 𝟙 (F.obj X)) ≫ F.μ (𝟙_ C) X = F.map (λ_ X).inv :=
begin
  rw [iso.inv_comp_eq, F.left_unitality, category.assoc, category.assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

@[simp, reassoc]
lemma lax_monoidal_functor.right_unitality_inv (F : lax_monoidal_functor C D) (X : C) :
  (ρ_ (F.obj X)).inv ≫ (𝟙 (F.obj X) ⊗ F.ε) ≫ F.μ X (𝟙_ C) = F.map (ρ_ X).inv :=
begin
  rw [iso.inv_comp_eq, F.right_unitality, category.assoc, category.assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

@[simp, reassoc]
lemma lax_monoidal_functor.associativity_inv (F : lax_monoidal_functor C D) (X Y Z : C) :
  (𝟙 (F.obj X) ⊗ F.μ Y Z) ≫ F.μ X (Y ⊗ Z) ≫ F.map (α_ X Y Z).inv =
    (α_ (F.obj X) (F.obj Y) (F.obj Z)).inv ≫ (F.μ X Y ⊗ 𝟙 (F.obj Z)) ≫ F.μ (X ⊗ Y) Z :=
begin
  rw [iso.eq_inv_comp, ←F.associativity_assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

end

/--
A monoidal functor is a lax monoidal functor for which the tensorator and unitor as isomorphisms.

See <https://stacks.math.columbia.edu/tag/0FFL>.
-/
structure monoidal_functor
extends lax_monoidal_functor.{v₁ v₂} C D :=
(ε_is_iso            : is_iso ε . tactic.apply_instance)
(μ_is_iso            : Π X Y : C, is_iso (μ X Y) . tactic.apply_instance)

attribute [instance] monoidal_functor.ε_is_iso monoidal_functor.μ_is_iso

variables {C D}

/--
The unit morphism of a (strong) monoidal functor as an isomorphism.
-/
noncomputable
def monoidal_functor.ε_iso (F : monoidal_functor.{v₁ v₂} C D) :
  tensor_unit D ≅ F.obj (tensor_unit C) :=
as_iso F.ε

/--
The tensorator of a (strong) monoidal functor as an isomorphism.
-/
noncomputable
def monoidal_functor.μ_iso (F : monoidal_functor.{v₁ v₂} C D) (X Y : C) :
  (F.obj X) ⊗ (F.obj Y) ≅ F.obj (X ⊗ Y) :=
as_iso (F.μ X Y)

end

open monoidal_category

namespace lax_monoidal_functor

variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C]

/-- The identity lax monoidal functor. -/
@[simps] def id : lax_monoidal_functor.{v₁ v₁} C C :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  .. 𝟭 C }

instance : inhabited (lax_monoidal_functor C C) := ⟨id C⟩

end lax_monoidal_functor

namespace monoidal_functor

section
variables {C : Type u₁} [category.{v₁} C] [monoidal_category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D] [monoidal_category.{v₂} D]
variable (F : monoidal_functor.{v₁ v₂} C D)

lemma map_tensor {X Y X' Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y') :
  F.map (f ⊗ g) = inv (F.μ X X') ≫ ((F.map f) ⊗ (F.map g)) ≫ F.μ Y Y' :=
by simp

lemma map_left_unitor (X : C) :
  F.map (λ_ X).hom = inv (F.μ (𝟙_ C) X) ≫ (inv F.ε ⊗ 𝟙 (F.obj X)) ≫ (λ_ (F.obj X)).hom :=
begin
  simp only [lax_monoidal_functor.left_unitality],
  slice_rhs 2 3 { rw ←comp_tensor_id, simp, },
  simp,
end

lemma map_right_unitor (X : C) :
  F.map (ρ_ X).hom = inv (F.μ X (𝟙_ C)) ≫ (𝟙 (F.obj X) ⊗ inv F.ε) ≫ (ρ_ (F.obj X)).hom :=
begin
  simp only [lax_monoidal_functor.right_unitality],
  slice_rhs 2 3 { rw ←id_tensor_comp, simp, },
  simp,
end

/-- The tensorator as a natural isomorphism. -/
noncomputable
def μ_nat_iso :
  (functor.prod F.to_functor F.to_functor) ⋙ (tensor D) ≅ (tensor C) ⋙ F.to_functor :=
nat_iso.of_components
  (by { intros, apply F.μ_iso })
  (by { intros, apply F.to_lax_monoidal_functor.μ_natural })

@[simp] lemma μ_iso_hom (X Y : C) : (F.μ_iso X Y).hom = F.μ X Y := rfl
@[simp, reassoc] lemma μ_inv_hom_id (X Y : C) : (F.μ_iso X Y).inv ≫ F.μ X Y = 𝟙 _ :=
(F.μ_iso X Y).inv_hom_id
@[simp] lemma μ_hom_inv_id (X Y : C) : F.μ X Y ≫ (F.μ_iso X Y).inv = 𝟙 _ :=
(F.μ_iso X Y).hom_inv_id

@[simp] lemma ε_iso_hom : F.ε_iso.hom = F.ε := rfl
@[simp, reassoc] lemma ε_inv_hom_id : F.ε_iso.inv ≫ F.ε = 𝟙 _ := F.ε_iso.inv_hom_id
@[simp] lemma ε_hom_inv_id : F.ε ≫ F.ε_iso.inv = 𝟙 _ := F.ε_iso.hom_inv_id

/-- Monoidal functors commute with left tensoring up to isomorphism -/
@[simps] noncomputable def comm_tensor_left (X : C) :
  F.to_functor ⋙ (tensor_left (F.to_functor.obj X)) ≅
  tensor_left X ⋙ F.to_functor :=
nat_iso.of_components (λ Y, F.μ_iso X Y) (λ Y Z f, by { convert F.μ_natural' (𝟙 _) f, simp })

/-- Monoidal functors commute with right tensoring up to isomorphism -/
@[simps] noncomputable def comm_tensor_right (X : C) :
  F.to_functor ⋙ (tensor_right (F.to_functor.obj X)) ≅
  tensor_right X ⋙ F.to_functor :=
nat_iso.of_components (λ Y, F.μ_iso Y X) (λ Y Z f, by { convert F.μ_natural' f (𝟙 _), simp })

end

section
variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C]

/-- The identity monoidal functor. -/
@[simps] def id : monoidal_functor.{v₁ v₁} C C :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  .. 𝟭 C }

instance : inhabited (monoidal_functor C C) := ⟨id C⟩

end

end monoidal_functor

variables {C : Type u₁} [category.{v₁} C] [monoidal_category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D] [monoidal_category.{v₂} D]
variables {E : Type u₃} [category.{v₃} E] [monoidal_category.{v₃} E]

namespace lax_monoidal_functor
variables (F : lax_monoidal_functor.{v₁ v₂} C D) (G : lax_monoidal_functor.{v₂ v₃} D E)

-- The proofs here are horrendous; rewrite_search helps a lot.
/-- The composition of two lax monoidal functors is again lax monoidal. -/
@[simps] def comp : lax_monoidal_functor.{v₁ v₃} C E :=
{ ε                := G.ε ≫ (G.map F.ε),
  μ                := λ X Y, G.μ (F.obj X) (F.obj Y) ≫ G.map (F.μ X Y),
  μ_natural'       := λ _ _ _ _ f g,
  begin
    simp only [functor.comp_map, assoc],
    rw [←category.assoc, lax_monoidal_functor.μ_natural, category.assoc, ←map_comp, ←map_comp,
        ←lax_monoidal_functor.μ_natural]
  end,
  associativity'   := λ X Y Z,
  begin
    dsimp,
    rw id_tensor_comp,
    slice_rhs 3 4 { rw [← G.to_functor.map_id, G.μ_natural], },
    slice_rhs 1 3 { rw ←G.associativity, },
    rw comp_tensor_id,
    slice_lhs 2 3 { rw [← G.to_functor.map_id, G.μ_natural], },
    rw [category.assoc, category.assoc, category.assoc, category.assoc, category.assoc,
        ←G.to_functor.map_comp, ←G.to_functor.map_comp, ←G.to_functor.map_comp,
        ←G.to_functor.map_comp, F.associativity],
  end,
  left_unitality'  := λ X,
  begin
    dsimp,
    rw [G.left_unitality, comp_tensor_id, category.assoc, category.assoc],
    apply congr_arg,
    rw [F.left_unitality, map_comp, ←nat_trans.id_app, ←category.assoc,
        ←lax_monoidal_functor.μ_natural, nat_trans.id_app, map_id, ←category.assoc, map_comp],
  end,
  right_unitality' := λ X,
  begin
    dsimp,
    rw [G.right_unitality, id_tensor_comp, category.assoc, category.assoc],
    apply congr_arg,
    rw [F.right_unitality, map_comp, ←nat_trans.id_app, ←category.assoc,
        ←lax_monoidal_functor.μ_natural, nat_trans.id_app, map_id, ←category.assoc, map_comp],
  end,
  .. (F.to_functor) ⋙ (G.to_functor) }.

infixr ` ⊗⋙ `:80 := comp

end lax_monoidal_functor

namespace lax_monoidal_functor
universes v₀ u₀
variables {B : Type u₀} [category.{v₀} B] [monoidal_category.{v₀} B]
variables (F : lax_monoidal_functor.{v₀ v₁} B C) (G : lax_monoidal_functor.{v₂ v₃} D E)

local attribute [simp] μ_natural associativity left_unitality right_unitality

/-- The cartesian product of two lax monoidal functors is lax monoidal. -/
@[simps]
def prod : lax_monoidal_functor (B × D) (C × E) :=
{ ε := (ε F, ε G),
  μ := λ X Y, (μ F X.1 Y.1, μ G X.2 Y.2),
  .. (F.to_functor).prod (G.to_functor) }

end lax_monoidal_functor

namespace monoidal_functor
variable (C)

/-- The diagonal functor as a monoidal functor. -/
@[simps]
def diag : monoidal_functor C (C × C) :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  .. functor.diag C }

end monoidal_functor

namespace lax_monoidal_functor
variables (F : lax_monoidal_functor.{v₁ v₂} C D) (G : lax_monoidal_functor.{v₁ v₃} C E)

/-- The cartesian product of two lax monoidal functors starting from the same monoidal category `C`
    is lax monoidal. -/
def prod' : lax_monoidal_functor C (D × E) :=
(monoidal_functor.diag C).to_lax_monoidal_functor ⊗⋙ (F.prod G)

@[simp] lemma prod'_to_functor :
  (F.prod' G).to_functor = (F.to_functor).prod' (G.to_functor) := rfl

@[simp] lemma prod'_ε : (F.prod' G).ε = (F.ε, G.ε) :=
by { dsimp [prod'], simp }

@[simp] lemma prod'_μ (X Y : C) : (F.prod' G).μ X Y = (F.μ X Y, G.μ X Y) :=
by { dsimp [prod'], simp }

end lax_monoidal_functor

namespace monoidal_functor

variables (F : monoidal_functor.{v₁ v₂} C D) (G : monoidal_functor.{v₂ v₃} D E)

/-- The composition of two monoidal functors is again monoidal. -/
@[simps]
def comp : monoidal_functor.{v₁ v₃} C E :=
{ ε_is_iso := by { dsimp, apply_instance },
  μ_is_iso := by { dsimp, apply_instance },
  .. (F.to_lax_monoidal_functor).comp (G.to_lax_monoidal_functor) }.

-- We overload notation; potentially dangerous, but it seems to work.
infixr (name := monoidal_functor.comp) ` ⊗⋙ `:80 := comp

end monoidal_functor

namespace monoidal_functor
universes v₀ u₀
variables {B : Type u₀} [category.{v₀} B] [monoidal_category.{v₀} B]
variables (F : monoidal_functor.{v₀ v₁} B C) (G : monoidal_functor.{v₂ v₃} D E)

/-- The cartesian product of two monoidal functors is monoidal. -/
@[simps]
def prod : monoidal_functor (B × D) (C × E) :=
{ ε_is_iso := (is_iso_prod_iff C E).mpr ⟨ε_is_iso F, ε_is_iso G⟩,
  μ_is_iso := λ X Y, (is_iso_prod_iff C E).mpr ⟨μ_is_iso F X.1 Y.1, μ_is_iso G X.2 Y.2⟩,
  .. (F.to_lax_monoidal_functor).prod (G.to_lax_monoidal_functor) }

end monoidal_functor

namespace monoidal_functor
variables (F : monoidal_functor.{v₁ v₂} C D) (G : monoidal_functor.{v₁ v₃} C E)

/-- The cartesian product of two monoidal functors starting from the same monoidal category `C`
    is monoidal. -/
def prod' : monoidal_functor C (D × E) := diag C ⊗⋙ (F.prod G)

@[simp] lemma prod'_to_lax_monoidal_functor :
    (F.prod' G).to_lax_monoidal_functor
  = (F.to_lax_monoidal_functor).prod' (G.to_lax_monoidal_functor) := rfl

end monoidal_functor

/--
If we have a right adjoint functor `G` to a monoidal functor `F`, then `G` has a lax monoidal
structure as well.
-/
@[simps]
noncomputable
def monoidal_adjoint (F : monoidal_functor C D) {G : D ⥤ C} (h : F.to_functor ⊣ G) :
  lax_monoidal_functor D C :=
{ to_functor := G,
  ε := h.hom_equiv _ _ (inv F.ε),
  μ := λ X Y,
    h.hom_equiv _ (X ⊗ Y) (inv (F.μ (G.obj X) (G.obj Y)) ≫ (h.counit.app X ⊗ h.counit.app Y)),
  μ_natural' := λ X Y X' Y' f g,
  begin
    rw [←h.hom_equiv_naturality_left, ←h.hom_equiv_naturality_right, equiv.apply_eq_iff_eq, assoc,
      is_iso.eq_inv_comp, ←F.to_lax_monoidal_functor.μ_natural_assoc, is_iso.hom_inv_id_assoc,
      ←tensor_comp, adjunction.counit_naturality, adjunction.counit_naturality, tensor_comp],
  end,
  associativity' := λ X Y Z,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←h.hom_equiv_naturality_left,
      ←h.hom_equiv_naturality_left, equiv.apply_eq_iff_eq,
      ← cancel_epi (F.to_lax_monoidal_functor.μ (G.obj X ⊗ G.obj Y) (G.obj Z)),
      ← cancel_epi (F.to_lax_monoidal_functor.μ (G.obj X) (G.obj Y) ⊗ 𝟙 (F.obj (G.obj Z))),
      F.to_lax_monoidal_functor.associativity_assoc (G.obj X) (G.obj Y) (G.obj Z),
      ←F.to_lax_monoidal_functor.μ_natural_assoc, assoc, is_iso.hom_inv_id_assoc,
      ←F.to_lax_monoidal_functor.μ_natural_assoc, is_iso.hom_inv_id_assoc, ←tensor_comp,
      ←tensor_comp, id_comp, functor.map_id, functor.map_id, id_comp, ←tensor_comp_assoc,
      ←tensor_comp_assoc, id_comp, id_comp, h.hom_equiv_unit, h.hom_equiv_unit, functor.map_comp,
      assoc, assoc, h.counit_naturality, h.left_triangle_components_assoc, is_iso.hom_inv_id_assoc,
      functor.map_comp, assoc, h.counit_naturality, h.left_triangle_components_assoc,
      is_iso.hom_inv_id_assoc],
    exact associator_naturality (h.counit.app X) (h.counit.app Y) (h.counit.app Z),
  end,
  left_unitality' := λ X,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←equiv.symm_apply_eq,
      h.hom_equiv_counit, F.map_left_unitor, h.hom_equiv_unit, assoc, assoc, assoc, F.map_tensor,
      assoc, assoc, is_iso.hom_inv_id_assoc, ←tensor_comp_assoc, functor.map_id, id_comp,
      functor.map_comp, assoc, h.counit_naturality, h.left_triangle_components_assoc,
      ←left_unitor_naturality, ←tensor_comp_assoc, id_comp, comp_id],
  end,
  right_unitality' := λ X,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←equiv.symm_apply_eq,
      h.hom_equiv_counit, F.map_right_unitor, assoc, assoc, ←right_unitor_naturality,
      ←tensor_comp_assoc, comp_id, id_comp, h.hom_equiv_unit, F.map_tensor, assoc, assoc, assoc,
      is_iso.hom_inv_id_assoc, functor.map_comp, functor.map_id, ←tensor_comp_assoc, assoc,
      h.counit_naturality, h.left_triangle_components_assoc, id_comp],
  end }.

/-- If a monoidal functor `F` is an equivalence of categories then its inverse is also monoidal. -/
@[simps]
noncomputable
def monoidal_inverse (F : monoidal_functor C D) [is_equivalence F.to_functor] :
  monoidal_functor D C :=
{ to_lax_monoidal_functor := monoidal_adjoint F (as_equivalence _).to_adjunction,
  ε_is_iso := by { dsimp [equivalence.to_adjunction], apply_instance },
  μ_is_iso := λ X Y, by { dsimp [equivalence.to_adjunction], apply_instance } }

end category_theory


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.const
import Mathlib.category_theory.discrete_category
import Mathlib.category_theory.yoneda
import Mathlib.category_theory.reflects_isomorphisms
import Mathlib.PostPort

universes v u l u'

namespace Mathlib

namespace category_theory

namespace functor

/--
`F.cones` is the functor assigning to an object `X` the type of
natural transformations from the constant functor with value `X` to `F`.
An object representing this functor is a limit of `F`.
-/
def cones {J : Type v} [small_category J] {C : Type u} [category C] (F : J ⥤ C) : Cᵒᵖ ⥤ Type v :=
  functor.op (const J) ⋙ obj yoneda F

/--
`F.cocones` is the functor assigning to an object `X` the type of
natural transformations from `F` to the constant functor with value `X`.
An object corepresenting this functor is a colimit of `F`.
-/
@[simp] theorem cocones_obj {J : Type v} [small_category J] {C : Type u} [category C] (F : J ⥤ C)
    (X : C) : obj (cocones F) X = (F ⟶ obj (const J) X) :=
  Eq.refl (F ⟶ obj (const J) X)

end functor

/--
Functorially associated to each functor `J ⥤ C`, we have the `C`-presheaf consisting of
cones with a given cone point.
-/
@[simp] theorem cones_map (J : Type v) [small_category J] (C : Type u) [category C] (F : J ⥤ C)
    (G : J ⥤ C) (f : F ⟶ G) :
    functor.map (cones J C) f =
        whisker_left (functor.op (functor.const J)) (functor.map yoneda f) :=
  Eq.refl (functor.map (cones J C) f)

/--
Contravariantly associated to each functor `J ⥤ C`, we have the `C`-copresheaf consisting of
cocones with a given cocone point.
-/
@[simp] theorem cocones_obj (J : Type v) [small_category J] (C : Type u) [category C]
    (F : J ⥤ Cᵒᵖ) : functor.obj (cocones J C) F = functor.cocones (opposite.unop F) :=
  Eq.refl (functor.obj (cocones J C) F)

namespace limits

/--
A `c : cone F` is:
* an object `c.X` and
* a natural transformation `c.π : c.X ⟶ F` from the constant `c.X` functor to `F`.

`cone F` is equivalent, via `cone.equiv` below, to `Σ X, F.cones.obj X`.
-/
structure cone {J : Type v} [small_category J] {C : Type u} [category C] (F : J ⥤ C) where
  X : C
  π : functor.obj (functor.const J) X ⟶ F

protected instance inhabited_cone {C : Type u} [category C] (F : discrete PUnit ⥤ C) :
    Inhabited (cone F) :=
  { default := cone.mk (functor.obj F PUnit.unit) (nat_trans.mk fun (X : discrete PUnit) => sorry) }

@[simp] theorem cone.w {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cone F) {j : J} {j' : J} (f : j ⟶ j') :
    nat_trans.app (cone.π c) j ≫ functor.map F f = nat_trans.app (cone.π c) j' :=
  sorry

/--
A `c : cocone F` is
* an object `c.X` and
* a natural transformation `c.ι : F ⟶ c.X` from `F` to the constant `c.X` functor.

`cocone F` is equivalent, via `cone.equiv` below, to `Σ X, F.cocones.obj X`.
-/
structure cocone {J : Type v} [small_category J] {C : Type u} [category C] (F : J ⥤ C) where
  X : C
  ι : F ⟶ functor.obj (functor.const J) X

protected instance inhabited_cocone {C : Type u} [category C] (F : discrete PUnit ⥤ C) :
    Inhabited (cocone F) :=
  { default :=
      cocone.mk (functor.obj F PUnit.unit) (nat_trans.mk fun (X : discrete PUnit) => sorry) }

@[simp] theorem cocone.w_assoc {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cocone F) {j : J} {j' : J} (f : j ⟶ j') {X' : C}
    (f' : functor.obj (functor.obj (functor.const J) (cocone.X c)) j' ⟶ X') :
    functor.map F f ≫ nat_trans.app (cocone.ι c) j' ≫ f' = nat_trans.app (cocone.ι c) j ≫ f' :=
  sorry

namespace cone

/-- The isomorphism between a cone on `F` and an element of the functor `F.cones`. -/
def equiv {J : Type v} [small_category J] {C : Type u} [category C] (F : J ⥤ C) :
    cone F ≅ sigma fun (X : Cᵒᵖ) => functor.obj (functor.cones F) X :=
  iso.mk (fun (c : cone F) => sigma.mk (opposite.op (X c)) (π c))
    fun (c : sigma fun (X : Cᵒᵖ) => functor.obj (functor.cones F) X) =>
      mk (opposite.unop (sigma.fst c)) (sigma.snd c)

/-- A map to the vertex of a cone naturally induces a cone by composition. -/
@[simp] def extensions {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cone F) : functor.obj yoneda (X c) ⟶ functor.cones F :=
  nat_trans.mk
    fun (X : Cᵒᵖ) (f : functor.obj (functor.obj yoneda (X c)) X) =>
      functor.map (functor.const J) f ≫ π c

/-- A map to the vertex of a cone induces a cone by composition. -/
@[simp] def extend {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cone F) {X : C} (f : X ⟶ X c) : cone F :=
  mk X (nat_trans.app (extensions c) (opposite.op X) f)

@[simp] theorem extend_π {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cone F) {X : Cᵒᵖ} (f : opposite.unop X ⟶ X c) :
    π (extend c f) = nat_trans.app (extensions c) X f :=
  rfl

/-- Whisker a cone by precomposition of a functor. -/
def whisker {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C} {K : Type v}
    [small_category K] (E : K ⥤ J) (c : cone F) : cone (E ⋙ F) :=
  mk (X c) (whisker_left E (π c))

end cone

namespace cocone

/-- The isomorphism between a cocone on `F` and an element of the functor `F.cocones`. -/
def equiv {J : Type v} [small_category J] {C : Type u} [category C] (F : J ⥤ C) :
    cocone F ≅ sigma fun (X : C) => functor.obj (functor.cocones F) X :=
  iso.mk (fun (c : cocone F) => sigma.mk (X c) (ι c))
    fun (c : sigma fun (X : C) => functor.obj (functor.cocones F) X) =>
      mk (sigma.fst c) (sigma.snd c)

/-- A map from the vertex of a cocone naturally induces a cocone by composition. -/
@[simp] def extensions {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cocone F) : functor.obj coyoneda (opposite.op (X c)) ⟶ functor.cocones F :=
  nat_trans.mk
    fun (X : C) (f : functor.obj (functor.obj coyoneda (opposite.op (X c))) X) =>
      ι c ≫ functor.map (functor.const J) f

/-- A map from the vertex of a cocone induces a cocone by composition. -/
@[simp] def extend {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cocone F) {X : C} (f : X c ⟶ X) : cocone F :=
  mk X (nat_trans.app (extensions c) X f)

@[simp] theorem extend_ι {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cocone F) {X : C} (f : X c ⟶ X) : ι (extend c f) = nat_trans.app (extensions c) X f :=
  rfl

/--
Whisker a cocone by precomposition of a functor. See `whiskering` for a functorial
version.
-/
@[simp] theorem whisker_ι {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    {K : Type v} [small_category K] (E : K ⥤ J) (c : cocone F) :
    ι (whisker E c) = whisker_left E (ι c) :=
  Eq.refl (ι (whisker E c))

end cocone

/-- A cone morphism between two cones for the same diagram is a morphism of the cone points which
commutes with the cone legs. -/
structure cone_morphism {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (A : cone F) (B : cone F)
    where
  hom : cone.X A ⟶ cone.X B
  w' :
    autoParam (∀ (j : J), hom ≫ nat_trans.app (cone.π B) j = nat_trans.app (cone.π A) j)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem cone_morphism.w {J : Type v} [small_category J] {C : Type u} [category C]
    {F : J ⥤ C} {A : cone F} {B : cone F} (c : cone_morphism A B) (j : J) :
    cone_morphism.hom c ≫ nat_trans.app (cone.π B) j = nat_trans.app (cone.π A) j :=
  sorry

@[simp] theorem cone_morphism.w_assoc {J : Type v} [small_category J] {C : Type u} [category C]
    {F : J ⥤ C} {A : cone F} {B : cone F} (c : cone_morphism A B) (j : J) {X' : C}
    (f' : functor.obj F j ⟶ X') :
    cone_morphism.hom c ≫ nat_trans.app (cone.π B) j ≫ f' = nat_trans.app (cone.π A) j ≫ f' :=
  sorry

protected instance inhabited_cone_morphism {J : Type v} [small_category J] {C : Type u} [category C]
    {F : J ⥤ C} (A : cone F) : Inhabited (cone_morphism A A) :=
  { default := cone_morphism.mk 𝟙 }

/-- The category of cones on a given diagram. -/
protected instance cone.category {J : Type v} [small_category J] {C : Type u} [category C]
    {F : J ⥤ C} : category (cone F) :=
  category.mk

namespace cones

/-- To give an isomorphism between cones, it suffices to give an
  isomorphism between their vertices which commutes with the cone
  maps. -/
def ext {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C} {c : cone F}
    {c' : cone F} (φ : cone.X c ≅ cone.X c')
    (w : ∀ (j : J), nat_trans.app (cone.π c) j = iso.hom φ ≫ nat_trans.app (cone.π c') j) :
    c ≅ c' :=
  iso.mk (cone_morphism.mk (iso.hom φ)) (cone_morphism.mk (iso.inv φ))

/--
Given a cone morphism whose object part is an isomorphism, produce an
isomorphism of cones.
-/
def cone_iso_of_hom_iso {J : Type v} [small_category J] {C : Type u} [category C] {K : J ⥤ C}
    {c : cone K} {d : cone K} (f : c ⟶ d) [i : is_iso (cone_morphism.hom f)] : is_iso f :=
  is_iso.mk (cone_morphism.mk (inv (cone_morphism.hom f)))

/--
Functorially postcompose a cone for `F` by a natural transformation `F ⟶ G` to give a cone for `G`.
-/
@[simp] theorem postcompose_map_hom {J : Type v} [small_category J] {C : Type u} [category C]
    {F : J ⥤ C} {G : J ⥤ C} (α : F ⟶ G) (c₁ : cone F) (c₂ : cone F) (f : c₁ ⟶ c₂) :
    cone_morphism.hom (functor.map (postcompose α) f) = cone_morphism.hom f :=
  Eq.refl (cone_morphism.hom (functor.map (postcompose α) f))

/-- Postcomposing a cone by the composite natural transformation `α ≫ β` is the same as
postcomposing by `α` and then by `β`. -/
def postcompose_comp {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    {G : J ⥤ C} {H : J ⥤ C} (α : F ⟶ G) (β : G ⟶ H) :
    postcompose (α ≫ β) ≅ postcompose α ⋙ postcompose β :=
  nat_iso.of_components
    (fun (s : cone F) => ext (iso.refl (cone.X (functor.obj (postcompose (α ≫ β)) s))) sorry) sorry

/-- Postcomposing by the identity does not change the cone up to isomorphism. -/
def postcompose_id {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C} :
    postcompose 𝟙 ≅ 𝟭 :=
  nat_iso.of_components
    (fun (s : cone F) => ext (iso.refl (cone.X (functor.obj (postcompose 𝟙) s))) sorry) sorry

/--
If `F` and `G` are naturally isomorphic functors, then they have equivalent categories of
cones.
-/
@[simp] theorem postcompose_equivalence_unit_iso {J : Type v} [small_category J] {C : Type u}
    [category C] {F : J ⥤ C} {G : J ⥤ C} (α : F ≅ G) :
    equivalence.unit_iso (postcompose_equivalence α) =
        nat_iso.of_components
          (fun (s : cone F) =>
            ext (iso.refl (cone.X (functor.obj 𝟭 s))) (postcompose_equivalence._proof_1 α s))
          (postcompose_equivalence._proof_2 α) :=
  Eq.refl (equivalence.unit_iso (postcompose_equivalence α))

/--
Whiskering on the left by `E : K ⥤ J` gives a functor from `cone F` to `cone (E ⋙ F)`.
-/
@[simp] theorem whiskering_obj {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    {K : Type v} [small_category K] (E : K ⥤ J) (c : cone F) :
    functor.obj (whiskering E) c = cone.whisker E c :=
  Eq.refl (functor.obj (whiskering E) c)

/--
Whiskering by an equivalence gives an equivalence between categories of cones.
-/
@[simp] theorem whiskering_equivalence_inverse {J : Type v} [small_category J] {C : Type u}
    [category C] {F : J ⥤ C} {K : Type v} [small_category K] (e : K ≌ J) :
    equivalence.inverse (whiskering_equivalence e) =
        whiskering (equivalence.inverse e) ⋙
          postcompose
            (iso.inv (functor.associator (equivalence.inverse e) (equivalence.functor e) F) ≫
              whisker_right (iso.hom (equivalence.counit_iso e)) F ≫
                iso.hom (functor.left_unitor F)) :=
  Eq.refl (equivalence.inverse (whiskering_equivalence e))

/--
The categories of cones over `F` and `G` are equivalent if `F` and `G` are naturally isomorphic
(possibly after changing the indexing category by an equivalence).
-/
def equivalence_of_reindexing {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    {K : Type v} [small_category K] {G : K ⥤ C} (e : K ≌ J) (α : equivalence.functor e ⋙ F ≅ G) :
    cone F ≌ cone G :=
  equivalence.trans (whiskering_equivalence e) (postcompose_equivalence α)

/-- Forget the cone structure and obtain just the cone point. -/
def forget {J : Type v} [small_category J] {C : Type u} [category C] (F : J ⥤ C) : cone F ⥤ C :=
  functor.mk (fun (t : cone F) => cone.X t) fun (s t : cone F) (f : s ⟶ t) => cone_morphism.hom f

/-- A functor `G : C ⥤ D` sends cones over `F` to cones over `F ⋙ G` functorially. -/
@[simp] theorem functoriality_obj_π_app {J : Type v} [small_category J] {C : Type u} [category C]
    (F : J ⥤ C) {D : Type u'} [category D] (G : C ⥤ D) (A : cone F) (j : J) :
    nat_trans.app (cone.π (functor.obj (functoriality F G) A)) j =
        functor.map G (nat_trans.app (cone.π A) j) :=
  Eq.refl (nat_trans.app (cone.π (functor.obj (functoriality F G) A)) j)

protected instance functoriality_full {J : Type v} [small_category J] {C : Type u} [category C]
    (F : J ⥤ C) {D : Type u'} [category D] (G : C ⥤ D) [full G] [faithful G] :
    full (functoriality F G) :=
  full.mk
    fun (X Y : cone F)
      (t : functor.obj (functoriality F G) X ⟶ functor.obj (functoriality F G) Y) =>
      cone_morphism.mk (functor.preimage G (cone_morphism.hom t))

protected instance functoriality_faithful {J : Type v} [small_category J] {C : Type u} [category C]
    (F : J ⥤ C) {D : Type u'} [category D] (G : C ⥤ D) [faithful G] :
    faithful (functoriality F G) :=
  faithful.mk

/--
If `e : C ≌ D` is an equivalence of categories, then `functoriality F e.functor` induces an
equivalence between cones over `F` and cones over `F ⋙ e.functor`.
-/
@[simp] theorem functoriality_equivalence_counit_iso {J : Type v} [small_category J] {C : Type u}
    [category C] (F : J ⥤ C) {D : Type u'} [category D] (e : C ≌ D) :
    equivalence.counit_iso (functoriality_equivalence F e) =
        nat_iso.of_components
          (fun (c : cone (F ⋙ equivalence.functor e)) =>
            ext (iso.app (equivalence.counit_iso e) (cone.X c))
              (functoriality_equivalence._proof_3 F e c))
          (functoriality_equivalence._proof_4 F e) :=
  Eq.refl (equivalence.counit_iso (functoriality_equivalence F e))

/--
If `F` reflects isomorphisms, then `cones.functoriality F` reflects isomorphisms
as well.
-/
protected instance reflects_cone_isomorphism {J : Type v} [small_category J] {C : Type u}
    [category C] {D : Type u'} [category D] (F : C ⥤ D) [reflects_isomorphisms F] (K : J ⥤ C) :
    reflects_isomorphisms (functoriality K F) :=
  reflects_isomorphisms.mk
    fun (A B : cone K) (f : A ⟶ B) (_inst_3_1 : is_iso (functor.map (functoriality K F) f)) =>
      cone_iso_of_hom_iso f

end cones

/-- A cocone morphism between two cocones for the same diagram is a morphism of the cocone points
which commutes with the cocone legs. -/
structure cocone_morphism {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (A : cocone F) (B : cocone F)
    where
  hom : cocone.X A ⟶ cocone.X B
  w' :
    autoParam (∀ (j : J), nat_trans.app (cocone.ι A) j ≫ hom = nat_trans.app (cocone.ι B) j)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

protected instance inhabited_cocone_morphism {J : Type v} [small_category J] {C : Type u}
    [category C] {F : J ⥤ C} (A : cocone F) : Inhabited (cocone_morphism A A) :=
  { default := cocone_morphism.mk 𝟙 }

@[simp] theorem cocone_morphism.w {J : Type v} [small_category J] {C : Type u} [category C]
    {F : J ⥤ C} {A : cocone F} {B : cocone F} (c : cocone_morphism A B) (j : J) :
    nat_trans.app (cocone.ι A) j ≫ cocone_morphism.hom c = nat_trans.app (cocone.ι B) j :=
  sorry

@[simp] theorem cocone_morphism.w_assoc {J : Type v} [small_category J] {C : Type u} [category C]
    {F : J ⥤ C} {A : cocone F} {B : cocone F} (c : cocone_morphism A B) (j : J) {X' : C}
    (f' : cocone.X B ⟶ X') :
    nat_trans.app (cocone.ι A) j ≫ cocone_morphism.hom c ≫ f' = nat_trans.app (cocone.ι B) j ≫ f' :=
  sorry

@[simp] theorem cocone.category_to_category_struct_id_hom {J : Type v} [small_category J]
    {C : Type u} [category C] {F : J ⥤ C} (B : cocone F) : cocone_morphism.hom 𝟙 = 𝟙 :=
  Eq.refl (cocone_morphism.hom 𝟙)

namespace cocones

/-- To give an isomorphism between cocones, it suffices to give an
  isomorphism between their vertices which commutes with the cocone
  maps. -/
@[simp] theorem ext_inv_hom {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    {c : cocone F} {c' : cocone F} (φ : cocone.X c ≅ cocone.X c')
    (w : ∀ (j : J), nat_trans.app (cocone.ι c) j ≫ iso.hom φ = nat_trans.app (cocone.ι c') j) :
    cocone_morphism.hom (iso.inv (ext φ w)) = iso.inv φ :=
  Eq.refl (cocone_morphism.hom (iso.inv (ext φ w)))

/--
Given a cocone morphism whose object part is an isomorphism, produce an
isomorphism of cocones.
-/
def cocone_iso_of_hom_iso {J : Type v} [small_category J] {C : Type u} [category C] {K : J ⥤ C}
    {c : cocone K} {d : cocone K} (f : c ⟶ d) [i : is_iso (cocone_morphism.hom f)] : is_iso f :=
  is_iso.mk (cocone_morphism.mk (inv (cocone_morphism.hom f)))

/--
Functorially precompose a cocone for `F` by a natural transformation `G ⟶ F` to give a cocone for `G`.
-/
def precompose {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C} {G : J ⥤ C}
    (α : G ⟶ F) : cocone F ⥤ cocone G :=
  functor.mk (fun (c : cocone F) => cocone.mk (cocone.X c) (α ≫ cocone.ι c))
    fun (c₁ c₂ : cocone F) (f : c₁ ⟶ c₂) => cocone_morphism.mk (cocone_morphism.hom f)

/-- Precomposing a cocone by the composite natural transformation `α ≫ β` is the same as
precomposing by `β` and then by `α`. -/
def precompose_comp {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    {G : J ⥤ C} {H : J ⥤ C} (α : F ⟶ G) (β : G ⟶ H) :
    precompose (α ≫ β) ≅ precompose β ⋙ precompose α :=
  nat_iso.of_components
    (fun (s : cocone H) => ext (iso.refl (cocone.X (functor.obj (precompose (α ≫ β)) s))) sorry)
    sorry

/-- Precomposing by the identity does not change the cocone up to isomorphism. -/
def precompose_id {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C} :
    precompose 𝟙 ≅ 𝟭 :=
  nat_iso.of_components
    (fun (s : cocone F) => ext (iso.refl (cocone.X (functor.obj (precompose 𝟙) s))) sorry) sorry

/--
If `F` and `G` are naturally isomorphic functors, then they have equivalent categories of
cocones.
-/
@[simp] theorem precompose_equivalence_functor {J : Type v} [small_category J] {C : Type u}
    [category C] {F : J ⥤ C} {G : J ⥤ C} (α : G ≅ F) :
    equivalence.functor (precompose_equivalence α) = precompose (iso.hom α) :=
  Eq.refl (equivalence.functor (precompose_equivalence α))

/--
Whiskering on the left by `E : K ⥤ J` gives a functor from `cocone F` to `cocone (E ⋙ F)`.
-/
def whiskering {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C} {K : Type v}
    [small_category K] (E : K ⥤ J) : cocone F ⥤ cocone (E ⋙ F) :=
  functor.mk (fun (c : cocone F) => cocone.whisker E c)
    fun (c c' : cocone F) (f : c ⟶ c') => cocone_morphism.mk (cocone_morphism.hom f)

/--
Whiskering by an equivalence gives an equivalence between categories of cones.
-/
def whiskering_equivalence {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    {K : Type v} [small_category K] (e : K ≌ J) : cocone F ≌ cocone (equivalence.functor e ⋙ F) :=
  equivalence.mk' (whiskering (equivalence.functor e))
    (whiskering (equivalence.inverse e) ⋙
      precompose
        (iso.inv (functor.left_unitor F) ≫
          whisker_right (iso.inv (equivalence.counit_iso e)) F ≫
            iso.inv (functor.associator (equivalence.inverse e) (equivalence.functor e) F)))
    (nat_iso.of_components (fun (s : cocone F) => ext (iso.refl (cocone.X (functor.obj 𝟭 s))) sorry)
      sorry)
    (nat_iso.of_components
      (fun (s : cocone (equivalence.functor e ⋙ F)) =>
        ext
          (iso.refl
            (cocone.X
              (functor.obj
                ((whiskering (equivalence.inverse e) ⋙
                    precompose
                      (iso.inv (functor.left_unitor F) ≫
                        whisker_right (iso.inv (equivalence.counit_iso e)) F ≫
                          iso.inv
                            (functor.associator (equivalence.inverse e) (equivalence.functor e)
                              F))) ⋙
                  whiskering (equivalence.functor e))
                s)))
          sorry)
      sorry)

/--
The categories of cocones over `F` and `G` are equivalent if `F` and `G` are naturally isomorphic
(possibly after changing the indexing category by an equivalence).
-/
@[simp] theorem equivalence_of_reindexing_functor_obj {J : Type v} [small_category J] {C : Type u}
    [category C] {F : J ⥤ C} {K : Type v} [small_category K] {G : K ⥤ C} (e : K ≌ J)
    (α : equivalence.functor e ⋙ F ≅ G) (X : cocone F) :
    functor.obj (equivalence.functor (equivalence_of_reindexing e α)) X =
        functor.obj (precompose (iso.inv α)) (cocone.whisker (equivalence.functor e) X) :=
  Eq.refl (functor.obj (precompose (iso.inv α)) (cocone.whisker (equivalence.functor e) X))

/-- Forget the cocone structure and obtain just the cocone point. -/
@[simp] theorem forget_map {J : Type v} [small_category J] {C : Type u} [category C] (F : J ⥤ C)
    (s : cocone F) (t : cocone F) (f : s ⟶ t) : functor.map (forget F) f = cocone_morphism.hom f :=
  Eq.refl (functor.map (forget F) f)

/-- A functor `G : C ⥤ D` sends cocones over `F` to cocones over `F ⋙ G` functorially. -/
@[simp] theorem functoriality_map_hom {J : Type v} [small_category J] {C : Type u} [category C]
    (F : J ⥤ C) {D : Type u'} [category D] (G : C ⥤ D) (_x : cocone F) :
    ∀ (_x_1 : cocone F) (f : _x ⟶ _x_1),
        cocone_morphism.hom (functor.map (functoriality F G) f) =
          functor.map G (cocone_morphism.hom f) :=
  fun (_x_1 : cocone F) (f : _x ⟶ _x_1) =>
    Eq.refl (cocone_morphism.hom (functor.map (functoriality F G) f))

protected instance functoriality_full {J : Type v} [small_category J] {C : Type u} [category C]
    (F : J ⥤ C) {D : Type u'} [category D] (G : C ⥤ D) [full G] [faithful G] :
    full (functoriality F G) :=
  full.mk
    fun (X Y : cocone F)
      (t : functor.obj (functoriality F G) X ⟶ functor.obj (functoriality F G) Y) =>
      cocone_morphism.mk (functor.preimage G (cocone_morphism.hom t))

protected instance functoriality_faithful {J : Type v} [small_category J] {C : Type u} [category C]
    (F : J ⥤ C) {D : Type u'} [category D] (G : C ⥤ D) [faithful G] :
    faithful (functoriality F G) :=
  faithful.mk

/--
If `e : C ≌ D` is an equivalence of categories, then `functoriality F e.functor` induces an
equivalence between cocones over `F` and cocones over `F ⋙ e.functor`.
-/
@[simp] theorem functoriality_equivalence_functor {J : Type v} [small_category J] {C : Type u}
    [category C] (F : J ⥤ C) {D : Type u'} [category D] (e : C ≌ D) :
    equivalence.functor (functoriality_equivalence F e) = functoriality F (equivalence.functor e) :=
  Eq.refl (equivalence.functor (functoriality_equivalence F e))

/--
If `F` reflects isomorphisms, then `cocones.functoriality F` reflects isomorphisms
as well.
-/
protected instance reflects_cocone_isomorphism {J : Type v} [small_category J] {C : Type u}
    [category C] {D : Type u'} [category D] (F : C ⥤ D) [reflects_isomorphisms F] (K : J ⥤ C) :
    reflects_isomorphisms (functoriality K F) :=
  reflects_isomorphisms.mk
    fun (A B : cocone K) (f : A ⟶ B) (_inst_3_1 : is_iso (functor.map (functoriality K F) f)) =>
      cocone_iso_of_hom_iso f

end cocones

end limits

namespace functor

/-- The image of a cone in C under a functor G : C ⥤ D is a cone in D. -/
/-- The image of a cocone in C under a functor G : C ⥤ D is a cocone in D. -/
@[simp] theorem map_cone_X {J : Type v} [small_category J] {C : Type u} [category C] {D : Type u'}
    [category D] {F : J ⥤ C} (H : C ⥤ D) (c : limits.cone F) :
    limits.cone.X (map_cone H c) = obj H (limits.cone.X c) :=
  Eq.refl (obj H (limits.cone.X c))

@[simp] theorem map_cocone_ι_app {J : Type v} [small_category J] {C : Type u} [category C]
    {D : Type u'} [category D] {F : J ⥤ C} (H : C ⥤ D) (c : limits.cocone F) (j : J) :
    nat_trans.app (limits.cocone.ι (map_cocone H c)) j =
        map H (nat_trans.app (limits.cocone.ι c) j) :=
  Eq.refl (map H (nat_trans.app (limits.cocone.ι c) j))

/-- Given a cone morphism `c ⟶ c'`, construct a cone morphism on the mapped cones functorially.  -/
def map_cone_morphism {J : Type v} [small_category J] {C : Type u} [category C] {D : Type u'}
    [category D] {F : J ⥤ C} (H : C ⥤ D) {c : limits.cone F} {c' : limits.cone F} (f : c ⟶ c') :
    map_cone H c ⟶ map_cone H c' :=
  map (limits.cones.functoriality F H) f

/-- Given a cocone morphism `c ⟶ c'`, construct a cocone morphism on the mapped cocones functorially.  -/
def map_cocone_morphism {J : Type v} [small_category J] {C : Type u} [category C] {D : Type u'}
    [category D] {F : J ⥤ C} (H : C ⥤ D) {c : limits.cocone F} {c' : limits.cocone F} (f : c ⟶ c') :
    map_cocone H c ⟶ map_cocone H c' :=
  map (limits.cocones.functoriality F H) f

/-- If `H` is an equivalence, we invert `H.map_cone` and get a cone for `F` from a cone
for `F ⋙ H`.-/
def map_cone_inv {J : Type v} [small_category J] {C : Type u} [category C] {D : Type u'}
    [category D] {F : J ⥤ C} (H : C ⥤ D) [is_equivalence H] (c : limits.cone (F ⋙ H)) :
    limits.cone F :=
  obj (equivalence.inverse (limits.cones.functoriality_equivalence F (as_equivalence H))) c

/-- `map_cone` is the left inverse to `map_cone_inv`. -/
def map_cone_map_cone_inv {J : Type v} [small_category J] {C : Type u} [category C] {D : Type u'}
    [category D] {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : limits.cone (F ⋙ H)) :
    map_cone H (map_cone_inv H c) ≅ c :=
  iso.app (equivalence.counit_iso (limits.cones.functoriality_equivalence F (as_equivalence H))) c

/-- `map_cone` is the right inverse to `map_cone_inv`. -/
def map_cone_inv_map_cone {J : Type v} [small_category J] {C : Type u} [category C] {D : Type u'}
    [category D] {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : limits.cone F) :
    map_cone_inv H (map_cone H c) ≅ c :=
  iso.app
    (iso.symm (equivalence.unit_iso (limits.cones.functoriality_equivalence F (as_equivalence H))))
    c

/-- If `H` is an equivalence, we invert `H.map_cone` and get a cone for `F` from a cone
for `F ⋙ H`.-/
def map_cocone_inv {J : Type v} [small_category J] {C : Type u} [category C] {D : Type u'}
    [category D] {F : J ⥤ C} (H : C ⥤ D) [is_equivalence H] (c : limits.cocone (F ⋙ H)) :
    limits.cocone F :=
  obj (equivalence.inverse (limits.cocones.functoriality_equivalence F (as_equivalence H))) c

/-- `map_cocone` is the left inverse to `map_cocone_inv`. -/
def map_cocone_map_cocone_inv {J : Type v} [small_category J] {C : Type u} [category C]
    {D : Type u'} [category D] {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H]
    (c : limits.cocone (F ⋙ H)) : map_cocone H (map_cocone_inv H c) ≅ c :=
  iso.app (equivalence.counit_iso (limits.cocones.functoriality_equivalence F (as_equivalence H))) c

/-- `map_cocone` is the right inverse to `map_cocone_inv`. -/
def map_cocone_inv_map_cocone {J : Type v} [small_category J] {C : Type u} [category C]
    {D : Type u'} [category D] {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : limits.cocone F) :
    map_cocone_inv H (map_cocone H c) ≅ c :=
  iso.app
    (iso.symm
      (equivalence.unit_iso (limits.cocones.functoriality_equivalence F (as_equivalence H))))
    c

/-- `functoriality F _ ⋙ postcompose (whisker_left F _)` simplifies to `functoriality F _`. -/
@[simp] theorem functoriality_comp_postcompose_inv_app_hom {J : Type v} [small_category J]
    {C : Type u} [category C] {D : Type u'} [category D] {F : J ⥤ C} {H : C ⥤ D} {H' : C ⥤ D}
    (α : H ≅ H') (X : limits.cone F) :
    limits.cone_morphism.hom (nat_trans.app (iso.inv (functoriality_comp_postcompose α)) X) =
        nat_trans.app (iso.inv α) (limits.cone.X X) :=
  Eq.refl (nat_trans.app (iso.inv α) (limits.cone.X X))

/--
For `F : J ⥤ C`, given a cone `c : cone F`, and a natural isomorphism `α : H ≅ H'` for functors
`H H' : C ⥤ D`, the postcomposition of the cone `H.map_cone` using the isomorphism `α` is
isomorphic to the cone `H'.map_cone`.
-/
def postcompose_whisker_left_map_cone {J : Type v} [small_category J] {C : Type u} [category C]
    {D : Type u'} [category D] {F : J ⥤ C} {H : C ⥤ D} {H' : C ⥤ D} (α : H ≅ H')
    (c : limits.cone F) :
    obj (limits.cones.postcompose (whisker_left F (iso.hom α))) (map_cone H c) ≅ map_cone H' c :=
  iso.app (functoriality_comp_postcompose α) c

/--
`map_cone` commutes with `postcompose`. In particular, for `F : J ⥤ C`, given a cone `c : cone F`, a
natural transformation `α : F ⟶ G` and a functor `H : C ⥤ D`, we have two obvious ways of producing
a cone over `G ⋙ H`, and they are both isomorphic.
-/
@[simp] theorem map_cone_postcompose_inv_hom {J : Type v} [small_category J] {C : Type u}
    [category C] {D : Type u'} [category D] {F : J ⥤ C} {G : J ⥤ C} (H : C ⥤ D) {α : F ⟶ G}
    {c : limits.cone F} : limits.cone_morphism.hom (iso.inv (map_cone_postcompose H)) = 𝟙 :=
  Eq.refl 𝟙

/--
`map_cone` commutes with `postcompose_equivalence`
-/
@[simp] theorem map_cone_postcompose_equivalence_functor_hom_hom {J : Type v} [small_category J]
    {C : Type u} [category C] {D : Type u'} [category D] {F : J ⥤ C} {G : J ⥤ C} (H : C ⥤ D)
    {α : F ≅ G} {c : limits.cone F} :
    limits.cone_morphism.hom (iso.hom (map_cone_postcompose_equivalence_functor H)) = 𝟙 :=
  Eq.refl 𝟙

/-- `functoriality F _ ⋙ precompose (whisker_left F _)` simplifies to `functoriality F _`. -/
@[simp] theorem functoriality_comp_precompose_inv_app_hom {J : Type v} [small_category J]
    {C : Type u} [category C] {D : Type u'} [category D] {F : J ⥤ C} {H : C ⥤ D} {H' : C ⥤ D}
    (α : H ≅ H') (X : limits.cocone F) :
    limits.cocone_morphism.hom (nat_trans.app (iso.inv (functoriality_comp_precompose α)) X) =
        nat_trans.app (iso.inv α) (limits.cocone.X X) :=
  Eq.refl (nat_trans.app (iso.inv α) (limits.cocone.X X))

/--
For `F : J ⥤ C`, given a cocone `c : cocone F`, and a natural isomorphism `α : H ≅ H'` for functors
`H H' : C ⥤ D`, the precomposition of the cocone `H.map_cocone` using the isomorphism `α` is
isomorphic to the cocone `H'.map_cocone`.
-/
def precompose_whisker_left_map_cocone {J : Type v} [small_category J] {C : Type u} [category C]
    {D : Type u'} [category D] {F : J ⥤ C} {H : C ⥤ D} {H' : C ⥤ D} (α : H ≅ H')
    (c : limits.cocone F) :
    obj (limits.cocones.precompose (whisker_left F (iso.inv α))) (map_cocone H c) ≅
        map_cocone H' c :=
  iso.app (functoriality_comp_precompose α) c

/--
`map_cocone` commutes with `precompose`. In particular, for `F : J ⥤ C`, given a cocone
`c : cocone F`, a natural transformation `α : F ⟶ G` and a functor `H : C ⥤ D`, we have two obvious
ways of producing a cocone over `G ⋙ H`, and they are both isomorphic.
-/
@[simp] theorem map_cocone_precompose_hom_hom {J : Type v} [small_category J] {C : Type u}
    [category C] {D : Type u'} [category D] {F : J ⥤ C} {G : J ⥤ C} (H : C ⥤ D) {α : F ⟶ G}
    {c : limits.cocone G} : limits.cocone_morphism.hom (iso.hom (map_cocone_precompose H)) = 𝟙 :=
  Eq.refl 𝟙

/--
`map_cocone` commutes with `precompose_equivalence`
-/
@[simp] theorem map_cocone_precompose_equivalence_functor_inv_hom {J : Type v} [small_category J]
    {C : Type u} [category C] {D : Type u'} [category D] {F : J ⥤ C} {G : J ⥤ C} (H : C ⥤ D)
    {α : F ≅ G} {c : limits.cocone G} :
    limits.cocone_morphism.hom (iso.inv (map_cocone_precompose_equivalence_functor H)) = 𝟙 :=
  Eq.refl 𝟙

/--
`map_cone` commutes with `whisker`
-/
@[simp] theorem map_cone_whisker_inv_hom {J : Type v} [small_category J] {C : Type u} [category C]
    {D : Type u'} [category D] {F : J ⥤ C} (H : C ⥤ D) {K : Type v} [small_category K] {E : K ⥤ J}
    {c : limits.cone F} : limits.cone_morphism.hom (iso.inv (map_cone_whisker H)) = 𝟙 :=
  Eq.refl 𝟙

/--
`map_cocone` commutes with `whisker`
-/
@[simp] theorem map_cocone_whisker_inv_hom {J : Type v} [small_category J] {C : Type u} [category C]
    {D : Type u'} [category D] {F : J ⥤ C} (H : C ⥤ D) {K : Type v} [small_category K] {E : K ⥤ J}
    {c : limits.cocone F} : limits.cocone_morphism.hom (iso.inv (map_cocone_whisker H)) = 𝟙 :=
  Eq.refl 𝟙

end functor

end category_theory

namespace category_theory.limits

/-- Change a `cocone F` into a `cone F.op`. -/
@[simp] theorem cocone.op_X {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cocone F) : cone.X (cocone.op c) = opposite.op (cocone.X c) :=
  Eq.refl (cone.X (cocone.op c))

/-- Change a `cone F` into a `cocone F.op`. -/
def cone.op {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C} (c : cone F) :
    cocone (functor.op F) :=
  cocone.mk (opposite.op (cone.X c))
    (nat_trans.mk fun (j : Jᵒᵖ) => has_hom.hom.op (nat_trans.app (cone.π c) (opposite.unop j)))

/-- Change a `cocone F.op` into a `cone F`. -/
def cocone.unop {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cocone (functor.op F)) : cone F :=
  cone.mk (opposite.unop (cocone.X c))
    (nat_trans.mk fun (j : J) => has_hom.hom.unop (nat_trans.app (cocone.ι c) (opposite.op j)))

/-- Change a `cone F.op` into a `cocone F`. -/
@[simp] theorem cone.unop_X {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    (c : cone (functor.op F)) : cocone.X (cone.unop c) = opposite.unop (cone.X c) :=
  Eq.refl (cocone.X (cone.unop c))

/--
The category of cocones on `F`
is equivalent to the opposite category of
the category of cones on the opposite of `F`.
-/
@[simp] theorem cocone_equivalence_op_cone_op_unit_iso {J : Type v} [small_category J] {C : Type u}
    [category C] (F : J ⥤ C) :
    equivalence.unit_iso (cocone_equivalence_op_cone_op F) =
        nat_iso.of_components
          (fun (c : cocone F) =>
            cocones.ext (iso.refl (cocone.X (functor.obj 𝟭 c)))
              (cocone_equivalence_op_cone_op._proof_7 F c))
          (cocone_equivalence_op_cone_op._proof_8 F) :=
  Eq.refl (equivalence.unit_iso (cocone_equivalence_op_cone_op F))

/-- Change a cocone on `F.left_op : Jᵒᵖ ⥤ C` to a cocone on `F : J ⥤ Cᵒᵖ`. -/
-- Here and below we only automatically generate the `@[simp]` lemma for the `X` field,

-- as we can write a simpler `rfl` lemma for the components of the natural transformation by hand.

def cone_of_cocone_left_op {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ (Cᵒᵖ)}
    (c : cocone (functor.left_op F)) : cone F :=
  cone.mk (opposite.op (cocone.X c))
    (nat_trans.remove_left_op
      (cocone.ι c ≫ iso.hom (functor.const.op_obj_unop (opposite.op (cocone.X c)))))

/-- Change a cone on `F : J ⥤ Cᵒᵖ` to a cocone on `F.left_op : Jᵒᵖ ⥤ C`. -/
def cocone_left_op_of_cone {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ (Cᵒᵖ)}
    (c : cone F) : cocone (functor.left_op F) :=
  cocone.mk (opposite.unop (cone.X c)) (nat_trans.left_op (cone.π c))

/-- Change a cone on `F.left_op : Jᵒᵖ ⥤ C` to a cocone on `F : J ⥤ Cᵒᵖ`. -/
/- When trying use `@[simps]` to generate the `ι_app` field of this definition, `@[simps]` tries to
  reduce the RHS using `expr.dsimp` and `expr.simp`, but for some reason the expression is not
  being simplified properly. -/

def cocone_of_cone_left_op {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ (Cᵒᵖ)}
    (c : cone (functor.left_op F)) : cocone F :=
  cocone.mk (opposite.op (cone.X c))
    (nat_trans.remove_left_op
      (iso.hom (functor.const.op_obj_unop (opposite.op (cone.X c))) ≫ cone.π c))

@[simp] theorem cocone_of_cone_left_op_ι_app {J : Type v} [small_category J] {C : Type u}
    [category C] {F : J ⥤ (Cᵒᵖ)} (c : cone (functor.left_op F)) (j : J) :
    nat_trans.app (cocone.ι (cocone_of_cone_left_op c)) j =
        has_hom.hom.op (nat_trans.app (cone.π c) (opposite.op j)) :=
  sorry

/-- Change a cocone on `F : J ⥤ Cᵒᵖ` to a cone on `F.left_op : Jᵒᵖ ⥤ C`. -/
def cone_left_op_of_cocone {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ (Cᵒᵖ)}
    (c : cocone F) : cone (functor.left_op F) :=
  cone.mk (opposite.unop (cocone.X c)) (nat_trans.left_op (cocone.ι c))

end category_theory.limits

namespace category_theory.functor

/-- The opposite cocone of the image of a cone is the image of the opposite cocone. -/
def map_cone_op {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C} {D : Type u'}
    [category D] (G : C ⥤ D) (t : limits.cone F) :
    limits.cone.op (map_cone G t) ≅ map_cocone (functor.op G) (limits.cone.op t) :=
  limits.cocones.ext (iso.refl (limits.cocone.X (limits.cone.op (map_cone G t)))) sorry

/-- The opposite cone of the image of a cocone is the image of the opposite cone. -/
def map_cocone_op {J : Type v} [small_category J] {C : Type u} [category C] {F : J ⥤ C}
    {D : Type u'} [category D] (G : C ⥤ D) {t : limits.cocone F} :
    limits.cocone.op (map_cocone G t) ≅ map_cone (functor.op G) (limits.cocone.op t) :=
  limits.cones.ext (iso.refl (limits.cone.X (limits.cocone.op (map_cocone G t)))) sorry

end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.Mon_

/-!
# The category of module objects over a monoid object.
-/

universes v₁ v₂ u₁ u₂

open category_theory
open category_theory.monoidal_category

variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C]

variables {C}

/-- A module object for a monoid object, all internal to some monoidal category. -/
structure Mod (A : Mon_ C) :=
(X : C)
(act : A.X ⊗ X ⟶ X)
(one_act' : (A.one ⊗ 𝟙 X) ≫ act = (λ_ X).hom . obviously)
(assoc' : (A.mul ⊗ 𝟙 X) ≫ act = (α_ A.X A.X X).hom ≫ (𝟙 A.X ⊗ act) ≫ act . obviously)

restate_axiom Mod.one_act'
restate_axiom Mod.assoc'
attribute [simp, reassoc] Mod.one_act Mod.assoc

namespace Mod

variables {A : Mon_ C} (M : Mod A)

lemma assoc_flip : (𝟙 A.X ⊗ M.act) ≫ M.act = (α_ A.X A.X M.X).inv ≫ (A.mul ⊗ 𝟙 M.X) ≫ M.act :=
by simp

/-- A morphism of module objects. -/
@[ext]
structure hom (M N : Mod A) :=
(hom : M.X ⟶ N.X)
(act_hom' : M.act ≫ hom = (𝟙 A.X ⊗ hom) ≫ N.act . obviously)

restate_axiom hom.act_hom'
attribute [simp, reassoc] hom.act_hom

/-- The identity morphism on a module object. -/
@[simps]
def id (M : Mod A) : hom M M :=
{ hom := 𝟙 M.X, }

instance hom_inhabited (M : Mod A) : inhabited (hom M M) := ⟨id M⟩

/-- Composition of module object morphisms. -/
@[simps]
def comp {M N O : Mod A} (f : hom M N) (g : hom N O) : hom M O :=
{ hom := f.hom ≫ g.hom, }

instance : category (Mod A) :=
{ hom := λ M N, hom M N,
  id := id,
  comp := λ M N O f g, comp f g, }

@[simp] lemma id_hom' (M : Mod A) : (𝟙 M : hom M M).hom = 𝟙 M.X := rfl
@[simp] lemma comp_hom' {M N K : Mod A} (f : M ⟶ N) (g : N ⟶ K) :
  (f ≫ g : hom M K).hom = f.hom ≫ g.hom := rfl

variables (A)

/-- A monoid object as a module over itself. -/
@[simps]
def regular : Mod A :=
{ X := A.X,
  act := A.mul, }

instance : inhabited (Mod A) := ⟨regular A⟩

/-- The forgetful functor from module objects to the ambient category. -/
def forget : Mod A ⥤ C :=
{ obj := λ A, A.X,
  map := λ A B f, f.hom, }

open category_theory.monoidal_category

/--
A morphism of monoid objects induces a "restriction" or "comap" functor
between the categories of module objects.
-/
@[simps]
def comap {A B : Mon_ C} (f : A ⟶ B) : Mod B ⥤ Mod A :=
{ obj := λ M,
  { X := M.X,
    act := (f.hom ⊗ 𝟙 M.X) ≫ M.act,
    one_act' :=
    begin
      slice_lhs 1 2 { rw [←comp_tensor_id], },
      rw [f.one_hom, one_act],
    end,
    assoc' :=
    begin
      -- oh, for homotopy.io in a widget!
      slice_rhs 2 3 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor], },
      rw id_tensor_comp,
      slice_rhs 4 5 { rw Mod.assoc_flip, },
      slice_rhs 3 4 { rw associator_inv_naturality, },
      slice_rhs 2 3 { rw [←tensor_id, associator_inv_naturality], },
      slice_rhs 1 3 { rw [iso.hom_inv_id_assoc], },
      slice_rhs 1 2 { rw [←comp_tensor_id, tensor_id_comp_id_tensor], },
      slice_rhs 1 2 { rw [←comp_tensor_id, ←f.mul_hom], },
      rw [comp_tensor_id, category.assoc],
    end, },
  map := λ M N g,
  { hom := g.hom,
    act_hom' :=
    begin
      dsimp,
      slice_rhs 1 2 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor], },
      slice_rhs 2 3 { rw ←g.act_hom, },
      rw category.assoc,
    end }, }

-- Lots more could be said about `comap`, e.g. how it interacts with
-- identities, compositions, and equalities of monoid object morphisms.

end Mod