module Struct.BinTree where

open import Core

infixr 10 _∷_

data List : Set where
  [] : List
  _∷_ : ℕ → List → List

module L where
  _++_ : List → List → List
  [] ++ ys = ys
  (x ∷ xs) ++ ys = x ∷ (xs ++ ys)


module Simple where
  infix 10 _⟦_⟧_

  data Tree : Set where
    ∅ : Tree
    _⟦_⟧_ : Tree → ℕ → Tree → Tree

  infix 5 _∈_

  data _∈_ : ℕ → Tree → Set where
    here : ∀ {x l r} → x ∈ l ⟦ x ⟧ r
    left : ∀ {x y l r} → x ∈ l → x ∈ l ⟦ y ⟧ r
    right : ∀ {x y l r} → x ∈ r → x ∈ l ⟦ y ⟧ r

  toList : Tree → List
  toList ∅ = []
  toList (l ⟦ x ⟧ r) = toList l L.++ (x ∷ toList r)

  _∈?_ : (x : ℕ) (tree : Tree) → Decidable (x ∈ tree)
  x ∈? ∅ = no λ ()
  x ∈? (l ⟦ y ⟧ r) with x ≟ y
  ... | yes x=y = yes (subst x=y (here {x} {l} {r}))
  ... | no ¬x=y with x ∈? l
  ... | yes x∈l = yes (left x∈l)
  ... | no ¬x∈l with x ∈? r
  ... | yes x∈r = yes (right x∈r)
  ... | no ¬x∈r = no λ
    { here → ¬x=y refl
    ; (left x∈l) → ¬x∈l x∈l
    ; (right x∈r) → ¬x∈r x∈r
    }

  insertˡ : ℕ → Tree → Tree
  insertˡ x ∅ = ∅ ⟦ x ⟧ ∅
  insertˡ x (l ⟦ y ⟧ r) with x ≟ y
  ... | yes x=y = l ⟦ y ⟧ r
  ... | no ¬x=y = insertˡ x l ⟦ y ⟧ r

  insertʳ : ℕ → Tree → Tree
  insertʳ x ∅ = ∅ ⟦ x ⟧ ∅
  insertʳ x (l ⟦ y ⟧ r) with x ≟ y
  ... | yes x=y = l ⟦ y ⟧ r
  ... | no ¬x=y = l ⟦ y ⟧ insertʳ x r

  insertˡ-∈ : ∀ x tree → x ∈ insertˡ x tree
  insertˡ-∈ x ∅ = here
  insertˡ-∈ x (l ⟦ y ⟧ r) with x ≟ y
  ... | yes x=y = subst x=y (here {x} {l} {r})
  ... | no ¬x=y = left (insertˡ-∈ x l)

  insertʳ-∈ : ∀ x tree → x ∈ insertʳ x tree
  insertʳ-∈ x ∅ = here
  insertʳ-∈ x (l ⟦ y ⟧ r) with x ≟ y
  ... | yes x=y = subst x=y (here {x} {l} {r})
  ... | no ¬x=y = right (insertʳ-∈ x r)

  fromListˡ : List → Tree
  fromListˡ [] = ∅
  fromListˡ (x ∷ xs) = insertˡ x (fromListˡ xs)

  _++_ : Tree → Tree → Tree
  x ++ ∅ = x
  x ++ (l ⟦ y ⟧ r) = (x ++ l) ⟦ y ⟧ r

  ++-∈l : ∀ {x l r} → x ∈ l → x ∈ (l ++ r)
  ++-∈l {x} {l} {∅} x∈l = x∈l
  ++-∈l {x} {l} {m ⟦ y ⟧ r} x∈l = left (++-∈l x∈l)

  ++-∈r : ∀ {x l r} → x ∈ r → x ∈ (l ++ r)
  ++-∈r here = here
  ++-∈r (left x∈r) = left (++-∈r x∈r)
  ++-∈r (right x∈r) = right x∈r

  ++-¬∈ : ∀ {x l r} → ¬ x ∈ l → ¬ x ∈ r → ¬ x ∈ (l ++ r)
  ++-¬∈ {x} {l} {∅} ¬x∈l ¬x∈r x∈lr = ¬x∈l x∈lr
  ++-¬∈ {.y} {l} {m ⟦ y ⟧ r} ¬x∈l ¬x∈r here = ¬x∈r here
  ++-¬∈ {x} {l} {m ⟦ y ⟧ r} ¬x∈l ¬x∈r (left x∈lr) =
    ++-¬∈ ¬x∈l (λ z → ¬x∈r (left z)) x∈lr
  ++-¬∈ {x} {l} {m ⟦ y ⟧ r} ¬x∈l ¬x∈r (right x∈lr) =
    ¬x∈r (right x∈lr)

  delete : ℕ → Tree → Tree
  delete x ∅ = ∅
  delete x (l ⟦ y ⟧ r) with x ≟ y
  ... | yes x=y = delete x l ++ delete x r
  ... | no ¬x=y = delete x l ⟦ y ⟧ delete x r

  delete-¬∈ : ∀ x tree → x ∈ delete x tree → ⊥
  delete-¬∈ x ∅ ()
  delete-¬∈ x (l ⟦ y ⟧ r) with x ≟ y
  ... | yes x=y = λ x∈lr → ++-¬∈ (delete-¬∈ x l) (delete-¬∈ x r) x∈lr
  ... | no ¬x=y = λ
    { here → ¬x=y refl
    ; (left x∈l) → delete-¬∈ x l x∈l
    ; (right x∈r) → delete-¬∈ x r x∈r
    }
