bsc-leon-vatthauer/agda/bsc-thesis/Monad.Instance.Maybe.EquationalLifting.md

The maybe monad

module Monad.Instance.Maybe.EquationalLifting {o ℓ e} {C : Category o ℓ e} (distributive : Distributive C) where
  open Category C
  open M C
  open MR C
  open MP C
  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)

  equationalLifting : ∀ {X} → ((id +₁ !) ∘ distributeˡ⁻¹) ∘ Δ {X + ⊤} ≈ ⟨ i₁ , id ⟩ +₁ id
  equationalLifting = sym (+-unique inj₁ inj₂)
    where
    inj₁ : (((id +₁ !) ∘ distributeˡ⁻¹) ∘ Δ) ∘ i₁ ≈ i₁ ∘ ⟨ i₁ , id ⟩
    inj₁ = begin 
      (((id +₁ !) ∘ distributeˡ⁻¹) ∘ Δ) ∘ i₁                ≈⟨ pullʳ Δ∘ ⟩ 
      ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ i₁ , i₁ ⟩             ≈˘⟨ refl⟩∘⟨ (⁂∘⟨⟩ ○ ⟨⟩-cong₂ identityˡ identityʳ) ⟩ 
      ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ i₁) ∘ ⟨ i₁ , id ⟩ ≈⟨ pullʳ (pullˡ distributeˡ⁻¹-i₁) ⟩ 
      (id +₁ !) ∘ i₁ ∘ ⟨ i₁ , id ⟩                          ≈⟨ pullˡ (inject₁ ○ identityʳ) ⟩ 
      i₁ ∘ ⟨ i₁ , id ⟩                                      ∎
    inj₂ : (((id +₁ !) ∘ distributeˡ⁻¹) ∘ Δ) ∘ i₂ ≈ i₂ ∘ id
    inj₂ = begin 
      (((id +₁ !) ∘ distributeˡ⁻¹) ∘ Δ) ∘ i₂                ≈⟨ pullʳ Δ∘ ⟩ 
      ((id +₁ !) ∘ distributeˡ⁻¹) ∘ ⟨ i₂ , i₂ ⟩             ≈˘⟨ refl⟩∘⟨ (⁂∘⟨⟩ ○ ⟨⟩-cong₂ identityˡ identityʳ) ⟩ 
      ((id +₁ !) ∘ distributeˡ⁻¹) ∘ (id ⁂ i₂) ∘ ⟨ i₂ , id ⟩ ≈⟨ pullʳ (pullˡ distributeˡ⁻¹-i₂) ⟩ 
      (id +₁ !) ∘ i₂ ∘ ⟨ i₂ , id ⟩                          ≈⟨ pullˡ inject₂ ⟩ 
      (i₂ ∘ !) ∘ ⟨ i₂ , id ⟩                                ≈⟨ pullʳ (sym (!-unique (! ∘ ⟨ i₂ , id ⟩))) ⟩ 
      i₂ ∘ !                                                ≈⟨ refl⟩∘⟨ (!-unique id) ⟩ 
      i₂ ∘ id                                               ∎