{-# OPTIONS --without-K #-} -- this disables uniqueness of identity proofs
{-# OPTIONS --rewriting #-} -- makes the computation rule for ∥ A ∥ possible

module lec3-exercises where

open import Agda.Primitive
open import Agda.Builtin.Unit
open import Agda.Builtin.Bool
open import Agda.Builtin.Equality renaming (_≡_ to _==_)

----- Sigma and sum types -----------------------------------

record Σ {a b} (A : Set a) (B : A -> Set b) : Set (a ⊔ b) where
  constructor _,_
  field
    fst : A
    snd : B fst

open Σ
infixr 4 _,_

syntax Σ A (λ x → B) = Σ[ x ∈ A ] B

_×_ : ∀ {a b} → (A : Set a) (B : Set b) -> Set (a ⊔ b)
A × B = Σ A (λ _ → B)

data ⊥ : Set where

¬_ : Set -> Set
¬ A = A -> ⊥

data _+_ (A B : Set) : Set where
  inl : A -> A + B
  inr : B -> A + B

infixr 1 _+_

----- Functions -------------------------------------------

id : ∀ {ℓ} → {A : Set ℓ} -> A -> A
id x = x

_∘_ : ∀ {ℓ ℓ' ℓ''} → {A : Set ℓ}{B : Set ℓ'}{C : Set ℓ''} ->
      (B -> C) -> (A -> B) -> A -> C
(f ∘ g) x = f (g x)

----- Paths -----------------------------------------------

infixr 80 _·_

_·_ : ∀ {ℓ} → {A : Set ℓ} -> {a b c : A} -> a == b -> b == c -> a == c
refl · q = q

_⁻¹ : ∀ {ℓ} → {A : Set ℓ} {a b : A} -> a == b -> b == a
refl ⁻¹ = refl

ap : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : Set ℓ'}(f : A -> B){x y : A} ->
     x == y -> f x == f y
ap f refl = refl

transport : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : A -> Set ℓ'}{x y : A} ->
            x == y -> B x -> B y
transport refl = id

pair= : {A : Set}{B : A -> Set} -> {a a' : A}{b : B a}{b' : B a'} ->
        (p : a == a') -> transport p b == b' -> (a , b) == (a' , b')
pair= refl refl = refl

----- Groupoid laws ---------------------------------------

lunit : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) -> p · refl == p
lunit refl = refl

runit : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) -> refl · p == p
runit refl = refl

linverse : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) ->  (p ⁻¹) · p == refl
linverse refl = refl

rinverse : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) ->  p · (p ⁻¹) == refl
rinverse refl = refl

inverse-unique : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) ->  (p ⁻¹) ⁻¹ == p
inverse-unique refl = refl

assoc : ∀ {ℓ} → {A : Set ℓ} -> {x y z w : A} -> (p : x == y)(q : y == z)(r : z == w) ->
        p · (q · r) == (p · q) · r
assoc refl refl refl = refl

----- hlevels ---------------------------------------------

isContr : Set -> Set
isContr A = Σ[ x ∈ A ] ((y : A) -> x == y)

isProp : Set -> Set
isProp A = (x y : A) -> x == y

isSet : Set -> Set
isSet A = (x y : A) -> isProp (x == y)

----- Equivalences and univalence -------------------------

isEquiv : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : Set ℓ'} -> (A -> B) -> Set (ℓ ⊔ ℓ')
isEquiv {A = A} {B} f = Σ[ g ∈ (B -> A) ] (
                        Σ[ η ∈ ((x : A) → g (f x) == x) ] (
                        Σ[ ε ∈ ((y : B) → f (g y) == y) ] (
                         (x : A) -> ap f (η x) == ε (f x))))

qinv : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : Set ℓ'} -> (A -> B) -> Set (ℓ ⊔ ℓ')
qinv {A = A} {B} f = Σ[ g ∈ (B -> A) ] (
                     Σ[ η ∈ ((x : A) → g (f x) == x) ]
                       ((y : B) → f (g y) == y))

infix 30 _≃_

_≃_ : Set -> Set -> Set
A ≃ B = Σ (A -> B) λ f → isEquiv f

idtoeqv : {A B : Set} -> A == B -> A ≃ B
idtoeqv refl = (id , id , (λ x → refl) , ((λ y → refl) , (λ x → refl)))

postulate
  univalence : {A B : Set} -> isEquiv (idtoeqv {A} {B})

ua : {A B : Set} -> A ≃ B -> A == B
ua = fst univalence

----- Propositional truncation -------------------------

data ∥_∥ (A : Set) : Set where -- do not pattern match on this type!
  ∣_∣ : A -> ∥ A ∥

postulate
  prop-trunc-rec : {A : Set} -> (P : Set) -> isProp P ->
                   (g : A -> P) -> (∥ A ∥ -> P)
  prop-trunc-rec-β : {A P : Set}(p : isProp P)(g : A -> P) ->
                 (a : A) -> prop-trunc-rec P p g ∣ a ∣ == g a

{-# BUILTIN REWRITE _==_ #-}
{-# REWRITE prop-trunc-rec-β #-}

{----- Exercise 1 ----------------}

LEM→DNE : {A : Set} -> ((A : Set) -> A + ¬ A) -> ((A : Set) -> ¬ ¬ A -> A)
LEM→DNE {A} f = {!!}

DNE→LEM : {A : Set} -> ((A : Set) -> ¬ ¬ A -> A) -> ((A : Set) -> A + ¬ A)
DNE→LEM {A} g = {!!}

{----- Exercise 2 ----------------}

-- a) State a more traditional dependent elimination rule for the
-- propositional truncation

-- b) Derive it using `prop-trunc-rec` above.

prop-trunc-ind : {!!}
prop-trunc-ind = {!!}

{----- Exercise 3 ----------------}

disjoint-isProp : {A B : Set} ->
                  isProp A -> isProp B -> ¬ (A × B) -> isProp (A + B)
disjoint-isProp = {!!}

{----- Exercise 4 ----------------}

ac-equiv : {A : Set}{B : Set}{R : A -> B -> Set} ->
           ((x : A) -> Σ[ y ∈ B ] R x y)
               ≃ (Σ[ f ∈ (A -> B) ] ((x : A) -> R x (f x)))
ac-equiv = {!!}

-- It is of course enough to construct a quasi-equivalence and then
-- apply the map qinv -> isEquiv

{----- Exercise 5 ----------------}

open import Agda.Builtin.Nat hiding (_==_) renaming (Nat to ℕ)

True : Bool -> Set
True true = ⊤
True false = ⊥

isPropTruncOf : (A : Set) -> (||A|| : Set) -> Set1
isPropTruncOf A ||A|| = isProp ||A|| ×
                        (Σ[ η ∈ (A -> ||A||) ]
                        Σ[ g-bar ∈ ((P : Set) -> isProp P -> (g : A -> P) -> ||A|| -> P) ]
                        (∀ {P p g} -> (a : A) -> g-bar P p g (η a) == g a))


minimise : {f : ℕ -> ℕ} ->
           isPropTruncOf (Σ[ n ∈ ℕ ] (f n == 0))
                         (Σ[ n ∈ ℕ ] ((f n == 0) ×
                                      ((m : ℕ) -> f m == 0 -> True (n < m))))
minimise = {!!}