import Lean.Elab.Tactic
-- import Lean.Elab.Tactic.Simp

#exit

#check Lean.Meta.getSimpLemmas
#check Lean.Elab.Tactic.mkSimpContext
#check Lean.Elab.Tactic.evalSimp

theorem pointfree_left {f : α → β} {g : β → γ} :
  g (f x) = y →
  (g ∘ f) x = y := id

theorem pointfree_right {f : α → β} {g : β → γ} :
  x = g (f y) →
  x = (g ∘ f) y := id

theorem finish_pointfree {f g : α → β} :
  (∀ x, f x = g x) → f = g := funext

namespace Lean.Meta

namespace MakeBuddies

end MakeBuddies

open Lean.Expr
open Meta
open Lean.Macro
open Lean.Meta

-- def mkLam (v : Expr) (b : Expr) : MetaM Expr := do
-- let lctx ← getLCtx
-- let decl := lctx.get! v.fvarId!
-- let n :=  decl.userName
-- let t :=  decl.type
-- let bi :=  decl.binderInfo
-- return mkLambda n bi t (b.abstract #[v])
-- open Lean.Meta (mkLambdaFVars)

partial def finishPointFree (pr : Expr) : MetaM (FVarId × Expr) := do
match (← inferType pr) with
| app (app eq (app f x@(fvar x' _) _) _) (app f' y@(fvar y' _) _) _ => do
  unless (x' == y') do
    throwError "cannot transform into point-free: {x} {y}";
  let args := #[none, none, f, f', (← mkLambdaFVars #[x] pr)]
  let l ← mkAppOptM ``finish_pointfree args
  return (x', l)
| t => do
  throwError "bad shape {(← ppExpr t)}"

-- #check @pointfree_right

partial def mkPointFreeRight (pr : Expr) : MetaM (FVarId × Expr) := do
match (← inferType pr) with
| app (app eq lhs _) (app f (app g x _) _) _ =>
      let args := #[none, none, none, none, x, g, f, pr]
      (mkAppOptM ``pointfree_right args
       >>= mkPointFreeRight)
| _ => finishPointFree pr

partial def mkPointFreeLeft (pr : Expr) : MetaM (FVarId × Expr) := do
match (← inferType pr) with
| app (app eq (app f (app g x _) _) _) _ _ =>
      let args := #[none, none, none, x, none, g, f, pr]
      (mkAppOptM ``pointfree_left args
       >>= mkPointFreeLeft)
| _ => mkPointFreeRight pr

def makeBuddies (n : Name) : MetaM (Name × Name) := do
let info ← getConstInfo n
let ls : List Name := info.levelParams
let l ← mkConst n (ls.map mkLevelParam)
let n' := Name.appendAfter info.name "_pointfree"
let t ← inferType l
forallTelescopeReducing t λ args hd => do
  for x in args do
    IO.println s!"{(← ppExpr x)} : {(← ppExpr (← inferType x))}"
  IO.println s!"{(← ppExpr hd)}"
  let l' := mkAppN l args
  IO.println s!"{(← ppExpr l')}"
  IO.println s!"{(← ppExpr (← inferType l'))}"
  let (v, e) ← mkPointFreeLeft l'
  let args := args.erase (mkFVar v)
  let e ← mkLambdaFVars args e
  let t ← inferType e
  -- let t ← mkForallFVars args (← inferType e)
  modifyEnv λ env => env.add
    <| ConstantInfo.thmInfo
    <| { name := n',
         levelParams := ls,
         type := t,
         value := e }
  IO.println s!"{(← ppExpr e)} : {(← ppExpr (← inferType e))}"
  return (n, n')

#eval makeBuddies ``LawfulFunctor.comp_map
#check @LawfulFunctor.comp_map_pointfree
#check getSimpLemmas
namespace Buddies

private partial def isPerm : Expr → Expr → MetaM Bool
  | Expr.app f₁ a₁ _, Expr.app f₂ a₂ _ => isPerm f₁ f₂ <&&> isPerm a₁ a₂
  | Expr.mdata _ s _, t => isPerm s t
  | s, Expr.mdata _ t _ => isPerm s t
  | s@(Expr.mvar ..), t@(Expr.mvar ..) => isDefEq s t
  | Expr.forallE n₁ d₁ b₁ _, Expr.forallE n₂ d₂ b₂ _ => isPerm d₁ d₂ <&&> withLocalDeclD n₁ d₁ fun x => isPerm (b₁.instantiate1 x) (b₂.instantiate1 x)
  | Expr.lam n₁ d₁ b₁ _, Expr.lam n₂ d₂ b₂ _ => isPerm d₁ d₂ <&&> withLocalDeclD n₁ d₁ fun x => isPerm (b₁.instantiate1 x) (b₂.instantiate1 x)
  | Expr.letE n₁ t₁ v₁ b₁ _, Expr.letE n₂ t₂ v₂ b₂ _ =>
    isPerm t₁ t₂ <&&> isPerm v₁ v₂ <&&> withLetDecl n₁ t₁ v₁ fun x => isPerm (b₁.instantiate1 x) (b₂.instantiate1 x)
  | Expr.proj _ i₁ b₁ _, Expr.proj _ i₂ b₂ _ => i₁ == i₂ <&&> isPerm b₁ b₂
  | s, t => s == t

private def checkTypeIsProp (type : Expr) : MetaM Unit :=
  unless (← isProp type) do
    throwError "invalid 'simp', proposition expected{indentExpr type}"

private def mkSimpLemmaCore (e : Expr) (levelParams : Array Name) (proof : Expr) (post : Bool) (prio : Nat) (name? : Option Name) : MetaM SimpLemma := do
  let type ← instantiateMVars (← inferType e)
  withNewMCtxDepth do
    let (xs, _, type) ← withReducible <| forallMetaTelescopeReducing type
    let type ← whnfR type
    let (keys, perm) ←
      match type.eq? with
      | some (_, lhs, rhs) => pure (← DiscrTree.mkPath lhs, ← isPerm lhs rhs)
      | none => throwError "unexpected kind of 'simp' theorem{indentExpr type}"
    return { keys := keys, perm := perm, post := post, levelParams := levelParams, proof := proof, name? := name?, priority := prio }

private partial def shouldPreprocess (type : Expr) : MetaM Bool :=
  forallTelescopeReducing type fun xs result => return !result.isEq

private partial def preprocess (e type : Expr) (inv : Bool) : MetaM (List (Expr × Expr)) := do
  let type ← whnf type
  if type.isForall then
    forallTelescopeReducing type fun xs type => do
      let e := mkAppN e xs
      let ps ← preprocess e type inv
      ps.mapM fun (e, type) =>
        return (← mkLambdaFVars xs e, ← mkForallFVars xs type)
  else if let some (_, lhs, rhs) := type.eq? then
    if inv then
      let type ← mkEq rhs lhs
      let e    ← mkEqSymm e
      return [(e, type)]
    else
      return [(e, type)]
  else if let some (lhs, rhs) := type.iff? then
    if inv then
      let type ← mkEq rhs lhs
      let e    ← mkEqSymm (← mkPropExt e)
      return [(e, type)]
    else
      let type ← mkEq lhs rhs
      let e    ← mkPropExt e
      return [(e, type)]
  else if let some (_, lhs, rhs) := type.ne? then
    if inv then
      throwError "invalid '←' modifier in rewrite rule to 'False'"
    let type ← mkEq (← mkEq lhs rhs) (mkConst ``False)
    let e    ← mkEqFalse e
    return [(e, type)]
  else if let some p := type.not? then
    if inv then
      throwError "invalid '←' modifier in rewrite rule to 'False'"
    let type ← mkEq p (mkConst ``False)
    let e    ← mkEqFalse e
    return [(e, type)]
  else if let some (type₁, type₂) := type.and? then
    let e₁ := mkProj ``And 0 e
    let e₂ := mkProj ``And 1 e
    return (← preprocess e₁ type₁ inv) ++ (← preprocess e₂ type₂ inv)
  else
    if inv then
      throwError "invalid '←' modifier in rewrite rule to 'True'"
    let type ← mkEq type (mkConst ``True)
    let e    ← mkEqTrue e
    return [(e, type)]

private def mkSimpLemmasFromConst (declName : Name) (post : Bool) (inv : Bool) (prio : Nat) : MetaM (Array SimpLemma) := do
  let cinfo ← getConstInfo declName
  let val := mkConst declName (cinfo.levelParams.map mkLevelParam)
  withReducible do
    let type ← inferType val
    checkTypeIsProp type
    if inv || (← shouldPreprocess type) then
      let mut r := #[]
      for (val, type) in (← preprocess val type inv) do
        let auxName ← mkAuxLemma cinfo.levelParams type val
        r := r.push <| (← mkSimpLemmaCore (mkConst auxName (cinfo.levelParams.map mkLevelParam)) #[] (mkConst auxName) post prio declName)
      return r
    else
      #[← mkSimpLemmaCore (mkConst declName (cinfo.levelParams.map mkLevelParam)) #[] (mkConst declName) post prio declName]

abbrev SimpExtension := SimpleScopedEnvExtension SimpEntry SimpLemmas

def SimpExtension.getLemmas (ext : SimpExtension) : CoreM SimpLemmas :=
  return ext.getState (← getEnv)

def addSimpLemma (ext : SimpExtension) (declName : Name) (post : Bool) (inv : Bool) (attrKind : AttributeKind) (prio : Nat) : MetaM Unit := do
  let simpLemmas ← mkSimpLemmasFromConst declName post inv prio
  for simpLemma in simpLemmas do
    ext.add (SimpEntry.lemma simpLemma) attrKind

def mkSimpAttr (attrName : Name) (attrDescr : String) (ext : SimpExtension) : IO Unit :=
  registerBuiltinAttribute {
    name  := attrName
    descr := attrDescr
    add   := fun declName stx attrKind =>
      let go : MetaM Unit := do
        let info ← getConstInfo declName
        if (← isProp info.type) then
          let post :=
            if stx[1].isNone then true else stx[1][0].getKind == ``Lean.Parser.Tactic.simpPost
          let prio ← getAttrParamOptPrio stx[2]
          addSimpLemma ext declName post (inv := false) attrKind prio
        else if info.hasValue then
          ext.add (SimpEntry.toUnfold declName) attrKind
        else
          throwError "invalid 'simp', it is not a proposition nor a definition (to unfold)"
      discard <| go.run {} {}
    erase := fun declName => do
      let s ← ext.getState (← getEnv)
      let s ← s.erase declName
      modifyEnv fun env => ext.modifyState env fun _ => s
  }

def mkSimpExt (extName : Name) : IO SimpExtension :=
  registerSimpleScopedEnvExtension {
    name     := extName
    initial  := {}
    addEntry := fun d e =>
      match e with
      | SimpEntry.lemma e => addSimpLemmaEntry d e
      | SimpEntry.toUnfold n => d.addDeclToUnfold n
  }

def registerSimpAttr (attrName : Name) (attrDescr : String) (extName : Name := attrName.appendAfter "Ext") : IO SimpExtension := do
  let ext ← mkSimpExt extName
  mkSimpAttr attrName attrDescr ext
  return ext

builtin_initialize mySimpExtension : SimpExtension ← registerSimpAttr `my_simp "simplification theorem with buddies"

def getSimpLemmas : CoreM SimpLemmas :=
  simpExtension.getLemmas

end Buddies

end Lean.Meta

namespace Lean.Elab.Tactic
-- abbrev mkDischargeWrapper :=
-- _root_.Lean.Elab.Tactic.mkDischargeWrapper

open Lean.Meta

private def addDeclToUnfoldOrLemma (lemmas : Meta.SimpLemmas) (e : Expr) (post : Bool) (inv : Bool) : MetaM Meta.SimpLemmas := do
  if e.isConst then
    let declName := e.constName!
    let info ← getConstInfo declName
    if (← isProp info.type) then
      lemmas.addConst declName (post := post) (inv := inv)
    else
      if inv then
        throwError "invalid '←' modifier, '{declName}' is a declaration name to be unfolded"
      lemmas.addDeclToUnfold declName
  else
    lemmas.add #[] e (post := post) (inv := inv)

private def addSimpLemma (lemmas : Meta.SimpLemmas) (stx : Syntax) (post : Bool) (inv : Bool) : TermElabM Meta.SimpLemmas := do
  let (levelParams, proof) ← Term.withoutModifyingElabMetaStateWithInfo <| withRef stx <| Term.withoutErrToSorry do
    let e ← Term.elabTerm stx none
    Term.synthesizeSyntheticMVars (mayPostpone := false) (ignoreStuckTC := true)
    let e ← instantiateMVars e
    let e := e.eta
    if e.hasMVar then
      let r ← abstractMVars e
      return (r.paramNames, r.expr)
    else
      return (#[], e)
  lemmas.add levelParams proof (post := post) (inv := inv)

/--
  Elaborate extra simp lemmas provided to `simp`. `stx` is of the `simpLemma,*`
  If `eraseLocal == true`, then we consider local declarations when resolving names for erased lemmas (`- id`),
  this option only makes sense for `simp_all`.
-/
private def elabSimpArgs (stx : Syntax) (ctx : Simp.Context) (eraseLocal : Bool) : TacticM ElabSimpArgsResult := do
  if stx.isNone then
    return { ctx }
  else
    /-
    syntax simpPre := "↓"
    syntax simpPost := "↑"
    syntax simpLemma := (simpPre <|> simpPost)? term

    syntax simpErase := "-" ident
    -/
    withMainContext do
      let mut lemmas  := ctx.simpLemmas
      let mut starArg := false
      for arg in stx[1].getSepArgs do
        if arg.getKind == ``Lean.Parser.Tactic.simpErase then
          if eraseLocal && (← Term.isLocalIdent? arg[1]).isSome then
            -- We use `eraseCore` because the simp lemma for the hypothesis was not added yet
            lemmas ← lemmas.eraseCore arg[1].getId
          else
            let declName ← resolveGlobalConstNoOverloadWithInfo arg[1]
            lemmas ← lemmas.erase declName
        else if arg.getKind == ``Lean.Parser.Tactic.simpLemma then
          let post :=
            if arg[0].isNone then
              true
            else
              arg[0][0].getKind == ``Parser.Tactic.simpPost
          let inv  := !arg[1].isNone
          let term := arg[2]
          match (← resolveSimpIdLemma? term) with
          | some e => lemmas ← addDeclToUnfoldOrLemma lemmas e post inv
          | _      => lemmas ← addSimpLemma lemmas term post inv
        else if arg.getKind == ``Lean.Parser.Tactic.simpStar then
          starArg := true
        else
          throwUnsupportedSyntax
      return { ctx := { ctx with simpLemmas := lemmas }, starArg }
where
  resolveSimpIdLemma? (simpArgTerm : Syntax) : TacticM (Option Expr) := do
    if simpArgTerm.isIdent then
      try
        Term.resolveId? simpArgTerm (withInfo := true)
      catch _ =>
        return none
    else
      Term.elabCDotFunctionAlias? simpArgTerm

private def mkDischargeWrapper (optDischargeSyntax : Syntax) : TacticM Simp.DischargeWrapper := do
  if optDischargeSyntax.isNone then
    return Simp.DischargeWrapper.default
  else
    let (ref, d) ← tacticToDischarge optDischargeSyntax[0][3]
    return Simp.DischargeWrapper.custom ref d

-- TODO: move?
private def getPropHyps : MetaM (Array FVarId) := do
  let mut result := #[]
  for localDecl in (← getLCtx) do
    unless localDecl.isAuxDecl do
      if (← isProp localDecl.type) then
        result := result.push localDecl.fvarId
  return result

/--
  If `ctx == false`, the config argument is assumed to have type `Meta.Simp.Config`, and `Meta.Simp.ConfigCtx` otherwise.
  If `ctx == false`, the `discharge` option must be none -/
def mkSimpContext' (stx : Syntax) (eraseLocal : Bool) (ctx := false) (ignoreStarArg : Bool := false) : TacticM MkSimpContextResult := do
  if ctx && !stx[2].isNone then
    throwError "'simp_all' tactic does not support 'discharger' option"
  let dischargeWrapper ← mkDischargeWrapper stx[2]
  let simpOnly := !stx[3].isNone
  let simpLemmas ←
    if simpOnly then
      ({} : SimpLemmas).addConst ``eq_self
    else
      getSimpLemmas
  let congrLemmas ← getCongrLemmas
  let r ← elabSimpArgs stx[4] (eraseLocal := eraseLocal) {
    config      := (← elabSimpConfig stx[1] (ctx := ctx))
    simpLemmas, congrLemmas
  }
  if !r.starArg || ignoreStarArg then
    return { r with fvarIdToLemmaId := {}, dischargeWrapper }
  else
    let ctx := r.ctx
    let erased := ctx.simpLemmas.erased
    let hs ← getPropHyps
    let mut ctx := ctx
    let mut fvarIdToLemmaId := {}
    for h in hs do
      let localDecl ← getLocalDecl h
      unless erased.contains localDecl.userName do
        let fvarId := localDecl.fvarId
        let proof  := localDecl.toExpr
        let id     ← mkFreshUserName `h
        fvarIdToLemmaId := fvarIdToLemmaId.insert fvarId id
        let simpLemmas ← ctx.simpLemmas.add #[] proof (name? := id)
        ctx := { ctx with simpLemmas }
    return { ctx, fvarIdToLemmaId, dischargeWrapper }

@[tactic Lean.Parser.Tactic.simp] def evalSimp' : Tactic := fun stx => do
  IO.println "simp!!!"
  -- let { ctx, fvarIdToLemmaId, dischargeWrapper } ← withMainContext <| mkSimpContext stx (eraseLocal := false)
  -- -- trace[Meta.debug] "Lemmas {← toMessageData ctx.simpLemmas.post}"
  -- dischargeWrapper.with fun discharge? =>
  --   simpLocation ctx discharge? fvarIdToLemmaId (expandOptLocation stx[5])

end Lean.Elab.Tactic

example : True := by simp


import Lbar.ext_aux4
import Lbar.iota

noncomputable theory

universes v u u'

open opposite category_theory category_theory.limits category_theory.preadditive
open_locale nnreal zero_object

variables (r r' : ℝ≥0)
variables [fact (0 < r)] [fact (0 < r')] [fact (r < r')] [fact (r < 1)] [fact (r' < 1)]

open bounded_homotopy_category

variables {r'}
variables (BD : breen_deligne.package)
variables (κ κ₂ : ℝ≥0 → ℕ → ℝ≥0)
variables [∀ (c : ℝ≥0), BD.data.suitable (κ c)] [∀ n, fact (monotone (function.swap κ n))]
variables [∀ (c : ℝ≥0), BD.data.suitable (κ₂ c)] [∀ n, fact (monotone (function.swap κ₂ n))]
variables (M : ProFiltPseuNormGrpWithTinv₁.{u} r')

namespace Lbar

open ProFiltPseuNormGrpWithTinv₁ ProFiltPseuNormGrp₁ CompHausFiltPseuNormGrp₁
open bounded_homotopy_category

variables (r r')

def Tinv_sub (S : Profinite.{u}) (V : SemiNormedGroup.{u}) [normed_with_aut r V] (i : ℤ) :
  ((Ext' i).obj (op $ (Lbar.condensed.{u} r').obj S)).obj V.to_Cond ⟶
  ((Ext' i).obj (op $ (Lbar.condensed.{u} r').obj S)).obj V.to_Cond :=
((Ext' i).map ((condensify_Tinv _).app S).op).app _ -
((Ext' i).obj _).map (Condensed.of_top_ab_map (normed_with_aut.T.inv).to_add_monoid_hom
  (normed_add_group_hom.continuous _))

-- move me
attribute [simps] Condensed.of_top_ab_map

variables (S : Profinite.{0}) (V : SemiNormedGroup.{0})
variables [complete_space V] [separated_space V]
variables (r')

-- TODO(!): TC loop? using "by apply_instance" causes a maximum TC error
instance (X : Profinite.{0}) :
  preserves_limits_of_shape.{0 0 0 0 1 1}
  (discrete_quotient.{0} ↥X) (PFPNGT₁_to_CHFPNG₁ₑₗ.{0} r') := {}

set_option pp.universes true
def condensify_iso_extend :
  condensify (Fintype_Lbar.{0 0} r' ⋙ PFPNGT₁_to_CHFPNG₁ₑₗ r') ≅
  (Profinite.extend (Fintype_Lbar.{0 0} r')) ⋙
    (PFPNGT₁_to_CHFPNG₁ₑₗ r' ⋙ CHFPNG₁_to_CHFPNGₑₗ.{0} ⋙
  CompHausFiltPseuNormGrp.to_Condensed.{0}) :=
(((whiskering_left _ _ _).map_iso $
  Profinite.extend_commutes (Fintype_Lbar.{0 0} r') (PFPNGT₁_to_CHFPNG₁ₑₗ r')).app
    (CHFPNG₁_to_CHFPNGₑₗ.{0} ⋙ CompHausFiltPseuNormGrp.to_Condensed.{0})).symm

def condensify_iso_extend' :
  (condensify (Fintype_Lbar.{0 0} r' ⋙ PFPNGT₁_to_CHFPNG₁ₑₗ r')).obj S ≅
  ((Profinite.extend (Fintype_Lbar.{0 0} r')).obj S).to_Condensed :=
(condensify_iso_extend r').app S

section move_me

--universes u'

open Profinite

variables {C : Type u} [category.{v} C] (F : Fintype.{v} ⥤ C)
variables {D : Type u'} [category.{v} D]
variable [∀ X : Profinite, has_limit (X.fintype_diagram ⋙ F)]

@[reassoc]
lemma extend_commutes_comp_extend_extends' (G : C ⥤ D)
  [∀ X : Profinite.{v}, preserves_limits_of_shape (discrete_quotient X) G]
  [∀ X : Profinite.{v}, has_limit (X.fintype_diagram ⋙ F ⋙ G)] :
  whisker_left Fintype.to_Profinite (extend_commutes F G).hom =
  (functor.associator _ _ _).inv ≫ (whisker_right (extend_extends _).hom G) ≫
    (extend_extends _).inv :=
by rw [← category.assoc, iso.eq_comp_inv, extend_commutes_comp_extend_extends]

@[reassoc]
lemma extend_commutes_comp_extend_extends'' (G : C ⥤ D)
  [∀ X : Profinite.{v}, preserves_limits_of_shape (discrete_quotient X) G]
  [∀ X : Profinite.{v}, has_limit (X.fintype_diagram ⋙ F ⋙ G)] :
  whisker_left Fintype.to_Profinite (extend_commutes F G).inv =
  (extend_extends _).hom ≫ (whisker_right (extend_extends _).inv G) ≫
    (functor.associator _ _ _).hom :=
begin
  rw [← iso.inv_comp_eq, ← iso_whisker_left_inv, iso.comp_inv_eq, iso_whisker_left_hom,
    extend_commutes_comp_extend_extends', category.assoc, iso.hom_inv_id_assoc,
    ← iso_whisker_right_hom, ← iso_whisker_right_inv, iso.inv_hom_id_assoc],
end

end move_me

lemma condensify_Tinv_iso :
  condensify_Tinv (Fintype_Lbar.{0 0} r') ≫ (condensify_iso_extend r').hom =
  (condensify_iso_extend r').hom ≫ (@whisker_right _ _ _ _ _ _ _ _ (Tinv_nat_trans _) _) :=
begin
  delta Tinv_cond condensify_Tinv condensify_nonstrict condensify_iso_extend' condensify_iso_extend,
  ext S : 2,
  rw [iso.symm_hom, iso.app_inv, functor.map_iso_inv, nat_trans.comp_app, nat_trans.comp_app,
    whiskering_left_map_app_app, ← iso.app_inv, ← functor.map_iso_inv, iso.comp_inv_eq,
    functor.map_iso_inv, functor.map_iso_hom, functor.comp_map, functor.comp_map,
    whisker_right_app, whisker_right_app, ← functor.map_comp, ← functor.map_comp],
  congr' 1,
  rw [iso.app_inv, iso.app_hom, ← whisker_right_app, ← whisker_right_app,
    ← nat_trans.comp_app, ← nat_trans.comp_app],
  congr' 1,
  refine nonstrict_extend_ext _ _ (r'⁻¹) (1 * (r'⁻¹ * 1)) _ _ _,
  { intro X, apply nonstrict_extend_bound_by },
  { intro X,
    apply comphaus_filtered_pseudo_normed_group_hom.bound_by.comp,
    apply comphaus_filtered_pseudo_normed_group_hom.bound_by.comp,
    { apply strict_comphaus_filtered_pseudo_normed_group_hom.to_chfpsng_hom.bound_by_one },
    { apply Tinv_bound_by },
    { apply strict_comphaus_filtered_pseudo_normed_group_hom.to_chfpsng_hom.bound_by_one }, },
  { rw [whisker_left_comp, whisker_left_comp, ← whisker_right_left, ← whisker_right_left,
      extend_commutes_comp_extend_extends', extend_commutes_comp_extend_extends''],
    rw nonstrict_extend_whisker_left,

    ext X : 2,
    simp only [whisker_left_app, whisker_right_app, nat_trans.comp_app,
      functor.associator_hom_app, functor.associator_inv_app,
      category.id_comp, category.comp_id, category.assoc, functor.map_comp],
    slice_rhs 2 3 {},
    congr' 2,

    simp only [← iso.app_hom, ← iso.app_inv, ← functor.map_iso_hom, ← functor.map_iso_inv,
      category.assoc, iso.eq_inv_comp],

    ext x : 1,
    exact (comphaus_filtered_pseudo_normed_group_with_Tinv_hom.map_Tinv
      ((Profinite.extend_extends (Fintype_Lbar.{0 0} r')).app X).hom x).symm }
end

lemma condensify_Tinv_iso' :
  (condensify_Tinv (Fintype_Lbar.{0 0} r')).app S ≫ (condensify_iso_extend' r' S).hom =
  (condensify_iso_extend' r' S).hom ≫ ((Profinite.extend (Fintype_Lbar.{0 0} r')).obj S).Tinv_cond :=
begin
  have := condensify_Tinv_iso r',
  apply_fun (λ η, η.app S) at this,
  exact this,
end

def useful_commsq (i : ℤ) (ι : ulift.{1} ℕ → ℝ≥0) (hι : monotone ι) [normed_with_aut r V] :=
  shift_sub_id.commsq
    (ExtQprime.Tinv2 r r' breen_deligne.eg.data
      (λ c n, c * breen_deligne.eg.κ r r' n)
      (λ c n, r' * (c * breen_deligne.eg.κ r r' n))
      ((Lbar.functor.{0 0} r').obj S) V i) ι hι

section
open breen_deligne thm95.universal_constants

variables (i : ℕ)

lemma useful_commsq_bicartesian (ι : ulift.{1} ℕ → ℝ≥0) (hι : monotone ι) [normed_with_aut r V]
  (H1 : ∀ j, c₀ r r' eg (λ n, eg.κ r r' n) (eg.κ' r r') (i+1) ⟨ℤ⟩ ≤ ι j)
  (H2 : ∀ j, k (eg.κ' r r') i ^ 2 * ι j ≤ ι (j + 1))
  (H3 : ∀ j, k (eg.κ' r r') (i+1) ^ 2 * ι j ≤ ι (j + 1)) :
  (useful_commsq r r' S V i ι hι).bicartesian :=
begin
  apply shift_sub_id.bicartesian_iso _ _
    (ExtQprime_iso_aux_system r' _ _ _ V i).symm (ExtQprime_iso_aux_system r' _ _ _ V i).symm ι hι
    (ExtQprime_iso_aux_system_comm' _ _ _ _ _ _ _ _),
  rw [← whisker_right_twice],
  refine shift_sub_id.bicartesian (aux_system.incl'.{0 1} r r' _ _ _ (eg.κ r r')) _
    i ι hι _ _ _,
  { apply_with system_of_complexes.shift_eq_zero {instances := ff},
    swap 3, { apply thm94.explicit r r' _ _ (eg.κ' r r'), },
    any_goals { apply_instance },
    { intro j,
      refine le_trans _ ((c₀_mono _ _ _ _ _ _ (i+1)).out.trans (H1 j)),
      rw nat.add_sub_cancel, },
    { exact H2 } },
  { apply_with system_of_complexes.shift_eq_zero {instances := ff},
    swap 3, { apply thm94.explicit r r' _ _ (eg.κ' r r'), },
    any_goals { apply_instance },
    { exact H1 },
    { exact H3 } },
  { intros c n,
    let κ := eg.κ r r',
    apply aux_system.short_exact r r' _ _ _ (λ c n, r' * (c * κ n)) κ,
    intro c, dsimp, apply_instance, }
end

lemma bicartesian_of_is_zero {𝓒 : Type*} [category 𝓒] [abelian 𝓒]
  {A B C D : 𝓒} (f₁ : A ⟶ B) (g₁ : A ⟶ C) (g₂ : B ⟶ D) (f₂ : C ⟶ D) (h : commsq f₁ g₁ g₂ f₂)
  (hA : is_zero A) (hB : is_zero B) (hC : is_zero C) (hD : is_zero D) :
  h.bicartesian :=
begin
  delta commsq.bicartesian,
  apply_with short_exact.mk {instances:=ff},
  { refine ⟨λ X f g h, _⟩, apply hA.eq_of_tgt },
  { refine ⟨λ X f g h, _⟩, apply hD.eq_of_src },
  { apply exact_of_is_zero ((is_zero_biprod _ _ hB hC).of_iso (h.sum.iso (sum_str.biprod _ _))), }
end

lemma is_zero_pi {𝓒 : Type*} [category 𝓒] [abelian 𝓒] {ι : Type*} (f : ι → 𝓒) [has_product f]
  (hf : ∀ i, is_zero (f i)) :
  is_zero (∏ f) :=
begin
  rw is_zero_iff_id_eq_zero,
  ext ⟨j⟩,
  apply (hf j).eq_of_tgt,
end

lemma useful_commsq_bicartesian_neg  (ι : ulift.{1} ℕ → ℝ≥0) (hι : monotone ι) [normed_with_aut r V]
  (i : ℤ) (hi : i < 0) :
  (useful_commsq r r' S V i ι hι).bicartesian :=
begin
  have : 1 + i ≤ 0, { linarith only [hi] },
  apply bicartesian_of_is_zero;
  apply is_zero_pi; intro x;
  apply Ext_single_right_is_zero _ _ 1 _ _ (chain_complex.bounded_by_one _) this
end

lemma is_iso_sq {𝓒 : Type*} [category 𝓒] {X Y : 𝓒} (f₁ : X ⟶ X) (f₂ : Y ⟶ Y)
  (e : X ≅ Y) (h : f₁ ≫ e.hom = e.hom ≫ f₂) (h₁ : is_iso f₁) :
  is_iso f₂ :=
by { rw [← iso.inv_comp_eq] at h, rw ← h, apply_instance }

open category_theory.preadditive

lemma is_iso_sq' {𝓒 : Type*} [category 𝓒] [abelian 𝓒] [enough_projectives 𝓒]
  {X Y Z : bounded_homotopy_category 𝓒} (f₁ : X ⟶ X) (f₂ : Y ⟶ Y) (f₃ : Z ⟶ Z)
  (e : Y ≅ X) (h : e.hom ≫ f₁ = f₂ ≫ e.hom) (i : ℤ)
  (h₁ : is_iso (((Ext i).map f₁.op).app Z - ((Ext i).obj _).map f₃)) :
  is_iso (((Ext i).map f₂.op).app Z - ((Ext i).obj _).map f₃) :=
begin
  refine is_iso_sq _ _ ((functor.map_iso _ e.op).app _) _ h₁,
  rw [iso.app_hom, functor.map_iso_hom, sub_comp, comp_sub, nat_trans.naturality,
      ← nat_trans.comp_app, ← nat_trans.comp_app, ← functor.map_comp, ← functor.map_comp,
      iso.op_hom, ← op_comp, ← op_comp, h],
end

/-- Thm 9.4bis of [Analytic]. More precisely: the first observation in the proof 9.4 => 9.1. -/
theorem is_iso_Tinv_sub [normed_with_aut r V] : ∀ i, is_iso (Tinv_sub r r' S V i) :=
begin
  erw (Condensed.bd_lemma _ _ _ _),
  swap, { apply Lbar.obj.no_zero_smul_divisors },
  intro i,
  refine is_iso_sq' _ _ _ (functor.map_iso _ $ condensify_iso_extend' _ _) _ _ _,
  { refine category_theory.functor.map _ _, refine Tinv_cond _ },
  { rw [functor.map_iso_hom, ← functor.map_comp, ← functor.map_comp, condensify_Tinv_iso'], },
  revert i,
  refine Tinv2_iso_of_bicartesian' r breen_deligne.eg
      (λ c n, c * breen_deligne.eg.κ r r' n)
      (λ c n, r' * (c * breen_deligne.eg.κ r r' n))
    ((Lbar.functor.{0 0} r').obj S) V _,
  rintro (i|(_|i)),
  { refine ⟨ι r r' i, hι r r' i, _, _, _, _⟩,
    { intros s m,
      apply Lbar.sufficiently_increasing_eg },
    { intros s m,
      apply Lbar.sufficiently_increasing_eg' },
    all_goals { apply useful_commsq_bicartesian },
    { rintro ⟨j⟩, apply Hι1 },
    { rintro ⟨j⟩, apply Hι2a },
    { rintro ⟨j⟩, apply Hι2b },
    { rintro ⟨j⟩, apply Hι1' },
    { rintro ⟨j⟩, apply Hι2b },
    { rintro ⟨j⟩, apply Hι2c } },
  { refine ⟨ι r r' 0, hι r r' 0, _, _, _, _⟩,
    { intros s m, apply Lbar.sufficiently_increasing_eg, },
    { intros s m, apply Lbar.sufficiently_increasing_eg', },
    { apply useful_commsq_bicartesian_neg, dec_trivial },
    { apply useful_commsq_bicartesian,
    { rintro ⟨j⟩, apply Hι1 },
    { rintro ⟨j⟩, apply Hι2a },
    { rintro ⟨j⟩, apply Hι2b }, }, },
  { refine ⟨ι r r' 0, hι r r' 0, _, _, _, _⟩,
    { intros s m, apply Lbar.sufficiently_increasing_eg, },
    { intros s m, apply Lbar.sufficiently_increasing_eg', },
    { apply useful_commsq_bicartesian_neg, dec_trivial },
    { apply useful_commsq_bicartesian_neg,
      rw [int.neg_succ_of_nat_eq'],
      simp only [int.coe_nat_succ, neg_add_rev, sub_add_cancel, add_neg_lt_iff_le_add', add_zero],
      dec_trivial }, },
end

/-- Thm 9.4bis of [Analytic]. More precisely: the first observation in the proof 9.4 => 9.1. -/
theorem is_iso_Tinv2 [normed_with_aut r V]
  (hV : ∀ (v : V), (normed_with_aut.T.inv v) = 2 • v) :
  ∀ i, is_iso (((Ext' i).map ((condensify_Tinv2 (Fintype_Lbar.{0 0} r')).app S).op).app
    (Condensed.of_top_ab ↥V)) :=
begin
  intro i,
  rw [condensify_Tinv2_eq, ← functor.flip_obj_map, nat_trans.app_sub, category_theory.op_sub,
    nat_trans.app_nsmul,  category_theory.op_nsmul, two_nsmul, nat_trans.id_app, op_id,
    functor.map_sub, functor.map_add, category_theory.functor.map_id],
  convert is_iso_Tinv_sub r r' S V i using 2,
  suffices : Condensed.of_top_ab_map (normed_add_group_hom.to_add_monoid_hom normed_with_aut.T.inv) _ =
    2 • 𝟙 _,
  { rw [this, two_nsmul, functor.map_add, category_theory.functor.map_id], refl, },
  ext T f t,
  dsimp only [Condensed.of_top_ab_map_val, whisker_right_app, Ab.ulift_map_apply_down,
    add_monoid_hom.mk'_apply, continuous_map.coe_mk, function.comp_app],
  erw [hV, two_nsmul, two_nsmul],
  refl,
end

end

end Lbar


import .geom3d_series
import tactic.linarith

def ts := time_std_space

def world_fr := geom3d_std_frame
def world := geom3d_std_space

def bl_fr :=
 let origin := mk_position3d world 1.000000 2.000000 3.000000 in
 let basis0 := mk_displacement3d world 4.000000 3.000000 2.000000 in
 let basis1 := mk_displacement3d world 1.000000 2.000000 3.000000 in
 let basis2 := mk_displacement3d world 2.000000 1.000000 2.000000 in
 mk_geom3d_frame origin basis0 basis1 basis2

def fr1 :=
 let origin := mk_position3d world 2.000000 4.000000 3.000000 in
 let basis0 := mk_displacement3d world 4.000000 3.000000 2.000000 in
 let basis1 := mk_displacement3d world 1.000000 2.000000 3.000000 in
 let basis2 := mk_displacement3d world 2.000000 1.000000 2.000000 in
 mk_geom3d_frame origin basis0 basis1 basis2

def fr2 :=
 let origin := mk_position3d world 4.000000 4.000000 3.000000 in
 let basis0 := mk_displacement3d world 4.000000 3.000000 2.000000 in
 let basis1 := mk_displacement3d world 1.000000 2.000000 3.000000 in
 let basis2 := mk_displacement3d world 2.000000 1.000000 2.000000 in
 mk_geom3d_frame origin basis0 basis1 basis2

def ser : geom3d_series ts :=
  ⟨
    [
      (mk_time _ 2,world_fr)--,
    --  (mk_time _ 1,fr1),
      --(mk_time _ 0,fr2)

      --(mk_time _ 2),
      --(mk_time _ 1),
      --(mk_time _ 0)
    ]⟩
/-(⟨mk_time _ 0,sorry⟩-/

#eval ser

#check quotient.eq

def v1 := mk_displacement3d_timefixed_at_time ser (mk_time ts (2.4:ℚ)) 1 1 1

def v2 := mk_displacement3d_timefixed_at_time ser (mk_time ts (2.5:ℚ)) 1 1 1

example : v1.frame = world_fr := begin
  unfold displacement3d.frame,
  unfold geom3d_series.find,
  split,
end

example : v1.frame = v2.frame := begin
  dsimp [displacement3d.frame],
  split,
end

#check v1 +ᵥ v2

def t1 := ⟦(⟨(mk_time ts (2.4:ℚ))⟩ : series_index ts ser)⟧
def t2 := ⟦(⟨(mk_time ts (2.5:ℚ))⟩ : series_index ts ser)⟧

example : t1 = t2 := sorry

#check t1

#check quotient.lift

def v3 := mk_displacement3d_timefixed_at_time'' ser ⟦series_index.mk (mk_time ts (2.4:ℚ))⟧ 1 1 1

def v4 := mk_displacement3d_timefixed_at_time'' ser ⟦series_index.mk (mk_time ts (2.5:ℚ))⟧ 1 1 1

#check v3 +ᵥ v4


import .brown

universes v u

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

namespace homotopy_theory.cofibrations
open precofibration_category cofibration_category
open homotopy_theory.weak_equivalences

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

-- Following Rădulescu-Banu, Cofibrations in Homotopy Theory, Lemma 1.4.1

variables {a₁ a₂ a₃ a₄ b₁ b₂ b₃ b₄ : C}
  {f₁₂ : a₁ ⟶ a₂} {f₁₃ : a₁ ⟶ a₃} {f₂₄ : a₂ ⟶ a₄} {f₃₄ : a₃ ⟶ a₄}
  (po_f : Is_pushout f₁₂ f₁₃ f₂₄ f₃₄)
  {g₁₂ : b₁ ⟶ b₂} {g₁₃ : b₁ ⟶ b₃} {g₂₄ : b₂ ⟶ b₄} {g₃₄ : b₃ ⟶ b₄}
  (po_g : Is_pushout g₁₂ g₁₃ g₂₄ g₃₄)
  {u₁ : a₁ ⟶ b₁} {u₂ : a₂ ⟶ b₂} {u₃ : a₃ ⟶ b₃} -- u₄ will be the induced map of pushouts
  (ha₁ : cofibrant a₁) (ha₃ : cofibrant a₃) (hb₁ : cofibrant b₁) (hb₃ : cofibrant b₃)
  (hf₁₂ : is_cof f₁₂) (hg₁₂ : is_cof g₁₂)
  (hwu₁ : is_weq u₁) (hwu₂ : is_weq u₂) (hwu₃ : is_weq u₃)
  (s₁₂ : f₁₂ ≫ u₂ = u₁ ≫ g₁₂) (s₁₃ : f₁₃ ≫ u₃ = u₁ ≫ g₁₃)

lemma gluing_weq_aux (hcu₁ : is_cof u₁) (hcu₃ : is_cof u₃)
  (hcu₂'' : is_cof ((pushout_by_cof f₁₂ u₁ hf₁₂).is_pushout.induced u₂ g₁₂ s₁₂)) :
  is_weq (pushout_of_maps po_f po_g u₁ u₂ u₃ s₁₂ s₁₃) :=
have acof_u₁ : is_acof u₁ := ⟨hcu₁, hwu₁⟩,
have acof_u₃ : is_acof u₃ := ⟨hcu₃, hwu₃⟩,
let po₁₂ := pushout_by_cof f₁₂ u₁ hf₁₂,
    u₂' := po₁₂.map₀,
    u₂'' := po₁₂.is_pushout.induced u₂ g₁₂ s₁₂,
    u₄ := pushout_of_maps po_f po_g u₁ u₂ u₃ s₁₂ s₁₃,
    po₃₄ := pushout_by_cof f₃₄ u₃ (pushout_is_cof po_f hf₁₂),
    u₄' := po₃₄.map₀,
    u₄'' := po₃₄.is_pushout.induced u₄ g₃₄ (by simp) in
have acof_u₂' : is_acof u₂' := pushout_is_acof po₁₂.is_pushout.transpose acof_u₁,
have acof_u₄' : is_acof u₄' := pushout_is_acof po₃₄.is_pushout.transpose acof_u₃,
have acof_u₂'' : is_acof u₂'' := have _ := hwu₂, begin
  refine ⟨hcu₂'', category_with_weak_equivalences.weq_of_comp_weq_left acof_u₂'.2 _⟩,
  simpa using this
end,
let k := pushout_of_maps po₁₂.is_pushout po₃₄.is_pushout f₁₃ f₂₄ g₁₃ po_f.commutes s₁₃.symm in
suffices Is_pushout u₂'' k g₂₄ u₄'',
  by convert weq_comp acof_u₄'.2 (pushout_is_acof this acof_u₂'').2; simp,
have _ := Is_pushout_of_Is_pushout_of_Is_pushout po_f po₃₄.is_pushout,
have Is_pushout f₁₂ (u₁ ≫ g₁₃) (u₂' ≫ k) po₃₄.map₁ := begin
  convert this using 1,
  { exact s₁₃.symm },
  { simp }
end,
have Is_pushout po₁₂.map₁ g₁₃ k po₃₄.map₁ :=
  Is_pushout_of_Is_pushout_of_Is_pushout' po₁₂.is_pushout this (by simp),
have po_g' : Is_pushout (po₁₂.map₁ ≫ u₂'') g₁₃ g₂₄ (po₃₄.map₁ ≫ u₄'') := by convert po_g using 1; simp,
Is_pushout_of_Is_pushout_of_Is_pushout_vert' this po_g' $
  by apply po₁₂.is_pushout.uniqueness; rw [←category.assoc, ←category.assoc]; simp [po_g.commutes]

lemma gluing_weq : is_weq (pushout_of_maps po_f po_g u₁ u₂ u₃ s₁₂ s₁₃) :=
let ⟨c₁⟩ := exists_brown_factorization ha₁ hb₁ u₁,
    ⟨c₂, h₁₂, hv₂, hr₂, hw₂, x, y⟩ :=
      exists_relative_brown_factorization
        ha₁ hb₁ (cofibrant_of_cof ha₁ hf₁₂) (cofibrant_of_cof hb₁ hg₁₂) u₁ u₂ f₁₂ g₁₂ s₁₂.symm c₁,
    ⟨c₃, h₁₃, hv₃, hr₃, hw₃, _, _⟩ :=
      exists_relative_brown_factorization ha₁ hb₁ ha₃ hb₃ u₁ u₃ f₁₃ g₁₃ s₁₃.symm c₁,
    po := pushout_by_cof c₁.f' f₁₂ c₁.hf' in
have cof_h₁₂ : is_cof h₁₂ := begin
  convert cof_comp (pushout_is_cof po.is_pushout.transpose hf₁₂) (x hg₁₂) using 1,
  simp
end,
have wv : _ := gluing_weq_aux po_f (pushout_by_cof h₁₂ h₁₃ cof_h₁₂).is_pushout hf₁₂
  (c₁.weq_f' hwu₁) (c₂.weq_f' hwu₂) (c₃.weq_f' hwu₃) hv₂.symm hv₃.symm c₁.hf' c₃.hf'
  (by rw ←Is_pushout.transpose_induced; exact cof_comp (cof_iso _) (x hg₁₂)),
have ww : _ := gluing_weq_aux po_g (pushout_by_cof h₁₂ h₁₃ cof_h₁₂).is_pushout hg₁₂
  c₁.hs.2 c₂.hs.2 c₃.hs.2 hw₂.symm hw₃.symm c₁.hs.1 c₃.hs.1
  (by rw ←Is_pushout.transpose_induced; exact cof_comp (cof_iso _) (y hf₁₂).1),
let po_h := pushout_by_cof h₁₂ h₁₃ cof_h₁₂ in
have wr : is_weq (pushout_of_maps po_h.is_pushout po_g c₁.r c₂.r c₃.r hr₂.symm hr₃.symm), begin
  refine (weq_iff_weq_inv _).mp ww,
  rw ←pushout_of_maps_comp,
  convert pushout_of_maps_id po_g,
  { exact c₁.hsr }, { exact c₂.hsr }, { exact c₃.hsr }
end,
begin
  convert weq_comp wv wr,
  rw ←pushout_of_maps_comp,
  congr,
  { exact c₁.hf'r.symm }, { exact c₂.hf'r.symm}, { exact c₃.hf'r.symm }
end

end homotopy_theory.cofibrations


import Lbar.ext_aux1

noncomputable theory

universes v u u'

open opposite category_theory category_theory.limits category_theory.preadditive
open_locale nnreal zero_object

variables (r r' : ℝ≥0)
variables [fact (0 < r)] [fact (r < r')] [fact (r < 1)]

section

open bounded_homotopy_category

variables (BD : breen_deligne.data)
variables (κ κ₂ : ℝ≥0 → ℕ → ℝ≥0)
variables [∀ (c : ℝ≥0), BD.suitable (κ c)] [∀ n, fact (monotone (function.swap κ n))]
variables [∀ (c : ℝ≥0), BD.suitable (κ₂ c)] [∀ n, fact (monotone (function.swap κ₂ n))]
variables (M : ProFiltPseuNormGrpWithTinv₁.{u} r')
variables (V : SemiNormedGroup.{u})

lemma QprimeFP_map (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) :
  (QprimeFP r' BD κ M).map h = of'_hom ((QprimeFP_int r' BD κ _).map h) := rfl

instance aaahrg (X : Profinite) : seminormed_add_comm_group (locally_constant X V) :=
locally_constant.seminormed_add_comm_group

def V_T_inv (r : ℝ≥0) (V : SemiNormedGroup.{u}) [normed_with_aut r V] : V ⟶ V :=
normed_with_aut.T.{u}.inv

variables [fact (0 < r')] [fact (r' < 1)]

section

variables [complete_space V] [separated_space V]

set_option pp.universes true

lemma final_boss_aux₁ (X : Profinite) (x) :
 ((LCC_iso_Cond_of_top_ab_add_equiv.{u} X V).symm) x =
 (LCC_iso_Cond_of_top_ab_equiv X V).symm x := rfl

lemma final_boss_aux₂ [normed_with_aut r V] (X : Profinite) (x : locally_constant X V) :
((locally_constant.map_hom.{u u u} (V_T_inv r V)).completion)
  (uniform_space.completion.cpkg.{u}.coe x) =
  uniform_space.completion.map (locally_constant.map_hom (V_T_inv r V)) x := rfl

-- should this be a global instance earlier in mathlib?
local attribute [instance]
abstract_completion.uniform_struct

lemma final_boss_aux₃ [normed_with_aut r V] (X : Profinite) :
  continuous.{u u}
  (λ (x : C(X,V)),
  ((locally_constant.map_hom.{u u u} normed_with_aut.T.{u}.inv).completion)
  (((uniform_space.completion.cpkg.{u}.compare_equiv (locally_constant.pkg.{u} X ↥V)).symm) x)) :=
begin
  dsimp [abstract_completion.compare_equiv],
  refine (normed_add_group_hom.continuous _).comp _,
  refine ((locally_constant.pkg X V).uniform_continuous_compare _).continuous,
end

example {β : Type*} [uniform_space β] (a : abstract_completion β) : uniform_space a.space :=
by apply_instance

lemma final_boss_aux₄ [normed_with_aut r V] (X : Profinite) :
@continuous.{u u} _ _ _ (uniform_space.completion.cpkg.uniform_struct.to_topological_space)
  (λ (x : C(X,V)),
  ((locally_constant.pkg X V).compare
    uniform_space.completion.cpkg.{u}
  {to_fun := (V_T_inv r V) ∘ x.to_fun, continuous_to_fun :=
  (normed_with_aut.T.inv.continuous.comp x.2)})) :=
begin
  let e : C(X,V) → C(X,V) := λ e, ⟨(V_T_inv r V) ∘ e,
    (V_T_inv r V).continuous.comp e.2⟩,
  have he : continuous e := continuous_map.continuous_comp
    ((⟨(V_T_inv r V), (V_T_inv r V).continuous⟩ : C(V,V))),
  refine continuous.comp _ he,
  refine ((locally_constant.pkg X V).uniform_continuous_compare _).continuous,
end

lemma final_boss [normed_with_aut r V] (X : Profinite)
  (x : ((Condensed.of_top_ab.presheaf V).obj (op X))) :
((locally_constant.map_hom (V_T_inv r V)).completion)
    (((LCC_iso_Cond_of_top_ab_add_equiv X V).symm) x) =
  ((LCC_iso_Cond_of_top_ab_add_equiv X V).symm)
    {to_fun := (normed_with_aut.T.inv) ∘ x.1, continuous_to_fun :=
      (normed_with_aut.T.inv.continuous.comp x.2)} :=
begin
  rw final_boss_aux₁,
  rw final_boss_aux₁,
  dsimp only [V_T_inv],
  dsimp only [LCC_iso_Cond_of_top_ab_equiv],
  change C(X,V) at x,
  apply abstract_completion.induction_on (locally_constant.pkg.{u} X ↥V) x,
  { apply is_closed_eq,
    { apply final_boss_aux₃ },
    { apply final_boss_aux₄ } },
  clear x,
  intros x,
  change ((locally_constant.map_hom.{u u u} normed_with_aut.T.{u}.inv).completion)
    ((locally_constant.pkg.{u} X ↥V).compare uniform_space.completion.cpkg.{u}
       ((locally_constant.pkg.{u} X ↥V).coe x)) = _,
  --dsimp [abstract_completion.compare_equiv],
  rw abstract_completion.compare_coe,
  erw final_boss_aux₂,
  erw uniform_space.completion.map_coe,
  let q : C(X,V) :=
    {to_fun := (normed_with_aut.T.{u}.inv) ∘ ((locally_constant.pkg.{u} X ↥V).coe x).to_fun,
    continuous_to_fun := _},
  swap,
  { apply continuous.comp,
    apply normed_add_group_hom.continuous,
    refine ((locally_constant.pkg.{u} X ↥V).coe x).2 },
  have hq : q = (locally_constant.pkg X V).coe
    ((locally_constant.map_hom.{u u u} (V_T_inv.{u} r V)) x),
  { ext, refl },

  change _ =
    ((locally_constant.pkg.{u} X ↥V).compare uniform_space.completion.cpkg) q,
  rw hq,

  rw abstract_completion.compare_coe,

  refl,

  apply normed_add_group_hom.uniform_continuous,
end

end

@[reassoc]
lemma massive_aux₁ (X Y : Profinite.{u}) (f : X ⟶ Y) :
  (preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map (freeCond.{u}.map f).op ≫
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond X).hom =
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond Y).hom ≫
  V.to_Cond.val.map f.op :=
begin
  erw preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural',
  refl,
end

lemma add_equiv.mk_symm {A B : Type*} [add_comm_group A] [add_comm_group B]
  (f : A →+ B) (g : B →+ A) (h1 h2 h3) :
  (add_equiv.mk f g h1 h2 h3).symm =
  add_equiv.mk g f h2 h1 (by { intros x y, apply h1.injective, rw [h3, h2, h2, h2] }) := rfl

lemma add_equiv.mk_symm_apply {A B : Type*} [add_comm_group A] [add_comm_group B]
  (f : A →+ B) (g : B →+ A) (h1 h2 h3) (x : B) :
  (add_equiv.mk f g h1 h2 h3).symm x = g x := rfl

lemma locally_constant.comap_hom_map_hom {X Y V W : Type*}
  [topological_space X] [compact_space X]
  [topological_space Y] [compact_space Y]
  [seminormed_add_comm_group V] [seminormed_add_comm_group W]
  (f : X → Y) (hf : continuous f) (g : normed_add_group_hom V W) (φ : locally_constant Y V) :
  locally_constant.comap_hom f hf (locally_constant.map_hom g φ) =
  ((locally_constant.map_hom g) ∘ (locally_constant.comap_hom f hf)) φ :=
begin
  dsimp only [locally_constant.comap_hom_apply, locally_constant.map_hom_apply, function.comp],
  rw locally_constant.comap_map,
  exact hf
end

instance (X : Profinite) :
  uniform_space.{u} (locally_constant.{u u} X V) :=
@pseudo_metric_space.to_uniform_space.{u}
  (@locally_constant.{u u} (@coe_sort.{u+2 u+2} Profinite.{u} (Type u) Profinite.has_coe_to_sort.{u} X)
     (@coe_sort.{u+2 u+2} SemiNormedGroup.{u} (Type u) SemiNormedGroup.has_coe_to_sort.{u} V)
     (Top.topological_space.{u} X.to_CompHaus.to_Top))
  (@seminormed_add_comm_group.to_pseudo_metric_space.{u}
     (@locally_constant.{u u} (@coe_sort.{u+2 u+2} Profinite.{u} (Type u) Profinite.has_coe_to_sort.{u} X)
        (@coe_sort.{u+2 u+2} SemiNormedGroup.{u} (Type u) SemiNormedGroup.has_coe_to_sort.{u} V)
        (Top.topological_space.{u} X.to_CompHaus.to_Top))
     locally_constant.seminormed_add_comm_group)

instance (X : Profinite) : topological_space ↥(V.to_Cond.val.obj (op X)) :=
@ulift.topological_space _ (continuous_map.compact_open.{u u})

variables [complete_space V] [separated_space V]

lemma to_Cond_val_map_apply (X Y : Profinite.{u}) (f : X ⟶ Y) (x) :
  V.to_Cond.val.map f.op x = ⟨continuous_map.comp_right_continuous_map V f x.down⟩ :=
rfl

lemma to_Cond_val_map (X Y : Profinite.{u}) (f : X ⟶ Y) :
  ⇑(V.to_Cond.val.map f.op) =
  (λ x, ⟨continuous_map.comp_right_continuous_map V f x.down⟩ : ↥(V.to_Cond.val.obj (op Y)) → ↥(V.to_Cond.val.obj (op X))) :=
by { ext x, rw to_Cond_val_map_apply }

lemma massive_aux₂ (X Y : Profinite.{u}) (f : X ⟶ Y) (x : (V.to_Cond.val.obj (op.{u+2} Y))) :
  uniform_space.completion.map.{u u} (locally_constant.comap_hom.{u u u} f f.continuous)
    ((locally_constant.pkg.{u} Y ↥V).compare uniform_space.completion.cpkg.{u} x.down) =
  ((locally_constant.pkg.{u} X ↥V).compare uniform_space.completion.cpkg.{u})
    ((V.to_Cond.val.map f.op) x).down :=
begin
  cases x,
  apply abstract_completion.induction_on (locally_constant.pkg.{u} Y V) x,
  { apply is_closed_eq,
    { apply uniform_space.completion.continuous_map.comp,
      apply (abstract_completion.uniform_continuous_compare _ _).continuous },
    { apply (abstract_completion.uniform_continuous_compare _ _).continuous.comp,
      let φ : C(Y, V) → C(X, V) := _, change continuous φ,
      let ψ := V.to_Cond.val.map f.op, have hψ : φ = ulift.down ∘ ψ ∘ ulift.up := rfl,
      rw hψ, clear hψ,
      refine continuous_induced_dom.comp _,
      refine continuous.comp _ continuous_ulift_up,
      rw [to_Cond_val_map],
      refine continuous.comp _ _, { exact continuous_ulift_up },
      dsimp only [Condensed.of_top_ab, Condensed.of_top_ab.presheaf],
      exact (map_continuous (continuous_map.comp_right_continuous_map ↥V f)).comp continuous_induced_dom, } },
  { intro φ,
    dsimp only,
    simp only [abstract_completion.compare_coe, to_Cond_val_map_apply,
      uniform_space.completion.map],
    rw [abstract_completion.map_coe],
    swap,
    { letI : seminormed_add_comm_group (locally_constant ↥(X.to_CompHaus.to_Top) ↥V),
      { exact locally_constant.seminormed_add_comm_group },
      letI : seminormed_add_comm_group (locally_constant ↥(Y.to_CompHaus.to_Top) ↥V),
      { exact locally_constant.seminormed_add_comm_group },
      exact normed_add_group_hom.uniform_continuous _, },
    have : (continuous_map.comp_right_continuous_map ↥V f) ((locally_constant.pkg Y V).coe φ) =
      (locally_constant.pkg X V).coe _ := _,
    rw [this, abstract_completion.compare_coe],
    ext1,
    erw [locally_constant.coe_comap],
    refl,
    exact f.continuous },
end

lemma massive_aux (X Y : Profinite.{u}) (f : X ⟶ Y) :
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond Y).hom ≫
      Ab.ulift.{u+1 u}.map ((LCC_iso_Cond_of_top_ab.{u} V).inv.app (op.{u+2} Y)) ≫
        (ExtQprime_iso_aux_system_obj_aux'.{u} V Y).hom ≫
          (forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map
            ((FreeAb.eval.{u+1 u+2} SemiNormedGroup.{u+1}ᵒᵖ).map
              ((CLC.{u+1 u} (SemiNormedGroup.ulift.{u+1 u}.obj V)).right_op.map_FreeAb.map
                  ((FreeAb.of_functor.{u+1 u} Profinite.{u}).map f))).unop =
    (preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map
        ((FreeAb.eval.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1})).map
          (freeCond.{u}.map_FreeAb.map ((FreeAb.of_functor.{u+1 u} Profinite.{u}).map f))).op ≫
      (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond X).hom ≫
        Ab.ulift.{u+1 u}.map ((LCC_iso_Cond_of_top_ab.{u} V).inv.app (op.{u+2} X)) ≫
          (ExtQprime_iso_aux_system_obj_aux'.{u} V X).hom :=
begin
  dsimp only [functor.map_FreeAb, FreeAb.of_functor, FreeAb.eval],
  simp only [free_abelian_group.map_of_apply, free_abelian_group.lift.of, id],
  dsimp only [functor.right_op_map, quiver.hom.op_unop, quiver.hom.unop_op],
  rw massive_aux₁_assoc, congr' 1,
  ext1 x, simp only [comp_apply],
  dsimp only [ExtQprime_iso_aux_system_obj_aux', LCC_iso_Cond_of_top_ab,
    LCC_iso_Cond_of_top_ab_add_equiv, LCC_iso_Cond_of_top_ab_equiv, CLC, LC, functor.comp_map,
    Condensed.of_top_ab],
  simp only [add_equiv.to_fun_eq_coe, normed_add_group_hom.completion_coe_to_fun,
    add_equiv.to_AddCommGroup_iso_hom, add_equiv.coe_to_add_monoid_hom, add_equiv.trans_apply,
    add_equiv.ulift_apply, equiv.to_fun_as_coe, equiv.ulift_apply_2,
    Ab.ulift_map_apply_down, add_equiv.coe_mk, nat_iso.of_components_inv_app,
    add_equiv.to_AddCommGroup_iso, add_equiv.mk_symm,
    SemiNormedGroup.forget₂_Ab_map, normed_add_group_hom.coe_to_add_monoid_hom],
  let F := SemiNormedGroup.Completion.{u+1}.map ((SemiNormedGroup.LocallyConstant.{u+1 u}.obj
    (SemiNormedGroup.ulift.{u+1 u}.obj V)).map f.op),
  let g := _,
  let Z := _,
  change F ((uniform_space.completion.map g) Z) = _,
  change (F ∘ uniform_space.completion.map g) Z = _,
  erw [uniform_space.completion.map_comp],
  rotate,
  { apply normed_add_group_hom.uniform_continuous, },
  { apply normed_add_group_hom.uniform_continuous, },
  conv_lhs
  { dsimp only [function.comp, normed_add_group_hom.coe_to_add_monoid_hom, g,
      SemiNormedGroup.LocallyConstant_obj_map], },
  simp only [locally_constant.comap_hom_map_hom],
  letI : uniform_space.{u} (locally_constant.{u u} ↥(unop.{u+2} (op.{u+2} X)) ↥V) := _,
  erw [← uniform_space.completion.map_comp],
  rotate,
  { apply normed_add_group_hom.uniform_continuous, },
  { apply normed_add_group_hom.uniform_continuous, },
  dsimp only [function.comp, Z, quiver.hom.unop_op],
  congr' 1, clear Z g F,
  exact massive_aux₂ V X Y f x,
end

lemma massive (X Y : FreeAb Profinite.{u}) (f : X ⟶ Y) :
  (((preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond Y.as).hom ≫
    (Condensed_Ab_to_presheaf.{u}.map (Condensed_LCC_iso_of_top_ab.{u} V).inv).app (op.{u+2} Y.as) ≫
    (ExtQprime_iso_aux_system_obj_aux'.{u} V Y.as).hom) ≫
    (𝟙 _)) ≫
    (forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map
      (((CLC.{u+1 u} (SemiNormedGroup.ulift.{u+1 u}.obj V)).right_op.map_FreeAb ⋙
        FreeAb.eval.{u+1 u+2} SemiNormedGroup.{u+1}ᵒᵖ).map f).unop =
  (preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map
    ((freeCond.{u}.map_FreeAb ⋙ FreeAb.eval.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1})).map f).op ≫
    ((preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond X.as).hom ≫
    (Condensed_Ab_to_presheaf.{u}.map (Condensed_LCC_iso_of_top_ab.{u} V).inv).app (op.{u+2} X.as) ≫
    (ExtQprime_iso_aux_system_obj_aux'.{u} V X.as).hom) ≫  𝟙 _ :=
begin
  simp only [Condensed_Ab_to_presheaf_map, category.assoc, category.comp_id, functor.comp_map],
  dsimp only [Condensed_LCC_iso_of_top_ab, Sheaf.iso.mk_inv_val,
    iso_whisker_right_inv, whisker_right_app],
  apply free_abelian_group.induction_on f; clear f,
  { simp only [functor.map_zero, unop_zero, comp_zero, op_zero, zero_comp], },
  { apply massive_aux },
  { intros f hf,
    simp only [functor.map_neg, unop_neg, op_neg, comp_neg, neg_comp, hf], },
  { intros f g hf hg,
    simp only [functor.map_add, unop_add, op_add, comp_add, add_comp, hf, hg], },
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_c (c₁ c₂) (h : c₁ ⟶ c₂) :
  (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c₂).hom ≫
  (category_theory.functor.map _ h.op) =
  (category_theory.functor.map _
  begin
    refine homological_complex.op_functor.map (quiver.hom.op _),
    refine category_theory.functor.map _ h,
  end) ≫ (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c₁).hom :=
begin
  ext n : 2,
  have aux : ∀ (n : ℕ), (monotone.{0 0} (function.swap.{1 1 1} κ n)),
  { intro n, exact fact.out _ },
  haveI : fact (κ c₁ n ≤ κ c₂ n) := ⟨aux n h.le⟩,
  have := massive V
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ c₁ n)
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ c₂ n)
    ((breen_deligne.FP2.res.{u} r' _ _ _).app ⟨M⟩),
  exact this
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_κ (c : (ℝ≥0))
  [∀ (c : ℝ≥0) (n : ℕ), fact (κ₂ c n ≤ κ c n)] :
  (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c).hom ≫
  (whisker_right (aux_system.res _ _ _ _ _ _) _).app _ =
  begin
    refine category_theory.functor.map _ _,
    refine homological_complex.op_functor.map (quiver.hom.op _),
    refine (QprimeFP_nat.ι BD κ₂ κ M).app _,
  end ≫ (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ₂ M V c).hom :=
begin
  ext n : 2,
  have := massive V
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ₂ c n)
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ c n)
    ((breen_deligne.FP2.res.{u} r' _ _ _).app ⟨M⟩),
  exact this
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_Tinv (c : ℝ≥0)
  [∀ (c : ℝ≥0) (n : ℕ), fact (κ₂ c n ≤ r' * κ c n)] :
  (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c).hom ≫
  (whisker_right
    (aux_system.Tinv _ _ _ _ _ _) _).app _ =
  begin
    refine category_theory.functor.map _ _,
    refine homological_complex.op_functor.map (quiver.hom.op _),
    refine (QprimeFP_nat.Tinv BD κ₂ κ M).app _,
  end
  ≫ (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ₂ M V c).hom :=
begin
  ext n : 2,
  have := massive V
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ₂ c n)
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ c n)
    (((breen_deligne.FPsystem.Tinv.{u} r' BD ⟨M⟩ κ₂ κ).app c).f n),
  exact this,
end

def to_Cond_T_inv (r : ℝ≥0) (V : SemiNormedGroup.{u}) [normed_with_aut r V] : V.to_Cond ⟶ V.to_Cond :=
(Condensed.of_top_ab_map.{u} (normed_add_group_hom.to_add_monoid_hom.{u u} normed_with_aut.T.{u}.inv)
  (normed_add_group_hom.continuous _))

lemma uniform_space.completion.map_comp'
  {α β γ : Type*} [uniform_space α] [uniform_space β] [uniform_space γ]
  {g : β → γ} {f : α → β}
  (hg : uniform_continuous g) (hf : uniform_continuous f) (x) :
  uniform_space.completion.map g (uniform_space.completion.map f x) =
  uniform_space.completion.map (g ∘ f) x :=
begin
  rw [← uniform_space.completion.map_comp hg hf],
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv_aux_helper
  (r : ℝ≥0) (V : SemiNormedGroup.{u}) [normed_with_aut r V] [complete_space V] [separated_space V]
  (X : Profinite.{u}) :
  (ExtQprime_iso_aux_system_obj_aux' V X).hom ≫
  category_theory.functor.map _
  (SemiNormedGroup.Completion.map
  (nat_trans.app
    (SemiNormedGroup.LocallyConstant.map
    (category_theory.functor.map _ $ V_T_inv _ _)) _)) =
  Ab.ulift.map
  (category_theory.functor.map _ $
  category_theory.functor.map _ $
  nat_trans.app
  (SemiNormedGroup.LocallyConstant.map $ V_T_inv _ _) _) ≫
  (ExtQprime_iso_aux_system_obj_aux' V X).hom
   :=
begin
  ext1 ⟨f⟩,
  simp only [comp_apply],
  dsimp only [ExtQprime_iso_aux_system_obj_aux', add_equiv.to_AddCommGroup_iso,
    add_equiv.coe_to_add_monoid_hom, add_equiv.trans_apply],
  simp only [add_equiv.to_fun_eq_coe, SemiNormedGroup.LocallyConstant_map_app, SemiNormedGroup.Completion_map,
  normed_add_group_hom.completion_coe_to_fun, add_equiv.ulift_apply, equiv.to_fun_as_coe, equiv.ulift_apply_2,
  add_equiv.coe_mk, Ab.ulift_map_apply_down, SemiNormedGroup.forget₂_Ab_map,
    normed_add_group_hom.coe_to_add_monoid_hom],
  rw uniform_space.completion.map_comp',
  rotate,
  { apply normed_add_group_hom.uniform_continuous },
  { apply normed_add_group_hom.uniform_continuous },
  rw uniform_space.completion.map_comp',
  rotate,
  { apply normed_add_group_hom.uniform_continuous },
  { apply normed_add_group_hom.uniform_continuous },
  refl
end

lemma another_aux_lemma [normed_with_aut r V] (X : Profinite) :
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab V.to_Cond X).hom
  ≫ (Condensed_Ab_to_presheaf.map_iso (Condensed_LCC_iso_of_top_ab V)).inv.app (op X)
  ≫
  begin
    refine nat_trans.app _ _,
    refine Condensed_Ab_to_presheaf.map _,
    refine Sheaf.hom.mk _,
    dsimp [Condensed_LCC],
    refine whisker_right _ _,
    refine whisker_right _ _,
    refine SemiNormedGroup.LCC.map _,
    exact V_T_inv r V,
  end =
  (preadditive_yoneda.map
    (to_Cond_T_inv r V)).app _ ≫
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab V.to_Cond X).hom ≫
  (Condensed_Ab_to_presheaf.map_iso (Condensed_LCC_iso_of_top_ab V)).inv.app _ :=
begin
  have := preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural
    (to_Cond_T_inv r V) X,
  erw ← reassoc_of this,
  congr' 1,
  dsimp only [Condensed_Ab_to_presheaf, functor.map_iso_inv, nat_iso.app_inv,
    Sheaf_to_presheaf_map, id, whisker_right_app, SemiNormedGroup.LCC,
    curry, uncurry, curry_obj, functor.comp_map],
  simp only [category_theory.functor.map_id, category.comp_id],
  rw ← nat_trans.comp_app,
  rw ← Sheaf.hom.comp_val, -- how to make those commute?
  ext ⟨x⟩,
  dsimp only [Condensed_LCC_iso_of_top_ab, Sheaf.iso.mk, iso_whisker_right, to_Cond_T_inv,
    Ab.ulift],
  simp only [comp_apply],
  dsimp [Condensed.of_top_ab_map],
  simp only [comp_apply],
  dsimp [LCC_iso_Cond_of_top_ab, forget₂, has_forget₂.forget₂],
  apply final_boss,
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv_aux (c : ℝ≥0)
  [normed_with_aut r V] (n : ℕ) (t) :
((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map
       (((aux_system.T_inv.{u u+1} r r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ).app
           (op.{1} c)).f n))
    ((((ExtQprime_iso_aux_system_obj_aux.{u} V).hom.app
           (((breen_deligne.FPsystem.{u} r' BD ⟨M⟩ κ).obj c).X n)).unop) t) =
  (((ExtQprime_iso_aux_system_obj_aux.{u} V).hom.app
        (((breen_deligne.FPsystem.{u} r' BD ⟨M⟩ κ).obj c).X n)).unop)
        (t ≫ to_Cond_T_inv.{u} r V) :=
begin
  /-
  Note: This should reduce to some calcuation with the sheafification adjunction,
  as well as something about completion/ulift compatibiity.
  If we can reduce this to such statements, we will be in pretty good shape.
  -/
  /- This code block is pretty slow.
  dsimp [ExtQprime_iso_aux_system_obj_aux, ExtQprime_iso_aux_system_obj_aux'],
  simp only [comp_apply],
  dsimp [forget₂, has_forget₂.forget₂, aux_system.T_inv,
    Condensed_LCC_iso_of_top_ab, LCC_iso_Cond_of_top_ab],
  rw nat_iso.of_components_inv_app,
  dsimp only [unop_op],
  -/
  dsimp only [forget₂, has_forget₂.forget₂, ExtQprime_iso_aux_system_obj_aux,
    nat_iso.of_components_hom_app, id, iso.op, iso.trans_hom, iso.symm,
    nat_iso.app_inv, aux_system.T_inv, quiver.hom.op_unop, quiver.hom.unop_op,
    homological_complex.unop],
  simp only [comp_apply],
  let X : Profinite := (((breen_deligne.FPsystem r' BD ⟨M⟩ κ).obj c).X n).as,
  have := preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural
    (to_Cond_T_inv r V) X,
  apply_fun (λ e, e t) at this,
  erw this, clear this,
  simp only [comp_apply],
  dsimp only [SemiNormedGroup.LocallyConstant],
  have := hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv_aux_helper r V X,
  let s := ((Condensed_Ab_to_presheaf.map_iso (Condensed_LCC_iso_of_top_ab V)).inv.app (op X))
    (((preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab V.to_Cond X).hom)
    (t)),
  apply_fun (λ e, e s) at this,
  erw this, clear this,
  simp only [comp_apply],
  congr' 1, dsimp only [s],
  simp only [← comp_apply],
  congr' 1,
  simp only [category.assoc],
  erw ← another_aux_lemma r V X,
  congr' 2,
  ext1 ⟨x⟩, dsimp only [Ab.ulift, Condensed_Ab_to_presheaf, whisker_right_app,
    Sheaf_to_presheaf],
  ext1,
  dsimp,
  congr' 2,
  dsimp only [SemiNormedGroup.LCC, curry, curry_obj, functor.comp_map, uncurry],
  simp only [category_theory.functor.map_id, category.comp_id],
  refl,
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv (c : ℝ≥0)
  [normed_with_aut r V] :
(hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V c).hom ≫
  ((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map_homological_complex
       (complex_shape.up.{0} ℕ)).map (nat_trans.app
        ((aux_system.T_inv.{u u+1} r r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ)) _) =
  begin
    let e := preadditive_yoneda.map (to_Cond_T_inv r V),
    let e' := nat_trans.map_homological_complex e (complex_shape.down ℕ).symm,
    let Q := ((QprimeFP_nat r' BD κ M).obj c).op,
    exact e'.app Q,
  end ≫
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V (c)).hom :=
begin
  ext n : 2, ext1 t,
  dsimp [hom_complex_QprimeFP_nat_iso_aux_system],
  simp only [comp_apply],
  dsimp [nat_iso.map_homological_complex, forget₂_unop],
  erw id_apply, erw id_apply,
  erw [functor.map_homological_complex_map_f],
  apply hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv_aux,
end

namespace ExtQprime_iso_aux_system_obj_naturality_setup

/-
lemma aux₁ (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) :
homological_complex.unop_functor.{u+2 u+1 0}.map
    (((preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
         forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
           AddCommGroup.{u+1}).right_op.map_homological_complex
        (complex_shape.up.{0} ℤ)).map
       ((homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_down_int_up).map
          ((QprimeFP_nat.{u} r' BD κ M).map h))).op ≫
  homological_complex.unop_functor.{u+2 u+1 0}.map
      ((map_homological_complex_embed.{u+2 u+2 u+1 u+1}
          (preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
             forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
               AddCommGroup.{u+1}).right_op).inv.app
         ((QprimeFP_nat.{u} r' BD κ M).obj c₁)).op ≫
    embed_unop.{u+2 u+1}.hom.app
      (op.{u+3}
         (((preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
              forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
                Ab.{u+1}).right_op.map_homological_complex
             (complex_shape.down.{0} ℕ)).obj
            ((QprimeFP_nat.{u} r' BD κ M).obj c₁))) =
  begin
    dsimp,
    let e := (QprimeFP_nat r' BD κ M).map h,
    let e₁ := ((preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
      forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
      Ab.{u+1}).right_op.map_homological_complex
      (complex_shape.down.{0} ℕ)).map e,
    let e₂ := homological_complex.unop_functor.map e₁.op,
    refine _ ≫
      (homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_up_int_down).map
      e₂,
    refine homological_complex.unop_functor.{u+2 u+1 0}.map
    ((map_homological_complex_embed.{u+2 u+2 u+1 u+1}
        (preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
           forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
             AddCommGroup.{u+1}).right_op).inv.app
       ((QprimeFP_nat.{u} r' BD κ M).obj c₂)).op ≫
    embed_unop.{u+2 u+1}.hom.app
    (op.{u+3}
       (((preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
            forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
              Ab.{u+1}).right_op.map_homological_complex
           (complex_shape.down.{0} ℕ)).obj
          ((QprimeFP_nat.{u} r' BD κ M).obj c₂)))
  end := admit

def F : ℝ≥0 ⥤
  (homological_complex.{u+1 u+2 0} AddCommGroup.{u+1} (complex_shape.down.{0} ℕ).symm)ᵒᵖ :=
QprimeFP_nat.{u} r' BD κ M ⋙
  (preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
     forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
       AddCommGroup.{u+1}).right_op.map_homological_complex
    (complex_shape.down.{0} ℕ) ⋙ homological_complex.unop_functor.right_op

@[reassoc]
lemma naturality_helper {c₁ c₂ : ℝ≥0} (h : c₁ ⟶ c₂) (n : ℕ) (w1 w2) :
  (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1} complex_shape.embedding.nat_up_int_down
   nat_up_int_down_c_iff n (-↑n) w1).hom.app
    (((preadditive_yoneda.{u+1 u+2}.obj
    V.to_Cond).right_op.map_homological_complex (complex_shape.down.{0} ℕ)).obj
     ((QprimeFP_nat.{u} r' BD κ M).obj c₂)).unop ≫
     (homology_functor _ _ _).map
     (homological_complex.map_unop _ _ $
     category_theory.functor.map _ $ category_theory.functor.map _ h) =
  category_theory.functor.map _
  (homological_complex.map_unop _ _ $
    category_theory.functor.map _ $ category_theory.functor.map _ h) ≫
    (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1} complex_shape.embedding.nat_up_int_down
  nat_up_int_down_c_iff n (-↑n) w2).hom.app
    (((preadditive_yoneda.{u+1 u+2}.obj
    V.to_Cond).right_op.map_homological_complex (complex_shape.down.{0} ℕ)).obj
    ((QprimeFP_nat.{u} r' BD κ M).obj c₁)).unop :=
admit
-/

lemma aux₁ (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) (n : ℕ) :
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V c₂).hom ≫
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
  ((aux_system.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ).to_Ab.map h.op) =
  (homology_functor _ _ _).map
  (category_theory.functor.map _
      (homological_complex.op_functor.map ((QprimeFP_nat r' BD κ M).map h).op)) ≫
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V c₁).hom :=
begin
  rw [← functor.map_comp, ← functor.map_comp],
  congr' 1,
  erw ← hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_c,
end

lemma aux₂ (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) (n : ℕ) :
  (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1}
    complex_shape.embedding.nat_up_int_down n (-↑n) (by { cases n; refl})).hom.app
    (hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₂) V.to_Cond) ≫
    (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
    (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map_homological_complex
    (complex_shape.down.{0} ℕ).symm).map (homological_complex.op_functor.{u+2 u+1 0}.map
    ((QprimeFP_nat.{u} r' BD κ M).map h).op)) =
  (homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_up_int_down ⋙
  homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.down.{0} ℤ) (-↑n)).map
  (category_theory.functor.map _
      (homological_complex.op_functor.map ((QprimeFP_nat r' BD κ M).map h).op)) ≫
  (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1}
  complex_shape.embedding.nat_up_int_down n (-↑n) (by { cases n; refl})).hom.app
  (hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₁) V.to_Cond) :=
begin
  erw nat_trans.naturality,
end

lemma aux₃ (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) (n : ℕ) :
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₂) V.to_Cond).hom ≫
  (homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_up_int_down ⋙
  homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.down.{0} ℤ) (-↑n)).map
  (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map_homological_complex
  (complex_shape.down.{0} ℕ).symm).map (homological_complex.op_functor.{u+2 u+1 0}.map
  ((QprimeFP_nat.{u} r' BD κ M).map h).op))
  =
  ((homology_functor.{u+1 u+2 0} AddCommGroup.{u+1}
  (complex_shape.up.{0} ℤ).symm (-↑n)).op.map
  (homological_complex.unop_functor.{u+2 u+1 0}.right_op.map
  (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).right_op.map_homological_complex
  (complex_shape.up.{0} ℤ)).map ((QprimeFP_int.{u} r' BD κ M).map h)))).unop ≫
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₁) V.to_Cond).hom
  :=
begin
  dsimp only [functor.op_map, functor.comp_map],
  erw [← functor.map_comp],
  erw [← functor.map_comp],
  congr' 1,
  ext ((_ | k) | k ) : 2,
  { refine (category.id_comp _).trans (category.comp_id _).symm },
  { apply is_zero.eq_of_tgt,
    exact is_zero_zero _ },
  { refine (category.id_comp _).trans (category.comp_id _).symm },
end
/-
lemma naturality_helper {c₂ : ℝ≥0} (n : ℕ) :
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₂) V.to_Cond).hom ≫
  (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1}
  complex_shape.embedding.nat_up_int_down nat_up_int_down_c_iff n (-↑n) (by { cases n; refl})).hom.app
  (hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₂) V.to_Cond) =
  _
-/

end ExtQprime_iso_aux_system_obj_naturality_setup

lemma QprimeFP_acyclic (c) (k i : ℤ) (hi : 0 < i) :
  is_zero (((Ext' i).obj (op (((QprimeFP_int.{u} r' BD κ M).obj c).X k))).obj V.to_Cond) :=
begin
  rcases k with ((_|k)|k),
  { apply free_acyclic, exact hi },
  { rw [← functor.flip_obj_obj], refine functor.map_is_zero _ _, refine (is_zero_zero _).op, },
  { apply free_acyclic, exact hi },
end

lemma ExtQprime_iso_aux_system_obj_natrality (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) (n : ℕ) :
  (ExtQprime_iso_aux_system_obj r' BD κ M V c₂ n).hom ≫
  (homology_functor _ _ _).map
  ((system_of_complexes.to_Ab _).map h.op)  =
  ((Ext n).map ((QprimeFP r' BD κ _).map h).op).app _ ≫
  (ExtQprime_iso_aux_system_obj r' BD κ M V c₁ n).hom :=
begin
  dsimp only [ExtQprime_iso_aux_system_obj,
    iso.trans_hom, id, functor.map_iso_hom],
  haveI : ((homotopy_category.quotient.{u+1 u+2 0}
    (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ M).obj c₁)).is_bounded_above :=
    chain_complex.is_bounded_above _,
  haveI : ((homotopy_category.quotient.{u+1 u+2 0}
    (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ M).obj c₂)).is_bounded_above :=
    chain_complex.is_bounded_above _,
  have := Ext_compute_with_acyclic_naturality
    ((QprimeFP_int.{u} r' BD κ M).obj c₁)
    ((QprimeFP_int.{u} r' BD κ M).obj c₂)
    V.to_Cond _ _
    ((QprimeFP_int.{u} r' BD κ M).map h) n,
  rotate,
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  dsimp only [functor.comp_map] at this,
  erw reassoc_of this, clear this,
  simp only [category.assoc, nat_iso.app_hom],
  congr' 1,
  rw ExtQprime_iso_aux_system_obj_naturality_setup.aux₁ r' BD κ M V c₁ c₂ h n,
  simp only [← category.assoc], congr' 1,
  simp only [category.assoc],
  rw ExtQprime_iso_aux_system_obj_naturality_setup.aux₂ r' BD κ M V c₁ c₂ h n,
  simp only [← category.assoc], congr' 1,

  exact ExtQprime_iso_aux_system_obj_naturality_setup.aux₃ r' BD κ M V c₁ c₂ h n,

  --- OLD PROOF FROM HERE
  --have := ExtQprime_iso_aux_system_obj_naturality_setup.naturality_helper r' BD κ
  --  M V h n _ _,
  --simp only [category.assoc, functor.map_comp],
  --slice_rhs 3 4
  --{ erw ← this },

  /-
  dsimp only [QprimeFP_int],
  congr' 1,
  dsimp only [nat_iso.app_hom],
  simp only [functor.map_comp, functor.comp_map, nat_trans.naturality,
    nat_trans.naturality_assoc],
  dsimp only [functor.op_map, quiver.hom.unop_op, functor.right_op_map],
  simp only [← functor.map_comp, ← functor.map_comp_assoc, category.assoc],
  dsimp [-homology_functor_map],
  rw ExtQprime_iso_aux_system_obj_naturality_setup.aux₁,
  dsimp [-homology_functor_map],
  simp only [functor.map_comp, functor.map_comp_assoc,
    category.assoc, nat_trans.naturality_assoc],
  congr' 2,
  dsimp [-homology_functor_map],
  dsimp only [← functor.comp_map, ← functor.comp_obj],
  --erw nat_trans.naturality_assoc,
  --refine congr_arg2 _ _ (congr_arg2 _ rfl _),

  --congr' 1,
  --refl,
  admit

  -/
end

def ExtQprime_iso_aux_system (n : ℕ) :
  (QprimeFP r' BD κ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) ≅
  aux_system r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ ⋙
    (forget₂ _ Ab).map_homological_complex _ ⋙ homology_functor _ _ n :=
nat_iso.of_components (λ c, ExtQprime_iso_aux_system_obj r' BD κ M V (unop c) n)
begin
  intros c₁ c₂ h,
  dsimp [-homology_functor_map],
  rw ← ExtQprime_iso_aux_system_obj_natrality,
  refl,
end

/-- The `Tinv` map induced by `M` -/
def ExtQprime.Tinv
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (n : ℤ) :
  (QprimeFP r' BD κ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) ⟶
  (QprimeFP r' BD κ₂ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) :=
whisker_right (nat_trans.op $ QprimeFP.Tinv BD _ _ M) _

/-- The `T_inv` map induced by `V` -/
def ExtQprime.T_inv [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (n : ℤ) :
  (QprimeFP r' BD κ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) ⟶
  (QprimeFP r' BD κ₂ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) :=
whisker_right (nat_trans.op $ QprimeFP.ι BD _ _ M) _ ≫ whisker_left _ ((Ext n).flip.map $ (single _ _).map $
  (Condensed.of_top_ab_map (normed_with_aut.T.inv).to_add_monoid_hom
  (normed_add_group_hom.continuous _)))

def ExtQprime.Tinv2 [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (n : ℤ) :
  (QprimeFP r' BD κ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) ⟶
  (QprimeFP r' BD κ₂ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) :=
ExtQprime.Tinv r' BD κ κ₂ M V n - ExtQprime.T_inv r r' BD κ κ₂ M V n

namespace ExtQprime_iso_aux_system_comm_Tinv_setup

variables (c : (ℝ≥0)ᵒᵖ) (n : ℕ)
  [∀ (c : ℝ≥0) (n : ℕ), fact (κ₂ c n ≤ r' * κ c n)]

lemma aux₁  :
(homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
    (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V (unop.{1} c)).hom ≫
  ((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map_homological_complex
       (complex_shape.up.{0} ℕ) ⋙
     homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
    ((aux_system.Tinv.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ₂ κ).app c) =
  (homology_functor _ _ _).map
  (category_theory.functor.map _
      (homological_complex.op_functor.map (quiver.hom.op $
      (QprimeFP_nat.Tinv  BD κ₂ κ M).app _))) ≫
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ₂ M V (unop.{1} c)).hom :=
begin
  simp only [← functor.map_comp, functor.comp_map], congr' 1,
  apply hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_Tinv,
end

lemma aux₂ :
(homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
      (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj (unop.{1} c)) V.to_Cond).hom ≫
    (homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_up_int_down ⋙
       homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.down.{0} ℤ) (-↑n)).map
      (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map_homological_complex (complex_shape.down.{0} ℕ).symm).map
         (homological_complex.op_functor.{u+2 u+1 0}.map ((QprimeFP_nat.Tinv.{u} BD κ₂ κ M).app (unop.{1} c)).op)) =
  (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).right_op.map_homological_complex (complex_shape.up.{0} ℤ) ⋙
        homological_complex.unop_functor.{u+2 u+1 0}.right_op ⋙
          (homology_functor.{u+1 u+2 0} AddCommGroup.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).op).map
       ((QprimeFP_int.Tinv.{u} BD κ₂ κ M).app (unop.{1} c))).unop ≫
    (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
      (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond).hom :=
begin
  dsimp only [functor.op_map, functor.comp_map],
  erw [← functor.map_comp],
  erw [← functor.map_comp],
  congr' 1,
  ext ((_ | k) | k ) : 2,
  { refine (category.id_comp _).trans (category.comp_id _).symm },
  { apply is_zero.eq_of_tgt,
    exact is_zero_zero _ },
  { refine (category.id_comp _).trans (category.comp_id _).symm },
end

end ExtQprime_iso_aux_system_comm_Tinv_setup

lemma ExtQprime_iso_aux_system_comm_Tinv
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)] (n : ℕ) :
  (ExtQprime_iso_aux_system r' BD κ M V n).hom ≫
  whisker_right (aux_system.Tinv.{u} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ₂ κ)
    ((forget₂ _ _).map_homological_complex _ ⋙ homology_functor Ab.{u+1} (complex_shape.up ℕ) n) =
  ExtQprime.Tinv r' BD κ κ₂ M V n ≫
  (ExtQprime_iso_aux_system r' BD κ₂ M V n).hom :=
begin
  ext c : 2,
  dsimp only [ExtQprime_iso_aux_system_obj,
    ExtQprime_iso_aux_system,
    iso.trans_hom, id, functor.map_iso_hom, nat_iso.of_components_hom_app,
    nat_trans.comp_app],
  haveI : ((homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c))).is_bounded_above :=
     chain_complex.is_bounded_above _,
  haveI : ((homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ₂ M).obj (unop.{1} c))).is_bounded_above :=
     chain_complex.is_bounded_above _,
  have := Ext_compute_with_acyclic_naturality
    ((QprimeFP_int.{u} r' BD κ₂ M).obj c.unop)
    ((QprimeFP_int.{u} r' BD κ M).obj c.unop)
    V.to_Cond _ _
    ((QprimeFP_int.Tinv BD κ₂ κ M).app _) n,
  rotate,
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  erw reassoc_of this, clear this, simp only [category.assoc], congr' 1,
  dsimp only [whisker_right_app],
  rw ExtQprime_iso_aux_system_comm_Tinv_setup.aux₁ r' BD κ κ₂ M V c n,
  simp only [← category.assoc], congr' 1, simp only [category.assoc],
  erw ← nat_trans.naturality,
  simp only [← category.assoc], congr' 1,
  exact ExtQprime_iso_aux_system_comm_Tinv_setup.aux₂ r' BD κ κ₂ M V c n,
end

-- lemma ExtQprime_iso_aux_system_comm_T_inv [normed_with_aut r V] (n : ℕ) (c : ℝ≥0ᵒᵖ) :
--   (ExtQprime_iso_aux_system_obj.{u} r' BD κ₂ M V (unop.{1} c) n).hom ≫
--     ((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map_homological_complex (complex_shape.up.{0} ℕ) ⋙
--    homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
--   ((aux_system.res.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ₂ κ).app c) =
--   ((Ext.{u+1 u+2} ↑n).flip.map
--       ((single.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1}) 0).map
--           (Condensed.of_top_ab_map.{u} (normed_add_group_hom.to_add_monoid_hom.{u u} normed_with_aut.T.{u}.inv) _))).app
--       ((QprimeFP.{u} r' BD κ₂ M).op.obj c) ≫
--     (ExtQprime_iso_aux_system_obj.{u} r' BD κ₂ M V (unop.{1} c) n).hom :=
-- by admit

def homological_complex.map_unop {A M : Type*} [category A] [abelian A]
  {c : complex_shape M} (C₁ C₂ : homological_complex Aᵒᵖ c) (f : C₁ ⟶ C₂) :
  C₂.unop ⟶ C₁.unop :=
homological_complex.unop_functor.map f.op

namespace ExtQprime_iso_aux_system_comm_setup

include r
variables [normed_with_aut r V] [∀ (c : ℝ≥0) (n : ℕ), fact (κ₂ c n ≤ κ c n)]

def hom_complex_map_T_inv (c : (ℝ≥0)ᵒᵖ) :
  hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj (unop.{1} c)) V.to_Cond ⟶
  hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond :=
  begin
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    refine preadditive_yoneda.map _,
    refine Condensed.of_top_ab_map.{u} (normed_add_group_hom.to_add_monoid_hom.{u u}
      normed_with_aut.T.{u}.inv) (normed_add_group_hom.continuous _)
  end ≫
  (category_theory.functor.map _
      (homological_complex.op_functor.map (quiver.hom.op $
      (QprimeFP_nat.ι BD κ₂ κ M).app _)))

omit r

lemma embed_hom_complex_nat_iso₀ (c : (ℝ≥0)ᵒᵖ) : (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond).hom.f (int.of_nat 0) = 𝟙 _ := rfl

lemma embed_hom_complex_nat_iso_neg (n : ℕ) (c : (ℝ≥0)ᵒᵖ) : (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond).hom.f (-[1+ n]) = 𝟙 _ := rfl

lemma add_equiv.to_AddCommGroup_iso_apply (A B : AddCommGroup.{u})
  (e : A ≃+ B) (a : A) : e.to_AddCommGroup_iso.hom a = e a := rfl

lemma preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_apply (M) (X) (t) :
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab M X).hom t =
  yoneda'_equiv _ _ (Condensed_Ab_CondensedSet_adjunction.hom_equiv X.to_Condensed M t).val := rfl

include r

lemma aux₁ (c : (ℝ≥0)ᵒᵖ):
(hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V (unop.{1} c)).hom ≫
  ((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map_homological_complex
     (complex_shape.up.{0} ℕ)).map ((aux_system.T_inv.{u u+1} r r' BD
    ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ).app c ≫
  (aux_system.res.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ₂ κ).app c) =
  hom_complex_map_T_inv _ _ _ _ _ _ _ _ ≫
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ₂ M V (unop.{1} c)).hom :=
begin
  --simp only [← category_theory.functor.map_comp, functor.comp_map], congr' 1,
  dsimp only [hom_complex_map_T_inv], simp only [category.assoc],
  rw ← hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_κ r' BD κ κ₂ M V c.unop,
  simp only [functor.map_comp, ← category.assoc], congr' 1,
  apply hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv

  /- -- IGNORE THIS
  ext k t : 3,
  dsimp [hom_complex_nat] at t,
  dsimp only [hom_complex_QprimeFP_nat_iso_aux_system, aux_system.T_inv,
    aux_system.res, hom_complex_nat, functor.map_iso, iso.trans_hom,
    homological_complex.unop_functor, homological_complex.comp_f,
    nat_iso.map_homological_complex, nat_iso.app_hom, iso.op_hom, quiver.hom.unop_op,
    nat_trans.map_homological_complex_app_f, ExtQprime_iso_aux_system_obj_aux,
    nat_iso.of_components_hom_app, id, iso.symm_hom, nat_iso.app_inv,
    whisker_right_app, nat_trans.op, functor.comp_map],
  simp only [category_theory.functor.map_comp],
  dsimp only [homological_complex.comp_f, functor.map_homological_complex, functor.op_obj,
    functor.unop, forget₂_unop, nat_iso.of_components_hom_app,
    homological_complex.hom.iso_of_components, iso.refl],
  simp only [category.assoc, category.id_comp],
  erw category.id_comp,
  dsimp only [functor.op, quiver.hom.unop_op],
  erw category.comp_id,
  repeat { rw [comp_apply] },
  -/ -- UUUUGGGHHH

end

lemma aux₂ (c : (ℝ≥0)ᵒᵖ) :
((((preadditive_yoneda.{u+1 u+2}.obj (Condensed.of_top_ab.{u} ↥V)).right_op.map_homological_complex
         (complex_shape.up.{0} ℤ)).obj
        ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c))).map_unop
       (((preadditive_yoneda.{u+1 u+2}.obj (Condensed.of_top_ab.{u} ↥V)).right_op.map_homological_complex
           (complex_shape.up.{0} ℤ)).obj
          ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c)))
       ((nat_trans.map_homological_complex.{u+1 u+2 0 u+2 u+1}
           (nat_trans.right_op.{u+1 u+1 u+2 u+2} (preadditive_yoneda.{u+1 u+2}.map
           (Condensed.of_top_ab_map.{u} (normed_add_group_hom.to_add_monoid_hom.{u u}
        normed_with_aut.T.{u}.inv) (normed_add_group_hom.continuous _))))
           (complex_shape.up.{0} ℤ)).app
          ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c))) ≫
     (homological_complex.unop_functor.{u+2 u+1 0}.right_op.map
        (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).right_op.map_homological_complex (complex_shape.up.{0} ℤ)).map
           ((QprimeFP_int.ι.{u} BD κ₂ κ M).app (unop.{1} c)))).unop) ≫
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond).hom =
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj (unop.{1} c)) V.to_Cond).hom ≫
  category_theory.functor.map _
  (hom_complex_map_T_inv _ _ _ _ _ _ _ _) :=
begin
  ext ((_ | k) | k ) : 2,
  { dsimp only [functor.comp],
    simp only [functor.right_op_map, quiver.hom.unop_op, category.assoc, homological_complex.comp_f,
  homological_complex.unop_functor_map_f, functor.map_homological_complex_map_f],
  rw embed_hom_complex_nat_iso₀,
  rw embed_hom_complex_nat_iso₀,
  ext, refl },
  { apply is_zero.eq_of_tgt,
    exact is_zero_zero _ },
  { dsimp only [functor.comp],
    simp only [functor.right_op_map, quiver.hom.unop_op, category.assoc, homological_complex.comp_f,
  homological_complex.unop_functor_map_f, functor.map_homological_complex_map_f],
  rw embed_hom_complex_nat_iso_neg,
  rw embed_hom_complex_nat_iso_neg,
  ext, refl },
end

end ExtQprime_iso_aux_system_comm_setup

section naturality_snd_var

variables {A : Type*} [category A] [abelian A] [enough_projectives A]
  (X : cochain_complex A ℤ)
  [((homotopy_category.quotient A (complex_shape.up.{0} ℤ)).obj X).is_bounded_above]
  {B₁ B₂ : A} (f : B₁ ⟶ B₂) -- (h₁) (h₂) (i)

@[reassoc]
lemma Ext_compute_with_acyclic_aux₁_naturality_snd_var (i)
  (e : (0 : ℤ) - i = -i) :
  (Ext_compute_with_acyclic_aux₁ X B₁ i).hom ≫
  begin
    refine nat_trans.app _ _,
    refine preadditive_yoneda.map _,
    refine category_theory.functor.map _ f,
  end =
  category_theory.functor.map _
  (category_theory.functor.map _ f) ≫
  (Ext_compute_with_acyclic_aux₁ X B₂ i).hom :=
begin
  ext t,
  simp only [comp_apply],
  dsimp [Ext_compute_with_acyclic_aux₁, Ext],
  simp only [category.assoc],
  generalize_proofs h1 h2,
  let φ₁ := λ j, (single _ j).obj B₁,
  let φ₂ := λ j, (single _ j).obj B₂,
  change t ≫ _ ≫ eq_to_hom (congr_arg φ₁ e) ≫ _ =
    _ ≫ _ ≫ _ ≫ eq_to_hom (congr_arg φ₂ e),
  induction e,
  dsimp, simp only [category.id_comp, category.comp_id],
  erw ← nat_trans.naturality,
  refl,
end

@[reassoc]
lemma Ext_compute_with_acyclic_aux₂_naturality_snd_var (i) :
  (Ext_compute_with_acyclic_aux₂ X B₁ i).hom ≫
  (homology_functor _ _ _).map
  begin
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    exact preadditive_yoneda.map f,
  end =
  nat_trans.app
  (preadditive_yoneda.map $ category_theory.functor.map _ f) _ ≫
  (Ext_compute_with_acyclic_aux₂ X B₂ i).hom :=
begin
  dsimp only [Ext_compute_with_acyclic_aux₂, unop_op],
  have := hom_single_iso_naturality_snd_var_good (of' X).replace (-i) f,
  erw ← this,
end

include f
lemma Ext_compute_with_acyclic_aux₃_naturality_snd_var (i) :
  (homology_functor _ _ _).map
  begin
    refine homological_complex.map_unop _ _ _,
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    refine nat_trans.right_op _,
    exact preadditive_yoneda.map f,
  end ≫ Ext_compute_with_acyclic_aux₃ X B₂ i =
  Ext_compute_with_acyclic_aux₃ X B₁ i ≫
  (homology_functor _ _ _).map
  begin
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    exact preadditive_yoneda.map f,
  end :=
begin
  dsimp only [Ext_compute_with_acyclic_aux₃],
  erw ← (homology_functor.{u_2 u_2+1 0} AddCommGroup.{u_2}
    (complex_shape.up.{0} ℤ).symm (-i)).map_comp,
  erw ← (homology_functor.{u_2 u_2+1 0} AddCommGroup.{u_2}
    (complex_shape.up.{0} ℤ).symm (-i)).map_comp,
  congr' 1,
  ext t x,
  dsimp [Ext_compute_with_acyclic_HomB],
  simp only [comp_apply],
  dsimp [nat_trans.map_homological_complex, functor.right_op,
    homological_complex.map_unop],
  simp only [category.assoc],
end

lemma Ext_compute_with_acyclic_naturality_snd_var
  (h₁) (h₂) (i) :
  (Ext_compute_with_acyclic X B₁ h₁ i).hom ≫
  (homology_functor _ _ _).map
  (begin
    refine homological_complex.map_unop _ _ _,
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    exact (preadditive_yoneda.map f).right_op,
  end) =
  category_theory.functor.map _
  (category_theory.functor.map _ f) ≫ (Ext_compute_with_acyclic X B₂ h₂ i).hom :=
begin
  dsimp [Ext_compute_with_acyclic, - homology_functor_map],
  simp only [category.assoc],
  rw ← Ext_compute_with_acyclic_aux₁_naturality_snd_var_assoc,
  rw ← Ext_compute_with_acyclic_aux₂_naturality_snd_var_assoc,
  simp only [category.assoc], congr' 2,
  rw [is_iso.eq_comp_inv, category.assoc, is_iso.inv_comp_eq],
  apply Ext_compute_with_acyclic_aux₃_naturality_snd_var,
  simp,
end

end naturality_snd_var

lemma ExtQprime_iso_aux_system_comm [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)] (n : ℕ) :
  (ExtQprime_iso_aux_system r' BD κ M V n).hom ≫
  whisker_right (aux_system.Tinv2.{u} r r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ₂ κ)
    ((forget₂ _ _).map_homological_complex _ ⋙ homology_functor Ab.{u+1} (complex_shape.up ℕ) n) =
  ExtQprime.Tinv2 r r' BD κ κ₂ M V n ≫
  (ExtQprime_iso_aux_system r' BD κ₂ M V n).hom :=
begin
  ext c : 2, dsimp only [aux_system.Tinv2, ExtQprime.Tinv2, nat_trans.comp_app, whisker_right_app],
  simp only [sub_comp, nat_trans.app_sub, functor.map_sub, comp_sub],
  refine congr_arg2 _ _ _,
  { rw [← nat_trans.comp_app, ← ExtQprime_iso_aux_system_comm_Tinv], refl },

  dsimp only [ExtQprime_iso_aux_system_obj,
    ExtQprime_iso_aux_system,
    iso.trans_hom, id, functor.map_iso_hom, nat_iso.of_components_hom_app,
    nat_trans.comp_app],

  haveI : ((homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1})
    (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c))).is_bounded_above :=
     chain_complex.is_bounded_above _,
  haveI : ((homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1})
    (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ₂ M).obj (unop.{1} c))).is_bounded_above :=
     chain_complex.is_bounded_above _,
  have := Ext_compute_with_acyclic_naturality
    ((QprimeFP_int.{u} r' BD κ₂ M).obj c.unop)
    ((QprimeFP_int.{u} r' BD κ M).obj c.unop)
    V.to_Cond _ _
    ((QprimeFP_int.ι BD κ₂ κ M).app _) n,
  rotate,
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  { intros k i hi, apply QprimeFP_acyclic, exact hi },

  simp only [category.assoc], dsimp only [ExtQprime.T_inv, nat_trans.comp_app,
    whisker_right_app, whisker_left_app, functor.flip],
  let η := (Ext.{u+1 u+2} ↑n).map ((nat_trans.op.{0 u+1 0 u+2} (QprimeFP.ι.{u} BD κ₂ κ M)).app c),

  slice_rhs 1 2 { erw ← η.naturality },
  slice_rhs 2 3 { erw this },
  simp only [category.assoc], clear this η,

  let t : Condensed.of_top_ab V ⟶ _ :=
    Condensed.of_top_ab_map.{u} (normed_add_group_hom.to_add_monoid_hom.{u u}
      normed_with_aut.T.{u}.inv) (normed_add_group_hom.continuous _),
  have := Ext_compute_with_acyclic_naturality_snd_var
    ((QprimeFP_int r' BD κ M).obj c.unop) t _ _ n,
  rotate,
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  erw ← reassoc_of this, clear this, congr' 1,
  simp only [functor.comp_map, category_theory.functor.map_comp,
    functor.op_map, quiver.hom.unop_op],
  slice_rhs 1 2 { rw ← category_theory.functor.map_comp },
  slice_lhs 4 5 { rw ← category_theory.functor.map_comp },
  simp only [category.assoc,
    ← category_theory.functor.map_comp, ← functor.map_comp_assoc],

  rw ExtQprime_iso_aux_system_comm_setup.aux₁ r r' BD κ κ₂ M V c,
  slice_lhs 2 4
  { simp only [category_theory.functor.map_comp] },

  simp only [← category.assoc], congr' 1,

  rw ExtQprime_iso_aux_system_comm_setup.aux₂ r r' BD κ κ₂ M V c,
  simp only [category_theory.functor.map_comp, category.assoc],
  congr' 1,

  rw [nat_iso.app_hom, ← nat_trans.naturality],
  congr' 1,

  -- have := Ext_compute_with_acyclic_naturality, <-- we need naturality in the other variable?!

  --simp only [category.assoc],
  --erw reassoc_of this,
   --clear this, simp only [category.assoc], congr' 1,

  /-
  rw [nat_trans.comp_app, functor.map_comp, ExtQprime.T_inv,
    nat_trans.comp_app, whisker_right_app, whisker_left_app, category.assoc],
  dsimp only [ExtQprime_iso_aux_system, nat_iso.of_components_hom_app, aux_system,
    aux_system.res, functor.comp_map],
  -/
end

lemma ExtQprime_iso_aux_system_comm' [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)] (n : ℕ) :
  whisker_right (aux_system.Tinv2.{u} r r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ₂ κ)
    ((forget₂ _ _).map_homological_complex _ ⋙ homology_functor Ab.{u+1} (complex_shape.up ℕ) n) ≫
  (ExtQprime_iso_aux_system r' BD κ₂ M V n).inv =
  (ExtQprime_iso_aux_system r' BD κ M V n).inv ≫
  ExtQprime.Tinv2 r r' BD κ κ₂ M V n :=
begin
  rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp],
  apply ExtQprime_iso_aux_system_comm
end

end

section

def _root_.category_theory.functor.map_commsq
  {C D : Type*} [category C] [abelian C] [category D] [abelian D] (F : C ⥤ D) {X Y Z W : C}
  {f₁ : X ⟶ Y} {g₁ : X ⟶ Z} {g₂ : Y ⟶ W} {f₂ : Z ⟶ W} (sq : commsq f₁ g₁ g₂ f₂) :
  commsq (F.map f₁) (F.map g₁) (F.map g₂) (F.map f₂) :=
commsq.of_eq $ by rw [← F.map_comp, sq.w, F.map_comp]

end

section

variables {r'}
variables (BD : breen_deligne.package)
variables (κ κ₂ : ℝ≥0 → ℕ → ℝ≥0)
variables [∀ (c : ℝ≥0), BD.data.suitable (κ c)] [∀ n, fact (monotone (function.swap κ n))]
variables [∀ (c : ℝ≥0), BD.data.suitable (κ₂ c)] [∀ n, fact (monotone (function.swap κ₂ n))]
variables (M : ProFiltPseuNormGrpWithTinv₁.{u} r')
variables (V : SemiNormedGroup.{u}) [complete_space V] [separated_space V]

open bounded_homotopy_category

-- move me
instance eval'_is_bounded_above :
  ((homotopy_category.quotient (Condensed Ab) (complex_shape.up ℤ)).obj
    ((BD.eval' freeCond').obj M.to_Condensed)).is_bounded_above :=
by { delta breen_deligne.package.eval', refine ⟨⟨1, _⟩⟩, apply chain_complex.bounded_by_one }

variables (ι : ulift.{u+1} ℕ → ℝ≥0) (hι : monotone ι)

def Ext_Tinv2
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A B V : bounded_homotopy_category 𝓐}
  (Tinv : A ⟶ B) (ι : A ⟶ B) (T_inv : V ⟶ V) (i : ℤ) :
  ((Ext i).obj (op B)).obj V ⟶ ((Ext i).obj (op A)).obj V :=
(((Ext i).map Tinv.op).app V - (((Ext i).map ι.op).app V ≫ ((Ext i).obj _).map T_inv))

open category_theory.preadditive

def Ext_Tinv2_commsq
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A₁ B₁ A₂ B₂ V : bounded_homotopy_category 𝓐}
  (Tinv₁ : A₁ ⟶ B₁) (ι₁ : A₁ ⟶ B₁)
  (Tinv₂ : A₂ ⟶ B₂) (ι₂ : A₂ ⟶ B₂)
  (f : A₁ ⟶ A₂) (g : B₁ ⟶ B₂) (sqT : f ≫ Tinv₂ = Tinv₁ ≫ g) (sqι : f ≫ ι₂ = ι₁ ≫ g)
  (T_inv : V ⟶ V) (i : ℤ) :
  commsq
    (((Ext i).map g.op).app V)
    (Ext_Tinv2 Tinv₂ ι₂ T_inv i)
    (Ext_Tinv2 Tinv₁ ι₁ T_inv i)
    (((Ext i).map f.op).app V) :=
commsq.of_eq
begin
  delta Ext_Tinv2,
  simp only [comp_sub, sub_comp, ← nat_trans.comp_app, ← functor.map_comp, ← op_comp, sqT,
    ← nat_trans.naturality, ← nat_trans.naturality_assoc, category.assoc, sqι],
end

open category_theory.preadditive

lemma auux
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A₁ B₁ A₂ B₂ : cochain_complex 𝓐 ℤ}
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A₁).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj B₁).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A₂).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj B₂).is_bounded_above]
  {f₁ : A₁ ⟶ B₁} {f₂ : A₂ ⟶ B₂} {α : A₁ ⟶ A₂} {β : B₁ ⟶ B₂}
  (sq1 : commsq f₁ α β f₂) :
  of_hom f₁ ≫ of_hom β = of_hom α ≫ of_hom f₂ :=
begin
  have := sq1.w,
  apply_fun (λ f, (homotopy_category.quotient _ _).map f) at this,
  simp only [functor.map_comp] at this,
  exact this,
end

@[simp] lemma of_hom_id
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A : cochain_complex 𝓐 ℤ}
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A).is_bounded_above] :
  of_hom (𝟙 A) = 𝟙 _ :=
by { delta of_hom, rw [category_theory.functor.map_id], refl }

lemma Ext_iso_of_bicartesian_of_bicartesian
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A₁ B₁ C A₂ B₂ : cochain_complex 𝓐 ℤ}
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A₁).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj B₁).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj C).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A₂).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj B₂).is_bounded_above]
  {f₁ : A₁ ⟶ B₁} {g₁ : B₁ ⟶ C} (w₁ : ∀ n, short_exact (f₁.f n) (g₁.f n))
  {f₂ : A₂ ⟶ B₂} {g₂ : B₂ ⟶ C} (w₂ : ∀ n, short_exact (f₂.f n) (g₂.f n))
  (α : A₁ ⟶ A₂) (β : B₁ ⟶ B₂) (γ : C ⟶ C)
  (ιA : A₁ ⟶ A₂) (ιB : B₁ ⟶ B₂)
  (sq1 : commsq f₁ α β f₂) (sq2 : commsq g₁ β γ g₂)
  (sq1' : commsq f₁ ιA ιB f₂) (sq2' : commsq g₁ ιB (𝟙 _) g₂)
  (V : bounded_homotopy_category 𝓐) (T_inv : V ⟶ V)
  (i : ℤ)
  (H1 : (Ext_Tinv2_commsq (of_hom α) (of_hom ιA) (of_hom β) (of_hom ιB) (of_hom f₁) (of_hom f₂)
    (auux sq1) (auux sq1') T_inv i).bicartesian)
  (H2 : (Ext_Tinv2_commsq (of_hom α) (of_hom ιA) (of_hom β) (of_hom ιB) (of_hom f₁) (of_hom f₂)
    (auux sq1) (auux sq1') T_inv (i+1)).bicartesian) :
  is_iso (Ext_Tinv2 (of_hom γ) (𝟙 _) T_inv (i+1)) :=
begin
  have LES₁ := (((Ext_five_term_exact_seq' _ _ i V w₁).drop 2).pair.cons (Ext_five_term_exact_seq' _ _ (i+1) V w₁)),
  replace LES₁ := (((Ext_five_term_exact_seq' _ _ i V w₁).drop 1).pair.cons LES₁).extract 0 4,
  have LES₂ := (((Ext_five_term_exact_seq' _ _ i V w₂).drop 2).pair.cons (Ext_five_term_exact_seq' _ _ (i+1) V w₂)).extract 0 4,
  replace LES₂ := (((Ext_five_term_exact_seq' _ _ i V w₂).drop 1).pair.cons LES₂).extract 0 4,
  refine iso_of_bicartesian_of_bicartesian LES₂ LES₁ _ _ _ _ H1 H2,
  { apply commsq.of_eq, delta Ext_Tinv2, clear LES₁ LES₂,
    rw [sub_comp, comp_sub, ← functor.flip_obj_map, ← functor.flip_obj_map],
    rw ← Ext_δ_natural i V _ _ _ _ α β γ sq1.w sq2.w w₁ w₂,
    congr' 1,
    rw [← nat_trans.naturality, ← functor.flip_obj_map, category.assoc,
      Ext_δ_natural i V _ _ _ _ ιA ιB (𝟙 _) sq1'.w sq2'.w w₁ w₂],
    simp only [op_id, category_theory.functor.map_id, nat_trans.id_app,
      category.id_comp, of_hom_id, category.comp_id],
    erw [category.id_comp],
    symmetry,
    apply Ext_δ_natural', },
  { apply Ext_Tinv2_commsq,
    { exact auux sq2 },
    { exact auux sq2' }, },
end

end