{-# OPTIONS --without-K #-}
open import HoTT.Base
open import HoTT.Identity
open import HoTT.Equivalence
open import HoTT.Equivalence.Sigma
open import HoTT.Identity.Sigma
open import HoTT.Identity.Pi
open import HoTT.Transport.Identity
open import HoTT.HLevel
open import HoTT.Exercises.Chapter2.Exercise11 using (module Square ; pullback)

module HoTT.Exercises.Chapter2.Exercise12
  {i} {A B C D E F : 𝒰 i}
  {ac : A → C} {ab : A → B} {cd : C → D} {bd : B → D}
  {ce : C → E} {ef : E → F}              {df : D → F} where

module Squareₗ = Square ac ab cd bd
module Squareᵣ = Square ce cd ef df
module Squareₒ = Square (ce ∘ ac) ab ef (df ∘ bd)

module _ {commₗ : Squareₗ.IsCommutative} {commᵣ : Squareᵣ.IsCommutative}
         {pullbackᵣ : Squareᵣ.IsPullback commᵣ {i}}
  where
  commₒ : Squareₒ.IsCommutative
  commₒ = commᵣ ∘ ac ∙ₕ ap df ∘ commₗ

  open Squareₗ.Commutative commₗ using () renaming (inducedMap to fₗ)
  open Squareᵣ.Commutative commᵣ using () renaming (inducedMap to fᵣ)
  open Squareₒ.Commutative commₒ using () renaming (inducedMap to fₒ)

  -- Solution based on https://pcapriotti.github.io/hott-exercises/chapter2.ex12.core.html
  equiv : (X : 𝒰 i) →
          pullback (X → C) (X → B) (cd ∘_) (bd ∘_) ≃
          pullback (X → E) (X → B) (ef ∘_) ((df ∘ bd) ∘_)
  equiv X =
    -- Use pullbackᵣ to expand X → C to pullback (X → E) (X → D) (ef ∘_) (df ∘_)
    pullback (X → C) (X → B) (cd ∘_) (bd ∘_)
      ≃⟨ Σ-equiv₁ (fᵣ , pullbackᵣ X) ⟩
    -- Reassociate pairs
    Σ[ (_ , xd , _) ∶ pullback (X → E) (X → D) (ef ∘_) (df ∘_) ] Σ[ xb ∶ (X → B) ] (xd == bd ∘ xb)
      ≃⟨ (λ{((xe , xd , pᵣ) , xb , pₗ) → xe , xb , xd , pₗ , pᵣ}) , qinv→isequiv
       ( (λ{(xe , xb , xd , pₗ , pᵣ) → (xe , xd , pᵣ) , xb , pₗ})
       , (λ{((xe , xd , pᵣ) , xb , refl) → refl})
       , (λ{(xe , xb , xd , pₗ , pᵣ) → refl}) ) ⟩
    Σ[ xe ∶ (X → E) ] Σ[ xb ∶ (X → B) ] Σ[ xd ∶ (X → D) ] (xd == bd ∘ xb) × (ef ∘ xe == df ∘ xd)
      ≃⟨ Σ-equiv₂ (λ xe → Σ-equiv₂ λ xb →
        -- Use pₗ to rewrite ef ∘ xe == df ∘ xd as df ∘ bd ∘ xb,
        -- removing the dependency on xd
        Σ[ xd ∶ (X → D) ] (xd == bd ∘ xb) × (ef ∘ xe == df ∘ xd)
          ≃⟨ Σ-equiv₂ (λ xd → Σ-equiv₂ (idtoeqv ∘ ap (λ xf → ef ∘ xe == df ∘ xf))) ⟩
        -- Associate pₗ with xd
        Σ[ xd ∶ (X → D) ] (xd == bd ∘ xb) × (ef ∘ xe == df ∘ bd ∘ xb)
          ≃⟨ Σ-assoc ⟩
        -- Use Lemmas 3.11.8 and 3.11.9 (ii) to contract xd to bd ∘ xb
        (Σ[ xd ∶ (X → D) ] (xd == bd ∘ xb)) × (ef ∘ xe == df ∘ bd ∘ xb)
          ≃⟨ Σ-contr₁ ⦃ =-contrᵣ (bd ∘ xb) ⦄ ⟩
        ef ∘ xe == df ∘ bd ∘ xb
          ∎) ⟩
    pullback (X → E) (X → B) (ef ∘_) ((df ∘ bd) ∘_)
      ∎
    where
    open ≃-Reasoning

  -- Proves that we compose the above equivalence with fₗ, we get out fₒ
  equiv-fₗ→fₒ : {X : 𝒰 i} (xa : X → A) → pr₁ (equiv X) (fₗ xa) == fₒ xa
  equiv-fₗ→fₒ {X = X} xa = pair⁼ (refl , pair⁼ (refl , p))
    where
    xe = ce ∘ ac ∘ xa
    q : (cd ∘ ac ∘ xa , _) == (bd ∘ ab ∘ xa , _)
    q = pair⁼ (funext (commₗ ∘ xa) ⁻¹ , _) ⁻¹
    p : pr₂ (pr₂ (pr₁ (equiv X) (fₗ xa))) == funext (commᵣ ∘ ac ∘ xa ∙ₕ ap df ∘ commₗ ∘ xa)
    p =
      -- Simplify the constant transport
      transport _ q _
        =⟨ transportconst q  _ ⟩
      -- Move the ap function into the transport
      transport id (ap (λ xd → ef ∘ xe == df ∘ xd) (funext (commₗ ∘ xa))) (funext (commᵣ ∘ ac ∘ xa))
        =⟨ transport-ap id (λ xd → ef ∘ xe == df ∘ xd) (funext (commₗ ∘ xa)) (funext (commᵣ ∘ ac ∘ xa)) ⟩
      -- Apply Theorem 2.11.3 to eliminate the transport
      transport (λ xf → ef ∘ xe == df ∘ xf) (funext (commₗ ∘ xa)) (funext (commᵣ ∘ ac ∘ xa))
        =⟨ transport=-constₗ (ef ∘ xe) (df ∘_) (funext (commₗ ∘ xa)) (funext (commᵣ ∘ ac ∘ xa)) ⟩
      -- Combine the ap df into the funext on the right
      funext (commᵣ ∘ ac ∘ xa) ∙ ap (df ∘_) (funext (commₗ ∘ xa))
        =⟨ _ ∙ₗ funext-ap df (commₗ ∘ xa) ⁻¹ ⟩
      -- Combine the two funext
      funext (commᵣ ∘ ac ∘ xa) ∙ funext (ap df ∘ commₗ ∘ xa)
        =⟨ funext-∙ₕ (commᵣ ∘ ac ∘ xa) (ap df ∘ commₗ ∘ xa) ⁻¹ ⟩
      funext (commᵣ ∘ ac ∘ xa ∙ₕ ap df ∘ commₗ ∘ xa)
        ∎
      where open =-Reasoning

  prop₁ : Squareₗ.IsPullback commₗ → Squareₒ.IsPullback commₒ
  prop₁ pullbackₗ X = transport isequiv (funext equiv-fₗ→fₒ) (pr₂ ((fₗ , pullbackₗ X) ∙ₑ equiv X))

  equiv-fₒ→fₗ : {X : 𝒰 i} (xa : X → A) → pr₁ (equiv X ⁻¹ₑ) (fₒ xa) == fₗ xa
  equiv-fₒ→fₗ {X = X} xa = ap g (equiv-fₗ→fₒ xa ⁻¹) ∙ η (fₗ xa)
    where
    open qinv (isequiv→qinv (pr₂ (equiv X)))

  prop₂ : Squareₒ.IsPullback commₒ {i} → Squareₗ.IsPullback commₗ {i}
  prop₂ pullbackₒ X = transport isequiv (funext equiv-fₒ→fₗ) (pr₂ ((fₒ , pullbackₒ X) ∙ₑ equiv X ⁻¹ₑ))

  -- I tried quite hard to come up with the equivalences directly,
  -- but was only able to find one of the four necessary homotopies.
  -- The other three quickly spiraled out of control.

  =pullback-intro : {A B C : 𝒰 i} {ac : A → C} {bc : B → C}
                    {x@(a₁ , b₁ , p) y@(a₂ , b₂ , q) : pullback A B ac bc} →
                    Σ[ p₁ ∶ a₁ == a₂ ] Σ[ p₂ ∶ b₁ == b₂ ] (p ∙ ap bc p₂ == ap ac p₁ ∙ q) → x == y
  =pullback-intro {x = _ , _ , _} {y = _ , _ , _} (refl , refl , p) rewrite unitᵣ ∙ p ∙ unitₗ ⁻¹ = refl

  =pullback-elim : {A B C : 𝒰 i} {ac : A → C} {bc : B → C}
                   {x@(a₁ , b₁ , p) y@(a₂ , b₂ , q) : pullback A B ac bc} →
                   x == y → Σ[ p₁ ∶ a₁ == a₂ ] Σ[ p₂ ∶ b₁ == b₂ ] (p ∙ ap bc p₂ == ap ac p₁ ∙ q)
  =pullback-elim {x = _ , _ , _} {y = _ , _ , _} refl = refl , refl , unitᵣ ⁻¹ ∙ unitₗ

  prop₁' : Squareₗ.IsPullback commₗ → Squareₒ.IsPullback commₒ
  prop₁' pullbackₗ X with isequiv→qinv (pullbackᵣ X) | isequiv→qinv (pullbackₗ X)
  ... | (gᵣ , ηᵣ , εᵣ) | (gₗ , ηₗ , εₗ) = qinv→isequiv (gₒ , ηₒ , εₒ)
    where
    gₒ : pullback (X → E) (X → B) (ef ∘_) ((df ∘ bd) ∘_) → (X → A)
    gₒ (xe , xb , p) = gₗ (gᵣ xc' , xb , ap (pr₁ ∘ pr₂) (εᵣ xc'))
      where
      xc' = (xe , bd ∘ xb , p)

    ηₒ : gₒ ∘ fₒ ~ id
    ηₒ xa = ap gₗ (=pullback-intro (p-xc , refl , p-pₗ)) ∙ ηₗ xa
      where
      pᵣ = funext (commᵣ ∘ ac ∘ xa ∙ₕ ap df ∘ commₗ ∘ xa)
      xc' = ce ∘ ac ∘ xa , bd ∘ ab ∘ xa , pᵣ
      p-xd = funext (commₗ ∘ xa) ⁻¹
      p-pᵣ : pᵣ ∙ ap (df ∘_) p-xd == refl ∙ funext (commᵣ ∘ ac ∘ xa)
      p-pᵣ =
        pᵣ ∙ ap (df ∘_) p-xd                  =⟨ _ ∙ₗ ap-inv (df ∘_) (funext (commₗ ∘ xa)) ⟩
        _ ∙ p ⁻¹                              =⟨ funext-∙ₕ (commᵣ ∘ ac ∘ xa) (ap df ∘ commₗ ∘ xa) ∙ᵣ _  ⟩
        _ ∙ funext (ap df ∘ commₗ ∘ xa) ∙ _   =⟨ _ ∙ₗ funext-ap df (commₗ ∘ xa) ∙ᵣ _ ⟩
        funext (commᵣ ∘ ac ∘ xa) ∙ p ∙ p ⁻¹   =⟨ assoc ⁻¹ ⟩
        funext (commᵣ ∘ ac ∘ xa) ∙ (p ∙ p ⁻¹) =⟨ _ ∙ₗ invᵣ ⟩
        funext (commᵣ ∘ ac ∘ xa) ∙ refl       =⟨ unitᵣ ⁻¹ ⟩
        funext (commᵣ ∘ ac ∘ xa)              =⟨ unitₗ ⟩
        refl ∙ funext (commᵣ ∘ ac ∘ xa)       ∎
        where
        open =-Reasoning
        p = ap (df ∘_) (funext (commₗ ∘ xa))
      p-xc : gᵣ xc' == ac ∘ xa
      p-xc = ap gᵣ (=pullback-intro (refl , p-xd , p-pᵣ)) ∙ ηᵣ (ac ∘ xa)

      -- TODO
      postulate
        p-pₗ : ap (pr₁ ∘ pr₂) (εᵣ xc') ∙ refl == ap (cd ∘_) p-xc ∙ funext (commₗ ∘ xa)

    -- TODO
    postulate
      εₒ : fₒ ∘ gₒ ~ id

  prop₂' : Squareₒ.IsPullback commₒ → Squareₗ.IsPullback commₗ
  prop₂' sₒ-pullback X = qinv→isequiv (gₗ , ηₗ , εₗ)
    where
    open qinv (isequiv→qinv (sₒ-pullback X)) renaming (g to gₒ ; η to ηₒ ; ε to εₒ)
    open qinv (isequiv→qinv (pullbackᵣ X)) renaming (g to gᵣ ; η to ηᵣ ; ε to εᵣ)

    gₗ : pullback (X → C) (X → B) (cd ∘_) (bd ∘_) → (X → A)
    gₗ (xc , xb , pₗ) = gₒ (ce ∘ xc , xb , funext (commᵣ ∘ xc) ∙ ap (df ∘_) pₗ)

    ηₗ : gₗ ∘ fₗ ~ id
    ηₗ xa = ap gₒ (pair⁼ (refl , pair⁼ (refl ,
      _ ∙ₗ funext-ap df (commₗ ∘ xa) ⁻¹ ∙
      funext-∙ₕ (commᵣ ∘ ac ∘ xa) (ap df ∘ commₗ ∘ xa) ⁻¹))) ∙ ηₒ xa

    εₗ : fₗ ∘ gₗ ~ id
    εₗ (xc , xb , pₗ) = =pullback-intro (p-xc , p-xb , p-pₗ)
      where
      xa = gₗ (xc , xb , pₗ)
      xa' = ce ∘ xc , xb , funext (commᵣ ∘ xc) ∙ ap (df ∘_) pₗ
      p-xa' = =pullback-elim (εₒ xa')
      p-xe = pr₁ p-xa'
      p-xb = pr₁ (pr₂ p-xa')
      p-pₒ = pr₂ (pr₂ p-xa')
      p-xd = funext (commₗ ∘ xa) ∙ ap (bd ∘_) p-xb ∙ pₗ ⁻¹
      -- TODO
      postulate
        p-pᵣ : funext (commᵣ ∘ ac ∘ xa) ∙ ap (df ∘_) p-xd == ap (ef ∘_) p-xe ∙ funext (commᵣ ∘ xc)
      p-xc : ac ∘ xa == xc
      p-xc = ηᵣ (ac ∘ xa) ⁻¹ ∙ ap gᵣ (=pullback-intro (p-xe , p-xd , p-pᵣ)) ∙ ηᵣ xc
      -- TODO
      postulate
        p-pₗ : funext (commₗ ∘ xa) ∙ ap (bd ∘_) p-xb == ap (cd ∘_) p-xc ∙ pₗ


module Imports.Test where

open import Common.Level

record Foo (ℓ : Level) : Set ℓ where


{-# OPTIONS --without-K --rewriting #-}

module Basics where

open import Base public
open import PropT public
open import hSet public

open import lib.Basics public


{-# OPTIONS --without-K --rewriting #-}

open import HoTT
open import homotopy.EilenbergMacLane
open import homotopy.EilenbergMacLane1
open import homotopy.SmashFmapConn
open import homotopy.IterSuspSmash
open import homotopy.EilenbergMacLaneFunctor
open import cohomology.CupProduct.OnEM.InLowDegrees
open import cohomology.CupProduct.OnEM.InLowDegrees2
open import cohomology.CupProduct.OnEM.InAllDegrees
open import cohomology.CupProduct.OnEM.CommutativityInLowDegrees using (⊙×-cp₀₀-comm)
open import cohomology.CupProduct.OnEM.CommutativityInLowDegrees2

module cohomology.CupProduct.OnEM.CommutativityInAllDegrees where

module _ {i} {j} (G : AbGroup i) (H : AbGroup j) where

  open EMExplicit

  private
    module G = AbGroup G
    module H = AbGroup H
    module G⊗H = TensorProduct G H
    module H⊗G = TensorProduct H G

  private
    ⊙×-cp₀ₕ'-comm : ∀ (n : ℕ)
      → ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S n) ◃⊙∘
        ⊙×-cp₀ₕ' G H n ◃⊙idf
        =⊙∘
        ⊙×-cpₕ₀' H G n ◃⊙∘
        ⊙×-swap ◃⊙idf
    ⊙×-cp₀ₕ'-comm n = =⊙∘-in $
      →-⊙→-uncurry (λ g → ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S n) ⊙∘
                          ⊙EM-fmap H G⊗H.abgroup (G⊗H.ins-r-hom g) (S n))
        =⟨ (ap →-⊙→-uncurry $ λ= $ λ g →
           ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S n) ⊙∘
           ⊙EM-fmap H G⊗H.abgroup (G⊗H.ins-r-hom g) (S n)
             =⟨ ! (⊙EM-fmap-∘ H G⊗H.abgroup H⊗G.abgroup G⊗H.swap (G⊗H.ins-r-hom g) (S n)) ⟩
           ⊙EM-fmap H H⊗G.abgroup (G⊗H.swap ∘ᴳ G⊗H.ins-r-hom g) (S n)
             =⟨ ap (λ φ → ⊙EM-fmap H H⊗G.abgroup φ (S n)) $
                group-hom= {φ = G⊗H.swap ∘ᴳ G⊗H.ins-r-hom g} {ψ = H⊗G.ins-l-hom g} $
                λ= $ G⊗H.swap-β g ⟩
           ⊙EM-fmap H H⊗G.abgroup (H⊗G.ins-l-hom g) (S n) =∎)
         ⟩
      →-⊙→-uncurry (λ g → ⊙EM-fmap H H⊗G.abgroup (H⊗G.ins-l-hom g) (S n)) =∎

  ⊙×-cp₀ₕ-comm : ∀ (n : ℕ)
    → ⊙transport (⊙EM H⊗G.abgroup) (+-comm O (S n)) ◃⊙∘
      ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S n) ◃⊙∘
      ⊙×-cp₀ₕ G H n ◃⊙idf
      =⊙∘
      ⊙×-cpₕ₀ H G n ◃⊙∘
      ⊙×-swap ◃⊙idf
  ⊙×-cp₀ₕ-comm n =
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm O (S n)) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S n) ◃⊙∘
    ⊙×-cp₀ₕ G H n ◃⊙idf
      =⊙∘⟨ 2 & 1 & ⊙expand (⊙×-cp₀ₕ-seq G H n) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm O (S n)) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S n) ◃⊙∘
    ⊙×-cp₀ₕ' G H n ◃⊙∘
    ⊙×-fmap (⊙<– (⊙emloop-equiv G.grp)) (⊙idf (⊙EM H (S n))) ◃⊙idf
      =⊙∘⟨ 1 & 2 & ⊙×-cp₀ₕ'-comm n ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm O (S n)) ◃⊙∘
    ⊙×-cpₕ₀' H G n ◃⊙∘
    ⊙×-swap ◃⊙∘
    ⊙×-fmap (⊙<– (⊙emloop-equiv G.grp)) (⊙idf (⊙EM H (S n))) ◃⊙idf
      =⊙∘₁⟨ 0 & 1 & ap (⊙transport (⊙EM H⊗G.abgroup)) $
                    set-path ℕ-level (+-comm O (S n)) (! (+-unit-r (S n))) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-unit-r (S n))) ◃⊙∘
    ⊙×-cpₕ₀' H G n ◃⊙∘
    ⊙×-swap ◃⊙∘
    ⊙×-fmap (⊙<– (⊙emloop-equiv G.grp)) (⊙idf (⊙EM H (S n))) ◃⊙idf
      =⊙∘⟨ 2 & 2 &
           =⊙∘-in {gs = ⊙×-fmap (⊙idf (⊙EM H (S n))) (⊙<– (⊙emloop-equiv G.grp)) ◃⊙∘
                        ⊙×-swap ◃⊙idf} $ ! $ ⊙λ= $
           ⊙×-swap-natural (⊙<– (⊙emloop-equiv G.grp)) (⊙idf (⊙EM H (S n))) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-unit-r (S n))) ◃⊙∘
    ⊙×-cpₕ₀' H G n ◃⊙∘
    ⊙×-fmap (⊙idf (⊙EM H (S n))) (⊙<– (⊙emloop-equiv G.grp)) ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 0 & 3 & ⊙contract ⟩
    ⊙×-cpₕ₀ H G n ◃⊙∘
    ⊙×-swap ◃⊙idf ∎⊙∘

