{-# OPTIONS --type-in-type #-}

module Chapter3.IDesc.Levitation 
         {I : Set}
       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.IDesc
open import Chapter2.IDesc.Fixpoint
open import Chapter2.IDesc.Lifting
open import Chapter2.IDesc.Induction

open import Chapter3.IDesc


ψ : IDesc I  IDesc' I
ψ (`var i) = `var' i
ψ `1 = `1'
ψ (D  D') = ψ D `×' ψ D'
ψ ( n T) = `σ' n λ k  ψ (T k)
ψ ( S T) = `Σ' S λ s  ψ (T s)
ψ ( S T) = `Π' S λ s  ψ (T s)

private 
  record ⟨φ_⟩ (D : IDesc' I) : Set₁ where
    constructor return
    field 
      call : IDesc I
  open ⟨φ_⟩

  α : [ IDescD I ]^  D  ⟨φ D )   D  ⟨φ  proj₂ D  )
  α {_ , `var` , i , tt} tt = return (`var i)
  α {_ , `1` , tt} tt = return `1
  α {_ , `×` , D , D' , tt} (ihD , ihD' , tt) = return (call ihD  call ihD')
  α {_ , `σ` , n , T , tt} (ih , tt) = return ( n λ k  call (ih k))
  α {_ , `Σ` , S , T , tt} (ih , tt) = return ( S λ s  call (ih s))
  α {_ , `Π` , S , T , tt} (ih , tt) = return ( S λ s  call (ih s))

  φh : (D : IDesc' I)  ⟨φ D 
  φh = induction (IDescD I)  D  ⟨φ D )  {i}{xs}  α {i , xs})

φ : (D : IDesc' I)  IDesc I
φ D = call (φh D)


postulate 
  ⊢ψ∘φ :  (D : IDesc' I)   ψ (φ D)  D
  ⊢φ∘ψ :  (D : IDesc I)   φ (ψ D)  D