namespace BidirTT

inductive Level where
  | zero : Level
  | succ : Level → Level
  | max  : Level → Level → Level
  deriving Repr, Inhabited, BEq, DecidableEq

def Level.ofNat : Nat → Level
  | 0 => .zero
  | n + 1 => .succ (Level.ofNat n)

instance (n : Nat) : OfNat Level n where
  ofNat := Level.ofNat n

partial def Level.eval : Level → Nat
  | .zero => 0
  | .succ l => l.eval + 1
  | .max l r => Nat.max l.eval r.eval

def Level.normalise (l : Level) : Level :=
  .ofNat l.eval

def Level.succ' (l : Level) : Level :=
  .normalise (.succ l)

def Level.max' (l r : Level) : Level :=
  .normalise (.max l r)

def Level.pretty (l : Level) : String :=
  s!"{l.eval}"

abbrev LevelConstraint := Level × Level

def solveLevelConstraints (constraints : List LevelConstraint) : Except String Unit := do
  match constraints.find? fun (lhs, rhs) => lhs.eval > rhs.eval with
  | some (lhs, rhs) =>
      throw s!"unsatisfiable level constraint {lhs.pretty} <= {rhs.pretty}"
  | none =>
      pure ()

def Level.leq (lhs rhs : Level) : Except String Bool := do
  match solveLevelConstraints [(lhs, rhs)] with
  | Except.ok _ => pure true
  | Except.error _ => pure false

def Level.eqv (lhs rhs : Level) : Except String Bool := do
  match solveLevelConstraints [(lhs, rhs), (rhs, lhs)] with
  | Except.ok _ => pure true
  | Except.error _ => pure false

end BidirTT