/-
Port of `Isomorphism.agda` (`TransportFiniteHeight`).

With propositional equality this module shrinks dramatically: the Agda
hypotheses `f-preserves-≈`, `g-preserves-≈` are free, and `f-⊔-distr` /
`g-⊔-distr` (which in the setoid world encoded monotonicity of `f` and `g`
w.r.t. the derived order) become plain `Monotone` hypotheses. The chain
transport `portChain₁` / `portChain₂` is mathlib's `LTSeries.map`, using that
a monotone injective map between partial orders is strictly monotone.

Correspondence:
  IsInverseˡ / IsInverseʳ     ↦ explicit inverse hypotheses `hfg` / `hgf`
  f-Injective / g-Injective   ↦ local `Function.LeftInverse.injective`
  portChain₁ / portChain₂     ↦ LTSeries.map
  instance fixedHeight        ↦ Spa.FixedHeight.transport
  isFiniteHeightLattice,
  finiteHeightLattice         ↦ Spa.FiniteHeightLattice.transport
-/
import Spa.Lattice

namespace Spa

namespace FixedHeight

variable {α β : Type*} [PartialOrder α] [PartialOrder β] {h : ℕ}

/-- Agda: `TransportFiniteHeight.fixedHeight`. Transport a `FixedHeight`
structure along a monotone inverse pair `f : α → β`, `g : β → α`. -/
def transport (fh : FixedHeight α h) (f : α → β) (g : β → α)
    (hf : Monotone f) (hg : Monotone g)
    (hgf : ∀ a, g (f a) = a) (hfg : ∀ b, f (g b) = b) :
    FixedHeight β h where
  bot := f fh.bot
  top := f fh.top
  longestChain :=
    fh.longestChain.map f
      (hf.strictMono_of_injective (Function.LeftInverse.injective hgf))
  head_longestChain := by
    rw [LTSeries.head_map, fh.head_longestChain]
  last_longestChain := by
    rw [LTSeries.last_map, fh.last_longestChain]
  length_longestChain := fh.length_longestChain
  bounded := fun c =>
    fh.bounded
      (c.map g (hg.strictMono_of_injective (Function.LeftInverse.injective hfg)))

end FixedHeight

/-- Agda: `TransportFiniteHeight.finiteHeightLattice`. -/
def FiniteHeightLattice.transport {α β : Type*} [Lattice α] [Lattice β]
    (I : FiniteHeightLattice α) (f : α → β) (g : β → α)
    (hf : Monotone f) (hg : Monotone g)
    (hgf : ∀ a, g (f a) = a) (hfg : ∀ b, f (g b) = b) :
    FiniteHeightLattice β where
  height := I.height
  fixedHeight := I.fixedHeight.transport f g hf hg hgf hfg

end Spa