import UniverseAbstractions.Instances.Sort
import UniverseAbstractions.CategoryTheory.Meta
import UniverseAbstractions.CategoryTheory.Basic
import UniverseAbstractions.CategoryTheory.Functors
import UniverseAbstractions.CategoryTheory.NaturalTransformations
import UniverseAbstractions.CategoryTheory.Functors.Basic
import UniverseAbstractions.CategoryTheory.Functors.Nested
import UniverseAbstractions.CategoryTheory.FunctorExtensionality
import UniverseAbstractions.CategoryTheory.Utils.Trivial

set_option autoBoundImplicitLocal false
--set_option pp.universes true

universe u v w

-- This establishes the universe `type.{u}` as a morphism universe, which enables the construction
-- of categories with morphisms in `type`, i.e. regular 1-categories.
--
-- Due to the way functors are defined mathematically, the morphism universe always needs to be at
-- least as large as the universe of the domain, as it needs to hold natural transformation between
-- functors. We need to use some trickery to make Lean behave well with this restriction.

namespace type.IsHomUniverse

  open MetaRelation MetaFunctor CategoryTheory

  instance isHomUniverse : IsHomUniverse type.{u} := ⟨⟩

  abbrev homUniv := type.{max u w}

  -- This is defeq to `type.{u}` but solves some universe unification issues.
  abbrev type' := homUniv.{u, 0}

  instance hasCat (U : Universe.{u + 1}) : HasCatProp U homUniv.{u, w} :=
  { Cat  := CatDesc,
    desc := id }

  @[reducible] def Cat (U : Universe.{u + 1}) := HasCatProp.Category U homUniv.{u, w}
  @[reducible] def Cat' (U : Universe.{u + 1}) := HasCatProp.Category U type'.{u}

  def defCat {U : Universe.{u + 1}} {R : BundledRelation U homUniv.{u, w}} (C : CatDesc R) :
    HasCatProp.DefCat C :=
  { C   := C,
    hEq := IsPreorderEq.refl R.Hom (hR := C.homIsPreorder) }

  instance hasTrivialCatProp (U : Universe.{u + 1}) : HasCatProp.HasTrivialCatProp U homUniv.{u, w} :=
  ⟨defCat⟩

  theorem IsInv.ext {α : Sort u} {R : MetaRelation α type.{w}} [IsPreorder R]
                    {a b : α} {f : R a b} {g : R b a} (h₁ h₂ : IsInv (R := R) f g) :
    h₁ = h₂ :=
  match h₁, h₂ with
  | ⟨_, _⟩, ⟨_, _⟩ => rfl

  section

    variable {U : Universe.{u + 1}}

    theorem IsoDesc.ext {A : Cat.{u, w} U} {a b : A} {e₁ e₂ : IsoDesc a b} :
      e₁.toHom = e₂.toHom → e₁.invHom = e₂.invHom → e₁ = e₂ :=
    match e₁, e₂ with
    | { toHom := to₁, invHom := inv₁, isInv := isInv₁ },
      { toHom := to₂, invHom := inv₂, isInv := isInv₂ } =>
      λ (hTo : to₁ = to₂) (hInv : inv₁ = inv₂) => by subst hTo; subst hInv;
                                                     have invExt := IsInv.ext isInv₁ isInv₂;
                                                     subst invExt;
                                                     rfl

    theorem IsoDesc.ext' {A : Cat.{u, w} U} {a b : A} {e₁ e₂ : IsoDesc a b}
                         (h : e₁.toHom = e₂.toHom) :
      e₁ = e₂ :=
    IsoDesc.ext h (IsoDesc.toInvEquiv (e₁ := e₁) (e₂ := e₂) h)

    def IsoRel (A : Cat.{u, w} U) : MetaRelation A homUniv.{u, w} := IsoDesc

    instance hasIsoRel (A : Cat.{u, w} U) : HasIsoRel A :=
    { Iso         := IsoRel A,
      desc        := id,
      defToHomFun := λ _ _ => HasTrivialFunctoriality.defFun,
      toHomInj    := IsoDesc.ext' }

    def defIso {A : Cat.{u, w} U} {a b : A} (e : IsoDesc a b) : HasIsoRel.DefIso e :=
    { e    := e,
      toEq := rfl }

    instance hasTrivialIsomorphismCondition (A : Cat.{u, w} U) :
      HasIsoRel.HasTrivialIsomorphismCondition A :=
    ⟨defIso⟩

    instance isoIsEquivalence (A : Cat.{u, w} U) : IsEquivalence (IsoRel A) :=
    HasIsoOp.isoIsEquivalence A

    instance hasIsomorphisms (A : Cat.{u, w} U) : HasIsomorphisms A :=
    { isoHasSymmFun  := HasTrivialFunctoriality.hasSymmFun  (IsoRel A),
      isoHasTransFun := HasTrivialFunctoriality.hasTransFun (IsoRel A),
      defIsoCat      := HasCatProp.HasTrivialCatProp.defCat }

  end

  instance isCatUniverse (U : Universe.{u + 1}) : IsCatUniverse U homUniv.{u, w} := ⟨⟩
  instance isSortCatUniverse : IsSortCatUniverse.{u + 1} homUniv.{u, w} := ⟨⟩

  -- Functors

  section

    -- It should be possible for `U` and `V` to have different Lean universes. Unfortunately, that
    -- breaks all of the universe inference that we get from `homUniv`.
    variable {U V : Universe.{u + 1}}

    def FunProp (A : Cat.{u, w} U) (B : Cat.{u, w} V) : MetaProperty (A → B) homUniv.{u, w} :=
    FunDesc

    instance hasFunProp (A : Cat.{u, w} U) (B : Cat.{u, w} V) : HasFunProp A B :=
    { Fun  := FunProp A B,
      desc := id }

    def defFun {A : Cat.{u, w} U} {B : Cat.{u, w} V} {φ : A → B} (F : FunDesc φ) :
      HasFunProp.DefFun F :=
    { F  := F,
      eq := λ _ _ => rfl }

    instance hasTrivialFunctorialityCondition (A : Cat.{u, w} U) (B : Cat.{u, w} V) :
      HasFunProp.HasTrivialFunctorialityCondition A B :=
    ⟨defFun⟩

    -- Lean bug :-(
    noncomputable instance hasIsoFun {A : Cat.{u, w} U} {B : Cat.{u, w} V} (F : A ⮕ B) :
      HasIsoFun F :=
    { defMapIso    := λ _   => HasIsoRel.HasTrivialIsomorphismCondition.defIso,
      defMapIsoFun := λ _ _ => HasTrivialFunctoriality.defFun,
      defIsoFun    := HasFunProp.HasTrivialFunctorialityCondition.defFun }

  end

  instance hasIdFun {U : Universe.{u + 1}} (A : Cat.{u, w} U) : HasFunProp.HasIdFun A :=
  HasFunProp.HasIdFun.trivial A

  instance hasConstFun {U V : Universe.{u + 1}} (A : Cat.{u, w} U) (B : Cat.{u, w} V) :
    HasFunProp.HasConstFun A B :=
  HasFunProp.HasConstFun.trivial A B

  instance hasCompFun {U U' U'' : Universe.{u + 1}}
                      (A : Cat.{u, w} U) (B : Cat.{u, w} U') (C : Cat.{u, w} U'') :
    HasFunProp.HasCompFun A B C :=
  HasFunProp.HasCompFun.trivial A B C

  noncomputable instance isFunUniverse (U V : Universe.{u + 1}) :
    IsFunUniverse U V homUniv.{u, w} :=
  ⟨⟩

  noncomputable instance isSortFunUniverse : IsSortFunUniverse.{u + 1} homUniv.{u, w} := ⟨⟩

  instance isFunUniverse.hasCatIdFun (U : Universe.{u + 1}) :
    IsFunUniverse.HasCatIdFun U homUniv.{u, w} :=
  ⟨⟩

  instance isFunUniverse.hasCatConstFun (U V : Universe.{u + 1}) :
    IsFunUniverse.HasCatConstFun U V homUniv.{u, w} :=
  ⟨⟩

  instance isFunUniverse.hasCatCompFun (U U' U'' : Universe.{u + 1}) :
    IsFunUniverse.HasCatCompFun U U' U'' homUniv.{u, w} :=
  ⟨⟩

  -- Natural transformations

  theorem IsNatural.ext {α : Sort u} {β : Sort v}
                        {R : MetaRelation α type.{w}} {S : MetaRelation β type.{w}}
                        [HasTrans S] {φ ψ : α → β} {F : PreFunctor R S φ} {G : PreFunctor R S ψ}
                        (η : MetaQuantification S φ ψ) (h₁ h₂ : MetaQuantification.IsNatural F G η) :
    h₁ = h₂ :=
  match h₁, h₂ with
  | ⟨_⟩, ⟨_⟩ => rfl

  section

    variable {U V : Universe.{u + 1}}

    theorem NatDesc.ext {A : Cat.{u, w} U} {B : Cat.{u, w} V} {F G : A ⮕ B} (η₁ η₂ : NatDesc F G) :
      (∀ a, η₁.η a = η₂.η a) → η₁ = η₂ :=
    match η₁, η₂ with
    | { η := nat₁, isNat := isNat₁ }, { η := nat₂, isNat := isNat₂ } =>
      λ h => by have hNat : nat₁ = nat₂ := funext h;
                subst hNat;
                have hIsNat : isNat₁ = isNat₂ := IsNatural.ext nat₁ isNat₁ isNat₂;
                subst hIsNat;
                rfl

    def NatRel (A : Cat.{u, w} U) (B : Cat.{u, w} V) : MetaRelation (A ⮕ B) homUniv.{u, w} :=
    NatDesc

    instance hasNaturalityRelation (A : Cat.{u, w} U) (B : Cat.{u, w} V) : HasNatRel A B :=
    { Nat       := NatRel A B,
      desc      := id,
      defNatFun := λ _ _ _ => HasTrivialFunctoriality.defFun }

    def defNat {A : Cat.{u, w} U} {B : Cat.{u, w} V} {F G : A ⮕ B} (η : NatDesc F G) :
      HasNatRel.DefNat η :=
    { η     := η,
      natEq := λ _ => rfl }

    instance hasTrivialNaturalityCondition (A : Cat.{u, w} U) (B : Cat.{u, w} V) :
      HasNatRel.HasTrivialNaturalityCondition A B :=
    ⟨defNat⟩

    instance hasTrivialNatEquiv (A : Cat.{u, w} U) (B : Cat.{u, w} V) :
      HasNatRel.HasTrivialNatEquiv A B :=
    ⟨NatDesc.ext⟩

    instance natIsPreorder (A : Cat.{u, w} U) (B : Cat.{u, w} V) : IsPreorder (NatRel A B) :=
    HasNatOp.natIsPreorder A B

    instance hasNaturality (A : Cat' U) (B : Cat' V) : HasNaturality A B :=
    { natHasTransFun := HasTrivialFunctoriality.hasTransFun (NatRel A B),
      defFunCat      := HasCatProp.HasTrivialCatProp.defCat }

    instance hasIsoNat {A : Cat' U} {B : Cat' V} (F G : A ⮕' B) : HasIsoNat F G :=
    { defNatIso    := λ _ _ => HasIsoRel.HasTrivialIsomorphismCondition.defIso,
      defNatIsoFun := λ _   => HasTrivialFunctoriality.defFun }

    noncomputable instance hasIsoNaturality (A : Cat' U) (B : Cat' V) : HasIsoNaturality A B := ⟨⟩

    def natIsoDescBuilder {A : Cat' U} {B : Cat' V} {F G : A ⮕' B} (η : NatIsoDesc F G) :
      NatIsoDesc.IsoDescBuilder η :=
    { defToNat  := HasNatRel.HasTrivialNaturalityCondition.defNat,
      defInvNat := HasNatRel.HasTrivialNaturalityCondition.defNat,
      leftInv   := HasNatRel.HasTrivialNatEquiv.natEquiv,
      rightInv  := HasNatRel.HasTrivialNatEquiv.natEquiv }

    noncomputable def defNatIso {A : Cat' U} {B : Cat' V} {F G : A ⮕' B} (η : NatIsoDesc F G) :
      HasIsoNat.DefNatIso η :=
    { η     := NatIsoDesc.IsoDescBuilder.isoDesc η (natIsoDescBuilder η),
      natEq := λ _ => rfl }

    noncomputable instance hasTrivialIsoNaturalityCondition (A : Cat' U) (B : Cat' V) :
      HasIsoNaturality.HasTrivialIsoNaturalityCondition A B :=
    ⟨defNatIso⟩

  end

  noncomputable instance isNatUniverse (U V : Universe.{u + 1}) : IsNatUniverse U V type'.{u} :=
  ⟨⟩

  noncomputable instance isSortNatUniverse : IsSortNatUniverse.{u + 1} type'.{u} := ⟨⟩

  noncomputable instance isSortNatUniverse.hasTrivialNaturalIsomorphisms :
    IsSortNatUniverse.HasTrivialNaturalIsomorphisms.{u + 1} type'.{u} :=
  ⟨⟩

  -- Multifunctors

  section

    variable {U U' U'' : Universe.{u + 1}} {A : Cat' U} {B : Cat' U'} {C : Cat' U''}
             {F : A → (B ⮕ C)} {desc : HasNaturality.FunFunDesc F}

    def defFunFunBase : HasNaturality.DefFunFunBase desc :=
    { defNat     := λ _   => HasNatRel.HasTrivialNaturalityCondition.defNat,
      defNatFun  := λ _ _ => HasTrivialFunctoriality.defFun,
      natReflEq  := λ _   => HasNatRel.HasTrivialNatEquiv.natEquiv,
      natTransEq := λ _ _ => HasNatRel.HasTrivialNatEquiv.natEquiv }

    def defFunFun : HasNaturality.DefFunFun desc := HasNaturality.DefFunFun.trivial defFunFunBase

  end

  section

    variable {U U' U'' U''' : Universe.{u + 1}}
             {A : Cat' U} {B : Cat' U'} {C : Cat' U''} {D : Cat' U'''}
             {F : A → (B ⮕ C ⮕' D)} {desc : HasNaturality.FunFunFunDesc F}

    def defFunFunFunBase : HasNaturality.DefFunFunFunBase desc :=
    { defRevFunFun := λ _ => defFunFunBase,
      defNatNat    := λ _ => HasNaturality.DefNatNatBase.trivial }

    def defFunFunFun : HasNaturality.DefFunFunFun desc :=
    HasNaturality.DefFunFunFun.trivial defFunFunFunBase defFunFunBase

  end

  instance hasRevAppFunFun {U V : Universe.{u + 1}} (A : Cat' U) (B : Cat' V) :
    HasNaturality.HasRevAppFunFun A B :=
  { defRevAppFun    := λ _ => HasFunProp.HasTrivialFunctorialityCondition.defFun,
    defRevAppFunFun := defFunFun }

  instance hasCompFunFunFun {U U' U'' : Universe.{u + 1}} (A : Cat' U) (B : Cat' U') (C : Cat' U'') :
    HasNaturality.HasCompFunFunFun A B C :=
  { defCompFunFun    := λ _ => defFunFun,
    defCompFunFunFun := defFunFunFun }

  instance hasConstFunFun {U V : Universe.{u + 1}} (A : Cat' U) (B : Cat' V) :
    HasNaturality.HasConstFunFun A B :=
  { defConstFunFun := defFunFun }

  instance hasDupFunFun {U V : Universe.{u + 1}} (A : Cat' U) (B : Cat' V) :
    HasNaturality.HasDupFunFun A B :=
  { defDupFun    := λ _ => HasFunProp.HasTrivialFunctorialityCondition.defFun,
    defDupFunFun := defFunFun }

  noncomputable instance isSortNatUniverse.hasFullCatFun :
    IsSortNatUniverse.HasFullCatFun.{u + 1} type'.{u} :=
  { hasRevAppFunFun  := hasRevAppFunFun,
    hasCompFunFunFun := hasCompFunFunFun,
    hasConstFunFun   := hasConstFunFun,
    hasDupFunFun     := hasDupFunFun }

  noncomputable instance isSortNatUniverse.hasFullNatIso :
    IsSortNatUniverse.HasFullNatIso.{u + 1} type'.{u} :=
  inferInstance

end type.IsHomUniverse


import data.real.basic
import tactic
import real_definitions
-- import utils

-- #print linarith.make_comp_with_zero

import tactic.linarith.datatypes

import structures2
import utils

/-
- add an optional list of hypos in parameters, then compute is restricted to the given list.

- essayer le simple : assumption, tautology

- tags :
    - `target_strict`: but est une inégalité stricte ?
    - `target_abs`, `target_max`: but contient une valeur absolue / un max ?
    - `hypo_abs`, `hypo_max`: hypos contiennent des valeurs absolues / max, min ?

    - `target_strict`:
            - `get_pos_from_pos_eq`
            - `%%a ≠ 0` -->  `abs a >0` si target_abs (`abs_pos_of_ne_zero`)
            - `%%abs a ≠ 0` --> a ≠ 0   si pas target_abs (`ne_zero_of_abs_ne_zero`)
            - idem, utiliser |a| < b ==> -b < a < b, ...

- abs pre_processor:
    - abs ≥ 0. Comment l'utiliser au milieu d'une expression ?
    - simplifier |a| < b, |a| ≤ b, idem minoration

- min_max_preprocessor:
    max a b ≥ a, max a b ≥ b, ... à appliquer sur `%%a = max %%b %%c`

- pre-processing n°1:
    - from linarith: `[filter_comparisons, remove_negations, make_comp_with_zero]`
    ou même tout ? `[filter_comparisons, remove_negations, nat_to_int, strengthen_strict_int, make_comp_with_zero, cancel_denoms]`
    - Si `but = inégalité stricte`, y ajouter `get_pos_from_pos_eq` ?
    - pour la suite, il faut récupérer la liste des preuves résultantes
- puis appliquer `linarith` à cette liste (sans preprocessing!)

- target pre-processing:
    - `[apply mul_pos, inv_pos.mpr, mul_ne_zero]` avant de recommencer ?
    Attention, ces énoncés jouent sur le target, pas sur les hypos
    (donc ça ne rentre pas dans la classe preprocessors)
    Deux de ces tactiques dédouble le but (ab >0 remplacé par a>0 et b>0).

    Et ré-essayer `linarith`?
- pre-processor ifs:
    - dans la liste d'égalités / inégalité, unfold abs max (ou éventuellement ré-écrire abs ?)
    - split_ifs, cases_type or and,
-/

namespace tactic.interactive
open lean.parser tactic interactive
open interactive (loc.ns)
open interactive.types
open expr
open linarith

-- useful lemmas:
-- ge_iff_le
-- gt_iff_lt
-- lt_of_le_of_ne
-- le_of_lt
-- div_pos
-- mul_pos
-- inv_pos

-- open tactic.interactive

-------------------------------------------
-------------------------------------------
-- Make 'a < b' from 'a ≠ b' and 'a ≤ b' --
-------------------------------------------
-------------------------------------------
-- This is achieved by the following sequence of tactics:
-- * make_ineq  take "a ≤ b" and "a' ≠ b'" and try to make "a < b"
-- * extract_gt extract the list of inequalities "a ≤ b" from a list of expressions
-- * extract_non_eq does the same for "a ≠ b"
-- * list_prod make the product list of two lists
-- * get_pos_from_pos_eq_from_list is build on the previous ones:
-- it takes a list of expressions,
-- extract inequalities and non-equalities,
-- take all pairs and try to make "a < b" by applying make_ineq
-- * get_pos_from_pos_eq is an interactive tactic that applies this to the local context

set_option trace.linarith true
#help options

def compute3.trace: list string := [""]

meta def default_preprocessors : list global_preprocessor :=
[filter_comparisons, remove_negations, make_comp_with_zero]

------------------------------
-- Detecting abs, max, etc. --
------------------------------

/- Check if some expression contains some constant name inside app. -/
meta def contain_cst (cst_name: name) : expr → bool
| (const a a_1) := (a = cst_name)
| (app a a_1) := (contain_cst a) ∨ (contain_cst a_1)
| _ := ff

/- Check if expr contains abs inside app. -/
meta def contain_abs (e: expr) : tactic bool :=
return (contain_cst `abs e)

/- Detect abs in target in app. -/
meta def target_abs : tactic bool :=
do  target ← tactic.target, e ← infer_type target,
    trace target,
    b ← contain_abs target,
    trace b, return b

/- Check if target is a strict inequality. -/
meta def target_lt_or_gt : tactic bool :=
do target ← tactic.target,
    match target with
    | `(%%a < %%b) := do trace tt, return tt
    | `(%%a > %%b) := do trace tt, return tt
    | _ := return ff
    end

-- example (a b :ℝ) : a < 10*(|b| + 1)-22 :=
-- begin
--     targets_analysis,
--     target_abs,
--     target_lt_or_gt,
-- end

----------------------------
----------------------------
-- Get strict inequalities -
----------------------------
----------------------------

/- Take a proof of a non equality a≠b and replace it by a proof of a-b≠0 -/
private meta def rearr_noneq_aux : expr → expr → tactic expr
| prf `(%%a ≠ 0)    := return prf
| prf `(%%a ≠ %%b)  := mk_app ``sub_ne_zero_of_ne [prf]
| prf  a            := trace a >> fail "couldn't rearrange noneq"

meta def rearr_noneq (e : expr) : tactic expr :=
infer_type e >>= rearr_noneq_aux e

-- lemma neg_zero_of_zero (G: Type) [add_group G] (a: G) (H: a =0) : -a = 0 := neg_eq_zero.mpr H

/-  Take H1 of type "a ≤ 0", H2 of type "a' ≠ 0'", and if a=a'
    then add H3 of type "a < 0" in the local context -/
meta def make_lt_aux : expr × expr → expr × expr → tactic expr
| (prf, a) (prf', a') :=
    tactic.unify a a' >> to_expr ``(lt_of_le_of_ne %%prf %%prf')

/- The same, with the possibility that a=-a' -/
meta def make_lt_aux' : expr × expr → expr × expr → tactic expr
| (prf, a) (prf', a') := do
    prf'' ← mk_app `neg_eq_zero.mpr [prf'], t ← infer_type prf'',
    match t with
    | `(%%a'' = 0) := make_lt_aux (prf, a) (prf'', a'')
    | _ := fail "Unexpected failure"
    end

/-  Take proofs of "a ≤ 0", "a' ≠ 0'", and if a=a' or a = -a'
    then compute a proof of "a < 0". -/
meta def make_lt : expr × expr → expr × expr → tactic expr
| (prf, a) (prf', a') := make_lt_aux (prf, a) (prf', a') <|> make_lt_aux' (prf, a) (prf', a')

private meta def filter_le_zero : expr → bool
| `(%%a ≤ 0) := tt
| _          := ff

private meta def filter_neq_zero (prf: expr) : tactic (expr × expr) :=
do ineq ← infer_type prf, match ineq with
| `(%%a ≠ 0) := return (prf, a)
| _          := fail ""
end

/--
`mk_noneq_with_zero h` takes each proof `h` of a non-equality a ≠ b
and turns it into a proof of a-b ≠ 0.
 -/
meta def make_noneq_with_zero : preprocessor :=
{ name := "make non-equalities with zero",
  transform := λ e, singleton <$> rearr_noneq e <|> return [] }

-- meta def is_lt_zero : expr → tactic expr
-- | `(%%a < 0) := return a
-- | _ := fail "not ?? < 0"

-- meta def is_neq_zero : expr → tactic expr
-- | `(%%a ≠ 0) := return a
-- | _ := fail "not ?? ≠ 0"

/- Pre-processor version of get_pos_from_pos_eq.
We start with normalised comparisons. Specifically, we search for comparisons of the form
    a ≠ 0 (or -a ≠ 0) and a ≤ 0
get a new inequality a < 0 and clear both premises.
-/
meta def add_pos_from_pos_eq : global_preprocessor :=

{ name := "add strict inequalities, e.g. a < 0 from a ≠ 0 and a ≤ 0",
--(transform : list expr → tactic (list expr))
  transform := λ ls,
    -- TODO

-------------------
-------------------
-- Tactic compute -
-------------------
-------------------

lemma inv_pos_mpr {α : Type} [linear_ordered_field α] (a:α) :
0 < a → 0 < a⁻¹ := inv_pos.mpr

open linarith
/- Non-interactive version of nl_linarith. -/
meta def nl_linarith (cfg : linarith_config := {}): tactic unit :=
do
{
tactic.linarith false false []
  { cfg with preprocessors := some $
      cfg.preprocessors.get_or_else default_preprocessors ++ [nlinarith_extras] }
}

/-- A configuration object for `compute1`.
 develop_ite: set to tt to develop if_then_else definitions, e.g. abs and max.
 -/
meta structure compute_config : Type :=
(develop_ite : bool := ff)

/- Unfold some definitions using if_then_else, then get rid of if_then_else by case reasoning, and try to
close all the goals by linarith. Unfolded definitions includes abs, max, min.
-/
meta def develop_ite : tactic string :=
    do {`[unfold abs at *], `[unfold min max at *], `[split_ifs at *], repeat $ tactic.linarith false false [],
    return "unfold abs, unfold min max, split_ifs, repeat {linarith}"}
    <|>
    do {`[unfold abs], `[unfold min max], `[split_ifs],
    return "unfold abs, unfold min max, split_ifs"}

/- try several computing tactics for STRICT inequalities.
In case of success return the corresponding effective code. -/
meta def compute1 : tactic string :=
do
{   do {assumption, return "assumption"}
    <|>
    -- solve e.g. "n_0 ≤ n_0 ∨ n_0 ≤ n_1"
    -- with norm_num, solves "n_0 ≤ max n_0 n_1"
    do {tactic.tautology, return "tautology"}
    <|>
    do {tactic.linarith false false [], return "linarith"}
    <|>
    do {nl_linarith, return "nl_linarith"}
    <|>
    do {tactic.applyc ``mul_pos, return "apply mul_pos"}
    <|>
    -- a>0 → a⁻¹ >0
    do {tactic.applyc ``inv_pos_mpr, return "apply inv_pos.mpr"}
    <|>
 -- a≠0 → b≠0 → ab≠0
     do {tactic.applyc ``mul_ne_zero, return "apply mul_ne_zero"}
--  div_pos is now useless
}
#print mul_ne_zero
/- Repeat n times the tactic compute1 ; never fails -/
meta def compute_n_old (n: nat)  (cfg: compute_config := {}) : tactic string :=
do  effective_code_0 ←  if cfg.develop_ite
                        then try_tactic_string develop_ite
                        else skip_tactic_string,
    n ← num_goals, match n with
        | 0 := return effective_code_0
        | _ := do
        -- Try to add strict inequalities to the context, if there remains some goal:
        effective_code_1 ← get_pos_from_pos_eq,
        effective_code_2 ← iterate_and_return_code n compute1,
        return $ string.concatenate [effective_code_0, effective_code_1, effective_code_2]
        end

/- Repeat n times the tactic compute1 ; never fails -/
meta def compute_n (n: nat)  (cfg: compute_config := {}) : tactic string :=
do let first_tac := if cfg.develop_ite then [try_tactic_string develop_ite]
                      else ([]:list (tactic string)),
    -- Try to add strict inequalities to the context, if there remains some goal:
    let list_tac := first_tac.append [get_pos_from_pos_eq,
                                      iterate_and_return_code n compute1],
        code ← and_then_and_return_code list_tac,
        return code

/- Apply the compute_n tactic n times,
and in case of success trace the effective code with id. -/
meta def compute_and_return_code (n: nat) (id: string)  (cfg: compute_config := {}):
tactic unit :=
do apply_and_return_code id (tactic.interactive.compute_n n cfg)

end tactic.interactive

-------------
-- Example --
-------------
-- set_option trace.linarith true
example (a:ℝ) (H: a ≠ 0) (H': a ≥ 0): a^2 ≥ 0 :=
begin
    -- compute_n 1,
    norm_num at *,
    -- apply_and_return_code "12.1" (tactic.interactive.compute_n 1),
    compute_and_return_code 10 "12.1",
    --compute1,
    -- compute_and_return_code 10 "12.1",  -->
    -- have H_aux := lt_of_le_of_ne H' (ne.symm H), nl_linarith,
end


import justification common_meta property_catalogue.LTL
import pump1
open interactive S A

variable {α : Type}

set_option pp.structure_instances_qualifier true

def local_input_name : string := "pump1_input_1"
def local_strat_name : string := "pump1_strat_1"
def local_prf_name : string := "pump1_prf_1"

def preamble : string := "import justification pump1 common_meta property_catalogue.LTL \n open S A"

meta def proof_template (p₁ p₂ : string) : string :=
"\n\n
theorem " ++ local_prf_name ++ " : " ++ p₁ ++ " := \nbegin \n" ++ p₂ ++ "\nend" ++ "\n\n\n"

meta def evidence_file_template (ps : PROOF_STATE α) : string :=
preamble
++ "\n\n @[reducible] def " ++ local_input_name
++ " : property.input (path pump1) := "++ ps.input_string
++ "\n\n @[reducible] def "++ local_strat_name
++ " : Strategy (path pump1) := property.strategy " ++ local_input_name
++ proof_template ("deductive (path pump1) " ++ local_strat_name) (tscript_string ps.tscript)
++ ps.unused ++ hints_string ps.hints

meta def output (s : string) : io unit := do
  of ← io.mk_file_handle "src/evidence.lean" io.mode.write,
  io.fs.write of s.to_char_buffer

meta def driver (input : pexpr) : tactic unit :=
let α := path pump1 in
let ps : PROOF_STATE α := {} in
do
  STRAT ← tactic.to_expr input,
  match STRAT with
  | `(property.input.mk %%CLAIM %%PROPS) :=
  do
  inpt ← tactic.eval_expr (property.input α) STRAT,
  input_fmt ← tactic_format_expr STRAT,
  let input_s := input_fmt.to_string,
  let ps := { input := inpt,
              input_string := input_s,
              strat_expr := STRAT ,
              PROPS := PROPS,
              -- TODO : Clean this
              init_goal := `(deductive (path pump1) (property.strategy %%STRAT)),
              ..ps},
              -- And this
  let ps := get_originals ps,
  let goal_str := "deductive (path pump1) " ++ local_strat_name,
  set_goal ps.init_goal,
  ps ← SOLVE (ps),
  str ← get_unused ps,
    match ps.solved with
    | tt := tactic.trace "True"
    | ff := tactic.trace "False"
    end,
    tactic.unsafe_run_io $ output $ evidence_file_template {unused := str ..ps}
| _ := return ()
end

@[user_command]
meta def main
(meta_info : decl_meta_info)
(_ : parse (lean.parser.tk "main")) : lean.parser unit :=
do
   F ← read "src/input/pumpExample1.txt" types.texpr,
   lean.parser.of_tactic $ driver F
.

main

-- OLD version, will integrate
-- def foobar : property.input (path fcs) := {}

-- variable {α : Type}

-- set_option pp.structure_instances_qualifier true

-- def local_input_name : string := "fcs_input_1"
-- def local_strat_name : string := "fcs_strat_1"
-- def local_prf_name : string := "fcs_prf_1"

-- def preamble : string := "import justification fcs common_meta property_catalogue.LTL \n open S A"

-- meta def proof_template (p₁ p₂ : string) : string :=
-- "\n\n
-- theorem " ++ local_prf_name ++ " : " ++ p₁ ++ " := \nbegin \n" ++ p₂ ++ "\nend" ++ "\n\n\n"

-- meta def evidence_file_template (ps : PROOF_STATE α) : string :=
-- preamble
-- ++ "\n\n @[reducible] def " ++ local_input_name
-- ++ " : property.input (path fcs) := "++ ps.input_string
-- ++ "\n\n @[reducible] def "++ local_strat_name
-- ++ " : Strategy (path fcs) := property.strategy " ++ local_input_name
-- ++ proof_template ("deductive (path fcs) " ++ local_strat_name) (tscript_string ps.tscript)
-- ++ ps.unused ++ hints_string ps.hints

-- meta def output (s : string) : io unit := do
--   of ← io.mk_file_handle "src/evidence.lean" io.mode.write,
--   io.fs.write of s.to_char_buffer

-- meta def driver (input : pexpr) : tactic unit :=
-- let α := path fcs in
-- let ps : PROOF_STATE α := {} in
-- do
--   STRAT ← tactic.to_expr input,
--   match STRAT with
--   | `(property.input.mk %%CLAIM %%PROPS) :=
--   do
--   inpt ← tactic.eval_expr (property.input α) STRAT,
--   input_fmt ← tactic_format_expr STRAT,
--   let input_s := input_fmt.to_string,
--   let ps := { input := inpt,
--               input_string := input_s,
--               strat_expr := STRAT ,
--               PROPS := PROPS,
--               -- TODO : Clean this
--               init_goal := `(deductive (path fcs) (property.strategy %%STRAT)),
--               ..ps},
--               -- And this
--   let ps := get_originals ps,
--   let goal_str := "deductive (path fcs) " ++ local_strat_name,
--   set_goal ps.init_goal,
--   ps ← solve_inductive (ps),
--   str ← get_unused ps,
--     match ps.solved with
--     | tt := tactic.trace "True"
--     | ff := tactic.trace "False"
--     end,
--     tactic.unsafe_run_io $ output $ evidence_file_template {unused := str ..ps}
-- | _ := return ()
-- end

-- @[user_command]
-- meta def main
-- (meta_info : decl_meta_info)
-- (_ : parse (lean.parser.tk "main")) : lean.parser unit :=
-- do
--    F ← read "src/input/Inductive_Example.txt" types.texpr,
--    lean.parser.of_tactic $ driver F
-- .


import category_theory.pasting_pushouts
import homotopy_theory.formal.cylinder.definitions
import .cofibration_category

universes v u

open category_theory
open category_theory.category
local notation f ` ∘ `:80 g:80 := g ≫ f

namespace homotopy_theory.cofibrations
open homotopy_theory.cylinder (endpoint)
open homotopy_theory.weak_equivalences
open homotopy_theory.weak_equivalences.category_with_weak_equivalences
open precofibration_category cofibration_category

variables {C : Type u} [category.{v} C] [cofibration_category.{v} C]

variables {a b : C} {j : a ⟶ b} (hj : is_cof j)

structure relative_cylinder :=
(ob : C)
(ii : (pushout_by_cof j j hj).ob ⟶ ob)
(p : ob ⟶ b)
(hii : is_cof ii)
(hp : is_weq p)
(pii : p ∘ ii = (pushout_by_cof j j hj).is_pushout.induced (𝟙 b) (𝟙 b) rfl)

-- Any cofibration admits a relative cylinder.
lemma exists_relative_cylinder : nonempty (relative_cylinder hj) :=
let ⟨c, ii, p, hii, hp, pii⟩ :=
  factorization ((pushout_by_cof j j hj).is_pushout.induced (𝟙 b) (𝟙 b) rfl) in
⟨⟨c, ii, p, hii, hp, pii⟩⟩

variables {hj}

def relative_cylinder.i₀ (c : relative_cylinder hj) : b ⟶ c.ob :=
c.ii ∘ (pushout_by_cof j j hj).map₀

def relative_cylinder.i₁ (c : relative_cylinder hj) : b ⟶ c.ob :=
c.ii ∘ (pushout_by_cof j j hj).map₁

lemma relative_cylinder.pi₀ (c : relative_cylinder hj) : c.p ∘ c.i₀ = 𝟙 b :=
by unfold relative_cylinder.i₀; simp [c.pii]

lemma relative_cylinder.pi₁ (c : relative_cylinder hj) : c.p ∘ c.i₁ = 𝟙 b :=
by unfold relative_cylinder.i₁; simp [c.pii]

lemma relative_cylinder.ij (c : relative_cylinder hj) : c.i₀ ∘ j = c.i₁ ∘ j :=
begin
  unfold relative_cylinder.i₀ relative_cylinder.i₁,
  rw [←assoc, ←assoc, (pushout_by_cof j j hj).is_pushout.commutes]
end

lemma relative_cylinder.acof_i₀ (c : relative_cylinder hj) : is_acof c.i₀ :=
⟨cof_comp (pushout_is_cof (pushout_by_cof j j hj).is_pushout.transpose hj) c.hii,
 weq_of_comp_weq_right c.hp (by convert (weq_id _); exact c.pi₀)⟩

lemma relative_cylinder.acof_i₁ (c : relative_cylinder hj) : is_acof c.i₁ :=
⟨cof_comp (pushout_is_cof (pushout_by_cof j j hj).is_pushout hj) c.hii,
 weq_of_comp_weq_right c.hp (by convert (weq_id _); exact c.pi₁)⟩

-- If j : a → b is an *acyclic* cofibration, then so is c.ii.
lemma relative_cylinder.acof_ii (c : relative_cylinder hj) (hj' : is_weq j) : is_acof c.ii :=
have is_acof (pushout_by_cof j j hj).map₁, from
  pushout_is_acof (pushout_by_cof j j hj).is_pushout ⟨hj, hj'⟩,
have is_weq ((pushout_by_cof j j hj).is_pushout.induced (𝟙 b) (𝟙 b) rfl), from
  weq_of_comp_weq_left this.2 (by convert weq_id b using 1; simp),
⟨c.hii, weq_of_comp_weq_right c.hp (by convert this; simp [c.pii])⟩

structure cylinder_embedding (c c' : relative_cylinder hj) :=
(k : c.ob ⟶ c'.ob)
(hk : is_cof k)
(hkii : k ∘ c.ii = c'.ii)
(hpk : c'.p ∘ k = c.p)

lemma cylinder_embedding.hki₀ {c c' : relative_cylinder hj} (m : cylinder_embedding c c') :
  m.k ∘ c.i₀ = c'.i₀ :=
by unfold relative_cylinder.i₀; simp [m.hkii]

lemma cylinder_embedding.hki₁ {c c' : relative_cylinder hj} (m : cylinder_embedding c c') :
  m.k ∘ c.i₁ = c'.i₁ :=
by unfold relative_cylinder.i₁; simp [m.hkii]

lemma cylinder_embedding.acof_k {c c' : relative_cylinder hj} (m : cylinder_embedding c c') :
  is_acof m.k :=
⟨m.hk, weq_of_comp_weq_right c'.hp (by convert c.hp; rw m.hpk)⟩

def cylinder_embedding.refl (c : relative_cylinder hj) : cylinder_embedding c c :=
⟨𝟙 c.ob, cof_id _, by simp, by simp⟩

def cylinder_embedding.trans {c₀ c₁ c₂ : relative_cylinder hj}
  (m₀ : cylinder_embedding c₀ c₁) (m₁ : cylinder_embedding c₁ c₂) : cylinder_embedding c₀ c₂ :=
⟨m₁.k ∘ m₀.k,
 cof_comp m₀.hk m₁.hk,
 by rw [←assoc, m₀.hkii, m₁.hkii],
 by rw [assoc, m₁.hpk, m₀.hpk]⟩

-- Any two relative cylinders on the same cofibration can be embedded
-- in a third.

structure common_embedding (c₀ c₁ : relative_cylinder hj) :=
(c' : relative_cylinder hj)
(m₀ : cylinder_embedding c₀ c')
(m₁ : cylinder_embedding c₁ c')

-- Factor out the second part of the construction of a common
-- embedding, since we will need to apply it to a particular form of
-- factorization later, when verifying the identity and inverse laws
-- for track composition.
def common_embedding_of_factorization (c₀ c₁ : relative_cylinder hj)
  (po : pushout c₀.ii c₁.ii) (c'_ob : C) (l : po.ob ⟶ c'_ob) (q : c'_ob ⟶ b)
  (hl : is_cof l) (hq : is_weq q)
  (ql : q ∘ l = po.is_pushout.induced c₀.p c₁.p (by simp [c₀.pii, c₁.pii])) :
  common_embedding c₀ c₁ :=
let c' : relative_cylinder hj :=
  ⟨c'_ob, l ∘ po.map₁ ∘ c₁.ii, q,
   cof_comp c₁.hii (cof_comp (pushout_is_cof po.is_pushout c₀.hii) hl),
   hq, by simp [ql, c₁.pii]⟩ in
⟨c',
 ⟨l ∘ po.map₀,
  cof_comp (pushout_is_cof po.is_pushout.transpose c₁.hii) hl,
  by rw [←assoc, po.is_pushout.commutes, assoc],
  by simp [ql]⟩,
 ⟨l ∘ po.map₁,
  cof_comp (pushout_is_cof po.is_pushout c₀.hii) hl,
  rfl,
  by simp [ql]⟩⟩

lemma exists_common_embedding (c₀ c₁ : relative_cylinder hj) :
  nonempty (common_embedding c₀ c₁) :=
let po := pushout_by_cof c₀.ii c₁.ii c₀.hii,
    pp := po.is_pushout.induced c₀.p c₁.p (by rw [c₀.pii, c₁.pii]),
    ⟨c'_ob, l, q, hl, hq, ql⟩ := factorization pp in
⟨common_embedding_of_factorization c₀ c₁ po c'_ob l q hl hq ql⟩

def cylinder_embedding.pushout {c c₀ c₁ : relative_cylinder hj}
  (m₀ : cylinder_embedding c c₀) (m₁ : cylinder_embedding c c₁) : relative_cylinder hj :=
⟨(pushout_by_cof m₀.k m₁.k m₀.hk).ob,
 (pushout_by_cof m₀.k m₁.k m₀.hk).map₁ ∘ c₁.ii,
 (pushout_by_cof m₀.k m₁.k m₀.hk).is_pushout.induced c₀.p c₁.p
   (by rw [m₀.hpk, ←m₁.hpk]),
 cof_comp c₁.hii (pushout_is_cof (pushout_by_cof m₀.k m₁.k m₀.hk).is_pushout m₀.hk),
 weq_of_comp_weq_left
   (pushout_is_acof (pushout_by_cof m₀.k m₁.k m₀.hk).is_pushout m₀.acof_k).2
   (by convert c₁.hp; simp),
 by simp [c₁.pii]⟩

def cylinder_embedding.pushout.map₀ {c c₀ c₁ : relative_cylinder hj}
  (m₀ : cylinder_embedding c c₀) (m₁ : cylinder_embedding c c₁) :
  cylinder_embedding c₀ (cylinder_embedding.pushout m₀ m₁) :=
⟨(pushout_by_cof m₀.k m₁.k m₀.hk).map₀,
 pushout_is_cof (pushout_by_cof m₀.k m₁.k m₀.hk).is_pushout.transpose m₁.hk,
 show
   (pushout_by_cof m₀.k m₁.k m₀.hk).map₀ ∘ c₀.ii =
   (pushout_by_cof m₀.k m₁.k m₀.hk).map₁ ∘ c₁.ii,
 begin
   rw [←m₀.hkii, ←m₁.hkii],
   simp [(pushout_by_cof m₀.k m₁.k m₀.hk).is_pushout.commutes]
 end,
 show Is_pushout.induced _ _ _ _ ∘ _ = _, by simp⟩

def cylinder_embedding.pushout.map₁ {c c₀ c₁ : relative_cylinder hj}
  (m₀ : cylinder_embedding c c₀) (m₁ : cylinder_embedding c c₁) :
  cylinder_embedding c₁ (cylinder_embedding.pushout m₀ m₁) :=
⟨(pushout_by_cof m₀.k m₁.k m₀.hk).map₁,
 pushout_is_cof (pushout_by_cof m₀.k m₁.k m₀.hk).is_pushout m₀.hk,
 rfl,
 show Is_pushout.induced _ _ _ _ ∘ _ = _, by simp⟩

def cylinder_embedding.pushout.is_pushout {c c₀ c₁ : relative_cylinder hj}
  (m₀ : cylinder_embedding c c₀) (m₁ : cylinder_embedding c c₁) :
  Is_pushout m₀.k m₁.k
    (cylinder_embedding.pushout.map₀ m₀ m₁).k
    (cylinder_embedding.pushout.map₁ m₀ m₁).k :=
(pushout_by_cof m₀.k m₁.k m₀.hk).is_pushout

def relative_cylinder.reverse (c : relative_cylinder hj) : relative_cylinder hj :=
⟨c.ob,
 c.ii ∘ (pushout_by_cof j j hj).is_pushout.swap,
 c.p,
 cof_comp (cof_iso (pushout_by_cof j j hj).is_pushout.swap_iso) c.hii,
 c.hp,
 by simp [c.pii]⟩

@[simp] lemma relative_cylinder.reverse_i₀ {c : relative_cylinder hj} :
  c.reverse.i₀ = c.i₁ :=
show c.ii ∘ (pushout_by_cof j j hj).is_pushout.induced _ _ _ ∘ (pushout_by_cof j j hj).map₀ = _,
by rw [←assoc]; simp; refl

@[simp] lemma relative_cylinder.reverse_i₁ {c : relative_cylinder hj} :
  c.reverse.i₁ = c.i₀ :=
show c.ii ∘ (pushout_by_cof j j hj).is_pushout.induced _ _ _ ∘ (pushout_by_cof j j hj).map₁ = _,
by rw [←assoc]; simp; refl

def cylinder_embedding.reverse {c c' : relative_cylinder hj}
  (m : cylinder_embedding c c') : cylinder_embedding c.reverse c'.reverse :=
⟨m.k, m.hk, show m.k ∘ (c.ii ∘ _) = c'.ii ∘ _, by simp [m.hkii], m.hpk⟩

-- TODO: Should really have this `pushout_by_cof` exposed somewhere
def relative_cylinder.glue (c₀ c₁ : relative_cylinder hj) : relative_cylinder.{v} hj :=
let po := pushout_by_cof c₀.i₁ c₁.i₀ c₀.acof_i₁.1 in
⟨po.ob,
 (pushout_by_cof j j hj).is_pushout.induced (po.map₀ ∘ c₀.i₀) (po.map₁ ∘ c₁.i₁) $
   by rw [←assoc, ←assoc, c₀.ij, ←c₁.ij]; simp [po.is_pushout.commutes],
 po.is_pushout.induced c₀.p c₁.p (by rw [c₀.pi₁, c₁.pi₀]),
 begin
   let po₀ := pushout_by_cof c₀.i₀ (pushout_by_cof j j hj).map₀ c₀.acof_i₀.1,
   let po₀' :=
     (Is_pushout_of_Is_pushout_of_Is_pushout
       (pushout_by_cof j j hj).is_pushout.transpose po₀.is_pushout.transpose).transpose,
   let f :=
     (pushout_by_cof j j hj).is_pushout.induced
       (po₀.map₀ ∘ c₀.i₁) (po₀.map₁ ∘ (pushout_by_cof j j hj).map₁)
       (by rw [←assoc, ←assoc, ←c₀.ij,
               ←(pushout_by_cof j j hj).is_pushout.commutes,
               assoc, assoc, po₀.is_pushout.commutes]),
   let po₁ : Is_pushout c₀.i₁ (pushout_by_cof j j hj).map₀ po₀.map₀ f :=
     Is_pushout_of_Is_pushout_of_Is_pushout_vert'
       (pushout_by_cof j j hj).is_pushout
       (begin convert po₀' using 1, { exact c₀.ij.symm }, { simp } end) (by simp),
   let g := po₁.induced po.map₀ (po.map₁ ∘ c₁.ii)
     (by rw ←assoc; exact po.is_pushout.commutes),
   let po₂ : Is_pushout f c₁.ii g po.map₁ :=
     Is_pushout_of_Is_pushout_of_Is_pushout' po₁ (by convert po.is_pushout; simp) (by simp),
   have : ∀ p,
     (pushout_by_cof j j hj).is_pushout.induced (po.map₀ ∘ c₀.i₀) (po.map₁ ∘ c₁.i₁) p =
     g ∘ po₀.map₁ :=
   begin
     intro p, apply (pushout_by_cof j j hj).is_pushout.uniqueness,
     { rw [←assoc, ←po₀.is_pushout.commutes], simp },
     { rw ←assoc,
       have :
         po₀.map₁ ∘ (pushout_by_cof.{v} j j hj).map₁ =
         f ∘ (pushout_by_cof.{v} j j hj).map₁, by simp,
       rw this,
       rw [assoc, po₂.commutes, ←assoc],
       change _ = po.map₁ ∘ c₁.i₁, simp }
   end,
   rw this,
   exact cof_comp
     (pushout_is_cof po₀.is_pushout c₀.acof_i₀.1)
     (pushout_is_cof po₂.transpose c₁.hii)
 end,
 weq_of_comp_weq_left
   (pushout_is_acof po.is_pushout c₀.acof_i₁).2
   (by simpa using c₁.hp),
 begin
   apply (pushout_by_cof j j hj).is_pushout.uniqueness;
   { rw ←assoc, simp, rw [c₀.pi₀] <|> rw [c₁.pi₁] }
 end⟩

@[simp] lemma relative_cylinder.glue_i₀ {c₀ c₁ : relative_cylinder hj} :
  (c₀.glue c₁).i₀ = (pushout_by_cof c₀.i₁ c₁.i₀ c₀.acof_i₁.1).map₀ ∘ c₀.i₀ :=
let po := pushout_by_cof c₀.i₁ c₁.i₀ c₀.acof_i₁.1 in
show
  (pushout_by_cof j j hj).is_pushout.induced (po.map₀ ∘ c₀.i₀) (po.map₁ ∘ c₁.i₁) _ ∘
    (pushout_by_cof j j hj).map₀ = _, by simp

@[simp] lemma relative_cylinder.glue_i₁ {c₀ c₁ : relative_cylinder hj} :
  (c₀.glue c₁).i₁ = (pushout_by_cof c₀.i₁ c₁.i₀ c₀.acof_i₁.1).map₁ ∘ c₁.i₁ :=
let po := pushout_by_cof c₀.i₁ c₁.i₀ c₀.acof_i₁.1 in
show
  (pushout_by_cof j j hj).is_pushout.induced (po.map₀ ∘ c₀.i₀) (po.map₁ ∘ c₁.i₁) _ ∘
    (pushout_by_cof j j hj).map₁ = _, by simp

def cylinder_embedding.glue {c₀ c₁ c₀' c₁' : relative_cylinder hj}
  (m₀ : cylinder_embedding c₀ c₀') (m₁ : cylinder_embedding c₁ c₁') :
  cylinder_embedding (c₀.glue c₁) (c₀'.glue c₁') :=
⟨(pushout_by_cof c₀.i₁ c₁.i₀ c₀.acof_i₁.1).is_pushout.induced
   ((pushout_by_cof c₀'.i₁ c₁'.i₀ c₀'.acof_i₁.1).map₀ ∘ m₀.k)
   ((pushout_by_cof c₀'.i₁ c₁'.i₀ c₀'.acof_i₁.1).map₁ ∘ m₁.k)
   (by rw [←assoc, ←assoc, m₀.hki₁, m₁.hki₀];
       exact (pushout_by_cof c₀'.i₁ c₁'.i₀ c₀'.acof_i₁.1).is_pushout.commutes),
 begin
   apply cof_pushout m₀.hk m₁.hk,
   convert (pushout_by_cof c₀'.i₁ c₁'.i₀ c₀'.acof_i₁.1).is_pushout using 1,
   exact m₀.hki₁, exact m₁.hki₀
 end,
 begin
   apply (pushout_by_cof j j hj).is_pushout.uniqueness; rw ←assoc,
   { change _ ∘ (c₀.glue c₁).i₀ = (c₀'.glue c₁').i₀, simp [m₀.hki₀.symm] },
   { change _ ∘ (c₀.glue c₁).i₁ = (c₀'.glue c₁').i₁, simp [m₁.hki₁.symm] }
 end,
 begin
   apply (pushout_by_cof c₀.i₁ c₁.i₀ c₀.acof_i₁.1).is_pushout.uniqueness; rw ←assoc;
   change Is_pushout.induced _ _ _ _ ∘ _ = Is_pushout.induced _ _ _ _ ∘ _;
   simp [m₀.hpk, m₁.hpk]
 end⟩

section pair_map
variables (hj)
variables {a' b' : C} {j' : a' ⟶ b'} (hj' : is_cof j')

include hj hj'
structure pair_map :=
(g : a ⟶ a')
(h : b ⟶ b')
(commutes : h ∘ j = j' ∘ g)
omit hj hj'

variables {hj hj'}
def endpoints_map (h : pair_map hj hj') :
  (pushout_by_cof j j hj).ob ⟶ (pushout_by_cof j' j' hj').ob :=
pushout_of_maps
  (pushout_by_cof j j hj).is_pushout
  (pushout_by_cof j' j' hj').is_pushout
  h.g h.h h.h h.commutes h.commutes

-- Like `cylinder_embedding`, but we do not require that the map
-- between cylinders be a cofibration (since b → b' might not be one).
structure cylinder_map_over (h : pair_map hj hj')
  (c : relative_cylinder hj) (c' : relative_cylinder hj') :=
(k : c.ob ⟶ c'.ob)
(hkii : k ∘ c.ii = c'.ii ∘ endpoints_map h)
(hpk : c'.p ∘ k = h.h ∘ c.p)

lemma cylinder_map_over.hki₀ {h : pair_map hj hj'}
  {c : relative_cylinder hj} {c' : relative_cylinder hj'} (m : cylinder_map_over h c c') :
  m.k ∘ c.i₀ = c'.i₀ ∘ h.h :=
begin
  unfold relative_cylinder.i₀,
  rw [assoc, m.hkii],
  unfold endpoints_map pushout_of_maps,
  rw [←assoc], simp
end

lemma cylinder_map_over.hki₁ {h : pair_map hj hj'}
  {c : relative_cylinder hj} {c' : relative_cylinder hj'} (m : cylinder_map_over h c c') :
  m.k ∘ c.i₁ = c'.i₁ ∘ h.h :=
begin
  unfold relative_cylinder.i₁,
  rw [assoc, m.hkii],
  unfold endpoints_map pushout_of_maps,
  rw [←assoc], simp
end

lemma exists_of_pair_map (h : pair_map hj hj')
  (c₀ : relative_cylinder hj) (c₁ : relative_cylinder hj') :
  ∃ c' (m₀ : cylinder_map_over h c₀ c') (m₁ : cylinder_embedding c₁ c'), true :=
let po := pushout_by_cof c₀.ii (c₁.ii ∘ endpoints_map h) c₀.hii,
    pp := po.is_pushout.induced (h.h ∘ c₀.p) c₁.p $ begin
      rw [←assoc, c₀.pii, assoc, c₁.pii],
      unfold endpoints_map, rw [induced_pushout_of_maps, pushout_induced_comp],
      simp
    end,
    ⟨c'_ob, l, q, hl, hq, ql⟩ := factorization pp in
let c' : relative_cylinder hj' :=
  ⟨c'_ob, l ∘ po.map₁ ∘ c₁.ii, q,
   cof_comp c₁.hii (cof_comp (pushout_is_cof po.is_pushout c₀.hii) hl),
   hq, by simp [ql, c₁.pii]⟩ in
⟨c',
 ⟨l ∘ po.map₀,
  by rw [←assoc, po.is_pushout.commutes]; simp,
  by simp [ql]⟩,
 ⟨l ∘ po.map₁,
  cof_comp (pushout_is_cof po.is_pushout c₀.hii) hl,
  rfl,
  by simp [ql]⟩,
 trivial⟩

end pair_map

end homotopy_theory.cofibrations