The maybe monad

module Monad.Instance.Maybe.Strong {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)
  open import Monad.Instance.Maybe distributive

  open StrongMonad using (M; strength)
  open Strength renaming (identityˡ to s-identityˡ)

  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₂ ∘ !                                                                                                                      ∎