import Runtime.Execution.ReactionInputs

namespace Network.Graph.Class.Reaction

inductive Trigger (net : Network)
  | port {kind} (id : PortId net kind)
  | action (id : ActionId net)
  | timer (id : TimerId net)
  | startup
  | shutdown

def Trigger.lift {reactor : ReactorId net} {reaction : Reaction reactor.class} :
  reaction.val.triggerType → Trigger net
  | .action a => .action ⟨reactor, reaction.subAS.coe a⟩
  | .timer t  => .timer ⟨reactor, reaction.eqTimers ▸ t⟩
  | .startup  => .startup
  | .shutdown => .shutdown
  | .port p =>
    match reaction.subPS.coe p with
    | .inl input =>
      (.port (kind := .input) ⟨reactor, input⟩)
    | .inr ⟨c, output⟩ =>
      (.port (kind := .output) ⟨reactor.extend c, cast (by rw [Path.extend_class]) output⟩)

inductive Trigger.Equiv {reactor : ReactorId net} {reaction : Reaction reactor.class} :
  (Trigger net) → reaction.val.triggerType → Prop
  | action :   Equiv (.action ⟨reactor, reaction.subAS.coe a⟩) (.action a)
  | timer :    Equiv (.timer ⟨reactor, reaction.eqTimers ▸ t⟩) (.timer t)
  | startup :  Equiv .startup .startup
  | shutdown : Equiv .shutdown .shutdown
  | input :
    (reaction.subPS.coe p = .inl input) →
    Equiv (.port (kind := .input) ⟨reactor, input⟩) (.port p)
  | output :
    (reaction.subPS.coe p = .inr ⟨c, output⟩) →
    Equiv (.port (kind := .output) ⟨reactor.extend c, cast (by rw [Path.extend_class]) output⟩) (.port p)

infix:50 " ≡ " => Trigger.Equiv

theorem Trigger.Equiv.lift
  {reactor : ReactorId net} {reaction : Reaction reactor.class} (t : reaction.val.triggerType) :
  Trigger.lift t ≡ t := by
  cases t
  all_goals
    simp [Trigger.lift]
    first
    | constructor
    | split <;> (constructor; assumption)

end Network.Graph.Class.Reaction

namespace Execution.Executable
open Network Graph Class

/--
A predicate indicating whether a given executable triggers a given reaction by means of a given
trigger. The main use case for this predicate is its closure: `Triggers`.
-/
inductive Activates (exec : Executable net) : (Class.Reaction.Trigger net) → Prop
  | port     : (exec.portIsPresent p)       → Activates _ (.port p)
  | action   : (exec.actionIsPresent a)     → Activates _ (.action a)
  | timer    : (exec.timer t |>.isFiring)   → Activates _ (.timer t)
  | startup  : (exec.isStartingUp)          → Activates _ .startup
  | shutdown : (exec.state = .shuttingDown) → Activates _ .shutdown

/-- A predicate indicating whether a given executable triggers a given reaction. -/
inductive Triggers (exec) {reactor : ReactorId net} (reaction : Reaction reactor.class) : Prop
  | witness (equiv : t ≡ t') (mem : t' ∈ reaction.val.triggers.data) (active : Activates exec t)

/-- A decision procedure for `Triggers`. -/
private def triggers (exec : Executable net) {reactor : ReactorId net} (reaction : Reaction reactor.class) :=
  reaction.val.triggers.any (activated ·)
where
  activated : reaction.val.triggerType → Bool
  | .port   port   => exec.reactionInputs reactor |>.isPresent (reaction.subPS.coe port)
  | .action action => exec.interface reactor .actions |>.isPresent (reaction.subAS.coe action)
  | .timer  timer  => exec.reactors reactor |>.timer (reaction.eqTimers ▸ timer) |>.isFiring
  | .startup       => exec.isStartingUp
  | .shutdown      => exec.state = .shuttingDown

