import category_theory.adjunction.basic
import category_theory.limits.has_limits
import data.pfun

open category_theory category_theory.functor category_theory.limits
universes u v
variables (𝒞 : Type) [category.{0} 𝒞]

inductive bicompletion_aux : bool → Type 1
| of_cat_obj : 𝒞 → bicompletion_aux ff
| limit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt) : bicompletion_aux ff
| colimit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt) : bicompletion_aux ff
| of_cat_hom : Π {X Y : 𝒞}, (X ⟶ Y) → bicompletion_aux tt -- of_cat_obj X ⟶ of_cat_obj Y
| limit_cone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt)
  (X : 𝒟) (Y : bicompletion_aux ff) (f : bicompletion_aux tt) : -- F_obj X ⟶ Y
  bicompletion_aux tt -- limit_obj F_obj F_hom ⟶ Y
| colimit_cocone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt)
  (X : 𝒟) (Y : bicompletion_aux ff) (f : bicompletion_aux tt) : -- Y ⟶ F_obj X
  bicompletion_aux tt -- Y ⟶ colimit_obj F_obj F_hom
| is_limit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt)
  (cone_obj : bicompletion_aux ff)
  (cone : Π (X : 𝒟), bicompletion_aux tt) : -- cone_obj ⟶ F_obj X
  bicompletion_aux tt -- cone_obj → limit_obj F_obj F_hom
| is_colimit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt)
  (cocone_obj : bicompletion_aux ff)
  (cocone : Π (X : 𝒟), bicompletion_aux tt) : -- F_obj X ⟶ cocone_obj
  bicompletion_aux tt -- colimit_obj F_obj F_hom ⟶ cocone_obj
| id (X : bicompletion_aux ff) : bicompletion_aux tt -- X ⟶ X

namespace bicompletion_aux

variable {𝒞}

@[simp] def dom : Π (X : bicompletion_aux 𝒞 tt), bicompletion_aux 𝒞 ff
| (@of_cat_hom _ _ X Y f) := of_cat_obj X
| (@limit_cone_comp _ _ 𝒟 _ F_obj F_hom X _ _) := by exactI limit_obj F_obj @F_hom
| (@is_limit _ _ 𝒟 _ F_obj F_hom cone_obj cone) := cone_obj
| (@colimit_cocone_comp _ _ 𝒟 _ F_obj F_hom X Y f) := Y
| (@is_colimit _ _ 𝒟 _ F_obj F_hom cocone_obj cocone) := by exactI colimit_obj F_obj @F_hom
| (id X) := X

@[simp] def cod : Π (X : bicompletion_aux 𝒞 tt), bicompletion_aux 𝒞 ff
| (@of_cat_hom _ _ X Y f) := of_cat_obj Y
| (@colimit_cocone_comp _ _ 𝒟 _ F_obj F_hom X _ _) := by exactI colimit_obj F_obj @F_hom
| (@is_colimit _ _ 𝒟 _ F_obj F_hom cocone_obj cocone) := cocone_obj
| (@limit_cone_comp _ _ 𝒟 _ F_obj F_hom X Y f) := Y
| (@is_limit _ _ 𝒟 _ F_obj F_hom cone_obj cone) := by exactI limit_obj F_obj @F_hom
| (id X) := X

variable (𝒞)

def obj₁ : Type 1 := bicompletion_aux 𝒞 ff

variable {𝒞}
variables {𝒟 : Type} [category.{0} 𝒟]

def hom₁ (X Y : obj₁ 𝒞) : Type 1 :=
{ f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }

@[simp] lemma coe_dom {X Y : obj₁ 𝒞} (f : hom₁ X Y) :
  (@coe { f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }
    (bicompletion_aux 𝒞 tt) _ f).dom = X := f.2.1

@[simp] lemma coe_cod {X Y : obj₁ 𝒞} (f : hom₁ X Y) :
  (@coe { f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }
    (bicompletion_aux 𝒞 tt) _ f).cod = Y := f.2.2

def of_cat_obj₁ (X : 𝒞) : obj₁ 𝒞 := of_cat_obj X

def limit_obj₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) : obj₁ 𝒞 :=
limit_obj F_obj (λ X Y f, (F_hom f).1)

def colimit_obj₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) : obj₁ 𝒞 :=
colimit_obj F_obj (λ X Y f, (F_hom f).1)

def of_cat_hom₁ {X Y : 𝒞} (f : X ⟶ Y) : hom₁ (of_cat_obj X) (of_cat_obj Y) :=
⟨of_cat_hom f, by simp⟩

def limit_cone_comp₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₁ 𝒞} (f : hom₁ (F_obj X) Y) :
  hom₁ (limit_obj₁ F_obj @F_hom) Y :=
⟨limit_cone_comp F_obj (λ X Y f, (F_hom f).1) X Y f.1, by simp [limit_obj₁]⟩

def colimit_cocone_comp₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₁ 𝒞} (f : hom₁ Y (F_obj X)) :
  hom₁ Y (colimit_obj₁ F_obj @F_hom) :=
⟨colimit_cocone_comp F_obj (λ X Y f, (F_hom f).1) X Y f.1, by simp [colimit_obj₁]⟩

def is_limit₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cone_obj : obj₁ 𝒞)
  (cone : Π (X : 𝒟), hom₁ cone_obj (F_obj X)) :
  hom₁ cone_obj (limit_obj₁ F_obj @F_hom) :=
⟨is_limit F_obj (λ X Y f, (F_hom f).1) cone_obj (λ X, (cone X).1), by simp [limit_obj₁]⟩

def is_colimit₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cocone_obj : obj₁ 𝒞)
  (cocone : Π (X : 𝒟), hom₁ (F_obj X) cocone_obj) :
  hom₁ (colimit_obj₁ F_obj @F_hom) cocone_obj  :=
⟨is_colimit F_obj (λ X Y f, (F_hom f).1) cocone_obj (λ X, (cocone X).1), by simp [colimit_obj₁]⟩

def id₁ (X : obj₁ 𝒞) : hom₁ X X := ⟨id X, rfl, rfl⟩

@[elab_as_eliminator] def bicompletion_tt_rec_on
  {motive : bicompletion_aux 𝒞 tt → Sort u}
  (f : bicompletion_aux 𝒞 tt)
  (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom f))
  (limit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt)
    (ih : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)),
      motive f → by exactI motive (limit_cone_comp F_obj @F_hom X Y f))
  (colimit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt)
    (ih : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)),
      motive f → by exactI motive (colimit_cocone_comp F_obj @F_hom X Y f))
  (is_limit : Π {𝒟 : Type} [_inst_2 : category 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cone_obj : bicompletion_aux 𝒞 ff)
    (cone : 𝒟 → bicompletion_aux 𝒞 tt)
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
    by exactI motive (is_limit F_obj @F_hom cone_obj cone))
  (is_colimit : Π {𝒟 : Type} [_inst_2 : category 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cone_obj : bicompletion_aux 𝒞 ff)
    (cone : 𝒟 → bicompletion_aux 𝒞 tt)
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
    by exactI motive (is_colimit F_obj @F_hom cone_obj cone))
  (id : Π (X : bicompletion_aux 𝒞 ff), motive X.id) :
  motive f := sorry

def comp₁ (f : bicompletion_aux 𝒞 tt) : bicompletion_aux 𝒞 tt → part (bicompletion_aux 𝒞 tt) :=
bicompletion_tt_rec_on f
  begin
    intros X Y f g,
    refine bicompletion_tt_rec_on g _ _ _ _ _ _,
    { intros B C g,
      exact ⟨Y = B, λ h, by subst h; exact of_cat_hom (f ≫ g)⟩ },
    { intros, exact part.none },
    { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂,
      exact ih₂ >>= λ ih₂, return (colimit_cocone_comp F_obj @F_hom A B ih₂) },
    { introsI 𝒟 _ F_obj F_hom A cone ih₁ ih₂,
      exact ⟨∀ (X : 𝒟), (ih₂ X).dom, λ h, is_limit F_obj @F_hom (of_cat_obj X) (λ X, (ih₂ X).get (h X))⟩ },
    { intros, exact part.none },
    { intros, exact return (of_cat_hom f) }
  end
  begin
    introsI 𝒟 _ F_obj F_hom A B f _ ih₂ g,
    exact ih₂ g >>= λ ih₂, return (limit_cone_comp F_obj @F_hom A B ih₂)
  end
  begin
    introsI 𝒟 _ F_obj F_hom A B f ih₁ ih₂ g,
    revert ih₂ A,
    refine bicompletion_tt_rec_on g _ _ _ _ _ _,
    { intros, exact part.none },
    { intros, exact part.none },
    { introsI ℰ _ G_obj G_hom C Y g ih₃ ih₄ ih₂ A,
      exact ih₄ ih₂ A >>= λ ih₄, return (colimit_cocone_comp G_obj @G_hom C Y ih₄) },
    { introsI ℰ _ G_obj G_hom _ g ih₃ ih₄ ih₂ A,
      exact ⟨Π (X : ℰ), (ih₄ X ih₂ A).dom,
        λ h, is_limit G_obj @G_hom B (λ X, (ih₄ X ih₂ A).get (h X))⟩ },
    { introsI ℰ _ G_obj G_hom cocone_obj cocone _ g ih₂ A,
      exact ih₂ (cocone _) },
    { intros A f _,
      exact colimit_cocone_comp₂ F_obj @F_hom A f }
  end
  _ _ (λ _, return)
  -- begin
  --   introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ Z g,
  --   revert ih₂,
  --   refine hom₂_limit_obj_rec_on g _ _ _ _,
  --   { introsI ℰ _ G_obj G_hom A B g ih₂,
  --     exact ih₂ A g },
  --   { introsI ℰ _ F_obj F_hom A ℱ _ G_obj G_hom g ih₃ ih₂,
  --     exact colimit_cocone_comp₂ F_obj @F_hom A (ih₃ @ih₂) },
  --   { introsI ℰ _ F_obj F_hom ℱ _ G_obj G_hom ih₃ ih₄ ih₂,
  --     exact is_limit₂ F_obj @F_hom cone_obj (λ X, ih₄ _ @ih₂) },
  --   { introsI ih,
  --     exact is_limit₂ F_obj @F_hom cone_obj cone }
  -- end
  -- begin
  --   introsI 𝒟 _ F_obj F_hom ih₁ cocone_obj cocone ih₂ Z g,
  --   exact is_colimit₂ F_obj @F_hom Z (λ A, ih₂ A g)
  -- end
  -- (λ _ _ g, g)

inductive valid_obj₁ : Π (X : obj₁ 𝒞), Prop
| of_cat_obj (X : 𝒞) : valid_obj₁ (of_cat_obj X)
| limit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (h : Π X : 𝒟, valid_obj₁ (F_obj X)) :
  valid_obj₁ (limit_obj₁ F_obj @F_hom)
