import Spa.Lattice.IterProd
import Spa.Isomorphism

namespace Spa

namespace Tuple

universe u

variable {B : Type u}

private def iterOfFun : {n : ℕ} → (Fin n → B) → IterProd B PUnit n
  | 0, _ => PUnit.unit
  | _ + 1, f => (f 0, iterOfFun (Fin.tail f))

private def funOfIter : {n : ℕ} → IterProd B PUnit n → (Fin n → B)
  | 0, _ => Fin.elim0
  | _ + 1, ip => Fin.cons ip.1 (funOfIter ip.2)

private theorem funOfIter_iterOfFun : ∀ {n : ℕ} (f : Fin n → B),
    funOfIter (iterOfFun f) = f
  | 0, _ => funext fun i => i.elim0
  | _ + 1, f => by
    show Fin.cons (f 0) (funOfIter (iterOfFun (Fin.tail f))) = f
    rw [funOfIter_iterOfFun (Fin.tail f), Fin.cons_self_tail]

private theorem iterOfFun_funOfIter : ∀ {n : ℕ} (ip : IterProd B PUnit n),
    iterOfFun (funOfIter ip) = ip
  | 0, PUnit.unit => rfl
  | _ + 1, ip => by
    show (funOfIter ip 0, iterOfFun (Fin.tail (funOfIter ip))) = ip
    rw [show funOfIter ip = Fin.cons ip.1 (funOfIter ip.2) from rfl]
    simp [Fin.cons_zero, Fin.tail_cons, iterOfFun_funOfIter ip.2]

variable [Lattice B]

private theorem funOfIter_mono {n : ℕ} :
    Monotone (funOfIter : IterProd B PUnit n → (Fin n → B)) := by
  induction n with
  | zero => intro _ _ _ i; exact i.elim0
  | succ n ih =>
    intro ip₁ ip₂ h i
    obtain ⟨h1, h2⟩ := Prod.le_def.mp h
    rw [show funOfIter ip₁ = Fin.cons ip₁.1 (funOfIter ip₁.2) from rfl,
        show funOfIter ip₂ = Fin.cons ip₂.1 (funOfIter ip₂.2) from rfl]
    induction i using Fin.cases with
    | zero => rw [Fin.cons_zero, Fin.cons_zero]; exact h1
    | succ j => rw [Fin.cons_succ, Fin.cons_succ]; exact ih h2 j

private theorem iterOfFun_mono {n : ℕ} :
    Monotone (iterOfFun : (Fin n → B) → IterProd B PUnit n) := by
  induction n with
  | zero => intro f g _; exact le_of_eq rfl
  | succ n ih =>
    intro f g h
    exact Prod.le_def.mpr ⟨h 0, ih fun i => h i.succ⟩

instance instFiniteHeight {n : ℕ} [FiniteHeightLattice B] :
    FiniteHeightLattice (Fin n → B) :=
  FiniteHeightLattice.transport funOfIter iterOfFun
    funOfIter_mono iterOfFun_mono iterOfFun_funOfIter funOfIter_iterOfFun

end Tuple

end Spa