module Monad.Instance.Maybe.Strong {o ℓ e} {C : Category o ℓ e} (distributive : Distributive C) where open Category C open M C using (IsIso) open MR C open MP C using (Iso⇒Epi) open HomReasoning open Equiv open Distributive distributive open import Categories.Category.Distributive.Properties distributive open Cocartesian cocartesian open Cartesian cartesian using (terminal; products) open BinaryProducts products renaming (unique to ⟨⟩-unique) open Terminal terminal open CartesianMonoidal cartesian using (monoidal) open import Monad.Instance.Maybe distributive open StrongMonad using (M; strength) open Strength renaming (identityˡ to s-identityˡ)
The proofs are done by (somewhat) straightforward rewriting:
maybeStrong : StrongMonad monoidal maybeStrong .M = maybeMonad maybeStrong .strength .strengthen = ntHelper (record { η = λ X → (id +₁ !) ∘ distributeˡ⁻¹ ; commute = λ {X} {Y} (f , g) → begin ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (f ⁂ (g +₁ id)) ≈⟨ pullʳ (sym (distributeˡ⁻¹-natural f g id)) ⟩ (id +₁ !) ∘ (f ⁂ g +₁ f ⁂ id) ∘ distributeˡ⁻¹ ≈⟨ pullˡ (+₁∘+₁ ○ +₁-cong₂ identityˡ (sym (!-unique (! ∘ (f ⁂ id))))) ⟩ (f ⁂ g +₁ !) ∘ distributeˡ⁻¹ ≈˘⟨ pullˡ (+₁∘+₁ ○ +₁-cong₂ identityʳ identityˡ) ⟩ (f ⁂ g +₁ id) ∘ (id +₁ !) ∘ distributeˡ⁻¹ ∎ }) maybeStrong .strength .s-identityˡ = begin (π₂ +₁ id) ∘ (id +₁ !) ∘ distributeˡ⁻¹ ≈⟨ pullˡ (+₁∘+₁ ○ +₁-cong₂ identityʳ (identityˡ ○ !-unique π₂)) ⟩ (π₂ +₁ π₂) ∘ distributeˡ⁻¹ ≈⟨ distributeˡ⁻¹-π₂ ⟩ π₂ ∎ maybeStrong .strength .η-comm = begin ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ i₁) ≈⟨ pullʳ distributeˡ⁻¹-i₁ ⟩ (id +₁ !) ∘ i₁ ≈⟨ inject₁ ○ identityʳ ⟩ i₁ ∎ maybeStrong .strength .μ-η-comm = begin [ id , i₂ ] ∘ (((id +₁ !) ∘ distributeˡ⁻¹) +₁ id) ∘ (id +₁ !) ∘ distributeˡ⁻¹ ≈⟨ pullˡ ([]∘+₁ ○ []-cong₂ identityˡ identityʳ) ○ pullˡ ([]∘+₁ ○ []-cong₂ identityʳ refl) ⟩ [ (id +₁ !) ∘ distributeˡ⁻¹ , i₂ ∘ ! ] ∘ distributeˡ⁻¹ ≈⟨ Iso⇒Epi (IsIso.iso isIsoˡ) ([ (id +₁ !) ∘ distributeˡ⁻¹ , i₂ ∘ ! ] ∘ distributeˡ⁻¹) (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ [ id , i₂ ])) (begin ([ (id +₁ !) ∘ distributeˡ⁻¹ , i₂ ∘ ! ] ∘ distributeˡ⁻¹) ∘ distributeˡ ≈⟨ cancelʳ (IsIso.isoˡ isIsoˡ) ⟩ [ (id +₁ !) ∘ distributeˡ⁻¹ , i₂ ∘ ! ] ≈˘⟨ []-cong₂ refl inject₂ ⟩ [ (id +₁ !) ∘ distributeˡ⁻¹ , (id +₁ !) ∘ i₂ ] ≈˘⟨ []-cong₂ refl (pullʳ distributeˡ⁻¹-i₂) ⟩ [ (id +₁ !) ∘ distributeˡ⁻¹ , ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ i₂) ] ≈˘⟨ []-cong₂ (cancelʳ (⁂∘⁂ ○ ⁂-cong₂ identity² inject₁ ○ ⟨⟩-unique id-comm id-comm)) (pullʳ (⁂∘⁂ ○ ⁂-cong₂ identity² inject₂)) ⟩ [ (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ [ id , i₂ ])) ∘ (id ⁂ i₁) , (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ [ id , i₂ ])) ∘ (id ⁂ i₂) ] ≈˘⟨ ∘[] ⟩ (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ [ id , i₂ ])) ∘ distributeˡ ∎) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ [ id , i₂ ]) ∎ maybeStrong .strength .strength-assoc = Iso⇒Epi (IsIso.iso isIsoˡ) _ _ (begin ((⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ +₁ id) ∘ (id +₁ !) ∘ distributeˡ⁻¹) ∘ distributeˡ ≈⟨ pullʳ (cancelʳ (IsIso.isoˡ isIsoˡ)) ⟩ (⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ +₁ id) ∘ (id +₁ !) ≈⟨ +₁∘+₁ ○ +₁-cong₂ identityʳ identityˡ ⟩ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ +₁ ! ≈⟨ []-cong₂ (sym lhs) (sym rhs) ⟩ [ (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ (π₁ ∘ π₁) ∘ (id ⁂ i₁) , ⟨ π₂ ∘ π₁ , π₂ ⟩ ∘ (id ⁂ i₁) ⟩) , (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ (π₁ ∘ π₁) ∘ (id ⁂ i₂) , ⟨ π₂ ∘ π₁ , π₂ ⟩ ∘ (id ⁂ i₂) ⟩) ] ≈˘⟨ []-cong₂ (pullʳ (pullʳ ⟨⟩∘)) (pullʳ (pullʳ ⟨⟩∘)) ⟩ [ (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩) ∘ (id ⁂ i₁) , (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩) ∘ (id ⁂ i₂) ] ≈˘⟨ ∘[] ⟩ (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩) ∘ distributeˡ ∎) where lhs : ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ (π₁ ∘ π₁) ∘ (id ⁂ i₁) , ⟨ π₂ ∘ π₁ , π₂ ⟩ ∘ (id ⁂ i₁) ⟩ ≈ i₁ ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ lhs = begin ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ (π₁ ∘ π₁) ∘ (id ⁂ i₁) , ⟨ π₂ ∘ π₁ , π₂ ⟩ ∘ (id ⁂ i₁) ⟩ ≈⟨ refl⟩∘⟨ refl⟩∘⟨ ⟨⟩-cong₂ (pullʳ (project₁ ○ identityˡ)) (⟨⟩∘ ○ ⟨⟩-cong₂ (pullʳ (project₁ ○ identityˡ)) project₂) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , i₁ ∘ π₂ ⟩ ⟩ ≈⟨ refl⟩∘⟨ (⁂∘⟨⟩ ○ ⟨⟩-cong₂ identityˡ refl) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₂ ∘ π₁ , i₁ ∘ π₂ ⟩ ⟩ ≈˘⟨ refl⟩∘⟨ (⟨⟩-cong₂ refl (refl⟩∘⟨ (⁂∘⟨⟩ ○ ⟨⟩-cong₂ identityˡ refl))) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ i₁) ∘ ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ≈⟨ refl⟩∘⟨ (⟨⟩-cong₂ refl (pullˡ (pullʳ distributeˡ⁻¹-i₁))) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ((id +₁ !) ∘ i₁) ∘ ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ≈⟨ refl⟩∘⟨ (⟨⟩-cong₂ refl ((inject₁ ○ identityʳ) ⟩∘⟨refl)) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , i₁ ∘ ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ≈˘⟨ refl⟩∘⟨ (⁂∘⟨⟩ ○ ⟨⟩-cong₂ identityˡ refl) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ i₁) ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ≈⟨ pullˡ (pullʳ distributeˡ⁻¹-i₁) ⟩ ((id +₁ !) ∘ i₁) ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ≈⟨ (inject₁ ○ identityʳ) ⟩∘⟨refl ⟩ i₁ ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ∎ rhs : (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ (π₁ ∘ π₁) ∘ (id ⁂ i₂) , ⟨ π₂ ∘ π₁ , π₂ ⟩ ∘ (id ⁂ i₂) ⟩) ≈ i₂ ∘ ! rhs = begin (((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ (π₁ ∘ π₁) ∘ (id ⁂ i₂) , ⟨ π₂ ∘ π₁ , π₂ ⟩ ∘ (id ⁂ i₂) ⟩) ≈⟨ refl⟩∘⟨ refl⟩∘⟨ ⟨⟩-cong₂ (pullʳ (project₁ ○ identityˡ)) (⟨⟩∘ ○ ⟨⟩-cong₂ (pullʳ (project₁ ○ identityˡ)) project₂) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ (id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ⟨ π₂ ∘ π₁ , i₂ ∘ π₂ ⟩ ⟩ ≈⟨ refl⟩∘⟨ (⁂∘⟨⟩ ○ ⟨⟩-cong₂ identityˡ refl) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₂ ∘ π₁ , i₂ ∘ π₂ ⟩ ⟩ ≈˘⟨ refl⟩∘⟨ (⟨⟩-cong₂ refl (refl⟩∘⟨ (⁂∘⟨⟩ ○ ⟨⟩-cong₂ identityˡ refl))) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ i₂) ∘ ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ≈⟨ refl⟩∘⟨ (⟨⟩-cong₂ refl (pullˡ (pullʳ distributeˡ⁻¹-i₂))) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , ((id +₁ !) ∘ i₂) ∘ ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ≈⟨ refl⟩∘⟨ (⟨⟩-cong₂ refl (inject₂ ⟩∘⟨refl)) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , (i₂ ∘ !) ∘ ⟨ π₂ ∘ π₁ , π₂ ⟩ ⟩ ≈⟨ refl⟩∘⟨ (⟨⟩-cong₂ refl (pullʳ (sym (!-unique (! ∘ ⟨ π₂ ∘ π₁ , π₂ ⟩))))) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ π₁ ∘ π₁ , i₂ ∘ ! ⟩ ≈˘⟨ refl⟩∘⟨ (⁂∘⟨⟩ ○ ⟨⟩-cong₂ identityˡ refl) ⟩ ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ i₂) ∘ ⟨ π₁ ∘ π₁ , ! ⟩ ≈⟨ pullˡ (pullʳ distributeˡ⁻¹-i₂) ⟩ ((id +₁ !) ∘ i₂) ∘ ⟨ π₁ ∘ π₁ , ! ⟩ ≈⟨ inject₂ ⟩∘⟨refl ⟩ (i₂ ∘ !) ∘ ⟨ π₁ ∘ π₁ , ! ⟩ ≈⟨ pullʳ (sym (!-unique (! ∘ ⟨ π₁ ∘ π₁ , ! ⟩))) ⟩ i₂ ∘ ! ∎