| colimit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (h : Π X : 𝒟, valid_obj₁ (F_obj X)) :
  valid_obj₁ (colimit_obj₁ F_obj @F_hom)

def valid_obj₁_limit_obj
  {𝒟 : Type} [category.{0} 𝒟] {F_obj : 𝒟 → obj₁ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux 𝒞 tt}
  (h : valid_obj₁ (limit_obj F_obj @F_hom)) :
  Π (X : 𝒟), valid_obj₁ (F_obj X) :=
begin
  generalize hX : limit_obj F_obj @F_hom = X,
  rw hX at h,
  induction h,
  { simp * at * },
  { simp [limit_obj₁] at hX,
    rcases hX with ⟨hX₁, hX₂, hX₂, hX₄⟩,
    subst hX₁,
    simp at *,
    subst hX₂,
    assumption },
  { simp [*, colimit_obj₁] at * }
end

def valid_obj₁_colimit_obj
  {𝒟 : Type} [category.{0} 𝒟] {F_obj : 𝒟 → obj₁ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux 𝒞 tt}
  (h : valid_obj₁ (colimit_obj F_obj @F_hom)) :
  Π (X : 𝒟), valid_obj₁ (F_obj X) :=
begin
  generalize hX : colimit_obj F_obj @F_hom = X,
  rw hX at h,
  induction h,
  { simp * at * },
  { simp [*, limit_obj₁] at * },
  { simp [colimit_obj₁] at hX,
    rcases hX with ⟨hX₁, hX₂, hX₂, hX₄⟩,
    subst hX₁,
    simp at *,
    subst hX₂,
    assumption }
end

@[elab_as_eliminator] def hom_rec_on {motive : bicompletion_aux 𝒞 tt → Sort u}
  (f : bicompletion_aux 𝒞 tt)
  (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom f))
  (limit_cone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    motive f → motive (by exactI limit_cone_comp F_obj @F_hom X Y f))
  (is_limit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cone_obj : bicompletion_aux 𝒞 ff)
    (cone : 𝒟 → bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    (Π (X : 𝒟), motive (cone X)) → motive (by exactI is_limit F_obj @F_hom cone_obj cone))
  (colimit_cocone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    motive f → motive (by exactI colimit_cocone_comp F_obj @F_hom X Y f))
  (is_colimit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
   (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cocone_obj : bicompletion_aux 𝒞 ff)
   (cocone : 𝒟 → bicompletion_aux 𝒞 tt),
     (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
     (Π (X : 𝒟), motive (cocone X)) → motive (by exactI is_colimit F_obj @F_hom cocone_obj cocone))
  (id : Π (X : obj₁ 𝒞), motive (id X)) :
  motive f :=
have ∀ b (f : bicompletion_aux 𝒞 b) (h : b = tt), motive (eq.rec_on h f) :=
  begin
    intros b f,
    refine bicompletion_aux.rec_on f _ _ _ _ _ _ _ _ _,
    { intros, simp at *, contradiction },
    { intros, simp at *, contradiction },
    { intros, simp at *, contradiction },
    { intros X Y f _,
      exact of_cat_hom f },
    { introsI 𝒟 _ F_obj F_hom X Y f ih₁ ih₂ ih₃ ih₄ _,
      exact limit_cone_comp F_obj @F_hom X Y f (λ X Y f, ih₂ f rfl) (ih₄ rfl) },
    { introsI 𝒟 _ F_obj F_hom X Y f ih₁ ih₂ ih₃ ih₄ _,
      exact colimit_cocone_comp F_obj @F_hom X Y f (λ X Y f, ih₂ f rfl) (ih₄ rfl) },
    { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ ih₃ ih₄ _,
      exact is_limit F_obj @F_hom cone_obj cone (λ X Y f, ih₂ f rfl) (λ X, ih₄ X rfl) },
    { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ ih₃ ih₄ _,
      exact is_colimit F_obj @F_hom cone_obj cone (λ X Y f, ih₂ f rfl) (λ X, ih₄ X rfl) },
    { intros X _ _, exact id X }
  end,
this tt f rfl

inductive valid_hom₁ : Π {X Y : obj₁ 𝒞}, hom₁ X Y → Prop
| of_cat_hom {X Y : 𝒞} (f : X ⟶ Y) : valid_hom₁ (of_cat_hom₁ f)
| id (X : obj₁ 𝒞) : valid_hom₁ (id₁ X)
| limit_cone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (X : 𝒟) {Y : obj₁ 𝒞} (f : hom₁ (F_obj X) Y)
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (f_valid : valid_hom₁ f) :
  valid_hom₁ (limit_cone_comp₁ F_obj @F_hom X f)
| colimit_cocone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (X : 𝒟) {Y : obj₁ 𝒞} (f : hom₁ Y (F_obj X))
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (f_valid : valid_hom₁ f) :
  valid_hom₁ (colimit_cocone_comp₁ F_obj @F_hom X f)
| is_limit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cone_obj : obj₁ 𝒞)
  (cone : Π (X : 𝒟), hom₁ cone_obj (F_obj X))
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (cone_valid : Π (X : 𝒟), valid_hom₁ (cone X)) :
  valid_hom₁ (is_limit₁ F_obj @F_hom cone_obj cone)
| is_colimit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cocone_obj : obj₁ 𝒞)
  (cocone : Π (X : 𝒟), hom₁ (F_obj X) cocone_obj)
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (cocone_valid : Π (X : 𝒟), valid_hom₁ (cocone X)) :
  valid_hom₁ (is_colimit₁ F_obj @F_hom cocone_obj cocone)

variable (𝒞)

def obj₂ : Type 1 := { X : obj₁ 𝒞 // valid_obj₁ X }

variable {𝒞}

def hom₂ (X Y : obj₂ 𝒞) : Type 1 := { f : hom₁ X.1 Y.1 // valid_hom₁ f }

open valid_hom₁

def of_cat_obj₂ (X : 𝒞) : obj₂ 𝒞 :=
⟨of_cat_obj X, valid_obj₁.of_cat_obj _⟩

lemma of_cat_obj₂_injective : function.injective (@of_cat_obj₂ 𝒞 _) :=
begin
  intros X Y hXY,
  simp [of_cat_obj₂] at hXY,
  injection hXY,
end

def limit_obj₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) : obj₂ 𝒞 :=
⟨limit_obj₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1), valid_obj₁.limit_obj _ _ (λ X, (F_obj X).2)⟩

lemma limit_obj₂_injective {𝒟₁ 𝒟₂ : Type} [i₁ : category 𝒟₁] [i₂ : category 𝒟₂]
  {F_obj₁ : 𝒟₁ → obj₂ 𝒞} {F_obj₂ : 𝒟₂ → obj₂ 𝒞}
  {F_hom₁ : Π {X Y : 𝒟₁}, (X ⟶ Y) → hom₂ (F_obj₁ X) (F_obj₁ Y)}
  {F_hom₂ : Π {X Y : 𝒟₂}, (X ⟶ Y) → hom₂ (F_obj₂ X) (F_obj₂ Y)}
  (h : limit_obj₂ F_obj₁ @F_hom₁ = limit_obj₂ F_obj₂ @F_hom₂) :
  𝒟₁ = 𝒟₂ ∧ i₁ == i₂ ∧ F_obj₁ == F_obj₂ ∧ @F_hom₁ == @F_hom₂ :=
begin
  simp [limit_obj₂, limit_obj₁] at h,
  injection h with h₁ h₂ h₃ h₄,
  unfreezingI { subst h₁ },
  rw heq_iff_eq at h₂,
  unfreezingI { subst h₂ },
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₃,
  rw [← function.funext_iff] at h₃,
  dsimp at h₃,
  subst h₃,
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₄,
  simp,
  ext,
  simp *
end

def colimit_obj₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) : obj₂ 𝒞 :=
⟨colimit_obj₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1), valid_obj₁.colimit_obj _ _ (λ X, (F_obj X).2)⟩

lemma colimit_obj₂_injective {𝒟₁ 𝒟₂ : Type} [i₁ : category 𝒟₁] [i₂ : category 𝒟₂]
  {F_obj₁ : 𝒟₁ → obj₂ 𝒞} {F_obj₂ : 𝒟₂ → obj₂ 𝒞}
  {F_hom₁ : Π {X Y : 𝒟₁}, (X ⟶ Y) → hom₂ (F_obj₁ X) (F_obj₁ Y)}
  {F_hom₂ : Π {X Y : 𝒟₂}, (X ⟶ Y) → hom₂ (F_obj₂ X) (F_obj₂ Y)}
  (h : colimit_obj₂ F_obj₁ @F_hom₁ = colimit_obj₂ F_obj₂ @F_hom₂) :
  𝒟₁ = 𝒟₂ ∧ i₁ == i₂ ∧ F_obj₁ == F_obj₂ ∧ @F_hom₁ == @F_hom₂ :=
begin
  simp [colimit_obj₂, colimit_obj₁] at h,
  injection h with h₁ h₂ h₃ h₄,
  unfreezingI { subst h₁ },
  rw heq_iff_eq at h₂,
  unfreezingI { subst h₂ },
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₃,
  rw [← function.funext_iff] at h₃,
  dsimp at h₃,
  subst h₃,
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₄,
  simp,
  ext,
  simp *
end

def of_cat_hom₂ {X Y : 𝒞} (f : X ⟶ Y) : hom₂ (of_cat_obj₂ X) (of_cat_obj₂ Y) :=
⟨of_cat_hom₁ f, valid_hom₁.of_cat_hom _⟩

def limit_cone_comp₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y) :
  hom₂ (limit_obj₂ F_obj @F_hom) Y :=
⟨limit_cone_comp₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) X f.1,
  valid_hom₁.limit_cone_comp _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) f.2⟩

def colimit_cocone_comp₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₂ 𝒞} (f : hom₂ Y (F_obj X)):
  hom₂ Y (colimit_obj₂ F_obj @F_hom) :=
⟨colimit_cocone_comp₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) X f.1,
  valid_hom₁.colimit_cocone_comp _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) f.2⟩

def is_limit₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
  (cone_obj : obj₂ 𝒞)
  (cone : Π (X : 𝒟), hom₂ cone_obj (F_obj X)) :
  hom₂ cone_obj (limit_obj₂ F_obj @F_hom) :=
⟨is_limit₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) cone_obj.1 (λ X, (cone X).1),
  valid_hom₁.is_limit _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) (λ X, (cone X).2)⟩

def is_colimit₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
  (cocone_obj : obj₂ 𝒞)
  (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj) :
  hom₂ (colimit_obj₂ F_obj @F_hom) cocone_obj  :=
⟨is_colimit₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) cocone_obj.1 (λ X, (cocone X).1),
  valid_hom₁.is_colimit _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) (λ X, (cocone X).2)⟩

