open import Data.Nat hiding (fold)
open import Data.Fin hiding (fold)
open import Data.Product
open import Data.Sum
open import Data.Unit

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.InitialAlgebra
open import Chapter2.IDesc.Lifting
open import Chapter2.IDesc.Induction

open import Chapter5.Ornament.Examples.Lifting hiding ([_]^)
open import Chapter5.Ornament

module Chapter5.AlgebraicOrnament.Coherence
           {K : Set}
           {X : K  Set}
           (D : func K K)
           (α :  D ⟧func X  X) where

open import Chapter5.AlgebraicOrnament D α
open import Chapter5.Ornament.Algebra {u = proj₁} algOrn

postulate
  coherentOrn : ∀{k x}  
                (t : μ algOrnD (k , x))  
                 x  fold D α (forgetOrnament t)

-- Thanks to Andrea Vezzosi for the proof


{-

OAAO⊢ : ∀{k x} → 
        (t : μ algOrnD (k , x)) → ⊢ x ≡ ifold D α (forgetOrnament t)
OAAO⊢ {k} {x} = iinduction algData motive (λ {kx} → help (func.out D (proj₁ kx) ))
  where 
    motive : {kx : Σ K X} → μ ⟦ algOrn ⟧orn kx → Set
    motive {kx} t = ⊢ proj₂ kx ≡ ifold D α (forgetOrnament t)

    help : (D' : IDesc K) →
           step ⟦ algOrn ⟧orn motive
    help (`var k') {k , .(α xs)} (xs , refl , proj₃) ih = {!ih!}
    help `1 {proj₁ , .(α proj₃)} (proj₃ , refl , proj₅) ih = {!!}
    help (D' `× D'') {proj₁ , .(α proj₃)} (proj₃ , refl , proj₅) ih = {!!}
    help (`σ n T) {proj₁ , proj₂} xs ih = {!!}
    help (`Σ S T) {proj₁ , proj₂} xs ih = {!!}
    help (`Π S T) {proj₁ , proj₂} xs ih = {!!}
-}
{-
          Fold.hyps D α E
          (forgetMap0 (algOrnHelp E (proj₁ xs))
           (Fold.hyps ⟦ D ⁺ algOrn ⟧Orn
            (ornAlgebra) ⟦ algOrnHelp E (proj₁ xs) ⟧Orn
            (proj₂ xs)))
-}



{-
  induction algData motive 
            (λ { {j , .(α x)} (x , refl , t) hs → cong α (aux (D j) (x , t) hs)}) 
  where
    motive : {i' : Σ I X} → μ ⟦ D ⁺ algOrn ⟧Orn i' → Set
    motive {ij} t = proj₂ ij ≡ foldID D α (forgetOrnament t)
    aux : (E : IDesc I)
          (xs
           : Σ (⟦ E ⟧ X)
             (λ s →
                ⟦ ⟦ algOrnHelp E s ⟧Orn ⟧ (μ ⟦ D ⁺ algOrn ⟧Orn)))
          →
          □ ⟦ algOrnHelp E (proj₁ xs) ⟧Orn (proj₂ xs) motive →
          proj₁ xs ≡
          Fold.hyps D α E
          (forgetMap0 (algOrnHelp E (proj₁ xs))
           (Fold.hyps ⟦ D ⁺ algOrn ⟧Orn
            (ornAlgebra) ⟦ algOrnHelp E (proj₁ xs) ⟧Orn
            (proj₂ xs)))
    aux `1 (tt , tt) hs = refl
    aux (`X i0) (x' , con t) hs = hs
    aux (l `× r) (x' , t) hs = (cong₂ _,_ (aux l ((proj₁ x' , proj₁ t)) (proj₁ hs)) (aux r (proj₂ x' , proj₂ t) (proj₂ hs)))
    aux (l `+ r) (inj₁ x' , t) hs = cong inj₁ (aux l (x' , t) hs)
    aux (l `+ r) (inj₂ y , t) hs = cong inj₂ (aux r (y , t) hs)
    aux (`Σ S T) ((s , x') , t) hs = cong (_,_ s) (aux (T s) (x' , t) hs)
    aux (`Π S T) (x' , t) hs = ext λ s → aux (T s) (x' s , t s) (hs s) where
      postulate
        ext : ∀ {S : Set}{T : S -> Set} -> {f g : (x : S) -> T x} -> (∀ x -> f x ≡ g x) -> f ≡ g
-}