module _ {i} {j} (G : AbGroup i) (H : AbGroup j) where

  open EMExplicit

  private
    module G = AbGroup G
    module H = AbGroup H
    module G⊗H = TensorProduct G H
    module H⊗G = TensorProduct H G

  ⊙∧-cpₕₕ'-comm : ∀ (m n : ℕ)
    → ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
      ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + S n) ◃⊙∘
      ⊙∧-cpₕₕ' G H m n ◃⊙idf
      =⊙∘
      ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
      ⊙∧-cpₕₕ' H G n m ◃⊙∘
      ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
  ⊙∧-cpₕₕ'-comm m n =
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + S n) ◃⊙∘
    ⊙∧-cpₕₕ' G H m n ◃⊙idf
      =⊙∘₁⟨ 1 & 1 & ! $ ⊙transport-⊙EM-uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative (S m + S n) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙transport (λ K → ⊙EM K (S (m + S n))) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative) ◃⊙∘
    ⊙∧-cpₕₕ' G H m n ◃⊙idf
      =⊙∘⟨ 2 & 1 & ⊙expand (⊙∧-cpₕₕ'-seq G H m n) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙transport (λ K → ⊙EM K (S (m + S n))) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative) ◃⊙∘
    ⊙cpₕₕ'' G⊗H.abgroup m n ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 1 & 2 & !⊙∘ $ ⊙transport-natural-=⊙∘
             (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative)
             (λ K → ⊙cpₕₕ'' K m n) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙cpₕₕ'' H⊗G.abgroup m n ◃⊙∘
    ⊙transport (λ K → ⊙Susp^ (m + n) (⊙EM K 2)) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘₁⟨ 2 & 1 & p₁ ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙cpₕₕ'' H⊗G.abgroup m n ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙Trunc-fmap (⊙Susp^-fmap 1 (⊙EM₁-fmap G⊗H.swap))) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 1 & 1 & ⊙expand (⊙cpₕₕ''-seq H⊗G.abgroup m n) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙cond-neg H⊗G.abgroup (S m + S n) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S m) n)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (m + n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙Trunc-fmap (⊙Susp^-fmap 1 (⊙EM₁-fmap G⊗H.swap))) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 0 & 2 & !⊙∘ $ ⊙transport-natural-=⊙∘
             (+-comm (S m) (S n))
             (λ k → ⊙cond-neg H⊗G.abgroup k (odd n)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S m) n)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (m + n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙Trunc-fmap (⊙Susp^-fmap 1 (⊙EM₁-fmap G⊗H.swap))) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 1 & 2 & !⊙∘ $ ⊙transport-∙ (⊙EM H⊗G.abgroup) (! (+-βr (S m) n)) (+-comm (S m) (S n)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S m) n) ∙ +-comm (S m) (S n)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (m + n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙Trunc-fmap (⊙Susp^-fmap 1 (⊙EM₁-fmap G⊗H.swap))) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘₁⟨ 1 & 1 & ap (⊙transport (⊙EM H⊗G.abgroup)) $
            set-path ℕ-level (! (+-βr (S m) n) ∙ +-comm (S m) (S n))
                             (ap (λ k → S (S k)) (+-comm m n) ∙ ! (+-βr (S n) m)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (ap (λ k → S (S k)) (+-comm m n) ∙ ! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (m + n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙Trunc-fmap (⊙Susp^-fmap 1 (⊙EM₁-fmap G⊗H.swap))) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 1 & 1 & ⊙transport-∙ (⊙EM H⊗G.abgroup)
             (ap (λ k → S (S k)) (+-comm m n))
             (! (+-βr (S n) m)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (ap (λ k → S (S k)) (+-comm m n)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (m + n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙Trunc-fmap (⊙Susp^-fmap 1 (⊙EM₁-fmap G⊗H.swap))) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘₁⟨ 2 & 1 & ⊙transport-⊙coe (⊙EM H⊗G.abgroup) (ap (λ k → S (S k)) (+-comm m n)) ∙
                    ap ⊙coe (∘-ap (⊙EM H⊗G.abgroup) (λ k → S (S k)) (+-comm m n)) ∙
                    ! (⊙transport-⊙coe (λ k → ⊙EM H⊗G.abgroup (S (S k))) (+-comm m n)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙transport (λ k → ⊙EM H⊗G.abgroup (S (S k))) (+-comm m n) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (m + n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙Trunc-fmap (⊙Susp^-fmap 1 (⊙EM₁-fmap G⊗H.swap))) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ G H) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 4 & 2 & ⊙Susp^-fmap-seq-=⊙∘ (m + n) (⊙∧-cp₁₁-comm G H) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙transport (λ k → ⊙EM H⊗G.abgroup (S (S k))) (+-comm m n) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (m + n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙EM-neg H⊗G.abgroup 2) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-swap (⊙EM₁ G.grp) (⊙EM₁ H.grp)) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 2 & 2 & !⊙∘ $ ⊙transport-natural-=⊙∘ (+-comm m n) (⊙EM2-Susp H⊗G.abgroup) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙transport (λ k → ⊙Susp^ k (⊙EM H⊗G.abgroup 2)) (+-comm m n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙EM-neg H⊗G.abgroup 2) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-swap (⊙EM₁ G.grp) (⊙EM₁ H.grp)) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 3 & 2 & !⊙∘ $ ⊙transport-natural-=⊙∘
             (+-comm m n)
             (λ k → ⊙Susp^-fmap k (⊙EM-neg H⊗G.abgroup 2)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙EM-neg H⊗G.abgroup 2) ◃⊙∘
    ⊙transport (λ k → ⊙Susp^ k (⊙EM H⊗G.abgroup 2)) (+-comm m n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-swap (⊙EM₁ G.grp) (⊙EM₁ H.grp)) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 4 & 2 & !⊙∘ $ ⊙transport-natural-=⊙∘
             (+-comm m n)
             (λ k → ⊙Susp^-fmap k (⊙∧-cp₁₁ H G)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙EM-neg H⊗G.abgroup 2) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙transport (λ k → ⊙Susp^ k (⊙EM₁ H.grp ⊙∧ ⊙EM₁ G.grp)) (+-comm m n) ◃⊙∘
    ⊙Susp^-fmap (m + n) (⊙∧-swap (⊙EM₁ G.grp) (⊙EM₁ H.grp)) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ◃⊙idf
      =⊙∘⟨ 5 & 3 & ⊙Σ^∧Σ^-out-swap (⊙EM₁ G.grp) (⊙EM₁ H.grp) m n ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙EM-neg H⊗G.abgroup 2) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙maybe-Susp^-flip (n + m) (and (odd n) (odd m)) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 4 & 2 & ⊙maybe-Susp^-flip-natural-=⊙∘ (⊙∧-cp₁₁ H G) (n + m) (and (odd n) (odd m)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙EM-neg H⊗G.abgroup 2) ◃⊙∘
    ⊙maybe-Susp^-flip (n + m) (and (odd n) (odd m)) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘₁⟨ 3 & 1 & ! p₂ ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙transport (λ K → ⊙Susp^ (n + m) (⊙EM K 2)) (inv-path H⊗G.abgroup) ◃⊙∘
    ⊙maybe-Susp^-flip (n + m) (and (odd n) (odd m)) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 2 & 2 & ⊙transport-natural-=⊙∘ (inv-path H⊗G.abgroup) (λ K → ⊙EM2-Susp K (n + m)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙transport (λ K → ⊙EM K (S (S (n + m)))) (inv-path H⊗G.abgroup) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙maybe-Susp^-flip (n + m) (and (odd n) (odd m)) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 1 & 2 & ⊙transport-natural-=⊙∘
             (inv-path H⊗G.abgroup)
             (λ K → ⊙transport (⊙EM K) (! (+-βr (S n) m))) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (λ K → ⊙EM K (S n + S m)) (inv-path H⊗G.abgroup) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙maybe-Susp^-flip (n + m) (and (odd n) (odd m)) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 3 & 2 & ⊙EM2-Susp-⊙maybe-Susp^-flip H⊗G.abgroup (n + m) (and (odd n) (odd m)) h₁ ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (λ K → ⊙EM K (S n + S m)) (inv-path H⊗G.abgroup) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙Trunc-fmap (⊙maybe-Susp-flip (⊙Susp^ (n + m) (⊙EM₁ H⊗G.grp)) (and (odd n) (odd m))) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘₁⟨ 3 & 1 & ⊙maybe-Susp^-flip-⊙cond-neg
              H⊗G.abgroup (S n + m) (and (odd n) (odd m)) h₂ ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (λ K → ⊙EM K (S n + S m)) (inv-path H⊗G.abgroup) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙cond-neg H⊗G.abgroup (S (S (n + m))) (and (odd n) (odd m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 2 & 2 & !⊙∘ $ ⊙transport-natural-=⊙∘
             (! (+-βr (S n) m))
             (λ k → ⊙cond-neg H⊗G.abgroup k (and (odd n) (odd m))) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙transport (λ K → ⊙EM K (S n + S m)) (inv-path H⊗G.abgroup) ◃⊙∘
    ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd n) (odd m)) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 1 & 2 & ⊙cond-neg-∘ H⊗G.abgroup (S n + S m) true (and (odd n) (odd m)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd n) ◃⊙∘
    ⊙cond-neg H⊗G.abgroup (S (n + S m)) (negate (and (odd n) (odd m))) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 0 & 2 & ⊙cond-neg-∘ H⊗G.abgroup (S n + S m) (odd n) (negate (and (odd n) (odd m))) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (xor (odd n) (negate (and (odd n) (odd m)))) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘₁⟨ 0 & 1 & ap (⊙cond-neg H⊗G.abgroup (S n + S m)) (bp (odd n) (odd m)) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (xor (and (negate (odd m)) (negate (odd n))) (odd m)) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 0 & 1 & !⊙∘ $ ⊙cond-neg-∘ H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) (odd m) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙cond-neg H⊗G.abgroup (S n + S m) (odd m) ◃⊙∘
    ⊙transport (⊙EM H⊗G.abgroup) (! (+-βr (S n) m)) ◃⊙∘
    ⊙EM2-Susp H⊗G.abgroup (n + m) ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 1 & 3 & ⊙contract ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙cpₕₕ'' H⊗G.abgroup n m ◃⊙∘
    ⊙Susp^-fmap (n + m) (⊙∧-cp₁₁ H G) ◃⊙∘
    ⊙Σ^∧Σ^-out (⊙EM₁ H.grp) (⊙EM₁ G.grp) n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 1 & 3 & ⊙contract ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙∧-cpₕₕ' H G n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf ∎⊙∘
    where
      p₁ : ⊙transport (λ K → ⊙Susp^ (m + n) (⊙EM K 2)) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative)
           == ⊙Susp^-fmap (m + n) (⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap 2)
      p₁ =
        ⊙transport (λ K → ⊙Susp^ (m + n) (⊙EM K 2)) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative)
          =⟨ ⊙transport-⊙coe
               (λ K → ⊙Susp^ (m + n) (⊙EM K 2))
               (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative) ⟩
        ⊙coe (ap (λ K → ⊙Susp^ (m + n) (⊙EM K 2)) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative))
          =⟨ ap ⊙coe (ap-∘ (⊙Susp^ (m + n)) (λ K → ⊙EM K 2) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative)) ⟩
        ⊙coe (ap (⊙Susp^ (m + n)) (ap (λ K → ⊙EM K 2) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative)))
          =⟨ ! $ ⊙transport-⊙coe
               (⊙Susp^ (m + n))
               (ap (λ K → ⊙EM K 2) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative)) ⟩
        ⊙transport (⊙Susp^ (m + n)) (ap (λ K → ⊙EM K 2) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative))
          =⟨ ⊙transport-⊙Susp^ (m + n) (ap (λ K → ⊙EM K 2) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative)) ⟩
        ⊙Susp^-fmap (m + n) (⊙coe (ap (λ K → ⊙EM K 2) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative)))
          =⟨ ap (⊙Susp^-fmap (m + n)) $ ! $
             ⊙transport-⊙coe (λ K → ⊙EM K 2) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative) ⟩
        ⊙Susp^-fmap (m + n) (⊙transport (λ K → ⊙EM K 2) (uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative))
          =⟨ ap (⊙Susp^-fmap (m + n)) (⊙transport-⊙EM-uaᴬᴳ G⊗H.abgroup H⊗G.abgroup G⊗H.commutative 2) ⟩
        ⊙Susp^-fmap (m + n) (⊙Trunc-fmap (⊙Susp^-fmap 1 (⊙EM₁-fmap (–>ᴳ G⊗H.commutative)))) =∎
      p₂ : ⊙transport (λ K → ⊙Susp^ (n + m) (⊙EM K 2)) (inv-path H⊗G.abgroup)
           == ⊙Susp^-fmap (n + m) (⊙EM-neg H⊗G.abgroup 2)
      p₂ =
        ⊙transport (λ K → ⊙Susp^ (n + m) (⊙EM K 2)) (inv-path H⊗G.abgroup)
          =⟨ ⊙transport-⊙coe (λ K → ⊙Susp^ (n + m) (⊙EM K 2)) (inv-path H⊗G.abgroup) ⟩
        ⊙coe (ap (λ K → ⊙Susp^ (n + m) (⊙EM K 2)) (inv-path H⊗G.abgroup))
          =⟨ ap ⊙coe (ap-∘ (⊙Susp^ (n + m)) (λ K → ⊙EM K 2) (inv-path H⊗G.abgroup)) ⟩
        ⊙coe (ap (⊙Susp^ (n + m)) (ap (λ K → ⊙EM K 2) (inv-path H⊗G.abgroup)))
          =⟨ ! $ ⊙transport-⊙coe (⊙Susp^ (n + m)) (ap (λ K → ⊙EM K 2) (inv-path H⊗G.abgroup)) ⟩
        ⊙transport (⊙Susp^ (n + m)) (ap (λ K → ⊙EM K 2) (inv-path H⊗G.abgroup))
          =⟨ ⊙transport-⊙Susp^ (n + m) (ap (λ K → ⊙EM K 2) (inv-path H⊗G.abgroup)) ⟩
        ⊙Susp^-fmap (n + m) (⊙coe (ap (λ K → ⊙EM K 2) (inv-path H⊗G.abgroup)))
          =⟨ ap (⊙Susp^-fmap (n + m)) $ ! $
             ⊙transport-⊙coe (λ K → ⊙EM K 2) (inv-path H⊗G.abgroup) ⟩
        ⊙Susp^-fmap (n + m) (⊙transport (λ K → ⊙EM K 2) (inv-path H⊗G.abgroup))
          =⟨ ap (⊙Susp^-fmap (n + m)) $
             ⊙transport-⊙EM-uaᴬᴳ H⊗G.abgroup H⊗G.abgroup (inv-iso H⊗G.abgroup) 2 ⟩
        ⊙Susp^-fmap (n + m) (⊙EM-neg H⊗G.abgroup 2) =∎
      h₁ : n + m == 0 → and (odd n) (odd m) == false
      h₁ p = ap (λ k → and (odd k) (odd m)) (fst (+-0 n m p))
      h₂ : S (n + m) == 0 → and (odd n) (odd m) == inr unit
      h₂ p = ⊥-elim (ℕ-S≠O (n + m) p)
      bp : ∀ (b c : Bool) → xor b (negate (and b c)) == xor (and (negate c) (negate b)) c
      bp true  true  = idp
      bp true  false = idp
      bp false true  = idp
      bp false false = idp

  ⊙∧-cpₕₕ-comm : ∀ (m n : ℕ)
    → ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
      ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + S n) ◃⊙∘
      ⊙∧-cpₕₕ G H m n ◃⊙idf
      =⊙∘
      ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
      ⊙∧-cpₕₕ H G n m ◃⊙∘
      ⊙∧-swap (⊙EM G (S m)) (⊙EM H (S n)) ◃⊙idf
  ⊙∧-cpₕₕ-comm m n =
    =⊙∘-in $
    –>-is-inj ⊙Ext.⊙restr-equiv _ _ $
    =⊙∘-out
      {fs = ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
            ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + S n) ◃⊙∘
            ⊙∧-cpₕₕ G H m n ◃⊙∘
            ⊙smash-truncate G H m n ◃⊙idf}
      {gs = ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
            ⊙∧-cpₕₕ H G n m ◃⊙∘
            ⊙∧-swap (⊙EM G (S m)) (⊙EM H (S n)) ◃⊙∘
            ⊙smash-truncate G H m n ◃⊙idf} $
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + S n) ◃⊙∘
    ⊙∧-cpₕₕ G H m n ◃⊙∘
    ⊙smash-truncate G H m n ◃⊙idf
      =⊙∘₁⟨ 2 & 2 & SmashCPₕₕ.⊙ext-β G H m n (⊙∧-cpₕₕ' G H m n) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + S n) ◃⊙∘
    ⊙∧-cpₕₕ' G H m n ◃⊙idf
      =⊙∘⟨ ⊙∧-cpₕₕ'-comm m n ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙∧-cpₕₕ' H G n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 1 & 1 & =⊙∘-in {gs = ⊙∧-cpₕₕ H G n m ◃⊙∘
                                ⊙smash-truncate H G n m ◃⊙idf} $
           ! $ SmashCPₕₕ.⊙ext-β H G n m (⊙∧-cpₕₕ' H G n m) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙∧-cpₕₕ H G n m ◃⊙∘
    ⊙smash-truncate H G n m ◃⊙∘
    ⊙∧-swap (⊙Susp^ m (⊙EM₁ G.grp)) (⊙Susp^ n (⊙EM₁ H.grp)) ◃⊙idf
      =⊙∘⟨ 2 & 2 & =⊙∘-in {gs = ⊙∧-swap (⊙EM G (S m)) (⊙EM H (S n)) ◃⊙∘
                                ⊙smash-truncate G H m n ◃⊙idf} $
           ⊙∧-swap-naturality
             ([_] {n = ⟨ S m ⟩} {A = Susp^ m (EM₁ G.grp)} , idp)
             ([_] {n = ⟨ S n ⟩} {A = Susp^ n (EM₁ H.grp)} , idp) ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙∧-cpₕₕ H G n m ◃⊙∘
    ⊙∧-swap (⊙EM G (S m)) (⊙EM H (S n)) ◃⊙∘
    ⊙smash-truncate G H m n ◃⊙idf ∎⊙∘
    where
    module ⊙Ext = ⊙ConnExtend
      {Z = ⊙EM H⊗G.abgroup (S n + S m)}
      {n = ⟨ S n + S m ⟩}
      (⊙smash-truncate G H m n)
      (transport (λ l → has-conn-fibers l (smash-truncate G H m n))
                 (ap ⟨_⟩ (+-comm (S m) (S n)))
                 (smash-truncate-conn G H m n))
      (EM-level H⊗G.abgroup (S n + S m))

  ⊙×-cpₕₕ-comm : ∀ (m n : ℕ)
    → ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
      ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + S n) ◃⊙∘
      ⊙×-cpₕₕ G H m n ◃⊙idf
      =⊙∘
      ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
      ⊙×-cpₕₕ H G n m ◃⊙∘
      ⊙×-swap ◃⊙idf
  ⊙×-cpₕₕ-comm m n =
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + S n) ◃⊙∘
    ⊙×-cpₕₕ G H m n ◃⊙idf
      =⊙∘⟨ 2 & 1 & ⊙expand (⊙×-cpₕₕ-seq G H m n) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) (S n)) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S (m + S n)) ◃⊙∘
    ⊙∧-cpₕₕ G H m n ◃⊙∘
    ×-⊙to-∧ ◃⊙idf
      =⊙∘⟨ 0 & 3 & ⊙∧-cpₕₕ-comm m n ⟩
    ⊙cond-neg H⊗G.abgroup (S n + S m) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙∧-cpₕₕ H G n m ◃⊙∘
    ⊙∧-swap (⊙EM G (S m)) (⊙EM H (S n)) ◃⊙∘
    ×-⊙to-∧ ◃⊙idf
      =⊙∘⟨ 2 & 2 & ×-⊙to-∧-swap (⊙EM G (S m)) (⊙EM H (S n)) ⟩
    ⊙cond-neg H⊗G.abgroup (S (n + S m)) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙∧-cpₕₕ H G n m ◃⊙∘
    ×-⊙to-∧ ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 1 & 2 & ⊙contract ⟩
    ⊙cond-neg H⊗G.abgroup (S (n + S m)) (and (odd (S m)) (odd (S n))) ◃⊙∘
    ⊙×-cpₕₕ H G n m ◃⊙∘
    ⊙×-swap ◃⊙idf ∎⊙∘

  ⊙×-cp-comm : ∀ (m n : ℕ)
    → ⊙transport (⊙EM H⊗G.abgroup) (+-comm m n) ◃⊙∘
      ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (m + n) ◃⊙∘
      ⊙×-cp G H m n ◃⊙idf
      =⊙∘
      ⊙cond-neg H⊗G.abgroup (n + m) (and (odd m) (odd n)) ◃⊙∘
      ⊙×-cp H G n m ◃⊙∘
      ⊙×-swap ◃⊙idf
  ⊙×-cp-comm 0 0 =
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm 0 0) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap 0 ◃⊙∘
    ⊙×-cp G H 0 0 ◃⊙idf
      =⊙∘⟨ 0 & 1 & =⊙∘-in {gs = ⊙idf-seq} $
           ap (⊙transport (⊙EM H⊗G.abgroup)) (set-path ℕ-level (+-comm 0 0) idp) ⟩
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap 0 ◃⊙∘
    ⊙×-cp G H 0 0 ◃⊙idf
      =⊙∘⟨ ⊙×-cp₀₀-comm G H ⟩
    ⊙×-cp H G 0 0 ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 0 & 0 & ⊙contract ⟩
    ⊙cond-neg H⊗G.abgroup 0 false ◃⊙∘
    ⊙×-cp H G 0 0 ◃⊙∘
    ⊙×-swap ◃⊙idf ∎⊙∘
  ⊙×-cp-comm 0 (S n) =
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm O (S n)) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S n) ◃⊙∘
    ⊙×-cp₀ₕ G H n ◃⊙idf
      =⊙∘⟨ ⊙×-cp₀ₕ-comm G H n ⟩
    ⊙×-cpₕ₀ H G n ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 0 & 0 & ⊙contract ⟩
    ⊙cond-neg H⊗G.abgroup (S n + O) false ◃⊙∘
    ⊙×-cpₕ₀ H G n ◃⊙∘
    ⊙×-swap ◃⊙idf ∎⊙∘
  ⊙×-cp-comm (S m) 0 =
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) O) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S (m + O)) ◃⊙∘
    ⊙×-cpₕ₀ G H m ◃⊙idf
      =⊙∘⟨ 3 & 0 & =⊙∘-in {gs = ⊙×-swap ◃⊙∘ ⊙×-swap ◃⊙idf} idp ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) O) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + O) ◃⊙∘
    ⊙×-cpₕ₀ G H m ◃⊙∘
    ⊙×-swap ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 2 & 2 & !⊙∘ (⊙×-cp₀ₕ-comm H G m) ⟩
    ⊙transport (⊙EM H⊗G.abgroup) (+-comm (S m) O) ◃⊙∘
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m + O) ◃⊙∘
    ⊙transport (⊙EM G⊗H.abgroup) (+-comm O (S m)) ◃⊙∘
    ⊙EM-fmap H⊗G.abgroup G⊗H.abgroup H⊗G.swap (S m) ◃⊙∘
    ⊙×-cp₀ₕ H G m ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 0 & 2 & !⊙∘ $
           ⊙transport-natural-=⊙∘
             (+-comm (S m) O)
             (⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap) ⟩
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m) ◃⊙∘
    ⊙transport (⊙EM G⊗H.abgroup) (+-comm (S m) O) ◃⊙∘
    ⊙transport (⊙EM G⊗H.abgroup) (+-comm O (S m)) ◃⊙∘
    ⊙EM-fmap H⊗G.abgroup G⊗H.abgroup H⊗G.swap (S m) ◃⊙∘
    ⊙×-cp₀ₕ H G m ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 1 & 2 & !⊙∘ $ ⊙transport-∙
             (⊙EM G⊗H.abgroup) (+-comm 0 (S m)) (+-comm (S m) O) ⟩
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m) ◃⊙∘
    ⊙transport (⊙EM G⊗H.abgroup) (+-comm 0 (S m) ∙ +-comm (S m) O) ◃⊙∘
    ⊙EM-fmap H⊗G.abgroup G⊗H.abgroup H⊗G.swap (S m) ◃⊙∘
    ⊙×-cp₀ₕ H G m ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 1 & 1 & =⊙∘-in {gs = ⊙idf-seq} $
           ap (⊙transport (⊙EM G⊗H.abgroup)) $
           set-path ℕ-level (+-comm 0 (S m) ∙ +-comm (S m) O) idp ⟩
    ⊙EM-fmap G⊗H.abgroup H⊗G.abgroup G⊗H.swap (S m) ◃⊙∘
    ⊙EM-fmap H⊗G.abgroup G⊗H.abgroup H⊗G.swap (S m) ◃⊙∘
    ⊙×-cp₀ₕ H G m ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘₁⟨ 0 & 2 & ! $
            ⊙EM-fmap-∘ H⊗G.abgroup G⊗H.abgroup H⊗G.abgroup G⊗H.swap H⊗G.swap (S m) ⟩
    ⊙EM-fmap H⊗G.abgroup H⊗G.abgroup (G⊗H.swap ∘ᴳ H⊗G.swap) (S m) ◃⊙∘
    ⊙×-cp₀ₕ H G m ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘₁⟨ 0 & 1 & ap (λ φ → ⊙EM-fmap H⊗G.abgroup H⊗G.abgroup φ (S m))
                       H⊗G.swap-swap-idhom ⟩
    ⊙EM-fmap H⊗G.abgroup H⊗G.abgroup (idhom H⊗G.grp) (S m) ◃⊙∘
    ⊙×-cp₀ₕ H G m ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘⟨ 0 & 1 & =⊙∘-in {gs = ⊙idf-seq} $ ⊙EM-fmap-idhom H⊗G.abgroup (S m) ⟩
    ⊙×-cp₀ₕ H G m ◃⊙∘
    ⊙×-swap ◃⊙idf
      =⊙∘₁⟨ 0 & 0 & ap (⊙cond-neg H⊗G.abgroup (S m)) (! (and-false-r (odd (S m)))) ⟩
    ⊙cond-neg H⊗G.abgroup (S m) (and (odd (S m)) (odd O)) ◃⊙∘
    ⊙×-cp₀ₕ H G m ◃⊙∘
    ⊙×-swap ◃⊙idf ∎⊙∘
  ⊙×-cp-comm (S m) (S n) = ⊙×-cpₕₕ-comm m n