def id₂ (X : obj₂ 𝒞) : hom₂ X X := ⟨id₁ X.1, valid_hom₁.id _⟩

@[elab_as_eliminator] protected def hom₂.rec_on
  {motive : Π {X Y : obj₂ 𝒞} (f : hom₂ X Y), Sort*} {X Y : obj₂ 𝒞} (f : hom₂ X Y)
  (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom₂ f))
  (limit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y)
    (ih_f : motive f),
      motive (by exactI limit_cone_comp₂ F_obj @F_hom X f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ Y (F_obj X))
    (ih_f : motive f),
      motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (cone_obj : obj₂ 𝒞) (cone : Π (X : 𝒟), hom₂ cone_obj (F_obj X))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
      motive (by exactI is_limit₂ F_obj @F_hom cone_obj cone))
  (is_colimit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (cocone_obj : obj₂ 𝒞) (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj)
    (ih_cone : Π (X : 𝒟), motive (cocone X)),
      motive (by exactI is_colimit₂ F_obj @F_hom cocone_obj cocone))
  (id : Π (X : obj₂ 𝒞), motive (id₂ X)):
  motive f :=
begin
  cases X with X hX, cases Y with Y hY,
  cases f with f hf,
  rcases f with ⟨f, hfd, hfc⟩,
  revert X Y hX hY,
  refine hom_rec_on f _ _ _ _ _ _,
  { intros A B f X Y hX hY hfd hfc hf,
    dsimp at hfd hfc, substs hfc hfd,
    exact of_cat_hom f },
  { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc, substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
     let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    have valid_g :
      ∃ (h₁ : g.dom = F_obj A) (h₂ : g.cod = B),
      valid_hom₁ ⟨g, h₁, h₂⟩,
    { cases hf, simpa },
    let g' : hom₂ (F_obj' A) ⟨B, hY⟩ :=
      ⟨⟨g, valid_g.fst, valid_g.snd.fst⟩, valid_g.snd.snd⟩,
    exact limit_cone_comp F_obj' F_hom'
      (λ X Y f, ih₁ f (F_obj X) (F_obj Y) (valid_F_obj _) (valid_F_obj _)
          (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
          (valid_F_hom _ _ f).snd.snd) A g'
          (ih₂ (F_obj' A).1 B (F_obj' A).2 hY g'.1.2.1 g'.1.2.2 g'.2) },
  { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc,
    substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
    let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    let cone_obj' : obj₂ 𝒞 := ⟨cone_obj, hX⟩,
    have valid_cone : ∀ (X : 𝒟), ∃ (h₁ : (cone X).dom = cone_obj'.1)
      (h₂ : (cone X).cod = (F_obj' X).1),
      valid_hom₁ ⟨cone X, h₁, h₂⟩,
    { cases hf, simpa },
    let cone' : Π (X : 𝒟), hom₂ cone_obj' (F_obj' X) :=
      λ X, ⟨⟨cone X, (valid_cone X).fst, (valid_cone X).snd.fst⟩, (valid_cone X).snd.snd⟩,
    exact is_limit F_obj' F_hom'
      (λ A B f, ih₁ f (F_obj A) (F_obj B) (F_obj' A).2 (F_obj' B).2
        (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
        (valid_F_hom _ _ f).snd.snd)
        cone_obj' cone'
        (λ X, ih₂ X cone_obj'.1 (F_obj' X).1 cone_obj'.2 (F_obj' X).2
            (cone' X).1.2.1 (cone' X).1.2.2 (cone' X).2) },
  { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc, substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
    have valid_g :
      ∃ (h₁ : g.dom = B) (h₂ : g.cod = F_obj A),
      valid_hom₁ ⟨g, h₁, h₂⟩,
    { cases hf, simpa },
    let g' : hom₂ ⟨B, hX⟩ (F_obj' A) :=
      ⟨⟨g, valid_g.fst, valid_g.snd.fst⟩, valid_g.snd.snd⟩,
    let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    exact colimit_cocone_comp F_obj' F_hom'
      (λ X Y f, ih₁ f (F_obj X) (F_obj Y) (valid_F_obj _) (valid_F_obj _)
          (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
          (valid_F_hom _ _ f).snd.snd) A g'
          (ih₂ B (F_obj' A).1 hX (F_obj' A).2 g'.1.2.1 g'.1.2.2 g'.2) },
  { introsI 𝒟 _ F_obj F_hom cocone_obj cocone ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc,
    substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
    let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    let cocone_obj' : obj₂ 𝒞 := ⟨cocone_obj, hY⟩,
    have valid_cocone : ∀ (X : 𝒟), ∃ (h₁ : (cocone X).dom = (F_obj' X).1)
      (h₂ : (cocone X).cod = cocone_obj'.1),
      valid_hom₁ ⟨cocone X, h₁, h₂⟩,
    { cases hf, simpa },
    let cocone' : Π (X : 𝒟), hom₂ (F_obj' X) cocone_obj' :=
      λ X, ⟨⟨cocone X, (valid_cocone X).fst, (valid_cocone X).snd.fst⟩, (valid_cocone X).snd.snd⟩,
    exact is_colimit F_obj' F_hom'
      (λ A B f, ih₁ f (F_obj A) (F_obj B) (F_obj' A).2 (F_obj' B).2
        (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
        (valid_F_hom _ _ f).snd.snd)
        cocone_obj' cocone'
        (λ X, ih₂ X (F_obj' X).1 cocone_obj'.1 (F_obj' X).2 cocone_obj'.2
            (cocone' X).1.2.1 (cocone' X).1.2.2 (cocone' X).2) },
  { intros A B C hB _ hAB hBC _,
    dsimp at hAB hBC, subst A, subst C,
    exact id ⟨B, hB⟩ }
end

def hom₂_of_cat_obj_rec_on
  {motive : Π {X : 𝒞} {Y : obj₂ 𝒞} (f : hom₂ (of_cat_obj₂ X) Y), Sort*}
  {X : 𝒞} {Y : obj₂ 𝒞} (f : hom₂ (of_cat_obj₂ X) Y)
  (of_cat_hom : Π {Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom₂ f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟) {Y : 𝒞} (f : hom₂ (of_cat_obj₂ Y) (F_obj X))
    (ih_f : motive f),
      motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (cone_obj : 𝒞) (cone : Π (X : 𝒟), hom₂ (of_cat_obj₂ cone_obj) (F_obj X))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
      motive (by exactI is_limit₂ F_obj @F_hom (of_cat_obj₂ cone_obj) cone))
  (id : motive (id₂ (of_cat_obj₂ X))):
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = of_cat_obj₂ X),
  motive (show hom₂ (of_cat_obj₂ X) B, from eq.rec_on h f))
  (of_cat_obj₂ X) Y f
  (λ A B g h, begin
      have := of_cat_obj₂_injective h,
      subst this,
      dsimp,
      exact of_cat_hom g
    end)
  begin
    intros,
    simp [limit_obj₂, of_cat_obj₂, limit_obj₁] at h,
    contradiction
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B g ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ _ (λ A, ih₂ A rfl),
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂] at h,
    contradiction
  end
  begin
    intros X h,
    subst h,
    exact id
  end
  rfl

def hom₂_limit_obj_rec_on
  {motive : Π {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
    {F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞},
    hom₂ (by exactI limit_obj₂ F_obj @F_hom) Y → Sort*}
  {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞}
  (f : hom₂ (limit_obj₂ F_obj @F_hom) Y)
  (limit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y),
      by exactI motive (limit_cone_comp₂ F_obj @F_hom X f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟)
    {ℰ : Type} [category ℰ] (G_obj : ℰ → obj₂ 𝒞)
    (G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y))
    (f : hom₂ (by exactI limit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_f : by exactI motive f),
      by exactI motive (colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    {ℰ : Type} [category ℰ] (G_obj : ℰ → obj₂ 𝒞)
    (G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y))
    (cone : Π (X : 𝒟), hom₂ (by exactI limit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_cone : Π (X : 𝒟), by exactI motive (cone X)),
      by exactI motive (is_limit₂ F_obj @F_hom (limit_obj₂ G_obj @G_hom) cone))
  (id : by exactI motive (id₂ (limit_obj₂ F_obj @F_hom))) :
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = limit_obj₂ F_obj @F_hom),
  motive (show hom₂ (limit_obj₂ F_obj @F_hom) B, from eq.rec_on h f))
  (limit_obj₂ F_obj @F_hom) Y f
  begin
    intros,
    simp [limit_obj₂, of_cat_obj₂, limit_obj₁] at h,
    contradiction
  end
  begin
    introsI ℰ _ G_obj G_hom ih₁ A B g ih₂ h,
    unfreezingI { rcases (limit_obj₂_injective h) with ⟨rfl, h₁, h₂, h₃⟩ },
    unfreezingI { subst h₁, subst h₂, subst h₃ },
    exact limit_cone_comp _ _ _ _
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B g ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ _ _ (λ A, ih₂ A rfl),
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, limit_obj₂] at h,
    contradiction
  end
  begin
    introsI X h,
    subst h,
    exact id
  end
  rfl

@[elab_as_eliminator] def hom₂_colimit_obj_rec_on
  {motive : Π {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
    {F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞},
    hom₂ (by exactI colimit_obj₂ F_obj @F_hom) Y → Sort*}
  {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞}
  (f : hom₂ (colimit_obj₂ F_obj @F_hom) Y)
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟)
    {ℰ : Type} [category ℰ] {G_obj : ℰ → obj₂ 𝒞}
    {G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y)}
    (f : hom₂ (by exactI colimit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_f : by exactI motive f),
      by exactI motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    {ℰ : Type} [category ℰ] {G_obj : ℰ → obj₂ 𝒞}
    {G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y)}
    (cone : Π (X : 𝒟), hom₂ (by exactI colimit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_cone : Π (X : 𝒟), by exactI motive (cone X)),
      by exactI motive (by exactI is_limit₂ F_obj @F_hom _ cone))
  (is_colimit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (cocone_obj : obj₂ 𝒞) (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj),
      by exactI motive (is_colimit₂ F_obj @F_hom cocone_obj cocone))
  (id : by exactI motive (id₂ (colimit_obj₂ F_obj @F_hom))):
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = colimit_obj₂ F_obj @F_hom),
  motive (show hom₂ (colimit_obj₂ F_obj @F_hom) B, from eq.rec_on h f))
  (colimit_obj₂ F_obj @F_hom) Y f
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, colimit_obj₁] at h,
    contradiction
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, colimit_obj₁, limit_obj₁, limit_obj₂] at h,
    contradiction
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ (λ X, ih₂ X rfl)
  end
  begin
    introsI ℰ _ G_obj G_hom ih₁ cocone_obj cocone ih₂ h,
    unfreezingI { rcases (colimit_obj₂_injective h) with ⟨rfl, h₁, h₂, h₃⟩ },
    unfreezingI { subst h₁, subst h₂, subst h₃ },
    exact is_colimit _ _ _ _
  end
  begin
    introsI X h,
    subst h,
    exact id
  end
  rfl

def comp₂ {X Y : obj₂ 𝒞} (f : hom₂ X Y) : Π {Z : obj₂ 𝒞}, hom₂ Y Z → hom₂ X Z :=
hom₂.rec_on f
  begin
    intros X Y f Z g,
    refine hom₂_of_cat_obj_rec_on g _ _ _ _,
    { intros B g,
      exact of_cat_hom₂ (f ≫ g) },
    { introsI 𝒟 _ F_obj F_hom A B g ih,
      exact colimit_cocone_comp₂ F_obj @F_hom A ih },
    { introsI 𝒟 _ F_obj F_hom A cone ih,
      exact is_limit₂ F_obj @F_hom (of_cat_obj₂ X) (λ X, ih _) },
    { exact of_cat_hom₂ f }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ Z g,
    refine limit_cone_comp₂ F_obj @F_hom A (ih₂ g),
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ Z g,
    revert ih₂ A,
    refine hom₂_colimit_obj_rec_on g _ _ _ _,
    { introsI ℰ _ G_obj G_hom C ℱ _ H_obj H_hom ih₃ ih₄ A g ih₂,
      refine colimit_cocone_comp₂ G_obj @G_hom C (ih₄ A g @ih₂) },
    { introsI ℰ _ G_obj G_hom ℱ _ H_obj H_hom ih₃ ih₄ A g ih₂,
      exact is_limit₂ G_obj @G_hom B (λ X, ih₄ X A g @ih₂) },
    { introsI ℰ _ G_obj G_hom cocone_obj cocone A g ih₂,
      exact ih₂ (cocone A) },
    { intros A f _,
      exact colimit_cocone_comp₂ F_obj @F_hom A f }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ Z g,
    revert ih₂,
    refine hom₂_limit_obj_rec_on g _ _ _ _,
    { introsI ℰ _ G_obj G_hom A B g ih₂,
      exact ih₂ A g },
    { introsI ℰ _ F_obj F_hom A ℱ _ G_obj G_hom g ih₃ ih₂,
      exact colimit_cocone_comp₂ F_obj @F_hom A (ih₃ @ih₂) },
    { introsI ℰ _ F_obj F_hom ℱ _ G_obj G_hom ih₃ ih₄ ih₂,
      exact is_limit₂ F_obj @F_hom cone_obj (λ X, ih₄ _ @ih₂) },
    { introsI ih,
      exact is_limit₂ F_obj @F_hom cone_obj cone }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cocone_obj cocone ih₂ Z g,
    exact is_colimit₂ F_obj @F_hom Z (λ A, ih₂ A g)
  end
  (λ _ _ g, g)
#print has_limits_of_size
variables {ℰ : Type u} [category ℰ] [has_limits_of_size.{0} ℰ] [has_colimits_of_size.{0} ℰ] (F : 𝒞 ⥤ ℰ)

def UMP_obj {X Y : obj₂ 𝒞} (f : hom₂ X Y) : Σ A B : ℰ, A ⟶ B :=
hom₂.rec_on f
  (λ X Y f, ⟨F.obj X, F.obj Y, F.map f⟩)
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B g ih₂,

  end
  _
  _
  _
  _

end bicompletion_aux


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ ε > 0, ∃ N : ℤ, ∀ n : ℤ, n > N → |n * α % 1 - 0| < ε :=
begin
  assume ε hε,
  -- Let $\alpha$ be an irrational number.
  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  -- If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → (i * α % 1 ≠ j * α % 1), from sorry,

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h2 : ∀ i : ℤ, ∃ j : ℤ, i * α % 1 = j * α % 1, from sorry,
  have h3 : ∀ i : ℤ, i * α % 1 ∈ Icc 0 1, from sorry,
  have h4 : ∀ i : ℤ, i * α % 1 ∈ set.range (λ (i : ℤ), i * α % 1), from sorry,
  have h5 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h6 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h7 : ∀ i : ℤ, i * α % 1 ∈ set.range (λ (i : ℤ), i * α % 1), from sorry,
  have h8 : ∀ i : ℤ, i * α % 1 ∈ set.range (λ (i : ℤ), i * α % 1), from sorry,
  have h9 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h10 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h11 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h12 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h13 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h14 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h15 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h16 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h17 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h18 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h19 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h20 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h21 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h22 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h23 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h24 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h25 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h26 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h27 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h28 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h29 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h30 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h31 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h32 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h33 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h34 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h35 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h36 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h37 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h38 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h39 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h40 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h41 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h42 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h43 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h44 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h45 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h46 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h47 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h48 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h49 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h50 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h51 : set.range (λ (i : ℤ), i * α % 1) ⊆ Icc 0 1, from sorry,
  have h52 : set.range (
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irrational_orbit_dense (α : ℝ) (h : ¬ is_rat α) : ∃ S : set ℝ, ∀ y ∈ set.Icc 0 1, ∃ x ∈ S, |y - x| < 1 :=
begin
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - i * α ≠ j * α - j * α, from sorry,

  --$S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  let S := {(i : ℝ) * α - i * α | i : ℤ},
  have h2 : ∀ i : ℤ, (i : ℝ) * α - i * α ∈ S, from sorry,
  have h3 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - i * α ≠ j * α - j * α, from sorry,
  have h4 : ∀ i : ℤ, (i : ℝ) * α - i * α ∈ set.Icc 0 1, from sorry,
  have h5 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - i * α ≠ j * α - j * α, from sorry,

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h6 : ∃ x ∈ set.Icc 0 1, ∃ s ∈ S, ∀ ε > 0, ∃ n : ℤ, n ≠ 0 ∧ |x - s - n| < ε, from sorry,

  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h7 : ∃ x ∈ set.Icc 0 1, ∃ s ∈ S, ∀ ε > 0, ∃ n : ℤ, n ≠ 0 ∧ |x - s - n| < ε, from sorry,

  --Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h8 : ∃ x ∈ set.Icc 0 1, ∃ s ∈ S, ∀ ε > 0, ∃ n : ℤ, n ≠ 0 ∧ |x - s - n| < ε, from sorry,

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h9 : ∃ x ∈ set.Icc 0 1, ∃ s ∈ S, ∀ ε > 0, ∃ n : ℤ, n ≠ 0 ∧ |x - s - n| < ε, from sorry,

  show ∃ S : set ℝ, ∀ y ∈ set.Icc 0 1, ∃ x ∈ S, |y - x| < 1, from sorry,
end

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) : ¬ is_rat α → ∀ ε > 0, ∃ (i : ℤ), 0 ≤ i ∧ i < 1 / ε ∧ ∀ (j : ℤ), 0 ≤ j ∧ j < 1 / ε → abs (α * i - α * j) < ε :=
begin
  assume h1 (ε),
  have h2 : ∀ (i j : ℤ), i ≠ j → (abs (α * i - α * j) = abs (α * (i - j))) ∧ (abs (α * (i - j)) = abs (α) * abs (i - j)) ∧ (abs (α) * abs (i - j) = abs (α) * (abs (i) + abs (j))),
  from sorry,
  have h3 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) = abs (α) * (abs (i) + abs (j)),
  from sorry,
  have h4 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ abs (α),
  from sorry,
  have h5 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 0,
  from sorry,
  have h6 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1,
  from sorry,
  have h7 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ ε,
  from sorry,
  have h8 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h9 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h10 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h11 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h12 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h13 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h14 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h15 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h16 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h17 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h18 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h19 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h20 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h21 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h22 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h23 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h24 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h25 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h26 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h27 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h28 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h29 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h30 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h31 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h32 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h33 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h34 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h35 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h36 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h37 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h38 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h39 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h40 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h41 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h42 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h43 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε,
  from sorry,
  have h44 : ∀ (i j : ℤ), i ≠ j → abs (α * i - α * j) ≥ 1 / ε
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (h : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ (set.range (λ (i : ℤ), i*α) : set ℝ), abs (y - x) < 1 :=
begin
  -- Let $\alpha$ be an irrational number.
  assume (h2 : ¬ is_rat α),
  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h3 : ∀ (i j : ℤ), i ≠ j → (i*α) % 1 ≠ (j*α) % 1, from sorry,
  -- If this were not true, then
  have h4 : ∀ (i j : ℤ), i ≠ j → (i*α) % 1 = (j*α) % 1 → false, from sorry,
  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h5 : ∀ (i : ℤ), (i*α) % 1 ∈ Icc 0 1, from sorry,
  have h6 : set.range (λ (i : ℤ), (i*α) % 1) = set.range (λ (i : ℤ), i*α) : set ℝ, from sorry,
  have h7 : set.range (λ (i : ℤ), i*α) : set ℝ = {(i*α) % 1 | i : ℤ}, from sorry,
  have h8 : {(i*α) % 1 | i : ℤ} ⊆ Icc 0 1, from sorry,
  have h9 : set.range (λ (i : ℤ), i*α) : set ℝ ⊆ Icc 0 1, from sorry,
  have h10 : set.range (λ (i : ℤ), i*α) : set ℝ ≠ ∅, from sorry,
  have h11 : set.range (λ (i : ℤ), i*α) : set ℝ ⊆ Icc 0 1, from sorry,
  have h12 : set.range (λ (i : ℤ), i*α) : set ℝ ≠ ∅, from sorry,
  have h13 : ∀ (y : ℝ), y ∈ Icc 0 1 → ∃ x ∈ (set.range (λ (i : ℤ), i*α) : set ℝ), abs (y - x) < 1, from sorry,
  show ∀ (y : ℝ), y ∈ Icc 0 1 → ∃ x ∈ (set.range (λ (i : ℤ), i*α) : set ℝ), abs (y - x) < 1, from sorry,
end

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
∀ (ε : ℝ) (hε : ε > 0), ∃ (i : ℤ) (x : ℝ), x ∈ {i | i ∈ ℤ} ∧ |x - α| < ε :=
begin
  assume (ε : ℝ) (hε : ε > 0),
  -- then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ (i j : ℤ), i ≠ j → (i * α) % 1 ≠ (j * α) % 1, from sorry,
  -- If this were not true, then
  -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
  -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h2 : ∀ (i j : ℤ), i ≠ j → ¬ is_rat α, from sorry,
  -- Hence,
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  -- is an infinite subset of $\left[0,1\right]$.
  have h3 : ∀ (i : ℤ), (i * α) % 1 ∈ {i | i ∈ ℤ}, from sorry,
  have h4 : ∀ (i : ℤ), (i * α) % 1 ∈ set.Ico (0 : ℝ) (1 : ℝ), from sorry,
  have h5 : ∞ = set.card {i | i ∈ ℤ}, from sorry,
  have h6 : ∞ = set.card (set.Ico (0 : ℝ) (1 : ℝ)), from sorry,
  have h7 : set.finite (set.Ico (0 : ℝ) (1 : ℝ)), from sorry,
  have h8 : set.finite {i | i ∈ ℤ}, from sorry,
  have h9 : set.finite {i | i ∈ ℤ} ∧ ∞ = set.card {i | i ∈ ℤ}, from sorry,
  have h10 : set.finite (set.Ico (0 : ℝ) (1 : ℝ)) ∧ ∞ = set.card (set.Ico (0 : ℝ) (1 : ℝ)), from sorry,

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h11 : ∃ (x : ℝ), x ∈ set.Ico (0 : ℝ) (1 : ℝ) ∧ ∀ (ε : ℝ), ε > 0 → ∃ (y : ℝ), y ∈ {i | i ∈ ℤ} ∧ |x - y| < ε,
  from sorry,

  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h12 : ∀ (ε : ℝ), ε > 0 → ∃ (x y : ℝ), x ∈ {i | i ∈ ℤ} ∧ y ∈ {i | i ∈ ℤ} ∧ |x - y| < ε,
  from sorry,

  --Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h13 : ∀ (x y : ℝ), x ∈ {i | i ∈ ℤ} ∧ y ∈ {i | i ∈ ℤ} → |x - y| ∈ {i | i ∈ ℤ}, from sorry,
  have h14 : ∀ (ε : ℝ), ε > 0 → ∃ (y : ℝ), y ∈ {i | i ∈ ℤ} ∧ |0 - y| < ε, from sorry,

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  --Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h15 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Ico (0 : ℝ) (1 : ℝ) ∧ ε > 0 → ∃ (i : ℤ) (x : ℝ), x ∈ {i | i ∈ ℤ} ∧ |x - y| < ε,
  from sorry,
  show ∃ (i : ℤ) (x : ℝ), x ∈ {i | i ∈ ℤ} ∧ |x - α| < ε, from sorry,
end

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : irrational α) :
∀ y ∈ Icc 0 1, ∃ N : ℤ, ∃ x ∈ Icc 0 1, |y - N * x| < 1 :=
begin
  assume (y : ℝ) (h1 : y ∈ Icc 0 1),
  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close.
  --Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h2 : ∃ (x : ℝ) (h2 : x ∈ Icc 0 1), ∃ (N : ℤ), ∃ (ε : ℝ) (hε : ε > 0), ∀ (ε' : ℝ) (hε' : ε' > 0), ∃ (N' : ℤ), ∃ (x' : ℝ) (hx' : x' ∈ Icc 0 1), |x' - x| < ε', from sorry,

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  --Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  cases h2 with x hx,
  cases hx with N hN,
  cases hN with ε hε,
  cases hε with hε hε',
  use N,
  use x,
  sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from sorry,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from sorry,
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by sorry
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by sorry
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from sorry,

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := sorry,

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from sorry,

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from sorry,

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from sorry,
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Computational realization of topological spaces (experimental).
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.bases
import Mathlib.data.analysis.filter
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4 u_5 u_6

namespace Mathlib

/-- A `ctop α σ` is a realization of a topology (basis) on `α`,
  represented by a type `σ` together with operations for the top element and
  the intersection operation. -/
structure ctop (α : Type u_1) (σ : Type u_2) where
  f : σ → set α
  top : α → σ
  top_mem : ∀ (x : α), x ∈ f (top x)
  inter : (a b : σ) → (x : α) → x ∈ f a ∩ f b → σ
  inter_mem : ∀ (a b : σ) (x : α) (h : x ∈ f a ∩ f b), x ∈ f (inter a b x h)
  inter_sub : ∀ (a b : σ) (x : α) (h : x ∈ f a ∩ f b), f (inter a b x h) ⊆ f a ∩ f b

namespace ctop

protected instance has_coe_to_fun {α : Type u_1} {σ : Type u_3} : has_coe_to_fun (ctop α σ) :=
  has_coe_to_fun.mk (fun (x : ctop α σ) => σ → set α) f

@[simp] theorem coe_mk {α : Type u_1} {σ : Type u_3} (f : σ → set α) (T : α → σ)
    (h₁ : ∀ (x : α), x ∈ f (T x)) (I : (a b : σ) → (x : α) → x ∈ f a ∩ f b → σ)
    (h₂ : ∀ (a b : σ) (x : α) (h : x ∈ f a ∩ f b), x ∈ f (I a b x h))
    (h₃ : ∀ (a b : σ) (x : α) (h : x ∈ f a ∩ f b), f (I a b x h) ⊆ f a ∩ f b) (a : σ) :
    coe_fn (mk f T h₁ I h₂ h₃) a = f a :=
  rfl

/-- Map a ctop to an equivalent representation type. -/
def of_equiv {α : Type u_1} {σ : Type u_3} {τ : Type u_4} (E : σ ≃ τ) : ctop α σ → ctop α τ := sorry

@[simp] theorem of_equiv_val {α : Type u_1} {σ : Type u_3} {τ : Type u_4} (E : σ ≃ τ) (F : ctop α σ)
    (a : τ) : coe_fn (of_equiv E F) a = coe_fn F (coe_fn (equiv.symm E) a) :=
  sorry

/-- Every `ctop` is a topological space. -/
def to_topsp {α : Type u_1} {σ : Type u_3} (F : ctop α σ) : topological_space α :=
  topological_space.generate_from (set.range (f F))

theorem to_topsp_is_topological_basis {α : Type u_1} {σ : Type u_3} (F : ctop α σ) :
    topological_space.is_topological_basis (set.range (f F)) :=
  sorry

@[simp] theorem mem_nhds_to_topsp {α : Type u_1} {σ : Type u_3} (F : ctop α σ) {s : set α} {a : α} :
    s ∈ nhds a ↔ ∃ (b : σ), a ∈ coe_fn F b ∧ coe_fn F b ⊆ s :=
  sorry

end ctop

/-- A `ctop` realizer for the topological space `T` is a `ctop`
  which generates `T`. -/
structure ctop.realizer (α : Type u_5) [T : topological_space α] where
  σ : Type u_6
  F : ctop α σ
  eq : ctop.to_topsp F = T

protected def ctop.to_realizer {α : Type u_1} {σ : Type u_3} (F : ctop α σ) : ctop.realizer α :=
  ctop.realizer.mk σ F sorry

namespace ctop.realizer

protected theorem is_basis {α : Type u_1} [T : topological_space α] (F : realizer α) :
    topological_space.is_topological_basis (set.range (f (F F))) :=
  eq.mp (Eq._oldrec (Eq.refl (topological_space.is_topological_basis (set.range (f (F F))))) (eq F))
    (to_topsp_is_topological_basis (F F))

protected theorem mem_nhds {α : Type u_1} [T : topological_space α] (F : realizer α) {s : set α}
    {a : α} : s ∈ nhds a ↔ ∃ (b : σ F), a ∈ coe_fn (F F) b ∧ coe_fn (F F) b ⊆ s :=
  eq.mp
    (Eq._oldrec (Eq.refl (s ∈ nhds a ↔ ∃ (b : σ F), a ∈ coe_fn (F F) b ∧ coe_fn (F F) b ⊆ s))
      (eq F))
    (mem_nhds_to_topsp (F F))

theorem is_open_iff {α : Type u_1} [topological_space α] (F : realizer α) {s : set α} :
    is_open s ↔ ∀ (a : α), a ∈ s → ∃ (b : σ F), a ∈ coe_fn (F F) b ∧ coe_fn (F F) b ⊆ s :=
  iff.trans is_open_iff_mem_nhds (ball_congr fun (a : α) (h : a ∈ s) => realizer.mem_nhds F)

theorem is_closed_iff {α : Type u_1} [topological_space α] (F : realizer α) {s : set α} :
    is_closed s ↔
        ∀ (a : α), (∀ (b : σ F), a ∈ coe_fn (F F) b → ∃ (z : α), z ∈ coe_fn (F F) b ∩ s) → a ∈ s :=
  sorry

theorem mem_interior_iff {α : Type u_1} [topological_space α] (F : realizer α) {s : set α} {a : α} :
    a ∈ interior s ↔ ∃ (b : σ F), a ∈ coe_fn (F F) b ∧ coe_fn (F F) b ⊆ s :=
  iff.trans mem_interior_iff_mem_nhds (realizer.mem_nhds F)

protected theorem is_open {α : Type u_1} [topological_space α] (F : realizer α) (s : σ F) :
    is_open (coe_fn (F F) s) :=
  sorry

theorem ext' {α : Type u_1} [T : topological_space α] {σ : Type u_2} {F : ctop α σ}
    (H : ∀ (a : α) (s : set α), s ∈ nhds a ↔ ∃ (b : σ), a ∈ coe_fn F b ∧ coe_fn F b ⊆ s) :
    to_topsp F = T :=
  sorry

theorem ext {α : Type u_1} [T : topological_space α] {σ : Type u_2} {F : ctop α σ}
    (H₁ : ∀ (a : σ), is_open (coe_fn F a))
    (H₂ : ∀ (a : α) (s : set α), s ∈ nhds a → ∃ (b : σ), a ∈ coe_fn F b ∧ coe_fn F b ⊆ s) :
    to_topsp F = T :=
  sorry

protected def id {α : Type u_1} [topological_space α] : realizer α :=
  mk (Subtype fun (x : set α) => is_open x)
    (mk subtype.val (fun (_x : α) => { val := set.univ, property := is_open_univ }) set.mem_univ
      (fun (_x : Subtype fun (x : set α) => is_open x) => sorry) sorry sorry)
    sorry

def of_equiv {α : Type u_1} {τ : Type u_4} [topological_space α] (F : realizer α) (E : σ F ≃ τ) :
    realizer α :=
  mk τ (of_equiv E (F F)) sorry

@[simp] theorem of_equiv_σ {α : Type u_1} {τ : Type u_4} [topological_space α] (F : realizer α)
    (E : σ F ≃ τ) : σ (of_equiv F E) = τ :=
  rfl

@[simp] theorem of_equiv_F {α : Type u_1} {τ : Type u_4} [topological_space α] (F : realizer α)
    (E : σ F ≃ τ) (s : τ) : coe_fn (F (of_equiv F E)) s = coe_fn (F F) (coe_fn (equiv.symm E) s) :=
  sorry

protected def nhds {α : Type u_1} [topological_space α] (F : realizer α) (a : α) :
    filter.realizer (nhds a) :=
  filter.realizer.mk (Subtype fun (s : σ F) => a ∈ coe_fn (F F) s)
    (cfilter.mk
      (fun (s : Subtype fun (s : σ F) => a ∈ coe_fn (F F) s) => coe_fn (F F) (subtype.val s))
      { val := top (F F) a, property := sorry }
      (fun (_x : Subtype fun (s : σ F) => a ∈ coe_fn (F F) s) => sorry) sorry sorry)
    sorry

@[simp] theorem nhds_σ {α : Type u_1} {β : Type u_2} [topological_space α] (m : α → β)
    (F : realizer α) (a : α) :
    filter.realizer.σ (realizer.nhds F a) = Subtype fun (s : σ F) => a ∈ coe_fn (F F) s :=
  rfl

@[simp] theorem nhds_F {α : Type u_1} {β : Type u_2} [topological_space α] (m : α → β)
    (F : realizer α) (a : α) (s : filter.realizer.σ (realizer.nhds F a)) :
    coe_fn (filter.realizer.F (realizer.nhds F a)) s = coe_fn (F F) (subtype.val s) :=
  rfl

theorem tendsto_nhds_iff {α : Type u_1} {β : Type u_2} [topological_space α] {m : β → α}
    {f : filter β} (F : filter.realizer f) (R : realizer α) {a : α} :
    filter.tendsto m f (nhds a) ↔
        ∀ (t : σ R),
          a ∈ coe_fn (F R) t →
            ∃ (s : filter.realizer.σ F),
              ∀ (x : β), x ∈ coe_fn (filter.realizer.F F) s → m x ∈ coe_fn (F R) t :=
  iff.trans (filter.realizer.tendsto_iff m F (realizer.nhds R a)) subtype.forall

end ctop.realizer

structure locally_finite.realizer {α : Type u_1} {β : Type u_2} [topological_space α]
    (F : ctop.realizer α) (f : β → set α)
    where
  bas : (a : α) → Subtype fun (s : ctop.realizer.σ F) => a ∈ coe_fn (ctop.realizer.F F) s
  sets :
    (x : α) →
      fintype ↥(set_of fun (i : β) => set.nonempty (f i ∩ coe_fn (ctop.realizer.F F) ↑(bas x)))

theorem locally_finite.realizer.to_locally_finite {α : Type u_1} {β : Type u_2}
    [topological_space α] {F : ctop.realizer α} {f : β → set α} (R : locally_finite.realizer F f) :
    locally_finite f :=
  sorry

theorem locally_finite_iff_exists_realizer {α : Type u_1} {β : Type u_2} [topological_space α]
    (F : ctop.realizer α) {f : β → set α} :
    locally_finite f ↔ Nonempty (locally_finite.realizer F f) :=
  sorry

def compact.realizer {α : Type u_1} [topological_space α] (R : ctop.realizer α) (s : set α) :=
  {f : filter α} →
    (F : filter.realizer f) →
      (x : filter.realizer.σ F) →
        f ≠ ⊥ → coe_fn (filter.realizer.F F) x ⊆ s → Subtype fun (a : α) => a ∈ s ∧ nhds a ⊓ f ≠ ⊥

end Mathlib


example (P : Prop) : ∀ {p : P}, P := by
  exact fun {p} => p

example (P : Prop) : ∀ {p : P}, P := by
  intro h; exact h

example (P : Prop) : ∀ {p : P}, P := by
  exact @id _

example (P : Prop) : ∀ {p : P}, P := by
  exact no_implicit_lambda% id

macro "exact'" x:term : tactic => `(exact no_implicit_lambda% $x)

example (P : Prop) : ∀ {p : P}, P := by
  exact' id

example (P : Prop) : ∀ {p : P}, P := by
  apply id

example (P : Prop) : ∀ p : P, P := by
  have : _ := 1
  apply id

example (P : Prop) : ∀ {p : P}, P := by
  refine no_implicit_lambda% (have : _ := 1; ?_)
  apply id

example (P : Prop) : ∀ {p : P}, P := by
  have : _ := 1
  apply id


variable {α : Type} in
def f (a : α) : List α :=
_

variable (P : List Nat → List Nat → Prop) in
theorem foo (xs : List Nat) : (ns : List Nat) → P xs ns
| []      => sorry
| (n::ns) => by {
  cases xs;
  exact sorry;
  exact sorry
}


import data.list.basic
import data.equiv.basic
import tactic
import meta.expr
import tactic.refine

universes u v w

open function

class canonical_equiv (α : Sort*) (β : Sort*) extends equiv α β.

def equiv.injective {α : Sort*} {β : Sort*} (eq : α ≃ β) :
  injective eq :=
injective_of_left_inverse eq.left_inv

#print prefix equiv.injective
#print equiv.injective.equations._eqn_1

variables  (f : Type u → Prop)
variables (on_equiv : Π {α β : Type u} (e : equiv α β), equiv (f α) (f β))

section
open tactic.interactive
meta def prove_on_equiv_law' (n := `on_equiv) :=
do intros [],
   eqv ← tactic.resolve_name n,
   `[dsimp [equiv.refl,equiv.trans]],
   generalize none () (``(%%eqv _),`k),
   `[cases k, refl]

meta def prove_on_equiv_law := prove_on_equiv_law'
end

class transportable (f : Type u → Type v) :=
(on_equiv : Π {α β : Type u} (e : equiv α β), equiv (f α) (f β))
(on_refl  : Π (α : Type u), on_equiv (equiv.refl α) = equiv.refl (f α) . prove_on_equiv_law)
(on_trans : Π {α β γ : Type u} (d : equiv α β) (e : equiv β γ), on_equiv (equiv.trans d e) = equiv.trans (on_equiv d) (on_equiv e) . prove_on_equiv_law)

-- Finally a command like: `initialize_transport group` would create the next two declarations automagically:

open transportable

definition equiv_mul {α β : Type u} : equiv α β → equiv (has_mul α) (has_mul β) := λ E,
{ to_fun :=  λ αmul,⟨λ b1 b2, E.to_fun (@has_mul.mul α αmul (E.inv_fun b1) (E.inv_fun b2))⟩,
  inv_fun := λ βmul,⟨λ a1 a2, E.inv_fun (@has_mul.mul β βmul (E.to_fun a1) (E.to_fun a2))⟩, -- didn't I just write that?
                                                                      -- should we introduce E-dual?
  left_inv := λ f, begin
    cases f, simp, -- aargh why do I struggle
    congr,
    -- suffices :  (λ (a1 a2 : α), E.inv_fun (E.to_fun (f _ _))) = (λ a1 a2, f a1 a2),
    --   by rw this,
    funext,
    simp [E.left_inv _,E.right_inv _], -- got there in the end
  end,
  right_inv := -- I can't even do this in term mode so I just copy out the entire tactic mode proof again.
 λ g, begin
    cases g, simp, -- aargh why do I struggle
    suffices :  (λ (b1 b2 : β), E.to_fun (E.inv_fun (g _ _))) = (λ b1 b2, g b1 b2),
      by rw this,
    funext,
    simp [E.left_inv _,E.right_inv _], -- got there in the end
  end, -- didn't I just write that?
}

namespace tactic

namespace interactive

open interactive function
#check @rfl
meta def eqn_lemma_type : expr → expr → expr → tactic (expr × expr)
| (expr.pi n bi d b) fn arg :=
do v ← mk_local' n bi d,
   arg ← head_beta (arg v),
   prod.map (expr.pis [v]) (expr.lambdas [v]) <$> eqn_lemma_type (b.instantiate_var v) (fn v) arg
| _ fn arg :=
prod.mk <$> to_expr ``(%%fn = %%arg) <*> to_expr ``(@rfl _ %%arg)

meta def eq_lemma_name (n : name) := n <.> "equations" <.> "_eqn_1"

meta def abstract_def (suffix : name) (t : expr) (tac : tactic unit) : tactic name :=
do (_,v) ← solve_aux t tac,
   n ← (++ suffix) <$> decl_name,
   v ← instantiate_mvars v,
   t ← instantiate_mvars t,
   add_decl $ mk_definition n t.collect_univ_params t v,
   defn ← mk_const n,
   (t,p) ← eqn_lemma_type t defn v,
   add_decl $ declaration.thm (eq_lemma_name n) t.collect_univ_params t (return p),
   set_basic_attribute `_refl_lemma (eq_lemma_name n),
   return n

meta def build_aux_decl_with (c : name) (type : pexpr) (is_lemma : bool) (tac : tactic unit) : tactic expr :=
do type' ← to_expr type,
   ((),v) ← solve_aux type' tac,
   add_aux_decl c type' v is_lemma

open functor

def strip_prefix (n : name) : name :=
name.update_prefix n name.anonymous
-- #check @equiv.injective
-- #print injective

meta def all_field_names : tactic (list name) :=
do gs ← get_goals,
   gs.mmap (λ g, set_goals [g] >> get_current_field)
   <* set_goals gs

-- meta def mk_app' (e : expr) (es : list expr) : tactic expr :=

meta def mk_to_fun (n : name) : tactic name :=
do env  ← get_env,
   decl ← env.get n,
   let univs := decl.univ_params,
   e ← resolve_name n,
   fields ← qualified_field_list n,
   t ← to_expr ``(Π α β : Type u, α ≃ β → %%e α → %%e β),
   abstract_def (n <.> "transport" <.> "to_fun") t
     (do α  ← tactic.intro `α, β  ← tactic.intro `β, eq_ ← tactic.intro `eqv,
         eqv ← to_expr ``(@coe_fn _ equiv.has_coe_to_fun (%%eq_)),
         eqv_symm ← to_expr ``(@coe_fn _ equiv.has_coe_to_fun (%%eq_).symm),
         x ← tactic.intro `x,
         [v] ← get_goals,
         refine_struct ``( { .. } ),
         let unfold_more := [`has_one.one,`has_zero.zero,`has_mul.mul,`has_add.add
                            ,`semigroup.mul,`group.mul],
         fs ← all_field_names >>= mmap resolve_name ∘ list.append unfold_more,
         all_goals (do
           fl ← get_current_field,
           xs ← tactic.intros,
           p ← mk_const fl >>= infer_type >>= pp,
           xs' ← mmap (λ x, eqv_symm <$>
             mcond (is_proof x)
                 (mk_mvar)
                 (pure x)) xs,
           e ← mk_app fl (map eqv_symm xs) <|>
               ((flip expr.mk_app xs' <$> mk_mapp fl [none,some x]) >>= to_expr ∘ to_pexpr) <|>
               fail format!"{fl} - {xs'} :: {p}",
           infer_type e >>= trace,
           trace "a",
           tactic.exact (eqv e) <|>
           (do refine ``((equiv.apply_eq_iff_eq (%%eq_).symm _ _).1 _) <|>
                      refine ``((not_iff_not_of_iff $ equiv.apply_eq_iff_eq (%%eq_).symm _ _).1 _),
               trace "b",
               g ← mk_mvar,
               refine ``(iff.elim_left (eq.to_iff %%g) %%e),
               -- tactic.type_check e,
               num_goals >>= trace,
               gs ← get_goals, set_goals $ g :: gs.diff [g],
               num_goals >>= trace,
               solve1 (do
               -- simp (some ()) ff (map simp_arg_type.expr $ ``(@equiv.inverse_apply_apply) :: fs) [] (loc.ns [none]),
               -- simp (some ()) ff (map simp_arg_type.expr $ fs) [] (loc.ns [none]),
               -- repeat $ dsimp ff (map simp_arg_type.expr $ fs ++ [``(@equiv.inverse_apply_apply)]) [] (loc.ns [none]),
                 trace "c",
                 -- infer_type e >>= trace,
                 simp (some ()) tt (map simp_arg_type.expr $ fs ++ [``(@equiv.inverse_apply_apply),``(id)]) [] (loc.ns [none]),
               -- try $ simp (some ()) ff (map simp_arg_type.expr $ fs ++ [``(@has_mul.mul),``(@equiv.inverse_apply_apply)]) [] (loc.ns [none]),
               -- repeat `[rw [equiv.inverse_apply_apply]],
                 trace_state,
                 trace "d",
                 done <|> refl <|> (congr; done <|> refl)),
               trace "e",
               done <|> solve1 (do
                 trace "f",
                 target >>= infer_type >>= trace,
                 target >>= instantiate_mvars >>= tactic.change,
                 target >>= trace,
                 done )) <|>
           (do refine ``((not_iff_not_of_iff $ equiv.apply_eq_iff_eq (%%eq_).symm _ _).1 _),
               refine ``(iff.elim_left _ %%e),
               refine ``(not_iff_not_of_iff _),
               refine ``(eq.to_iff _),
               simp (some ()) tt (map simp_arg_type.expr $ fs ++ [``(@equiv.inverse_apply_apply),``(id)]) [] (loc.ns [none]),
               done) <|>
           (do -- trace_state,
               infer_type e >>= trace,
               trace "dude",
               done)))

-- set_option pp.universes true
-- set_option pp.notation false
-- set_option pp.implicit true

-- run_cmd add_interactive [`mk_to_fun]

-- run_cmd mk_to_fun `group
-- #print prefix _run_command.group

meta def mk_on_equiv (n to_fun : name) : tactic name :=
do f ← resolve_name n,
   fn ← resolve_name to_fun,
   t ← to_expr ``(Π (α β : Type u), α ≃ β → %%f α ≃ %%f β),
   abstract_def (n ++ `on_eqv) t $
     do tactic.intron 2,
        eqv ← tactic.intro1,
        refine ``( { to_fun := %%fn _ _ %%eqv,
                     inv_fun := %%fn _ _ (%%eqv).symm,
                     .. } );
        abstract none (
        dunfold [`function.left_inverse,`function.right_inverse] (loc.ns [none]);
        (do x ← tactic.intro1, tactic.cases x,
            dunfold [to_fun] (loc.ns [none]),
            congr; tactic.funext;
            `[ simp only [equiv.inverse_apply_apply,equiv.apply_inverse_apply,id] ],
            return ()))

meta def mk_transportable_instance  (n : name) : tactic unit :=
do d ← decl_name,
   -- let to_fun := d ++ `group.transport.to_fun,
   to_fun ← mk_to_fun n,
   to_fun_lmm ← resolve_name $ eq_lemma_name to_fun,
   on_eqv_n ← mk_on_equiv n to_fun,
   on_eqv ← resolve_name on_eqv_n,
   on_eqv_lmm ← resolve_name $ eq_lemma_name on_eqv_n,
   fs ← expanded_field_list n,
   env  ← get_env,
   decl ← env.get n,
   let univs := decl.univ_params,
   let e := @expr.const tt n $ univs.map level.param,
   t ← to_expr ``(transportable %%e),
   let goal := (loc.ns [none]),
   (_,d) ← solve_aux t
     (do refine ``( { on_equiv := %%on_eqv, on_refl := _, on_trans := _ } ),
         -- cleanup,
         abstract (some $ n ++ `on_refl) (do
           intro1,
           fs' ← fs.mmap (resolve_name ∘ uncurry (flip name.update_prefix)),
           -- simp (some ()) ff (map simp_arg_type.expr $ [``(equiv.refl),``(equiv.symm),on_eqv_lmm,to_fun_lmm]) [] goal,
           dsimp ff (map simp_arg_type.expr $
             [``(equiv.refl),``(equiv.symm),on_eqv_lmm,to_fun_lmm]) [] goal,
           -- done,
           -- dunfold [``equiv.refl,on_eqv_n,to_fun] goal,
         -- num_goals >>= trace,
           -- done,
           try congr; tactic.funext; cases (none,```(x)) [];
           dunfold [`id,to_fun] goal;refl ),
         abstract (some $ n ++ `on_trans) (do
           intro1,
           fs' ← fs.mmap (resolve_name ∘ uncurry (flip name.update_prefix)),
           dsimp ff (map simp_arg_type.expr $
             [``(function.comp),``(equiv.to_fun),``(equiv.inv_fun),``(equiv.trans),
              ``(equiv.symm),on_eqv_lmm,to_fun_lmm  ]) [] goal,
         -- num_goals >>= trace,
           -- dunfold [on_eqv_n,`function.comp,`equiv.to_fun,`equiv.inv_fun,``equiv.trans] goal,
           -- dunfold [`id] goal,
         -- num_goals >>= trace,
           intron 4,
           try congr; tactic.funext; cases (none,```(x)) [];
           dunfold [`id,to_fun] goal;refl ),
         -- num_goals >>= trace,
         -- dunfold [`id,to_fun] goal,
         -- num_goals >>= trace,
         -- target >>= trace,
         -- num_goals >>= trace,
         -- dsimp ff (map simp_arg_type.expr fs') [] goal,
         -- num_goals >>= trace,
         -- trace_state,
         -- target >>= trace,
         -- prove_on_equiv_law,
         -- prove_on_equiv_law,
         done),
   d ← instantiate_mvars d,
   let def_name := n <.> "transportable",
   add_decl $ mk_definition def_name univs t d,
   set_basic_attribute `instance def_name tt

set_option profiler true
set_option formatter.hide_full_terms false
set_option pp.delayed_abstraction false
set_option pp.universes true

-- run_cmd do
--  mk_transportable_instance `group

set_option profiler false

-- example  : Π {α β : Type u} (e : equiv α β), equiv (group α) (group β) :=
-- begin
--   introv eqv,
--   refine_struct { to_fun  := @group.transport.to_fun _ _ eqv
--                 , inv_fun := @group.transport.to_fun _ _ eqv.symm
--                 , .. };
--   dsimp [left_inverse,function.right_inverse];
--   intro x ; dunfold group.transport.to_fun;
--   cases x; congr; funext;
--   simp only [equiv.inverse_apply_apply,equiv.apply_inverse_apply,id],
-- end

#check congr_arg

-- #print group.transport.to_fun

-- meta def mk_transportable (n : name) (e : expr) : tactic unit :=
-- do [v] ← get_goals,
--    trace "begin mk_transportable",
--    trace "-- | TO_FUN",
--    fields ← qualified_field_list n,
--    to_fun ← to_expr ``(Π α β : Type u, α ≃ β → %%e α → %%e β)
--      >>= define ( `to_fun),
--    solve1
--      (do α  ← tactic.intro `α,
--          β  ← tactic.intro `β,
--          eq ← tactic.intro `eqv,
--          eqv ← to_expr ``(@coe_fn _ equiv.has_coe_to_fun (%%eq)),
--          eqv_symm ← to_expr ``(@coe_fn _ equiv.has_coe_to_fun (%%eq).symm),
--          x ← tactic.intro `x,
--          [v] ← get_goals,
--          refine_struct ``( { .. } ),
--          -- trace_state,
--          all_goals (do
--            tgt ← target,
--            p ← is_prop tgt,
--            if p then do
--              trace "A",
--              current ← get_current_field <|> fail "get_current_field",
--              vs ← tactic.intros,
--              h ← mk_mapp current ( [α,x] ++ vs.map (some ∘ eqv_symm) ) >>= note `h none
--                <|> fail "mk_mapp",
--              unfold (fields) (loc.ns [none,h.local_pp_name]), -- h.local_pp_name]),
--              h ← get_local h.local_pp_name,
--              infer_type h >>= trace,
--              -- tactic.revert h,
--              fs ← mmap (resolve_name ∘ strip_prefix) fields,
--              simp (some ()) tt (map simp_arg_type.expr $ [``(equiv.apply_inverse_apply),``(equiv.inverse_apply_apply)] ++ fs) [] (loc.ns [none,h.local_pp_name]), -- ,h.local_pp_name
--              -- h ← get_local h.local_pp_name,
--              -- infer_type h >>= trace,
--              trace_state,
--              -- target >>= trace,
--              -- tactic.exact h,
--              done,
--              trace "C",
--              return ()
--            else do
--              trace "B",
--              -- target >>= trace,
--              -- [v] ← get_goals,
--              current ← get_current_field,
--              trace current,
--              vs ← tactic.intros,
--              -- infer_type eqv_symm >>= trace,
--              -- refine ``(%%eqv _) <|> fail "refine",
--              trace eqv_symm,
--              -- trace vs,
--              -- instantiate_mvars v >>= trace,
--              let vs' := map (some ∘ eqv_symm) vs,
--              e ← mk_mapp current ( [α,x] ++ vs' ),
--              e ← to_expr ``(@coe_fn _ equiv.has_coe_to_fun %%eq %%e),
--              trace "to_expr",
--              trace e,
--              tactic.exact e,
--              trace "C",
--              -- trace_state,
--              return () ),
--          -- instantiate_mvars v >>= trace,
--          trace_state,
--          return () ),
--    -- inv_fun ← build_aux_decl_with ( (`inv_fun).update_prefix n)
--    --   ``(Π {α β}, %%e β → %%e α) ff
--    --   (do trace_state >> admit),
--    trace "-- | EQUIV",
--    is_inv ← to_expr ``(∀ α β (eqv : equiv α β),
--             left_inverse (%%to_fun β α eqv.symm) (%%to_fun α β eqv))
--           >>= assert `is_inv,
--    solve1 (do
--           α  ← tactic.intro `α,
--           β  ← tactic.intro `β,
--           eq ← tactic.intro `eqv,
--           x ← tactic.intro `x,
--           tactic.cases x,
--           -- trace_state,
--           `[simp only [to_fun]],
--           congr ; funext [] ; dunfold fields (loc.ns [none]) ;
--           `[simp! only [_root_.eq.mpr,equiv.apply_inverse_apply,equiv.inverse_apply_apply]],
--           -- trace_state,
--           return () ),
--    fn ← to_expr ``(Π α β, equiv α β → equiv (%%e α) (%%e β))
--      >>= define ( (`on_equiv).update_prefix n),
--    solve1
--      (do α  ← tactic.intro `α,
--          β  ← tactic.intro `β,
--          eq ← tactic.intro `eqv,

--          refine_struct ``( { to_fun := %%to_fun %%α %%β %%eq,
--                        inv_fun := %%to_fun %%β %%α (%%eq).symm,
--                        left_inv := %%is_inv %%α %%β %%eq }),
--          admit ),
--      -- | transport
--    trace "-- | TRANSPORT",
--    refine_struct ``( { on_equiv := %%fn, .. } ), -- (some `duh),
--    admit <|> fail "admit A",
--    admit <|> fail "admit B",
--    trace_state <|> fail "here",
--    -- instantiate_mvars v >>= trace ,
--    trace "end (mk_transportable)"

meta def instance_derive_handler' (univ_poly := tt)
  (modify_target : name → list expr → expr → tactic expr := λ _ _, pure) : derive_handler :=
λ p n, do
let cls := `transportable,
if p.is_constant_of cls then
do decl ← get_decl n,
   cls_decl ← get_decl cls,
   env ← get_env,
   -- guard (env.is_inductive n) <|> fail format!"failed to derive '{cls}', '{n}' is not an inductive type",
   let ls := decl.univ_params.map $ λ n, if univ_poly then level.param n else level.zero,
   -- incrementally build up target expression `Π (hp : p) [cls hp] ..., cls (n.{ls} hp ...)`
   -- where `p ...` are the inductive parameter types of `n`
   let tgt : expr := expr.const n ls,
   ⟨params, _⟩ ← mk_local_pis (decl.type.instantiate_univ_params (decl.univ_params.zip ls)),
   (type,tgt) ← params.inits.any_of (λ param, do
     let tgt := tgt.mk_app param,
     prod.mk tgt <$> mk_app cls [tgt]),
   tgt ← modify_target n [] tgt,
   -- tgt ← params.enum.mfoldr (λ ⟨i, param⟩ tgt,
   -- do -- add typeclass hypothesis for each inductive parameter
   --    tgt ← do {
   --      guard $ i < env.inductive_num_params n,
   --      param_cls ← mk_app cls [param] <|> fail "fart",
   --      -- TODO(sullrich): omit some typeclass parameters based on usage of `param`?
   --      pure $ expr.pi `a binder_info.inst_implicit param_cls tgt
   --    } <|> pure tgt,
   --    pure $ tgt.bind_pi param
   -- ) tgt,
   mk_transportable_instance n,
   pure true
else pure false

@[derive_handler]
meta def transportable_handler : derive_handler :=
instance_derive_handler' tt $
λ n params, pure

-- -- ``(transportable) _

end interactive
end tactic

-- namespace group

-- variables {α β : Type u}
-- variables (eq : equiv α β)

-- @[simp] def tr₀ : α → β := eq
-- @[simp] def tr₁ (f : α → α) : β → β := λ x : β, eq (f $ eq.symm x)
-- @[simp] def tr₂ (f : α → α → α) : β → β → β := λ (x y : β), eq $ f (eq.symm x) (eq.symm y)
-- -- def etr₀ : β → α := eq.inv_fun
-- -- def etr₁ (f : β → β) (x : α) : α := eq.inv_fun (f $ eq.to_fun x)
-- -- def etr₂ (f : β → β → β) (x y : α) : α := eq.inv_fun $ f (eq.to_fun x) (eq.to_fun y)

-- -- @[simp]
-- -- lemma inv_fun_tr₀ (f : α) :
-- --   eq.inv_fun (tr₀ eq f) = f :=
-- -- by simp [tr₀,equiv.left_inv eq _]

-- -- @[simp]
-- -- lemma inv_fun_tr₁ (f : α → α) (x : β) :
-- --   eq.inv_fun (tr₁ eq f x) = f (eq.inv_fun x) :=
-- -- by simp [tr₁,equiv.left_inv eq _]

-- -- @[simp]
-- -- lemma inv_fun_tr₂ (f : α → α → α) (x y : β) :
-- --   eq.inv_fun (tr₂ eq f x y) = f (eq.inv_fun x) (eq.inv_fun y) :=
-- -- by simp [tr₂,equiv.left_inv eq _]

-- local attribute [simp] equiv.left_inv equiv.right_inv

-- -- @[simp]
-- -- lemma symm_inv_fun :
-- --   eq.symm.inv_fun = eq.to_fun :=
-- -- by cases eq ; refl

-- -- @[simp]
-- -- lemma symm_to_fun :
-- --   eq.symm.to_fun = eq.inv_fun :=
-- -- by cases eq ; refl

-- -- @[simp]
-- -- lemma inv_fun_etr₀ (f : β) :
-- --   eq.to_fun (etr₀ eq f) = f :=
-- -- by simp [etr₀,equiv.right_inv eq _]

-- -- @[simp]
-- -- lemma inv_fun_etr₁ (f : β → β) (x : α) :
-- --   eq.to_fun (etr₁ eq f x) = f (eq.to_fun x) :=
-- -- by simp [etr₁,equiv.left_inv eq _]

-- -- @[simp]
-- -- lemma inv_fun_etr₂ (f : α → α → α) (x y : β) :
-- --   eq.inv_fun (etr₂ eq f x y) = f (eq.inv_fun x) (eq.inv_fun y) :=
-- -- by simp [tr₂,equiv.left_inv eq _]

-- lemma inj {x y : β}
--   (h : eq.symm x = eq.symm y)
-- : x = y := sorry

-- -- @[simp]
-- -- def on_equiv.to_fun [group α] : group β :=
-- -- { one := tr₀ eq (one α)
-- -- , mul := tr₂ eq mul
-- -- , inv := tr₁ eq inv
-- -- , mul_left_inv := by { intros, apply inj eq, simp, apply mul_left_inv }
-- -- , one_mul := by { intros, apply inj eq, simp, apply one_mul }
-- -- , mul_one := by { intros, apply inj eq, simp [has_mul.mul], apply mul_one }
-- -- , mul_assoc := by { intros, apply inj eq, simp, apply mul_assoc }  }

-- -- @[simp]
-- -- def on_equiv.inv_fun [group β] : group α :=
-- -- { one := tr₀ eq.symm (one _)
-- -- , mul := tr₂ eq.symm mul
-- -- , inv := tr₁ eq.symm inv
-- -- , mul_left_inv := by { intros, apply inj eq.symm, simp, apply mul_left_inv }
-- -- , one_mul := by { intros, apply inj eq.symm, simp, apply one_mul }
-- -- , mul_one := by { intros, apply inj eq.symm, simp [has_mul.mul], apply mul_one }
-- -- , mul_assoc := by { intros, apply inj eq.symm, simp, apply mul_assoc }  }

-- -- def on_equiv' : group α ≃ group β :=
-- -- { to_fun := @on_equiv.to_fun _ _ eq,
-- --   inv_fun := @on_equiv.inv_fun _ _ eq,
-- --   right_inv :=
-- --   by { intro x, cases x, simp,
-- --        congr ;
-- --        funext ;
-- --        dsimp [mul,one,inv] ;
-- --        simp!, },
-- --   left_inv :=
-- --   by { intro x, cases x, simp,
-- --        congr ;
-- --        funext ;
-- --        dsimp [mul,one,inv] ;
-- --        simp!, } }

-- -- def transportable' : transportable group :=
-- -- begin
-- --   refine { on_equiv := @on_equiv', .. }
-- --   ; intros ; simp [on_equiv',equiv.refl,equiv.trans]
-- --   ; split ; funext x ; cases x ; refl,
-- -- end

-- -- set_option formatter.hide_full_terms false
-- set_option pp.all true
-- -- set_option trace.app_builder true
-- -- #check equiv.has_coe_to_fun

-- -- set_option profiler true

-- -- attribute [derive transportable] group monoid ring field --
-- -- attribute [derive transportable] monoid
-- -- attribute [derive transportable] has_add
-- -- ⊢ Π (α β : Type u), α ≃ β → group α → group β
-- -- α β : Type u,
-- -- eq : α ≃ β
-- -- ⊢ group α ≃ group β
-- -- on_equiv
-- -- 2 goals
-- -- case on_refl
-- -- ⊢ ∀ (α : Type u), on_equiv α α (equiv.refl α) = equiv.refl (group α)

-- -- case on_trans
-- -- ⊢ ∀ {α β γ : Type u} (d : α ≃ β) (e : β ≃ γ),
-- --     on_equiv α γ (equiv.trans d e) = equiv.trans (on_equiv α β d) (on_equiv β γ e)
-- -- [_field, on_refl]
-- -- [_field, on_trans]
-- -- def transportable' : transportable group :=

-- end group

-- -- #check derive_attr
-- instance group.transport {α β : Type u} [R : group α] [e : canonical_equiv α β] : group β :=
-- sorry
-- -- (@transportable.on_equiv group group.transportable _ _ e.to_equiv).to_fun R

-- -- class transportable (f : Type u → Type v) :=
-- -- (on_equiv : Π {α β : Type u} (e : equiv α β), equiv (f α) (f β))
-- -- (on_refl  : Π (α : Type u), on_equiv (equiv.refl α) = equiv.refl (f α))
-- -- (on_trans : Π {α β γ : Type u} (d : equiv α β) (e : equiv β γ), on_equiv (equiv.trans d e) = equiv.trans (on_equiv d) (on_equiv e))

-- -- -- Our goal is an automagic proof of the following
-- -- theorem group.transportable : transportable group := sorry

-- -- These we might need to define and prove by hand
-- def Const : Type u → Type v := λ α, punit
-- def Fun : Type u → Type v → Type (max u v) := λ α β, α → β
-- def Prod : Type u → Type v → Type (max u v) := λ α β, α × β
-- def Swap : Type u → Type v → Type (max u v) := λ α β, β × α

-- lemma Const.transportable (α : Type u) : (transportable Const) := sorry
-- lemma Fun.transportable (α : Type u) : (transportable (Fun α)) := sorry
-- lemma Prod.transportable (α : Type u) : (transportable (Prod α)) := sorry
-- lemma Swap.transportable (α : Type u) : (transportable (Swap α)) := sorry

-- -- And then we can define
-- def Hom1 (α : Type u) : Type v → Type (max u v) := λ β, α → β
-- def Hom2 (β : Type v) : Type u → Type (max u v) := λ α, α → β
-- def Aut : Type u → Type u := λ α, α → α

-- -- And hopefully automagically derive
-- lemma Hom1.transportable (α : Type u) : (transportable (Hom1 α)) := sorry
-- lemma Hom2.transportable (β : Type v) : (transportable (Hom1 β)) := sorry
-- lemma Aut.transportable (α : Type u) : (transportable Aut) := sorry

-- -- If we have all these in place...
-- -- A bit of magic might actually be able to derive `group.transportable` on line 11.
-- -- After all, a group just is a type plus some functions... and we can now transport functions.