{-# OPTIONS --without-K #-} -- this disables uniqueness of identity proofs

module lec2-exercises where

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

----- 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 -----------------------------------------------

_·_ : {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 r = refl

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

isContr : Set -> Set
isContr A = Σ A (λ x → (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 = Σ (B -> A) (λ g →
                    Σ ((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 = Σ (B -> A) (λ g →
                     Σ ((x : A) → g (f x) == x) λ η →
                       ((y : B) → f (g y) == y))

_≃_ : 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

{---- Part 1: hlevels ------------------------------------}

-- Exercise 1: prove the theorem on slide 5

contr→prop : {A : Set} -> isContr A -> isProp A
contr→prop p = {!!}

contr-if-inhabited→prop : {A : Set} -> (A -> isContr A) -> isProp A
contr-if-inhabited→prop g x y = {!!}

prop→set : {A : Set} -> isProp A -> isSet A
prop→set f x y p q = {!!}

-- Exercise 2: here is another characterisation of propositions:

prop→all-contr : {A : Set} -> isProp A -> ((x y : A) -> isContr (x == y))
prop→all-contr f x y = {!!}

all-contr→prop : {A : Set} -> ((x y : A) -> isContr (x == y)) -> isProp A
all-contr→prop g = {!!}

-- does this suggest a pattern in the definition of homotopy n-types?

-- Exercise 3: prove the vacuum cord principle on slide 8

vacuum-cord : {A : Set} -> (a : A) -> isContr (Σ A λ x → x == a)
vacuum-cord a = {!!}

-- Exercise 4: Closure properties (harder)

contr-is-contr : {A : Set} -> isContr A -> isContr (isContr A)
contr-is-contr p = {!!}

prop-is-prop-always : {A : Set} -> isProp (isProp A)
prop-is-prop-always = {!!}

{---- Part 2: Equivalences -------------------------------}

-- Exercise 5: Prove that quasi-equivalences can be upgraded to equivalences

adjointify : {A B : Set} -> (f : A -> B) -> qinv f -> isEquiv f
adjointify f p = {!!}

-- Exercise 6: Prove that A is contractible iff A ≃ 1
contr→trivial : {A : Set} -> isContr A -> A ≃ ⊤
contr→trivial p = {!!}

trivial→contr : {A : Set} -> A ≃ ⊤ -> isContr A
trivial→contr q = {!!}

-- Exercise 7: Extract an equivalence from a Voevodsky equivalence

fib : {A B : Set} -> (f : A -> B) -> B -> Set
fib {A} f y = Σ A λ x → f x == y

voevoedsky→equiv : {A B : Set} -> (f : A -> B) ->
                   ((y : B) -> isContr (fib f y)) -> isEquiv f
voevoedsky→equiv f p = {!!}

-- Exercise 8: Construct a "bi-functional relation" from an equivalence
equiv→bifun : {A B : Set} -> (f : A -> B) -> isEquiv f ->
              Σ (A -> B -> Set) λ R →
                Σ ((a : A) → isContr (Σ B λ b → R a b)) λ _ →
                  ((b : B) → isContr (Σ A λ a → R a b))
equiv→bifun f p = {!!}