Martin Escardo 7th December 2018.

Characterization of equality in the lifting via the structure of
identity principle.

\begin{code}

{-# OPTIONS --safe --without-K #-}

open import MLTT.Spartan

module Lifting.IdentityViaSIP
        (๐“ฃ : Universe)
        {๐“ค : Universe}
        {X : ๐“ค ฬ‡ }
       where

open import UF.Base
open import UF.Subsingletons
open import UF.Subsingletons-FunExt
open import UF.Equiv
open import UF.EquivalenceExamples
open import UF.FunExt
open import UF.Univalence
open import UF.UA-FunExt
open import UF.StructureIdentityPrinciple

open import Lifting.Construction ๐“ฃ

_โ‹_ : ๐“› X โ†’ ๐“› X โ†’ ๐“ฃ โŠ” ๐“ค ฬ‡
l โ‹ m = ฮฃ e ๊ž‰ is-defined l โ‰ƒ is-defined m , value l ๏ผ value m โˆ˜ โŒœ e โŒ

๐“›-Id : is-univalent ๐“ฃ โ†’ (l m : ๐“› X) โ†’ (l ๏ผ m) โ‰ƒ (l โ‹ m)
๐“›-Id ua = ๏ผ-is-โ‰ƒโ‚›'
 where
  open gsip-with-axioms'
        ๐“ฃ (๐“ฃ โŠ” ๐“ค) (๐“ฃ โŠ” ๐“ค) ๐“ฃ ua
        (ฮป P โ†’ P โ†’ X)
        (ฮป P s โ†’ is-prop P)
        (ฮป P s โ†’ being-prop-is-prop (univalence-gives-funext ua))
        (ฮป {l m (f , e) โ†’ prโ‚‚ l ๏ผ prโ‚‚ m โˆ˜ f})
        (ฮป l โ†’ refl)
        (ฮป P ฮต ฮด โ†’ id)
        (ฮป A ฯ„ ฯ… โ†’ refl-left-neutral)

โ‹-gives-๏ผ : is-univalent ๐“ฃ โ†’ {l m : ๐“› X} โ†’ (l โ‹ m) โ†’ l ๏ผ m
โ‹-gives-๏ผ ua = โŒœ ๐“›-Id ua _ _ โŒโปยน

\end{code}

When dealing with functions it is often more convenient to work with
pointwise equality, and hence we also consider:

\begin{code}

_โ‹ยท_ : ๐“› X โ†’ ๐“› X โ†’ ๐“ฃ โŠ” ๐“ค ฬ‡
l โ‹ยท m = ฮฃ e ๊ž‰ is-defined l โ‰ƒ is-defined m , value l โˆผ value m โˆ˜ โŒœ e โŒ

is-defined-โ‹ยท : (l m : ๐“› X)
              โ†’ l โ‹ยท m โ†’ is-defined l โ‰ƒ is-defined m
is-defined-โ‹ยท l m = prโ‚

value-โ‹ยท : (l m : ๐“› X) (๐•— : l โ‹ยท m)
         โ†’ value l โˆผ (ฮป x โ†’ value m (โŒœ is-defined-โ‹ยท l m ๐•— โŒ x))
value-โ‹ยท l m = prโ‚‚

Id-to-โ‹ยท : (l m : ๐“› X) โ†’ (l ๏ผ m) โ†’ (l โ‹ยท m)
Id-to-โ‹ยท l m refl = (โ‰ƒ-refl (is-defined l)) , (ฮป x โ†’ refl)

๐“›-Idยท : is-univalent ๐“ฃ
      โ†’ funext ๐“ฃ ๐“ค
      โ†’ (l m : ๐“› X) โ†’ (l ๏ผ m) โ‰ƒ (l โ‹ยท m)
๐“›-Idยท ua fe l m = (๐“›-Id ua l m)
                โ— (ฮฃ-cong (ฮป e โ†’ โ‰ƒ-funext fe (value l) (value m โˆ˜ โŒœ e โŒ)))

โ‹ยท-gives-๏ผ : is-univalent ๐“ฃ
           โ†’ funext ๐“ฃ ๐“ค
           โ†’ {l m : ๐“› X} โ†’ (l โ‹ยท m) โ†’ l ๏ผ m
โ‹ยท-gives-๏ผ ua fe = โŒœ ๐“›-Idยท ua fe _ _ โŒโปยน

\end{code}