\import Algebra.Meta
\import Category
\import Category.Limit
\import Equiv
\import Function.Meta
\import Logic
\import Meta
\import Paths
\import Paths.Meta
\class WFS {\classifying C : Precat} (L R : \Pi {x y : C} -> Hom x y -> \Prop) {
| factors {x z : C} (h : Hom x z) : \Sigma (y : C) (f : Hom x y) (g : Hom y z) (g ∘ f = h) (L f) (R g)
| lift {a b c d : C} (t : Hom a c) (s : Hom b d) (f : Hom a b) (g : Hom c d)
: g ∘ t = s ∘ f -> L f -> R g -> \Sigma (l : Hom b c) (l ∘ f = t) (g ∘ l = s)
} \where {
\open PrecatWithBprod
\lemma left-epi {C : CartesianPrecat} (w : WFS {C}) {x y : C} (f : Hom x y) (Lf : L f) {z : C} (Rd : R (diagonal z)) {g h : Hom y z} (p : g ∘ f = h ∘ f) : g = h
=> \have | (l,_,q) => lift (g ∘ f) (pair g h) f (diagonal z) (inv o-assoc *> pmap (∘ f) (pair-comp *> pmap2 pair id-left id-left) *> pair-comp *> pmap (pair _) p *> inv pair-comp) Lf Rd
| l=g => inv (pmap (∘ l) beta1) *> o-assoc *> pmap (proj1 ∘) q *> beta1
| l=h => inv (pmap (∘ l) beta2) *> o-assoc *> pmap (proj2 ∘) q *> beta2
\in inv l=g *> l=h
}
\class OFS \extends WFS
| unique-lift {a b c d : C} (f : Hom a b) (g : Hom c d)
: L f -> R g -> IsEquiv {Hom b c} {\Sigma (t : Hom a c) (s : Hom b d) (g ∘ t = s ∘ f)} (\lam l => (l ∘ f, g ∘ l, inv o-assoc))
| lift t s f g p Lf Rg =>
\have q => IsEquiv.f_ret (unique-lift f g Lf Rg)
\in (IsEquiv.ret (unique-lift f g Lf Rg) $ later (t,s,p), pmap __.1 q, pmap __.2 q)
\where {
\lemma liftFromMono {C : Precat} {a b c d : C} (f : Hom a b) (g : Hom c d) (m : Mono g) (l : \Pi (t : Hom a c) (s : Hom b d) -> g ∘ t = s ∘ f -> \Sigma (l : Hom b c) (g ∘ l = s))
: IsEquiv {Hom b c} {\Sigma (t : Hom a c) (s : Hom b d) (g ∘ t = s ∘ f)} (\lam l => (l ∘ f, g ∘ l, inv o-assoc))
=> IsEquiv.fromInjSurj
(\lam {l1} {l2} p => m.isMono (pmap __.2 p))
(\lam (t,s,p) => inP ((l t s p).1, ext (m.isMono (rewriteEq (l t s p).2 (inv p)), (l t s p).2)))
}