set_option pp.proofs.withType false in
theorem Activates.port_iff_equiv_port_activated {p'} :
  (.port p ≡ .port p') →
  ((Activates exec <| .port p) ↔ (triggers.activated exec reaction <| .port p')) := by
  intro he
  constructor <;> intro h
  case mp reactor =>
    simp only [triggers.activated, reactionInputs]
    cases hp : reaction.subPS.coe p'
    case inl loc =>
      simp
      cases he
      case input hi =>
        simp [hi] at hp
        cases h
        case port h =>
          simp [portIsPresent, hp] at h
          exact h
      case output ho =>
        rw [ho] at hp
        contradiction
    case inr sub =>
      have ⟨c, output⟩ := sub
      simp at output ⊢
      cases he
      case input hi =>
        rw [hi] at hp
        contradiction
      case output c' output' ho =>
        simp [ho] at hp
        injection hp with hc ho
        subst hc
        subst ho
        cases h
        case port h =>
          simp [portIsPresent] at h
          have ⟨v, hv⟩ := h
          exists cast sorry v
          simp [hv]
          -- https://leanprover.zulipchat.com/#narrow/stream/270676-lean4
          sorry
  case mpr =>
    sorry

theorem Activates.iff_equiv_trigger_activated {t'} :
  (t ≡ t') → (Activates exec t ↔ triggers.activated exec reaction t') := by
  intro equiv
  unfold triggers.activated
  constructor
  case mp =>
    intro activates
    cases t <;> cases t' <;> (try contradiction)
    case port.port => exact Activates.port_iff_equiv_port_activated equiv |>.mp activates
    all_goals
      cases activates
      cases equiv
      all_goals
        simp_all [actionIsPresent, portIsPresent, reactionInputs]
        try assumption
  case mpr =>
    intro h
    cases t <;> cases t' <;> (try contradiction)
    case port.port => exact Activates.port_iff_equiv_port_activated equiv |>.mpr h
    all_goals
      simp at h
      constructor
      cases equiv
      all_goals
        simp_all [actionIsPresent, portIsPresent, reactionInputs]
        try assumption

theorem Triggers.iff_triggers_eq_true : (Triggers exec reaction) ↔ (exec.triggers reaction) := by
  unfold triggers
  constructor
  case mp =>
    intro ⟨equiv, mem, active⟩
    rw [Array.any_iff_mem_where]
    refine ⟨_, mem, ?_⟩
    exact Activates.iff_equiv_trigger_activated equiv |>.mp active
  case mpr =>
    intro h
    have ⟨t', mem, active⟩ := Array.any_iff_mem_where.mp h
    have ⟨_, equiv⟩ : ∃ t, t ≡ t' := ⟨_, Reaction.Trigger.Equiv.lift t'⟩
    refine .witness equiv mem ?_
    exact Activates.iff_equiv_trigger_activated equiv |>.mpr active

instance : Decidable (Triggers exec reaction) :=
  decidable_of_iff' _ Triggers.iff_triggers_eq_true

end Execution.Executable


example : (p → q) ∧ r := by
  refine ⟨?a, ?b⟩

example : (p → q) ∧ r := by
  refine ⟨fun h => ?a, ?b⟩


/-
Copyright (c) 2022 Mac Malone. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
import Lake.Util.Name

namespace Lake

/-- The type of keys in the Lake build store. -/
inductive BuildKey
| moduleFacet (module : Name) (facet : Name)
| packageFacet (package : Name) (facet : Name)
| targetFacet (package : Name) (target : Name) (facet : Name)
| customTarget (package : Name) (target : Name)
deriving Inhabited, Repr, DecidableEq, Hashable

namespace BuildKey

def toString : (self : BuildKey) → String
| moduleFacet m f => s!"+{m}:{f}"
| packageFacet p f => s!"@{p}:{f}"
| targetFacet p t f => s!"{p}/{t}:{f}"
| customTarget p t => s!"{p}/{t}"

instance : ToString BuildKey := ⟨(·.toString)⟩

def quickCmp (k k' : BuildKey) : Ordering :=
  match k with
  | moduleFacet m f =>
    match k' with
    | moduleFacet m' f' =>
      match m.quickCmp m' with
      | .eq => f.quickCmp f'
      | ord => ord
    | _ => .lt
  | packageFacet p f =>
    match k' with
    | moduleFacet .. => .gt
    | packageFacet p' f' =>
      match p.quickCmp p' with
      | .eq => f.quickCmp f'
      | ord => ord
    | _ => .lt
  | targetFacet p t f =>
    match k' with
    | customTarget .. => .lt
    | targetFacet p' t' f' =>
      match p.quickCmp p' with
      | .eq =>
        match t.quickCmp t' with
        | .eq => f.quickCmp f'
        | ord => ord
      | ord => ord
    | _=> .gt
  | customTarget p t =>
    match k' with
    | customTarget p' t' =>
      match p.quickCmp p' with
      | .eq => t.quickCmp t'
      | ord => ord
    | _ => .gt

theorem eq_of_quickCmp {k k' : BuildKey}  :
quickCmp k k' = Ordering.eq → k = k' := by
  unfold quickCmp
  cases k with
  | moduleFacet m f =>
    cases k'
    case moduleFacet m' f' =>
      dsimp only; split
      next m_eq => intro f_eq; rw [eq_of_cmp m_eq, eq_of_cmp f_eq]
      next => intro; contradiction
    all_goals (intro; contradiction)
  | packageFacet p f =>
    cases k'
    case packageFacet p' f' =>
      dsimp only; split
      next p_eq => intro f_eq; rw [eq_of_cmp p_eq, eq_of_cmp f_eq]
      next => intro; contradiction
    all_goals (intro; contradiction)
  | targetFacet p t f =>
    cases k'
    case targetFacet p' t' f' =>
      dsimp only; split
      next p_eq =>
        split
        next t_eq =>
          intro f_eq
          rw [eq_of_cmp p_eq, eq_of_cmp t_eq, eq_of_cmp f_eq]
        next => intro; contradiction
      next => intro; contradiction
    all_goals (intro; contradiction)
  | customTarget p t =>
    cases k'
    case customTarget p' t' =>
      dsimp only; split
      next p_eq => intro t_eq; rw [eq_of_cmp p_eq, eq_of_cmp t_eq]
      next => intro; contradiction
    all_goals (intro; contradiction)

instance : LawfulCmpEq BuildKey quickCmp where
  eq_of_cmp := eq_of_quickCmp
  cmp_rfl {k} := by cases k <;> simp [quickCmp]


import breen_deligne.eval

noncomputable theory

namespace breen_deligne

open category_theory category_theory.limits category_theory.category
  category_theory.preadditive

variables {A₁ A₂ A₃ : Type*} [category A₁] [preadditive A₁] [has_finite_biproducts A₁]
  [category A₂] [preadditive A₂] --[has_finite_biproducts A₂]
  [category A₃] [preadditive A₃] --[has_finite_biproducts A₃]

namespace universal_map

variables {m n : ℕ} (f : universal_map m n)

def eval_Pow' (F : A₁ ⥤ A₂) : universal_map m n →+ (Pow m ⋙ F ⟶ Pow n ⋙ F) :=
free_abelian_group.lift $ λ g : basic_universal_map m n, whisker_right g.eval_Pow F

@[simp]
lemma eval_Pow'_of (F : A₁ ⥤ A₂) (f : basic_universal_map m n) :
  eval_Pow' F (free_abelian_group.of f) = whisker_right f.eval_Pow F :=
free_abelian_group.lift.of _ _

lemma eval_Pow'_hcomp (F : A₁ ⥤ A₂) (H : A₂ ⥤ A₃) [H.additive] :
  eval_Pow' F f ◫ 𝟙 H = eval_Pow' (F ⋙ H) f :=
begin
  revert f,
  let φ : universal_map m n →+ ((Pow m ⋙ F) ⋙ H ⟶ (Pow n ⋙ F) ⋙ H) :=
  { to_fun := λ f, whisker_right (eval_Pow' F f) H,
    map_zero' := by { ext, dsimp, simp only [map_zero, nat_trans.app_zero, functor.map_zero], },
    map_add' := λ f₁ f₂, by { ext, dsimp, simp only [map_add, nat_trans.app_add,
      functor.map_add], }, },
  suffices : φ = eval_Pow' (F ⋙ H),
  { intro f,
    change 𝟙 _ ≫ φ f = _,
    rw [category.id_comp, this], },
  ext1 f,
  simp only [add_monoid_hom.coe_mk, eval_Pow'_of, whisker_right_twice],
end

lemma map_eval_Pow' (F : A₁ ⥤ A₂) (H : A₂ ⥤ A₃) [H.additive] (M₁ : A₁) :
  H.map ((eval_Pow' F f).app M₁) = (eval_Pow' (F ⋙ H) f).app M₁ :=
by simpa only [nat_trans.hcomp_id_app] using nat_trans.congr_app (f.eval_Pow'_hcomp F H) M₁

lemma map_eval_Pow (F : A₁ ⥤ A₁) (H : A₁ ⥤ A₂) [H.additive] (M₁ : A₁) :
  H.map ((eval_Pow F f).app M₁) = (eval_Pow' (F ⋙ H) f).app M₁ :=
map_eval_Pow' f F H M₁

@[reassoc]
lemma congr_eval_Pow' {F F' : A₁ ⥤ A₂} (φ : F ⟶ F') (M₁ : A₁) :
  (eval_Pow' F f).app M₁ ≫ φ.app ((Pow n).obj M₁) =
  φ.app ((Pow m).obj M₁) ≫ (eval_Pow' F' f).app M₁ :=
begin
  revert f,
  let φ₁ : universal_map m n →+ ((Pow m ⋙ F).obj M₁ ⟶ (Pow n ⋙ F').obj M₁) :=
  { to_fun := λ f, (eval_Pow' F f).app M₁ ≫ φ.app ((Pow n).obj M₁),
    map_zero' := by simp only [map_zero, nat_trans.app_zero, zero_comp],
    map_add' := λ f₁ f₂, by simp only [map_add, nat_trans.app_add, add_comp], },
  let φ₂ : universal_map m n →+ ((Pow m ⋙ F).obj M₁ ⟶ (Pow n ⋙ F').obj M₁) :=
  { to_fun := λ f, φ.app ((Pow m).obj M₁) ≫ (eval_Pow' F' f).app M₁,
    map_zero' := by simp only [map_zero, nat_trans.app_zero, comp_zero],
    map_add' := λ f₁ f₂, by simp only [map_add, nat_trans.app_add, comp_add], },
  suffices : φ₁ = φ₂,
  { intro f,
    change φ₁ f = φ₂ f,
    rw this, },
  ext,
  dsimp only [φ₁, φ₂],
  simp only [add_monoid_hom.coe_mk, eval_Pow'_of, whisker_right_app, nat_trans.naturality],
end

end universal_map

end breen_deligne


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import for_mathlib.algebraic_topology.homotopical_algebra.fibrant

noncomputable theory

open category_theory category_theory.limits
open category_theory.category opposite

namespace algebraic_topology

namespace model_category

variables {C : Type*} [category C] [model_category C]

variables (A B : C)

structure precylinder  :=
(I : C) (d₀ d₁: A ⟶ I) (σ : I ⟶ A) [weq_σ : weak_eq σ]
(σd₀' : d₀ ≫ σ = 𝟙 A . obviously) (σd₁' : d₁ ≫ σ = 𝟙 A . obviously)

namespace precylinder

variables {A} (P : precylinder A)

restate_axiom σd₀'
restate_axiom σd₁'
attribute [simp, reassoc] σd₀ σd₁

instance weq_σ' : weak_eq P.σ := P.weq_σ
instance weq_d₀ : weak_eq P.d₀ := weak_eq.of_comp_right P.d₀ P.σ infer_instance
  (by { rw σd₀, apply_instance, })
instance weq_d₁ : weak_eq P.d₁ := weak_eq.of_comp_right P.d₁ P.σ infer_instance
  (by { rw σd₁, apply_instance, })

@[simps]
def change_I {I' : C} {f : P.I ⟶ I'} {g : I' ⟶ A} (fac : f ≫ g = P.σ) [weak_eq f] :
  precylinder A :=
begin
  haveI := weak_eq.of_comp_left f g infer_instance (by {rw fac, apply_instance, }),
  exact
  { I := I',
    d₀ := P.d₀ ≫ f,
    d₁ := P.d₁ ≫ f,
    σ := g,
    σd₀' := by { simp only [assoc, fac, σd₀], },
    σd₁' := by { simp only [assoc, fac, σd₁], }, },
end

@[simp]
def ι := coprod.desc P.d₀ P.d₁

@[simps]
def symm : precylinder A :=
{ I := P.I,
  d₀ := P.d₁,
  d₁ := P.d₀,
  σ := P.σ, }

end precylinder

structure cylinder extends precylinder A :=
[cof_ι : cofibration to_precylinder.ι]

namespace cylinder

variable {A}

def mk' (P : precylinder A) (h : cofibration P.ι) : cylinder A :=
by { haveI := h, exact mk P, }

abbreviation pre (Q : cylinder A) := Q.to_precylinder

instance cof_ι' (Q : cylinder A) : cofibration Q.pre.ι := Q.cof_ι

variable (A)

def some : cylinder A :=
begin
  let φ := coprod.desc (𝟙 A) (𝟙 A),
  let P : precylinder A :=
  { I := CM5b.obj φ,
    σ := CM5b.p φ,
    d₀ := coprod.inl ≫ CM5b.i φ,
    d₁ := coprod.inr ≫ CM5b.i φ, },
  apply mk' P,
  rw [show P.ι = CM5b.i φ, by tidy],
  apply_instance,
end

instance : fibration (some A).σ := by { dsimp [some, mk'], apply_instance, }
instance [is_fibrant A] : is_fibrant (some A).I := by { dsimp [some, mk'], apply_instance, }

instance : inhabited (cylinder A) := ⟨some A⟩
instance : inhabited (precylinder A) := ⟨(some A).pre⟩

variables {A} (Q : cylinder A)

instance cof_d₀ [is_cofibrant A] : cofibration (Q.d₀) :=
begin
  rw [show Q.d₀ = coprod.inl ≫ Q.pre.ι, by simp only [precylinder.ι, coprod.inl_desc]],
  apply_instance,
end

instance cof_d₁ [is_cofibrant A] : cofibration (Q.d₁) :=
begin
  rw [show Q.d₁ = coprod.inr ≫ Q.pre.ι, by simp only [precylinder.ι, coprod.inr_desc]],
  apply_instance,
end

instance is_cofibrant_I [is_cofibrant A] : is_cofibrant Q.I :=
begin
  change cofibration _,
  rw subsingleton.elim (initial.to Q.I) (initial.to A ≫ Q.d₀),
  apply_instance,
end

@[simps]
def symm : cylinder A := mk' Q.pre.symm
begin
  have eq : Q.pre.symm.ι = (coprod.braiding A A).hom ≫ Q.pre.ι,
  { simp only [precylinder.ι, precylinder.symm_d₀, precylinder.symm_d₁, coprod.braiding_hom,
      coprod.desc_comp, coprod.inr_desc, coprod.inl_desc], },
  rw eq,
  apply_instance,
end

@[simps]
def trans [is_cofibrant A] (Q Q' : cylinder A) : cylinder A :=
begin
  let φ := pushout.desc Q.σ Q'.σ (by rw [Q.pre.σd₁, Q'.pre.σd₀]),
  haveI : weak_eq φ,
  { apply weak_eq.of_comp_left (Q.d₀ ≫ pushout.inl),
    { apply_instance, },
    { simp only [assoc, pushout.inl_desc, precylinder.σd₀],
      apply_instance, }, },
  let P : precylinder A :=
  { I := pushout Q.d₁ Q'.d₀,
    d₀ := Q.d₀ ≫ pushout.inl,
    d₁ := Q'.d₁ ≫ pushout.inr,
    σ := φ, },
  apply mk' P,
  let ψ : Q.pre.I ⨿ A ⟶ P.I := coprod.desc pushout.inl (Q'.d₁ ≫ pushout.inr),
  have eq : P.ι = (coprod.map Q.d₀ (𝟙 A)) ≫ ψ,
  { by simp only [precylinder.ι, coprod.map_desc, id_comp], },
  rw eq,
  have fac : coprod.map Q.d₁ (𝟙 A) ≫ ψ = Q'.pre.ι ≫ pushout.inr,
  { dsimp [ψ],
    ext,
    { simp only [coprod.map_desc, coprod.inl_desc, coprod.desc_comp, pushout.condition], },
    { simp only [coprod.map_desc, id_comp, coprod.inr_desc, coprod.desc_comp], }, },
  have sq : is_pushout Q.pre.d₁ (coprod.inl ≫ Q'.pre.ι)
    (coprod.inl ≫ ψ) pushout.inr := by simpa only [precylinder.ι, coprod.inl_desc]
    using is_pushout.of_has_pushout Q.pre.d₁ Q'.pre.d₀,
  haveI : cofibration ψ := cofibration.direct_image
    (is_pushout.of_bot sq fac (is_pushout.of_coprod_inl_with_id Q.d₁ A).flip),
  apply_instance,
end

end cylinder

structure pre_path_object :=
(I : C) (d₀ d₁: I ⟶ B) (σ : B ⟶ I) [weq_σ : weak_eq σ]
(d₀σ' : σ ≫ d₀ = 𝟙 B . obviously) (d₁σ' : σ ≫ d₁ = 𝟙 B . obviously)

namespace pre_path_object

restate_axiom d₀σ'
restate_axiom d₁σ'
attribute [simp, reassoc] d₀σ d₁σ

variables {B} (P : pre_path_object B)

instance : weak_eq P.σ := P.weq_σ

@[simps]
def op (P : pre_path_object B) : precylinder (op B) :=
begin
  haveI : weak_eq P.σ.op := weak_eq.op infer_instance,
  exact
  { I := op P.I,
    d₀ := P.d₀.op,
    d₁ := P.d₁.op,
    σ := P.σ.op,
    σd₀' := by simp only [← op_comp, d₀σ, op_id],
    σd₁' := by simp only [← op_comp, d₁σ, op_id], }
end

@[simps]
def unop {B : Cᵒᵖ} (P : pre_path_object B) : precylinder B.unop :=
begin
  haveI : weak_eq P.σ.unop := weak_eq.unop infer_instance,
  exact
  { I := unop P.I,
    d₀ := P.d₀.unop,
    d₁ := P.d₁.unop,
    σ := P.σ.unop,
    σd₀' := by simp only [← unop_comp, d₀σ, unop_id],
    σd₁' := by simp only [← unop_comp, d₁σ, unop_id], }
end

end pre_path_object

namespace precylinder

variable {A}

@[simps]
def op (P : precylinder A) : pre_path_object (op A) :=
begin
  haveI : weak_eq P.σ.op := weak_eq.op infer_instance,
  exact
  { I := op P.I,
    d₀ := P.d₀.op,
    d₁ := P.d₁.op,
    σ := P.σ.op,
    d₀σ' := by simp only [← op_comp, σd₀, op_id],
    d₁σ' := by simp only [← op_comp, σd₁, op_id], }
end

@[simps]
def unop {A : Cᵒᵖ} (P : precylinder A) : pre_path_object (unop A) :=
begin
  haveI : weak_eq P.σ.unop := weak_eq.unop infer_instance,
  exact
  { I := unop P.I,
    d₀ := P.d₀.unop,
    d₁ := P.d₁.unop,
    σ := P.σ.unop,
    d₀σ' := by simp only [← unop_comp, σd₀, unop_id],
    d₁σ' := by simp only [← unop_comp, σd₁, unop_id], }
end

lemma unop_op (P : precylinder A) : P.op.unop = P := by { cases P, refl, }
lemma op_unop {A : Cᵒᵖ} (P : precylinder A) : P.unop.op = P := by { cases P, refl, }

end precylinder

namespace pre_path_object

variables {B} (P : pre_path_object B)

lemma unop_op : P.op.unop = P := by { cases P, refl, }
lemma op_unop {B : Cᵒᵖ} (P : precylinder B) : P.unop.op = P := by { cases P, refl, }

instance weq_d₀ : weak_eq P.d₀ := weak_eq.unop (infer_instance : weak_eq P.op.d₀)
instance weq_d₁ : weak_eq P.d₁ := weak_eq.unop (infer_instance : weak_eq P.op.d₁)

@[simps]
def change_I {I' : C} {f : I' ⟶ P.I} {g : B ⟶ I'} (fac : g ≫ f = P.σ) [weak_eq f] :
  pre_path_object B :=
begin
  haveI : weak_eq f.op := weak_eq.op infer_instance,
  have eq : f.op ≫ g.op = P.σ.op := by rw [← op_comp, fac],
  exact (P.op.change_I eq).unop,
end

@[simp]
def π := prod.lift P.d₀ P.d₁

lemma fibration_π_iff_cofibration_op_ι (P : pre_path_object B) :
  fibration P.π ↔ cofibration P.op.ι :=
by simpa only [fibration.iff_op]
  using cofibration.respects_iso _ _ (arrow.iso_op_prod_lift P.d₀ P.d₁)

lemma fibration_π_iff_cofibration_unop_ι {B : Cᵒᵖ} (P : pre_path_object B) :
  fibration P.π ↔ cofibration P.unop.ι :=
by simpa only [fibration.iff_unop]
  using cofibration.respects_iso _ _ (arrow.iso_unop_prod_lift P.d₀ P.d₁)

@[simps]
def symm : pre_path_object B :=
{ I := P.I,
  d₀ := P.d₁,
  d₁ := P.d₀,
  σ := P.σ, }

end pre_path_object

structure path_object extends pre_path_object B :=
[fib_π : fibration to_pre_path_object.π]

namespace path_object

variable {B}

def mk' (P : pre_path_object B) (h : fibration P.π) : path_object B :=
by { haveI := h, exact mk P, }

abbreviation pre (Q : path_object B) := Q.to_pre_path_object

instance (Q : path_object B) : fibration Q.pre.π := Q.fib_π

@[simps]
def change_I {B : C} (P : path_object B) {Z : C} {f : B ⟶ Z} {g : Z ⟶ P.I}
  (fac : f ≫ g = P.σ) [fibration g] [weak_eq g] : path_object B :=
begin
  haveI : fibration (P.pre.change_I fac).π,
  { convert (infer_instance : fibration (g ≫ P.π)),
    simp only [pre_path_object.π, pre_path_object.change_I_d₀,
      pre_path_object.change_I_d₁, prod.comp_lift], },
  exact path_object.mk (P.pre.change_I fac),
end

end path_object

namespace cylinder

@[simps]
def unop {A : Cᵒᵖ} (Q : cylinder A) : path_object A.unop :=
begin
  apply path_object.mk' Q.pre.unop,
  rw [pre_path_object.fibration_π_iff_cofibration_op_ι, precylinder.op_unop],
  apply_instance,
end

variable {A}

@[simps]
def op (Q : cylinder A) : path_object (op A) :=
begin
  apply path_object.mk' Q.pre.op,
  rw [pre_path_object.fibration_π_iff_cofibration_unop_ι, precylinder.unop_op],
  apply_instance,
end

end cylinder

namespace path_object

variable {B}

@[simps]
def op (Q : path_object B) : cylinder (op B) :=
begin
  apply cylinder.mk' Q.pre.op,
  rw ← Q.pre.fibration_π_iff_cofibration_op_ι,
  apply_instance,
end

@[simps]
def unop {B : Cᵒᵖ} (Q : path_object B) : cylinder B.unop :=
begin
  apply cylinder.mk' Q.pre.unop,
  rw ← Q.pre.fibration_π_iff_cofibration_unop_ι,
  apply_instance,
end

variable (B)

def some : path_object B := (cylinder.some (opposite.op B)).unop

instance : cofibration (some B).σ := by { dsimp [some], apply fibration.unop, apply_instance, }
instance [is_cofibrant B] : is_cofibrant (some B).I :=
begin
  change cofibration _,
  rw subsingleton.elim (initial.to ((some B).I)) (initial.to _ ≫ (some B).σ),
  apply_instance,
end

instance : inhabited (path_object B) := ⟨some B⟩
instance : inhabited (pre_path_object B) := ⟨(some B).pre⟩

variable {B}

@[simp]
def symm (P : path_object B) : path_object B := P.op.symm.unop

@[simps]
def trans [hB : is_fibrant B] (P P' : path_object B) : path_object B :=
by { haveI := hB.op, exact (P.op.trans P'.op).unop, }
/- TODO : use change_I to replace the dual of the pushout by a pullback -/

end path_object

end model_category

end algebraic_topology