open import Function

-- open import Data.Empty
open import Data.Unit hiding (_≟_)
-- open import Data.Nat
--open import Data.Fin
open import Data.Product
-- open import Data.Sum

open import Relation.Binary.PropositionalEquality

open import Chapter1.Logic

open import Chapter2.IDesc
open import Chapter2.IDesc.Fixpoint
open import Chapter2.IDesc.InitialAlgebra
--open import Data.Induction

open import Chapter5.Ornament
--import Ornament.OrnamentalAlgebra
--import Ornament.AlgebraicOrnament



module Chapter5.Reornament 
         {K I : Set}{D : func I I}
         {u : K  I}
         (o : orn D u u) 
       where

{-

open Ornament.OrnamentalAlgebra D f O

-- * 

-}

forgetIdx : Σ K (μ D  u)  K
forgetIdx = proj₁ 

Extension : ∀{D X}  Orn u D   D  X  Set
Extension `1 tt = 
Extension (O₁  O₂) (xs₁ , xs₂) = Extension O₁ xs₁ × Extension O₂ xs₂
Extension ( T⁺) (k , xs) = Extension (T⁺ k) xs
Extension ( T⁺) (s , xs) = Extension (T⁺ s) xs
Extension ( T⁺) f = (s : _)  Extension (T⁺ s) (f s)
Extension (`var (inv k)) xs = 
Extension (insert S D⁺) xs = Σ[ s  S ] Extension (D⁺ s) xs
Extension {X = X} (deleteΣ {T = T} s o) (s' , xs) = Σ[ q  s'  s ] Extension o (subst  s   T s  X) q xs) 
Extension {X = X} (deleteσ {T = T} k o) (k' , xs) = Σ[ q  k'  k ] Extension o (subst  k   T k  X) q xs)


Structure : ∀{D'}(O : Orn u D') 
            (xs' :  D'  (μ D))  Extension O xs'  Orn forgetIdx  O ⟧Orn
Structure `1 tt tt = `1
Structure (O₁  O₂) (xs₁ , xs₂) (e₁ , e₂) = Structure O₁ xs₁ e₁  Structure O₂ xs₂ e₂
Structure ( T⁺) (k , xs) e = deleteσ k (Structure (T⁺ k) xs e)
Structure ( T⁺) (s , xs) e = deleteΣ s (Structure (T⁺ s) xs e)
Structure ( T⁺) f e =   s  Structure (T⁺ s) (f s) (e s))
Structure (`var (inv k)) xs tt = `var (inv (k , xs))
Structure (insert S D⁺) xs (s , e) = deleteΣ s (Structure (D⁺ s) xs e)
Structure (deleteΣ s O) (.s , xs) (refl , e) = Structure O xs e
Structure (deleteσ k O) (.k , xs) (refl , e) = Structure O xs e

-- Or, merging the two:
Reorn : ∀{D'}  (O : Orn u D')   D'  (μ D)  Orn forgetIdx  O ⟧Orn
Reorn `1 tt = `1
Reorn (O₁  O₂) (xs₁ , xs₂) = Reorn O₁ xs₁  Reorn O₂ xs₂
Reorn ( T⁺) (k , xs) = deleteσ k (Reorn (T⁺ k) xs)
Reorn ( T⁺) (s , xs) = deleteΣ s (Reorn (T⁺ s) xs)
Reorn ( T⁺) f =  λ s  Reorn (T⁺ s) (f s)
Reorn (`var (inv k)) xs = `var (inv (k , xs))
Reorn (insert S D⁺) xs =  λ s  Reorn (D⁺ s) xs
Reorn (deleteΣ {T = T} s o) (s' , xs) = insert (s'  s) λ q  Reorn o (subst  s   T s  (μ D)) q xs) 
Reorn (deleteσ {T = T} k o) (k' , xs) = insert (k'  k) λ q  Reorn o (subst  k   T k  (μ D)) q xs)


reorn : orn  o ⟧orn forgetIdx forgetIdx
reorn = orn.mk  { (k ,  xs ) 
               let O = orn.out o k in
               insert (Extension O xs)  e  
               Structure O xs e) })

reornD : func (Σ K (μ D  u)) (Σ K (μ D  u))
reornD =  reorn ⟧orn


{-

forgetAll : ∀{ix t} → μ ornamentalData (ix , t) → μ D (f ix)
forgetAll {ix}{t} _  = t

forgetOrnAlg : ∀{ix t} → μ ornamentalData (ix , t) → μ ⟦ D ⁺ O ⟧Orn ix
forgetOrnAlg x = Ornament.OrnamentalAlgebra.forgetOrnament ⟦ D ⁺ O ⟧Orn proj₁ ornamentalOrnament x


-- Can't be bothered to reimplement
postulate 
  makeOrnAlg : ∀{i⁺} → (t : μ ⟦ D ⁺ O ⟧Orn i⁺) → μ ornamentalData (i⁺ , forgetOrnament t)

-- Can't be bothered to reimplement
postulate
  ornOAAO⊢ : ∀{i⁺}{t : μ D (f i⁺)} → (t⁺ : μ ornamentalData (i⁺ , t)) → t ≡ forgetOrnament (forgetOrnAlg t⁺)

-}