aoc2023/lib/maybe.quox

load "misc.quox"
load "pair.quox"
load "either.quox"

namespace maybe {

def0 Tag : ★ = {nothing, just}

def0 Payload : Tag → ★ → ★ =
  λ tag A ⇒ case tag return ★ of { 'nothing ⇒ True; 'just ⇒ A }

def0 Maybe : ★ → ★ =
  λ A ⇒ (t : Tag) × Payload t A

def tag : 0.(A : ★) → ω.(Maybe A) → Tag =
  λ _ x ⇒ caseω x return Tag of { (tag, _) ⇒ tag }

def Nothing : 0.(A : ★) → Maybe A =
  λ _ ⇒ ('nothing, 'true)

def Just : 0.(A : ★) → A → Maybe A =
  λ _ x ⇒ ('just, x)

def0 IsJustTag : Tag → ★ =
  λ t ⇒ case t return ★ of { 'just ⇒ True; 'nothing ⇒ False }

def0 IsJust : (A : ★) → Maybe A → ★ =
  λ A x ⇒ IsJustTag (tag A x)

def is-just? : 0.(A : ★) → ω.(x : Maybe A) → Dec (IsJust A x) =
  λ A x ⇒
  caseω tag A x return t ⇒ Dec (IsJustTag t) of {
    'just    ⇒ Yes True  'true;
    'nothing ⇒ No  False (λ x ⇒ x)
  }

def0 nothing-unique :
    (A : ★) → (x : True) → ('nothing, x) ≡ Nothing A : Maybe A =
  λ A x ⇒
  case x return x' ⇒ ('nothing, x') ≡ Nothing A : Maybe A of {
    'true ⇒ δ _ ⇒ ('nothing, 'true)
  }

def elim' :
    0.(A : ★) →
    0.(P : (t : Tag) → Payload t A → ★) →
    ω.(P 'nothing 'true) →
    ω.((x : A) → P 'just x) →
    (t : Tag) → (x : Payload t A) → P t x =
  λ A P nothing just tag ⇒
  case tag return t ⇒ (x : Payload t A) → P t x of {
    'nothing ⇒ λ x ⇒ case x return x' ⇒ P 'nothing x' of { 'true ⇒ nothing };
    'just    ⇒ just
  }

def elim :
    0.(A : ★) →
    0.(P : Maybe A → ★) →
    ω.(P (Nothing A)) →
    ω.((x : A) → P (Just A x)) →
    (x : Maybe A) → P x =
  λ A P n j x ⇒
    case x return x' ⇒ P x' of {
      (tag, payload) ⇒ elim' A (λ x t ⇒ P (x, t)) n j tag payload
    }

def elimω' :
    0.(A : ★) →
    0.(P : (t : Tag) → Payload t A → ★) →
    ω.(P 'nothing 'true) →
    ω.(ω.(x : A) → P 'just x) →
    ω.(t : Tag) → ω.(x : Payload t A) → P t x =
  λ A P nothing just tag ⇒
  case tag return t ⇒ ω.(x : Payload t A) → P t x of {
    'nothing ⇒ λ x ⇒ case x return x' ⇒ P 'nothing x' of { 'true ⇒ nothing };
    'just    ⇒ just
  }

def elimω :
    0.(A : ★) →
    0.(P : Maybe A → ★) →
    ω.(P (Nothing A)) →
    ω.(ω.(x : A) → P (Just A x)) →
    ω.(x : Maybe A) → P x =
  λ A P n j x ⇒
    caseω x return x' ⇒ P x' of {
      (tag, payload) ⇒ elimω' A (λ x t ⇒ P (x, t)) n j tag payload
    }

{-
-- direct elim implementation
def elim :
    0.(A : ★) →
    0.(P : Maybe A → ★) →
    ω.(P (Nothing A)) →
    ω.((x : A) → P (Just A x)) →
    (x : Maybe A) → P x =
  λ A P n j x ⇒
  case x return x' ⇒ P x' of { (tag, payload) ⇒
    (case tag
     return t ⇒
       0.(eq : tag ≡ t : Tag) → P (t, coe (𝑖 ⇒ Payload (eq @𝑖) A) payload)
     of {
       'nothing ⇒
          λ eq ⇒
          case coe (𝑖 ⇒ Payload (eq @𝑖) A) payload
          return p ⇒ P ('nothing, p)
          of { 'true ⇒ n };
       'just ⇒ λ eq ⇒ j (coe (𝑖 ⇒ Payload (eq @𝑖) A) payload)
     }) (δ 𝑖 ⇒ tag)
  }
-}

def fold : 0.(A B : ★) → ω.B → ω.(A → B) → Maybe A → B =
  λ A B ⇒ elim A (λ _ ⇒ B)

def foldω : 0.(A B : ★) → ω.B → ω.(ω.A → B) → ω.(Maybe A) → B =
  λ A B ⇒ elimω A (λ _ ⇒ B)

def join : 0.(A : ★) → (Maybe (Maybe A)) → Maybe A =
  λ A ⇒ fold (Maybe A) (Maybe A) (Nothing A) (λ x ⇒ x)

def pair : 0.(A B : ★) → ω.(Maybe A) → ω.(Maybe B) → Maybe (A × B) =
  λ A B x y ⇒
    foldω A (Maybe (A × B)) (Nothing (A × B))
      (λ x' ⇒ fold B (Maybe (A × B)) (Nothing (A × B))
        (λ y' ⇒ Just (A × B) (x', y')) y) x

def map : 0.(A B : ★) → ω.(A → B) → Maybe A → Maybe B =
  λ A B f ⇒ fold A (Maybe B) (Nothing B) (λ x ⇒ Just B (f x))

def mapω : 0.(A B : ★) → ω.(ω.A → B) → ω.(Maybe A) → Maybe B =
  λ A B f ⇒ foldω A (Maybe B) (Nothing B) (λ x ⇒ Just B (f x))


def check : 0.(A : ★) → (ω.A → Bool) → ω.A → Maybe A =
  λ A p x ⇒ bool.if (Maybe A) (p x) (Just A x) (Nothing A)

def or : 0.(A : ★) → Maybe A → ω.(Maybe A) → Maybe A =
  λ A l r ⇒ fold A (Maybe A) r (Just A) l

}

def0 Maybe   = maybe.Maybe
def  Just    = maybe.Just
def  Nothing = maybe.Nothing