-- WARNING: This file was generated automatically by Vehicle
-- and should not be modified manually!
-- Metadata
--  - Agda version: 2.6.2
--  - AISEC version: 0.1.0.1
--  - Time generated: ???

{-# OPTIONS --allow-exec #-}

open import Vehicle
open import Data.Integer as ℤ using (ℤ)
open import Data.Rational as ℚ using (ℚ)

module simple-arithmetic-temp-output where

precedence : ℚ → (ℚ → (ℚ → ℚ))
precedence x y z = (x ℚ.+ (ℤ.+ 2 ℚ./ 1) ℚ.* y) ℚ.- z ℚ.÷ y


module Base where

postulate String : Set
          Char   : Set
{-# BUILTIN STRING String #-}
{-# BUILTIN CHAR   Char   #-}

data Unit : Set where
  unit : Unit

{-# COMPILED_DATA Unit () #-}

data Bool : Set where
  true  : Bool
  false : Bool

data False  : Set where
record True : Set where

IsTrue : Bool -> Set
IsTrue true = True
IsTrue false = False

{-# COMPILED_DATA Bool True False #-}

infixr 40 _::_
data List (A : Set) : Set where
  [] : List A
  _::_ : A -> List A -> List A

{-# COMPILED_DATA List [] (:) #-}

data _×_ (A B : Set) : Set where
  _,_ : A -> B -> A × B

{-# COMPILED_DATA _×_ (,) #-}


-- MIT License

-- Copyright (c) 2021 Luca Ciccone and Luca Padovani

-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use,
-- copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the
-- Software is furnished to do so, subject to the following
-- conditions:

-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.

-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
-- OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-- HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
-- OTHER DEALINGS IN THE SOFTWARE.

open import Relation.Nullary
open import Relation.Binary.PropositionalEquality using (_≡_; refl)

open import Common

module Action {ℙ : Set} (message : Message ℙ)
  where

open Message message

data Action : Set where
  I O : ℙ -> Action

input-injective : ∀{x y} -> I x ≡ I y -> x ≡ y
input-injective refl = refl

output-injective : ∀{x y} -> O x ≡ O y -> x ≡ y
output-injective refl = refl

co-action : Action -> Action
co-action (I x) = O x
co-action (O x) = I x

co-action-injective : ∀{x y} -> co-action x ≡ co-action y -> x ≡ y
co-action-injective {I x} {I .x} refl = refl
co-action-injective {O x} {O .x} refl = refl

co-action-involution : (α : Action) -> co-action (co-action α) ≡ α
co-action-involution (I _) = refl
co-action-involution (O _) = refl

action-equality-dec : (α β : Action) -> Dec (α ≡ β)
action-equality-dec (I x) (I y) with x ?= y
... | yes eq rewrite eq = yes refl
... | no neq = no λ eq -> neq (input-injective eq)
action-equality-dec (I x) (O y) = no λ ()
action-equality-dec (O x) (I y) = no λ ()
action-equality-dec (O x) (O y) with x ?= y
... | yes eq rewrite eq = yes refl
... | no neq = no λ eq -> neq (output-injective eq)


-- Andreas, 2017-01-12, issue #2386

postulate
  A : Set

data _≡_ (x : A) : A → Set where
  refl : x ≡ x

{-# BUILTIN EQUALITY _≡_ #-}

-- Monomorphic equality is not accepted.

-- If needed, this could change in the future.


{-# OPTIONS --warning=error #-}

module Issue278 where

open import Agda.Builtin.Equality

abstract
  module A where
    Foo : Set₁
    Foo = Set
  module B where
    open A
    Foo≡Set : Foo ≡ Set
    Foo≡Set = refl


{-# OPTIONS --without-K --safe #-}

-- Enriched category over a Monoidal category V

open import Categories.Category
  using (categoryHelper) renaming (Category to Setoid-Category)
open import Categories.Category.Monoidal using (Monoidal)

module Categories.Enriched.Category {o ℓ e} {V : Setoid-Category o ℓ e}
                                    (M : Monoidal V) where

open import Level
open import Function using (_$_)

open import Categories.Category.Monoidal.Properties M using (module Kelly's)
open import Categories.Category.Monoidal.Reasoning M
open import Categories.Category.Monoidal.Utilities M using (module Shorthands)
open import Categories.Functor using (Functor)
open import Categories.Morphism.Reasoning V
import Categories.Morphism.IsoEquiv V as IsoEquiv

open Setoid-Category V renaming (Obj to ObjV; id to idV)
open Commutation
open Monoidal M
open Shorthands
open IsoEquiv._≃_

record Category v : Set (o ⊔ ℓ ⊔ e ⊔ suc v) where
  field
    Obj : Set v
    hom : (A B : Obj)   → ObjV
    id  : {A : Obj}     → unit ⇒ hom A A
    ⊚   : {A B C : Obj} → hom B C ⊗₀ hom A B ⇒ hom A C

    ⊚-assoc : {A B C D : Obj} →
      [ (hom C D ⊗₀ hom B C) ⊗₀ hom A B ⇒ hom A D ]⟨
        ⊚ ⊗₁ idV          ⇒⟨ hom B D ⊗₀ hom A B ⟩
        ⊚
      ≈ associator.from   ⇒⟨ hom C D ⊗₀ (hom B C ⊗₀ hom A B) ⟩
        idV ⊗₁ ⊚          ⇒⟨ hom C D ⊗₀ hom A C ⟩
        ⊚
      ⟩
    unitˡ : {A B : Obj} →
      [ unit ⊗₀ hom A B ⇒ hom A B ]⟨
        id ⊗₁ idV         ⇒⟨ hom B B ⊗₀ hom A B ⟩
        ⊚
      ≈ unitorˡ.from
      ⟩
    unitʳ : {A B : Obj} →
      [ hom A B ⊗₀ unit ⇒ hom A B ]⟨
        idV ⊗₁ id         ⇒⟨ hom A B ⊗₀ hom A A ⟩
        ⊚
      ≈ unitorʳ.from
      ⟩

  -- A version of ⊚-assoc using generalized hom-variables.
  --
  -- In this version of associativity, the generalized variables f, g
  -- and h represent V-morphisms, or rather, morphism-valued maps,
  -- such as V-natural transofrmations or V-functorial actions.  This
  -- version is therefore well-suited for proving derived equations,
  -- such as functorial laws or commuting diagrams, that involve such
  -- maps.  For examples, see Underlying.assoc below, or the modules
  -- Enriched.Functor and Enriched.NaturalTransformation.

  ⊚-assoc-var : {X Y Z : ObjV} {A B C D : Obj}
                {f : X ⇒ hom C D} {g : Y ⇒ hom B C} {h : Z ⇒ hom A B} →
      [ (X ⊗₀ Y) ⊗₀ Z ⇒ hom A D ]⟨
        (⊚ ∘ f ⊗₁ g) ⊗₁ h  ⇒⟨ hom B D ⊗₀ hom A B ⟩
        ⊚
      ≈ associator.from    ⇒⟨ X ⊗₀ (Y ⊗₀ Z) ⟩
        f ⊗₁ (⊚ ∘ g ⊗₁ h)  ⇒⟨ hom C D ⊗₀ hom A C ⟩
        ⊚
      ⟩
  ⊚-assoc-var {f = f} {g} {h} = begin
    ⊚ ∘ (⊚ ∘ f ⊗₁ g) ⊗₁ h                 ≈⟨ refl⟩∘⟨ split₁ˡ ⟩
    ⊚ ∘ ⊚ ⊗₁ idV ∘ (f ⊗₁ g) ⊗₁ h          ≈⟨ pullˡ ⊚-assoc ⟩
    (⊚ ∘ idV ⊗₁ ⊚ ∘ α⇒) ∘ (f ⊗₁ g) ⊗₁ h   ≈⟨ pullʳ (pullʳ assoc-commute-from) ⟩
    ⊚ ∘ idV ⊗₁ ⊚ ∘ f ⊗₁ (g ⊗₁ h) ∘ α⇒     ≈˘⟨ refl⟩∘⟨ pushˡ split₂ˡ ⟩
    ⊚ ∘ f ⊗₁ (⊚ ∘ g ⊗₁ h) ∘ α⇒            ∎

-- The usual shorthand for hom-objects of an arbitrary category.

infix 15 _[_,_]

_[_,_] : ∀ {c} (C : Category c) (X Y : Category.Obj C) → ObjV
_[_,_] = Category.hom

-- A V-category C does not have morphisms of its own, but the
-- collection of V-morphisms from the monoidal unit into the
-- hom-objects of C forms a setoid.  This induces the *underlying*
-- category of C.

Underlying : ∀ {c} (C : Category c) → Setoid-Category c ℓ e
Underlying C = categoryHelper (record
  { Obj = Obj
  ; _⇒_ = λ A B → unit ⇒ hom A B
  ; _≈_ = λ f g → f ≈ g
  ; id  = id
  ; _∘_ = λ f g → ⊚ ∘ f ⊗₁ g ∘ λ⇐
  ; assoc = λ {_} {_} {_} {_} {f} {g} {h} →
    begin
      ⊚ ∘ (⊚ ∘ h ⊗₁ g ∘ λ⇐) ⊗₁ f ∘ λ⇐
    ≈˘⟨ refl⟩∘⟨ assoc ⟩⊗⟨refl ⟩∘⟨refl ⟩
      ⊚ ∘ ((⊚ ∘ h ⊗₁ g) ∘ λ⇐) ⊗₁ f ∘ λ⇐
    ≈⟨ refl⟩∘⟨ pushˡ split₁ʳ ⟩
      ⊚ ∘ (⊚ ∘ h ⊗₁ g) ⊗₁ f ∘ (λ⇐ ⊗₁ idV) ∘ λ⇐
    ≈⟨ pullˡ ⊚-assoc-var ⟩
      (⊚ ∘ h ⊗₁ (⊚ ∘ g ⊗₁ f) ∘ α⇒) ∘ (λ⇐ ⊗₁ idV) ∘ λ⇐
    ≈˘⟨ pushˡ (pushʳ (pushʳ
          (switch-tofromˡ associator (to-≈ Kelly's.coherence-iso₁)))) ⟩
      (⊚ ∘ h ⊗₁ (⊚ ∘ g ⊗₁ f) ∘ λ⇐) ∘ λ⇐
    ≈⟨ pullʳ (pullʳ unitorˡ-commute-to) ⟩
      ⊚ ∘ h ⊗₁ (⊚ ∘ g ⊗₁ f) ∘ idV ⊗₁ λ⇐ ∘ λ⇐
    ≈˘⟨ refl⟩∘⟨ pushˡ split₂ʳ ⟩
      ⊚ ∘ h ⊗₁ ((⊚ ∘ g ⊗₁ f) ∘ λ⇐) ∘ λ⇐
    ≈⟨ refl⟩∘⟨ refl⟩⊗⟨ assoc ⟩∘⟨refl ⟩
      ⊚ ∘ h ⊗₁ (⊚ ∘ g ⊗₁ f ∘ λ⇐) ∘ λ⇐
    ∎
  ; identityˡ = λ {_} {_} {f} → begin
      ⊚ ∘ id ⊗₁ f ∘ λ⇐                 ≈⟨ refl⟩∘⟨ serialize₁₂ ⟩∘⟨refl ⟩
      ⊚ ∘ (id ⊗₁ idV ∘ idV ⊗₁ f) ∘ λ⇐  ≈˘⟨ refl⟩∘⟨ pushʳ unitorˡ-commute-to ⟩
      ⊚ ∘ id ⊗₁ idV ∘ λ⇐ ∘ f           ≈⟨ pullˡ unitˡ ⟩
      λ⇒ ∘ λ⇐ ∘ f                      ≈⟨ cancelˡ unitorˡ.isoʳ ⟩
      f                                ∎
  ; identityʳ = λ {_} {_} {f} → begin
      ⊚ ∘ f ⊗₁ id ∘ λ⇐                 ≈⟨ refl⟩∘⟨ serialize₂₁ ⟩∘⟨refl ⟩
      ⊚ ∘ (idV ⊗₁ id ∘ f ⊗₁ idV) ∘ λ⇐  ≈⟨ pullˡ (pullˡ unitʳ) ⟩
      (unitorʳ.from ∘ f ⊗₁ idV) ∘ λ⇐   ≈⟨ unitorʳ-commute-from ⟩∘⟨refl ⟩
      (f ∘ unitorʳ.from) ∘ λ⇐          ≈˘⟨ (refl⟩∘⟨ Kelly's.coherence₃) ⟩∘⟨refl ⟩
      (f ∘ λ⇒) ∘ λ⇐                    ≈⟨ cancelʳ unitorˡ.isoʳ ⟩
      f                                ∎
  ; equiv    = equiv
  ; ∘-resp-≈ = λ eq₁ eq₂ → ∘-resp-≈ʳ $ ∘-resp-≈ˡ $ ⊗-resp-≈ eq₁ eq₂
  })
  where open Category C

module Underlying {c} (C : Category c) = Setoid-Category (Underlying C)


module Data.Option.Categorical where

import Lvl
import      Functional as Fn
open import Function.Equals
open import Data.Option
open import Data.Option.Functions
open import Data.Option.Proofs
open import Lang.Instance
open import Logic
open import Logic.Predicate
open import Relator.Equals
open import Relator.Equals.Proofs.Equiv
import      Structure.Category.Functor as Functor
open import Structure.Operator.Monoid
open import Structure.Operator.Properties
open import Structure.Operator
open import Structure.Relator.Properties
open import Syntax.Transitivity
open import Type
open import Type.Category

private variable ℓ : Lvl.Level
private variable T : Type{ℓ}

-- Option is a functor by using `map`.
instance
  map-functor : Functor{ℓ}(Option)
  Functor.map           ⦃ map-functor ⦄ = map
  Functor.map-function  ⦃ map-functor ⦄ = map-function
  Functor.op-preserving ⦃ map-functor ⦄ = map-preserves-[∘]
  Functor.id-preserving ⦃ map-functor ⦄ = map-preserves-id

-- Option is a monad by using `andThen`.
instance
  andThen-monad : Monad{ℓ}(Option)
  Monad.η            ⦃ andThen-monad ⦄ _ = Some
  Monad.ext          ⦃ andThen-monad ⦄   = Fn.swap _andThen_
  Monad.ext-function ⦃ andThen-monad ⦄ = andThen-function
  Monad.ext-inverse  ⦃ andThen-monad ⦄ = andThenᵣ-Some
  Dependent._⊜_.proof (Monad.ext-identity   ⦃ andThen-monad ⦄) = [≡]-intro
  Dependent._⊜_.proof (Monad.ext-distribute ⦃ andThen-monad ⦄ {f = f} {g}) {x} = andThen-associativity {f = g}{g = f}{o = x}

-- A monoid is constructed by lifting an associative binary operator using `or-combine`.
-- Essentially means that an additional value (None) is added to the type, and it becomes an identity by definition.
module _ {_▫_ : T → T → T} where
  instance
    or-combine-monoid : ⦃ assoc : Associativity(_▫_) ⦄ → Monoid(or-combine(_▫_) Fn.id Fn.id)
    Associativity.proof (Monoid.associativity or-combine-monoid) {None}   {None}   {None}   = [≡]-intro
    Associativity.proof (Monoid.associativity or-combine-monoid) {None}   {None}   {Some z} = [≡]-intro
    Associativity.proof (Monoid.associativity or-combine-monoid) {None}   {Some y} {None}   = [≡]-intro
    Associativity.proof (Monoid.associativity or-combine-monoid) {None}   {Some y} {Some z} = [≡]-intro
    Associativity.proof (Monoid.associativity or-combine-monoid) {Some x} {None}   {None}   = [≡]-intro
    Associativity.proof (Monoid.associativity or-combine-monoid) {Some x} {None}   {Some z} = [≡]-intro
    Associativity.proof (Monoid.associativity or-combine-monoid) {Some x} {Some y} {None}   = [≡]-intro
    Associativity.proof (Monoid.associativity or-combine-monoid) {Some x} {Some y} {Some z} = [≡]-with(Some) (associativity(_▫_))
    ∃.witness (Monoid.identity-existence or-combine-monoid) = None
    Identityₗ.proof (Identity.left  (∃.proof (Monoid.identity-existence or-combine-monoid))) {None}   = [≡]-intro
    Identityₗ.proof (Identity.left  (∃.proof (Monoid.identity-existence or-combine-monoid))) {Some x} = [≡]-intro
    Identityᵣ.proof (Identity.right (∃.proof (Monoid.identity-existence or-combine-monoid))) {None}   = [≡]-intro
    Identityᵣ.proof (Identity.right (∃.proof (Monoid.identity-existence or-combine-monoid))) {Some x} = [≡]-intro

module _ {_▫_ : T → T → T} where
  open Monoid ⦃ … ⦄ using (id)

  -- A monoid is still a monoid when lifting a binary operator using `and-combine`.
  instance
    and-combine-monoid : ⦃ monoid : Monoid(_▫_) ⦄ → Monoid(and-combine(_▫_))
    Associativity.proof (Monoid.associativity and-combine-monoid) {None}   {None}   {None}   = [≡]-intro
    Associativity.proof (Monoid.associativity and-combine-monoid) {None}   {None}   {Some z} = [≡]-intro
    Associativity.proof (Monoid.associativity and-combine-monoid) {None}   {Some y} {None}   = [≡]-intro
    Associativity.proof (Monoid.associativity and-combine-monoid) {None}   {Some y} {Some z} = [≡]-intro
    Associativity.proof (Monoid.associativity and-combine-monoid) {Some x} {None}   {None}   = [≡]-intro
    Associativity.proof (Monoid.associativity and-combine-monoid) {Some x} {None}   {Some z} = [≡]-intro
    Associativity.proof (Monoid.associativity and-combine-monoid) {Some x} {Some y} {None}   = [≡]-intro
    Associativity.proof (Monoid.associativity and-combine-monoid) {Some x} {Some y} {Some z} = [≡]-with(Some) (associativity(_▫_))
    ∃.witness (Monoid.identity-existence and-combine-monoid) = Some(id)
    Identityₗ.proof (Identity.left  (∃.proof (Monoid.identity-existence and-combine-monoid))) {None}   = [≡]-intro
    Identityₗ.proof (Identity.left  (∃.proof (Monoid.identity-existence and-combine-monoid))) {Some x} = [≡]-with(Some) (identityₗ(_▫_)(_))
    Identityᵣ.proof (Identity.right (∃.proof (Monoid.identity-existence and-combine-monoid))) {None}   = [≡]-intro
    Identityᵣ.proof (Identity.right (∃.proof (Monoid.identity-existence and-combine-monoid))) {Some x} = [≡]-with(Some) (identityᵣ(_▫_)(_))

  instance
    and-combine-absorberₗ : Absorberₗ(and-combine(_▫_))(None)
    Absorberₗ.proof and-combine-absorberₗ = [≡]-intro

  instance
    and-combine-absorberᵣ : Absorberᵣ(and-combine(_▫_))(None)
    Absorberᵣ.proof and-combine-absorberᵣ {None}   = [≡]-intro
    Absorberᵣ.proof and-combine-absorberᵣ {Some x} = [≡]-intro

  -- `and-combine` essentially adds an additional value (None) to the type, and it becomes an absorber by definition.
  instance
    and-combine-absorber : Absorber(and-combine(_▫_))(None)
    and-combine-absorber = intro


{-

  Maybe structure: X ↦ Maybe (S X)

-}
{-# OPTIONS --cubical --no-import-sorts --no-exact-split --safe #-}
module Cubical.Structures.Relational.Maybe where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Function
open import Cubical.Foundations.Equiv
open import Cubical.Foundations.HLevels
open import Cubical.Foundations.Structure
open import Cubical.Foundations.RelationalStructure
open import Cubical.Data.Unit
open import Cubical.Data.Empty
open import Cubical.Data.Maybe
open import Cubical.Data.Sigma

open import Cubical.Structures.Maybe

private
  variable
    ℓ ℓ₁ ℓ₁' : Level

-- Structured relations

preservesSetsMaybe : {S : Type ℓ → Type ℓ₁} → preservesSets S → preservesSets (MaybeStructure S)
preservesSetsMaybe p setX = isOfHLevelMaybe 0 (p setX)

MaybeRelStr : {S : Type ℓ → Type ℓ₁} {ℓ₁' : Level}
  → StrRel S ℓ₁' → StrRel (λ X → Maybe (S X)) ℓ₁'
MaybeRelStr ρ R = MaybeRel (ρ R)

open SuitableStrRel

maybeSuitableRel : {S : Type ℓ → Type ℓ₁} {ρ : StrRel S ℓ₁'}
  → SuitableStrRel S ρ
  → SuitableStrRel (MaybeStructure S) (MaybeRelStr ρ)
maybeSuitableRel θ .quo (X , nothing) R _ .fst = nothing , _
maybeSuitableRel θ .quo (X , nothing) R _ .snd (nothing , _) = refl
maybeSuitableRel θ .quo (X , just s) R c .fst =
  just (θ .quo (X , s) R c .fst .fst) , θ .quo (X , s) R c .fst .snd
maybeSuitableRel θ .quo (X , just s) R c .snd (just s' , r) =
  cong (λ {(t , r') → just t , r'}) (θ .quo (X , s) R c .snd (s' , r))
maybeSuitableRel θ .symmetric R {nothing} {nothing} r = _
maybeSuitableRel θ .symmetric R {just s} {just t} r = θ .symmetric R r
maybeSuitableRel θ .transitive R R' {nothing} {nothing} {nothing} r r' = _
maybeSuitableRel θ .transitive R R' {just s} {just t} {just u} r r' = θ .transitive R R' r r'
maybeSuitableRel θ .prop propR nothing nothing = isOfHLevelLift 1 isPropUnit
maybeSuitableRel θ .prop propR nothing (just y) = isOfHLevelLift 1 isProp⊥
maybeSuitableRel θ .prop propR (just x) nothing = isOfHLevelLift 1 isProp⊥
maybeSuitableRel θ .prop propR (just x) (just y) = θ .prop propR x y

maybeRelMatchesEquiv : {S : Type ℓ → Type ℓ₁} (ρ : StrRel S ℓ₁') {ι : StrEquiv S ℓ₁'}
  → StrRelMatchesEquiv ρ ι
  → StrRelMatchesEquiv (MaybeRelStr ρ) (MaybeEquivStr ι)
maybeRelMatchesEquiv ρ μ (X , nothing) (Y , nothing) _ = idEquiv _
maybeRelMatchesEquiv ρ μ (X , nothing) (Y , just y) _ = idEquiv _
maybeRelMatchesEquiv ρ μ (X , just x) (Y , nothing) _ = idEquiv _
maybeRelMatchesEquiv ρ μ (X , just x) (Y , just y) = μ (X , x) (Y , y)


{-# OPTIONS --omega-in-omega --no-termination-check --overlapping-instances #-}

module Light.Implementation.Standard.Relation.Decidable where

open import Light.Variable.Sets
import Light.Implementation.Standard.Data.Empty
import Light.Implementation.Standard.Data.Unit
open import Light.Library.Data.Empty as Empty using (Empty)
open import Light.Library.Data.Unit as Unit using (Unit ; unit)
open import Light.Library.Relation.Decidable using (Library ; Dependencies)

instance dependencies : Dependencies
dependencies = record {}

instance library : Library dependencies
library = record
      {
            Implementation ;
            to‐witness = λ ⦃ a ⦄ → Implementation.to‐witness a ;
            to‐false‐witness = λ ⦃ a ⦄ → Implementation.to‐false‐witness a ;
            from‐witness = λ ⦃ a ⦄ → Implementation.from‐witness a ;
            from‐false‐witness = λ ⦃ a ⦄ → Implementation.from‐false‐witness a
      }
      where
      module Implementation where
            open import Relation.Nullary using (yes ; no) renaming (Dec to Decidable) public
            open Relation.Nullary using (does)
            open import Function using (_∘_)
            import Data.Bool as Boolean
            open import Function using (id)
            open import Relation.Nullary.Decidable
                  renaming (
                        toWitness to to‐witness ;
                        fromWitness to from‐witness ;
                        toWitnessFalse to to‐false‐witness ;
                        fromWitnessFalse to from‐false‐witness
                  )
                  public
            open import Light.Implementation.Standard.Relation.Sets using (base) public

            ℓf = id

            if′_then_else_ : Decidable 𝕒 → 𝕓 → 𝕓 → 𝕓
            if′_then_else_ = Boolean.if_then_else_ ∘ does

            if_then_else_ :
                  ∀ (a : Decidable 𝕒)
                  → (∀ ⦃ witness : 𝕒 ⦄ → 𝕓)
                  → (∀ ⦃ witness : 𝕒 → Empty ⦄ → 𝕓)
                  → 𝕓
            if yes w then a else _ = a ⦃ witness = w ⦄
            if no w then _ else a = a ⦃ witness = w ⦄

            module Style where
                  open import Relation.Nullary.Decidable using (True ; False) public
                  open import Relation.Nullary.Negation using () renaming (¬? to ¬_) public
                  open import Relation.Nullary.Product using () renaming (_×-dec_ to _∧_) public
                  open import Relation.Nullary.Sum using () renaming (_⊎-dec_ to _∨_) public
                  open import Relation.Nullary.Implication using () renaming (_→-dec_ to _⇢_) public

                  true : Decidable Unit
                  true = yes unit

                  false : Decidable Empty
                  false = no λ ()

            style = record { Style }


{-# OPTIONS --without-K #-}

open import HoTT

{- Useful lemmas for computing the effect of transporting a function
 - across an equivalence in the domain or codomain -}

module cohomology.FunctionOver where

{- transporting a function along an equivalcence or path in the domain -}
module _ {i} {j} {B : Type i} {C : Type j} (g : B → C) where

  domain-over-path : {A : Type i} (p : A == B)
    → g ∘ coe p == g [ (λ D → (D → C)) ↓ p ]
  domain-over-path idp = idp

  domain-over-equiv : {A : Type i} (e : A ≃ B)
    → g ∘ –> e == g [ (λ D → (D → C)) ↓ ua e ]
  domain-over-equiv e = ↓-app→cst-in $ λ q → ap g (↓-idf-ua-out e q)

module _ {i} {j} {A : Type i} {C : Type j} (f : A → C) where

  domain!-over-path : {B : Type i} (p : A == B)
    → f == f ∘ coe! p [ (λ D → (D → C)) ↓ p ]
  domain!-over-path idp = idp

  domain!-over-equiv : {B : Type i} (e : A ≃ B)
    → f == f ∘ <– e [ (λ D → (D → C)) ↓ ua e ]
  domain!-over-equiv e = ↓-app→cst-in $
    λ q → ap f (! (<–-inv-l e _) ∙ ap (<– e) (↓-idf-ua-out e q))

{- transporting a ptd function along a equivalence or path in the domain -}
module _ {i} {j} {Y : Ptd i} {Z : Ptd j} (g : fst (Y ⊙→ Z)) where

  domain-over-⊙path : {X : Ptd i} (p : fst X == fst Y)
    (q : coe p (snd X) == snd Y)
    → g ⊙∘ (coe p , q) == g [ (λ W → fst (W ⊙→ Z)) ↓ pair= p (↓-idf-in p q) ]
  domain-over-⊙path idp idp = idp

  domain-over-⊙equiv : {X : Ptd i} (e : fst X ≃ fst Y)
    (q : –> e (snd X) == snd Y)
    → g ⊙∘ ⊙–> e q == g [ (λ W → fst (W ⊙→ Z)) ↓ ⊙ua e q ]
  domain-over-⊙equiv {X = X} e q =
    ap (λ w → g ⊙∘ w) lemma ◃ domain-over-⊙path (ua e) (coe-β e (snd X) ∙ q)
    where
    lemma : Path {A = fst (X ⊙→ Y)}
       (⊙–> e q) (coe (ua e) , coe-β e (snd X) ∙ q)
    lemma = ! $ ⊙λ= (coe-β e) idp

module _ {i} {j} {X : Ptd i} {Z : Ptd j} (f : fst (X ⊙→ Z)) where

  domain!-over-⊙path : {Y : Ptd i} (p : fst X == fst Y)
    (q : coe p (snd X) == snd Y)
    → f == f ⊙∘ (coe! p , ap (coe! p) (! q) ∙ coe!-inv-l p (snd X))
      [ (λ W → fst (W ⊙→ Z)) ↓ pair= p (↓-idf-in p q) ]
  domain!-over-⊙path idp idp = idp

  domain!-over-⊙equiv : {Y : Ptd i} (e : fst X ≃ fst Y)
    (q : –> e (snd X) == snd Y)
    → f == f ⊙∘ (⊙<– e q) [ (λ W → fst (W ⊙→ Z)) ↓ ⊙ua e q ]
  domain!-over-⊙equiv {Y = Y} e q =
    (ap (λ w → f ⊙∘ w) (lemma e q) ∙ ! (⊙∘-assoc f _ (–> e , q))) ◃
    domain-over-⊙equiv
      (f ⊙∘ (<– e , ap (<– e) (! q) ∙ <–-inv-l e (snd X))) e q
    where
    lemma : {X Y : Ptd i}
      (e : fst X ≃ fst Y) (q : –> e (snd X) == snd Y)
      → ⊙idf X == ((<– e , ap (<– e) (! q) ∙ <–-inv-l e (snd X)) ⊙∘ (–> e , q))
    lemma {X = X} e idp = ! $ ⊙λ= (<–-inv-l e) (! (∙-unit-r _))

{- transporting a function along an equivalence or path in the codomain -}
module _ {i} {j} {A : Type i} {B : Type j} (f : A → B) where

  codomain-over-path : {C : Type j} (p : B == C)
    → f == coe p ∘ f [ (λ D → (A → D)) ↓ p ]
  codomain-over-path idp = idp

  codomain-over-equiv : {C : Type j} (e : B ≃ C)
    → f == –> e ∘ f [ (λ D → (A → D)) ↓ ua e ]
  codomain-over-equiv e = ↓-cst→app-in $ λ _ → ↓-idf-ua-in e idp

module _ {i} {j} {A : Type i} {C : Type j} (g : A → C) where

  codomain!-over-path : {B : Type j} (p : B == C)
    → coe! p ∘ g == g [ (λ D → (A → D)) ↓ p ]
  codomain!-over-path idp = idp

  codomain!-over-equiv : {B : Type j} (e : B ≃ C)
    → <– e ∘ g == g [ (λ D → (A → D)) ↓ ua e ]
  codomain!-over-equiv e = ↓-cst→app-in $ λ _ → ↓-idf-ua-in e (<–-inv-r e _)

{- transporting a ptd function along a equivalence or path in the codomain -}
module _ {i} {j} {X : Ptd i} {Y : Ptd j} (f : fst (X ⊙→ Y)) where

  codomain-over-⊙path : {Z : Ptd j} (p : fst Y == fst Z)
    (q : coe p (snd Y) == snd Z)
    → f == (coe p , q) ⊙∘ f [ (λ W → fst (X ⊙→ W)) ↓ pair= p (↓-idf-in p q) ]
  codomain-over-⊙path idp idp = pair= idp (! (∙-unit-r _ ∙ ap-idf (snd f)))

  codomain-over-⊙equiv : {Z : Ptd j} (e : fst Y ≃ fst Z)
    (q : –> e (snd Y) == snd Z)
    → f == (–> e , q) ⊙∘ f [ (λ W → fst (X ⊙→ W)) ↓ ⊙ua e q ]
  codomain-over-⊙equiv {Z = Z} e q =
    codomain-over-⊙path (ua e) (coe-β e (snd Y) ∙ q) ▹ ap (λ w → w ⊙∘ f) lemma
    where
    lemma : Path {A = fst (Y ⊙→ Z)}
      (coe (ua e) , coe-β e (snd Y) ∙ q) (–> e , q)
    lemma = ⊙λ= (coe-β e) idp

module _ {i} {j} {X : Ptd i} {Z : Ptd j} (g : fst (X ⊙→ Z)) where

  codomain!-over-⊙path : {Y : Ptd j} (p : fst Y == fst Z)
    (q : coe p (snd Y) == snd Z)
    → (coe! p , ap (coe! p) (! q) ∙ coe!-inv-l p (snd Y)) ⊙∘ g == g
      [ (λ W → fst (X ⊙→ W)) ↓ pair= p (↓-idf-in p q) ]
  codomain!-over-⊙path idp idp = pair= idp (∙-unit-r _ ∙ ap-idf (snd g))

  codomain!-over-⊙equiv : {Y : Ptd j} (e : fst Y ≃ fst Z)
    (q : –> e (snd Y) == snd Z)
    → (⊙<– e q) ⊙∘ g == g [ (λ W → fst (X ⊙→ W)) ↓ ⊙ua e q ]
  codomain!-over-⊙equiv {Y = Y} e q =
    codomain-over-⊙equiv
      ((<– e , ap (<– e) (! q) ∙ <–-inv-l e (snd Y)) ⊙∘ g) e q
    ▹ (! (⊙∘-assoc (–> e , q) _ g) ∙ ap (λ w → w ⊙∘ g) (lemma e q)
       ∙ ⊙∘-unit-l g)
    where
    lemma : {Y Z : Ptd j}
      (e : fst Y ≃ fst Z) (q : –> e (snd Y) == snd Z)
      → ((–> e , q) ⊙∘ (<– e , ap (<– e) (! q) ∙ <–-inv-l e (snd Y))) == ⊙idf Z
    lemma {Y = Y} e idp =
      ⊙λ= (<–-inv-r e) (ap (λ w → w ∙ idp) (<–-inv-adj e (snd Y)))

{- transporting a group homomorphism along an isomorphism -}

domain-over-iso : ∀ {i j} {G H : Group i} {K : Group j}
  (φ : G →ᴳ H) (ie : is-equiv (GroupHom.f φ)) (ψ : G →ᴳ K) (χ : H →ᴳ K)
  → GroupHom.f ψ == GroupHom.f χ
    [ (λ A → A → Group.El K) ↓ ua (GroupHom.f φ , ie) ]
  → ψ == χ [ (λ J → J →ᴳ K) ↓ group-ua (φ , ie) ]
domain-over-iso {K = K} φ ie ψ χ p = hom=-↓ _ _ $ ↓-ap-out _ Group.El _ $
  transport
    (λ q → GroupHom.f ψ == GroupHom.f χ [ (λ A → A → Group.El K) ↓ q ])
    (! (group-ua-el (φ , ie)))
    p

codomain-over-iso : ∀ {i j} {G : Group i} {H K : Group j}
  (φ : H →ᴳ K) (ie : is-equiv (GroupHom.f φ)) (ψ : G →ᴳ H) (χ : G →ᴳ K)
  → GroupHom.f ψ == GroupHom.f χ
    [ (λ A → Group.El G → A) ↓ ua (GroupHom.f φ , ie) ]
  → ψ == χ [ (λ J → G →ᴳ J) ↓ group-ua (φ , ie) ]
codomain-over-iso {G = G} φ ie ψ χ p = hom=-↓ _ _ $ ↓-ap-out _ Group.El _ $
  transport
    (λ q → GroupHom.f ψ == GroupHom.f χ [ (λ A → Group.El G → A) ↓ q ])
    (! (group-ua-el (φ , ie)))
    p


-- {-# OPTIONS -v term:20 -v tc.term:20  #-}
-- {-# OPTIONS -v tc.def.alias:100 -v tc.term.expr.coind:100 #-}
module Issue807 where

open import Common.Coinduction

data Stream : Set where
  cons : ∞ Stream → Stream

mutual

  -- s : Stream
  s = cons s′

  -- s′ : ∞ _
  s′ = ♯ s

-- Under 2.3.0.1: The code is accepted.
-- Under 2.3.2:   The termination checker complains.

-- Bug was that aliases did not lead to construction of ♯-auxiliary function.