{-# OPTIONS --type-in-type #-} module Chapter3.Desc.Levitation where open import Data.Unit open import Data.Product open import Relation.Binary.PropositionalEquality open import Chapter1.Logic open import Chapter1.IProp open import Chapter2.Desc open import Chapter2.Desc.Fixpoint open import Chapter2.Desc.Lifting open import Chapter2.Desc.Induction open import Chapter3.Desc ψ : Desc → Desc' ψ `var = `var' ψ `1 = `1' ψ (D `× D') = ψ D `×' ψ D' ψ (D `+ D') = ψ D `+' ψ D' ψ (`Σ S T) = `Σ' S λ s → ψ (T s) ψ (`Π S T) = `Π' S λ s → ψ (T s) private record ⟨φ_⟩ (D : Desc') : Set₁ where constructor return field call : Desc open ⟨φ_⟩ α : [ DescD ]^ (λ D → ⟨φ D ⟩) ⇒ (λ D → ⟨φ ⟨ D ⟩ ⟩) α {`var` , tt} tt = return `var α {`1` , tt} tt = return `1 α {`×` , D , D' , tt} (ihD , ihD' , tt) = return (call ihD `× call ihD') α {`+` , D , D' , tt} (ihD , ihD' , tt) = return (call ihD `+ call ihD') α {`Σ` , S , T , tt} (ih , tt) = return (`Σ S λ s → call (ih s)) α {`Π` , S , T , tt} (ih , tt) = return (`Π S λ s → call (ih s)) φh : (D : Desc') → ⟨φ D ⟩ φh = induction DescD (λ D → ⟨φ D ⟩) α φ : (D : Desc') → Desc φ D = call (φh D) postulate ⊢ψ∘φ : ∀ (D : Desc') → ⊢ ψ (φ D) ≡ D ⊢φ∘ψ : ∀ (D : Desc) → ⊢ φ (ψ D) ≡ D