/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module data.fun_like.basic
! leanprover-community/mathlib commit a148d797a1094ab554ad4183a4ad6f130358ef64
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Function.Basic
import Mathlib.Tactic.NormCast

/-!
# Typeclass for a type `F` with an injective map to `A → B`

This typeclass is primarily for use by homomorphisms like `MonoidHom` and `LinearMap`.

## Basic usage of `FunLike`

A typical type of morphisms should be declared as:
```
structure MyHom (A B : Type _) [MyClass A] [MyClass B] :=
(toFun : A → B)
(map_op' : ∀ {x y : A}, toFun (MyClass.op x y) = MyClass.op (toFun x) (toFun y))

namespace MyHom

variables (A B : Type _) [MyClass A] [MyClass B]

-- This instance is optional if you follow the "morphism class" design below:
instance : FunLike (MyHom A B) A (λ _, B) :=
{ coe := MyHom.toFun, coe_injective' := λ f g h, by cases f; cases g; congr' }

/-- Helper instance for when there's too many metavariables to apply
`FunLike.coe` directly. -/
instance : CoeFun (MyHom A B) (λ _, A → B) := ⟨MyHom.toFun⟩

@[ext] theorem ext {f g : MyHom A B} (h : ∀ x, f x = g x) : f = g := FunLike.ext f g h

/-- Copy of a `MyHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : MyHom A B) (f' : A → B) (h : f' = ⇑f) : MyHom A B :=
{ toFun := f',
  map_op' := h.symm ▸ f.map_op' }

end MyHom
```

This file will then provide a `CoeFun` instance and various
extensionality and simp lemmas.

## Morphism classes extending `FunLike`

The `FunLike` design provides further benefits if you put in a bit more work.
The first step is to extend `FunLike` to create a class of those types satisfying
the axioms of your new type of morphisms.
Continuing the example above:

```
/-- `MyHomClass F A B` states that `F` is a type of `MyClass.op`-preserving morphisms.
You should extend this class when you extend `MyHom`. -/
class MyHomClass (F : Type _) (A B : outParam <| Type _) [MyClass A] [MyClass B]
  extends FunLike F A (λ _, B) :=
(map_op : ∀ (f : F) (x y : A), f (MyClass.op x y) = MyClass.op (f x) (f y))

@[simp] lemma map_op {F A B : Type _} [MyClass A] [MyClass B] [MyHomClass F A B]
  (f : F) (x y : A) : f (MyClass.op x y) = MyClass.op (f x) (f y) :=
MyHomClass.map_op

-- You can replace `MyHom.FunLike` with the below instance:
instance : MyHomClass (MyHom A B) A B :=
{ coe := MyHom.toFun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_op := MyHom.map_op' }

-- [Insert `CoeFun`, `ext` and `copy` here]
```

The second step is to add instances of your new `MyHomClass` for all types extending `MyHom`.
Typically, you can just declare a new class analogous to `MyHomClass`:

```
structure CoolerHom (A B : Type _) [CoolClass A] [CoolClass B]
  extends MyHom A B :=
(map_cool' : toFun CoolClass.cool = CoolClass.cool)

class CoolerHomClass (F : Type _) (A B : outParam <| Type _) [CoolClass A] [CoolClass B]
  extends MyHomClass F A B :=
(map_cool : ∀ (f : F), f CoolClass.cool = CoolClass.cool)

@[simp] lemma map_cool {F A B : Type _} [CoolClass A] [CoolClass B] [CoolerHomClass F A B]
  (f : F) : f CoolClass.cool = CoolClass.cool :=
MyHomClass.map_op

-- You can also replace `MyHom.FunLike` with the below instance:
instance : CoolerHomClass (CoolHom A B) A B :=
{ coe := CoolHom.toFun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_op := CoolHom.map_op',
  map_cool := CoolHom.map_cool' }

-- [Insert `CoeFun`, `ext` and `copy` here]
```

Then any declaration taking a specific type of morphisms as parameter can instead take the
class you just defined:
```
-- Compare with: lemma do_something (f : MyHom A B) : sorry := sorry
lemma do_something {F : Type _} [MyHomClass F A B] (f : F) : sorry := sorry
```

This means anything set up for `MyHom`s will automatically work for `CoolerHomClass`es,
and defining `CoolerHomClass` only takes a constant amount of effort,
instead of linearly increasing the work per `MyHom`-related declaration.

-/

-- This instance should have low priority, to ensure we follow the chain
-- `FunLike → CoeFun`
-- Porting note: this is an elaboration detail from Lean 3, we are going to disable it
-- until it is clearer what the Lean 4 elaborator needs.
-- attribute [instance, priority 10] coe_fn_trans

/-- The class `FunLike F α β` expresses that terms of type `F` have an
injective coercion to functions from `α` to `β`.

This typeclass is used in the definition of the homomorphism typeclasses,
such as `ZeroHomClass`, `MulHomClass`, `MonoidHomClass`, ....
-/
@[notation_class * toFun Simps.findCoercionArgs]
class FunLike (F : Sort _) (α : outParam (Sort _)) (β : outParam <| α → Sort _) where
  /-- The coercion from `F` to a function. -/
  coe : F → ∀ a : α, β a
  /-- The coercion to functions must be injective. -/
  coe_injective' : Function.Injective coe
#align fun_like FunLike

section Dependent

/-! ### `FunLike F α β` where `β` depends on `a : α` -/

variable (F α : Sort _) (β : α → Sort _)

namespace FunLike

variable {F α β} [i : FunLike F α β]

instance (priority := 100) hasCoeToFun : CoeFun F fun _ ↦ ∀ a : α, β a where coe := FunLike.coe

#eval Lean.Elab.Command.liftTermElabM do
  Std.Tactic.Coe.registerCoercion ``FunLike.coe
    (some { numArgs := 5, coercee := 4, type := .coeFun })

-- @[simp] -- porting note: this loops in lean 4
theorem coe_eq_coe_fn : (FunLike.coe (F := F)) = (fun f => ↑f) := rfl
#align fun_like.coe_eq_coe_fn FunLike.coe_eq_coe_fn

theorem coe_injective : Function.Injective (fun f : F ↦ (f : ∀ a : α, β a)) :=
  FunLike.coe_injective'
#align fun_like.coe_injective FunLike.coe_injective

@[simp]
theorem coe_fn_eq {f g : F} : (f : ∀ a : α, β a) = (g : ∀ a : α, β a) ↔ f = g :=
  ⟨fun h ↦ FunLike.coe_injective' h, fun h ↦ by cases h; rfl⟩
#align fun_like.coe_fn_eq FunLike.coe_fn_eq

theorem ext' {f g : F} (h : (f : ∀ a : α, β a) = (g : ∀ a : α, β a)) : f = g :=
  FunLike.coe_injective' h
#align fun_like.ext' FunLike.ext'

theorem ext'_iff {f g : F} : f = g ↔ (f : ∀ a : α, β a) = (g : ∀ a : α, β a) :=
  coe_fn_eq.symm
#align fun_like.ext'_iff FunLike.ext'_iff

theorem ext (f g : F) (h : ∀ x : α, f x = g x) : f = g :=
  FunLike.coe_injective' (funext h)
#align fun_like.ext FunLike.ext

theorem ext_iff {f g : F} : f = g ↔ ∀ x, f x = g x :=
  coe_fn_eq.symm.trans Function.funext_iff
#align fun_like.ext_iff FunLike.ext_iff

protected theorem congr_fun {f g : F} (h₁ : f = g) (x : α) : f x = g x :=
  congr_fun (congr_arg _ h₁) x
#align fun_like.congr_fun FunLike.congr_fun

theorem ne_iff {f g : F} : f ≠ g ↔ ∃ a, f a ≠ g a :=
  ext_iff.not.trans not_forall
#align fun_like.ne_iff FunLike.ne_iff

/-- This is not an instance to avoid slowing down every single `Subsingleton` typeclass search.-/
lemma subsingleton_cod [∀ a, Subsingleton (β a)] : Subsingleton F :=
⟨fun _ _ ↦ coe_injective $ Subsingleton.elim _ _⟩
#align fun_like.subsingleton_cod FunLike.subsingleton_cod

end FunLike

end Dependent

section NonDependent

/-! ### `FunLike F α (λ _, β)` where `β` does not depend on `a : α` -/

variable {F α β : Sort _} [i : FunLike F α fun _ ↦ β]

namespace FunLike

protected theorem congr {f g : F} {x y : α} (h₁ : f = g) (h₂ : x = y) : f x = g y :=
  congr (congr_arg _ h₁) h₂
#align fun_like.congr FunLike.congr

protected theorem congr_arg (f : F) {x y : α} (h₂ : x = y) : f x = f y :=
  congr_arg _ h₂
#align fun_like.congr_arg FunLike.congr_arg

end FunLike

end NonDependent


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module tactic.apply
! leanprover-community/mathlib commit 8f6fd1b69096c6a587f745d354306c0d46396915
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Core

/-!
This file provides an alternative implementation for `apply` to fix the so-called "apply bug".

The issue arises when the goals is a Π-type -- whether it is visible or hidden behind a definition.

For instance, consider the following proof:

```
example {α β} (x y z : α → β) (h₀ : x ≤ y) (h₁ : y ≤ z) : x ≤ z :=
begin
  apply le_trans,
end
```

Because `x ≤ z` is definitionally equal to `∀ i, x i ≤ z i`, `apply` will fail. The alternative
definition, `apply'` fixes this. When `apply` would work, `apply` is used and otherwise,
a different strategy is deployed
-/

namespace Tactic

/-- With `gs` a list of proof goals, `reorder_goals gs new_g` will use the `new_goals` policy
`new_g` to rearrange the dependent goals to either drop them, push them to the end of the list
or leave them in place. The `bool` values in `gs` indicates whether the goal is dependent or not. -/
def reorderGoals {α} (gs : List (Bool × α)) : NewGoals → List α
  | new_goals.non_dep_first =>
    let ⟨dep, non_dep⟩ := gs.partitionₓ (coe ∘ Prod.fst)
    non_dep.map Prod.snd ++ dep.map Prod.snd
  | new_goals.non_dep_only => (gs.filterₓ (coe ∘ not ∘ Prod.fst)).map Prod.snd
  | new_goals.all => gs.map Prod.snd
#align tactic.reorder_goals Tactic.reorderGoals

private unsafe def has_opt_auto_param_inst_for_apply (ms : List (Name × expr)) : tactic Bool :=
  ms.foldlM
    (fun r m => do
      let type ← infer_type m.2
      let b ← is_class type
      return <| r || type `opt_param 2 || type `auto_param 2 || b)
    false
#align tactic.has_opt_auto_param_inst_for_apply tactic.has_opt_auto_param_inst_for_apply

private unsafe def try_apply_opt_auto_param_instance_for_apply (cfg : ApplyCfg)
    (ms : List (Name × expr)) : tactic Unit :=
  whenM (has_opt_auto_param_inst_for_apply ms) do
    let gs ← get_goals
    ms fun m =>
        whenM (not <$> is_assigned m.2) <|
          ((set_goals [m.2] >> try apply_instance) >> when cfg (try apply_opt_param)) >>
            when cfg (try apply_auto_param)
    set_goals gs
#align tactic.try_apply_opt_auto_param_instance_for_apply tactic.try_apply_opt_auto_param_instance_for_apply

private unsafe def retry_apply_aux :
    ∀ (e : expr) (cfg : ApplyCfg), List (Bool × Name × expr) → tactic (List (Name × expr))
  | e, cfg, gs =>
    (focus1 do
        let tgt : expr ← target
        let t ← infer_type e
        unify t tgt
        exact e
        let gs' ← get_goals
        let r := reorderGoals gs.reverse cfg.NewGoals
        set_goals (gs' ++ r Prod.snd)
        return r) <|>
      do
      let expr.pi n bi d b ← infer_type e >>= whnf |
        apply_core e cfg
      let v ← mk_meta_var d
      let b := b.has_var
      let e ← head_beta <| e v
      retry_apply_aux e cfg ((b, n, v) :: gs)
#align tactic.retry_apply_aux tactic.retry_apply_aux

private unsafe def retry_apply (e : expr) (cfg : ApplyCfg) : tactic (List (Name × expr)) :=
  apply_core e cfg <|> retry_apply_aux e cfg []
#align tactic.retry_apply tactic.retry_apply

/-- `apply'` mimics the behavior of `apply_core`. When
`apply_core` fails, it is retried by providing the term with meta
variables as additional arguments. The meta variables can then
become new goals depending on the `cfg.new_goals` policy.

`apply'` also finds instances and applies opt_params and auto_params. -/
unsafe def apply' (e : expr) (cfg : ApplyCfg := { }) : tactic (List (Name × expr)) := do
  let r ← retry_apply e cfg
  try_apply_opt_auto_param_instance_for_apply cfg r
  return r
#align tactic.apply' tactic.apply'

/-- Same as `apply'` but __all__ arguments that weren't inferred are added to goal list. -/
unsafe def fapply' (e : expr) : tactic (List (Name × expr)) :=
  apply' e { NewGoals := NewGoals.all }
#align tactic.fapply' tactic.fapply'

/-- Same as `apply'` but only goals that don't depend on other goals are added to goal list. -/
unsafe def eapply' (e : expr) : tactic (List (Name × expr)) :=
  apply' e { NewGoals := NewGoals.non_dep_only }
#align tactic.eapply' tactic.eapply'

/-- `relation_tactic` finds a proof rule for the relation found in the goal and uses `apply'`
to make one proof step. -/
private unsafe def relation_tactic (md : Transparency) (op_for : environment → Name → Option Name)
    (tac_name : String) : tactic Unit := do
  let tgt ← target >>= instantiate_mvars
  let env ← get_env
  let r := expr.get_app_fn tgt
  match op_for env (expr.const_name r) with
    | some refl => do
      let r ← mk_const refl
      retry_apply r
          { md
            NewGoals := new_goals.non_dep_only }
      return ()
    | none =>
      fail <|
        tac_name ++
          " tactic failed, target is not a relation application with the expected property."
#align tactic.relation_tactic tactic.relation_tactic

/-- Similar to `reflexivity` with the difference that `apply'` is used instead of `apply` -/
unsafe def reflexivity' (md := semireducible) : tactic Unit :=
  relation_tactic md environment.refl_for "reflexivity"
#align tactic.reflexivity' tactic.reflexivity'

/-- Similar to `symmetry` with the difference that `apply'` is used instead of `apply` -/
unsafe def symmetry' (md := semireducible) : tactic Unit :=
  relation_tactic md environment.symm_for "symmetry"
#align tactic.symmetry' tactic.symmetry'

/-- Similar to `transitivity` with the difference that `apply'` is used instead of `apply` -/
unsafe def transitivity' (md := semireducible) : tactic Unit :=
  relation_tactic md environment.trans_for "transitivity"
#align tactic.transitivity' tactic.transitivity'

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- Similarly to `apply`, the `apply'` tactic tries to match the current goal against the conclusion
of the type of term.

It differs from `apply` in that it does not unfold definition in order to find out what the
assumptions of the provided term is. It is especially useful when defining relations on function
spaces (e.g. `≤`) so that rules like transitivity on `le : (α → β) → (α → β) → (α → β)` will be
considered to have three parameters and two assumptions (i.e. `f g h : α → β`, `H₀ : f ≤ g`,
`H₁ : g ≤ h`) instead of three parameters, two assumptions and then one more parameter
(i.e. `f g h : α → β`, `H₀ : f ≤ g`, `H₁ : g ≤ h`, `x : α`). Whereas `apply` would expect the goal
`f x ≤ h x`, `apply'` will work with the goal `f ≤ h`.
-/
unsafe def apply' (q : parse texpr) : tactic Unit :=
  concat_tags do
    let h ← i_to_expr_for_apply q
    tactic.apply' h
#align tactic.interactive.apply' tactic.interactive.apply'

/-- Similar to the `apply'` tactic, but does not reorder goals.
-/
unsafe def fapply' (q : parse texpr) : tactic Unit :=
  concat_tags (i_to_expr_for_apply q >>= tactic.fapply')
#align tactic.interactive.fapply' tactic.interactive.fapply'

/--
Similar to the `apply'` tactic, but only creates subgoals for non-dependent premises that have not
been fixed by type inference or type class resolution.
-/
unsafe def eapply' (q : parse texpr) : tactic Unit :=
  concat_tags (i_to_expr_for_apply q >>= tactic.eapply')
#align tactic.interactive.eapply' tactic.interactive.eapply'

/--
Similar to the `apply'` tactic, but allows the user to provide a `apply_cfg` configuration object.
-/
unsafe def apply_with' (q : parse parser.pexpr) (cfg : ApplyCfg) : tactic Unit :=
  concat_tags do
    let e ← i_to_expr_for_apply q
    tactic.apply' e cfg
#align tactic.interactive.apply_with' tactic.interactive.apply_with'

/-- Similar to the `apply'` tactic, but uses matching instead of unification.
`mapply' t` is equivalent to `apply_with' t {unify := ff}`
-/
unsafe def mapply' (q : parse texpr) : tactic Unit :=
  concat_tags do
    let e ← i_to_expr_for_apply q
    tactic.apply' e { unify := ff }
#align tactic.interactive.mapply' tactic.interactive.mapply'

/-- Similar to `reflexivity` with the difference that `apply'` is used instead of `apply`.
-/
unsafe def reflexivity' : tactic Unit :=
  tactic.reflexivity'
#align tactic.interactive.reflexivity' tactic.interactive.reflexivity'

/-- Shorter name for the tactic `reflexivity'`.
-/
unsafe def refl' : tactic Unit :=
  tactic.reflexivity'
#align tactic.interactive.refl' tactic.interactive.refl'

/--
`symmetry'` behaves like `symmetry` but also offers the option `symmetry' at h` to apply symmetry
to assumption `h`
-/
unsafe def symmetry' : parse location → tactic Unit
  | l@loc.wildcard => l.try_apply symmetry_hyp tactic.symmetry'
  | loc.ns hs => (Loc.ns hs.reverse).apply symmetry_hyp tactic.symmetry'
#align tactic.interactive.symmetry' tactic.interactive.symmetry'

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- Similar to `transitivity` with the difference that `apply'` is used instead of `apply`.
-/
unsafe def transitivity' (q : parse (parser.optional texpr)) : tactic Unit :=
  tactic.transitivity' >>
    match q with
    | none => skip
    | some q => do
      let (r, lhs, rhs) ← target_lhs_rhs
      let t ← infer_type lhs
      i_to_expr ``(($(q) : $(t))) >>= unify rhs
#align tactic.interactive.transitivity' tactic.interactive.transitivity'

end Interactive

end Tactic


/-
Copyright (c) 2020 Dany Fabian. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Dany Fabian
-/

import tactic.split_ifs
/-!
  # Unfold cases tactic

  In Lean, pattern matching expressions are not atomic parts of the syntax, but
  rather they are compiled down into simpler terms that are later checked by the kernel.

  This allows Lean to have a minimalistic kernel but can occasionally lead an explosion
  of cases that need to be considered. What looks like one case in the `match` expression
  can in fact be compiled into many different cases that all need to proved by case analysis.

  This tactic automates the process by allowing us to write down an equation `f x = y`
  where we know that `f x = y` is provably true, but does not hold definitionally. In that
  case the `unfold_cases` tactic will continue unfolding `f` and introducing `cases` where
  necessary until the left hand side becomes definitionally equal to the right hand side.

  Consider a definition as follows:

  ```lean
  def myand : bool → bool → bool
  | ff _ := ff
  | _ ff := ff
  | _ _ := tt
  ```

  The equation compiler generates 4 equation lemmas for us:
  ```lean
  myand ff ff = ff
  myand ff tt = ff
  myand tt ff = ff
  myand tt tt = tt
  ```

  This is not in line with what one might expect looking at the definition.
  Whilst it is provably true, that `∀ x, myand ff x = ff` and `∀ x, myand x ff = ff`,
  we do not get these stronger lemmas from the compiler for free but must in fact
  prove them using `cases` or some other local reasoning.

  In other words, the following does not constitute a proof that lean accepts.
  ```lean
  example : ∀ x, myand ff x = ff :=
  begin
    intros, refl
  end
  ```

  However, you can use `unfold_cases { refl }` to prove `∀ x, myand ff x = ff` and
  `∀ x, myand x ff = ff`. For definitions with many cases, the savings can be very
  significant.

  The term that gets generated for the above definition looks like this:
  ```lean
  λ (a a_1 : bool),
  a.cases_on
    (a_1.cases_on (id_rhs bool ff) (id_rhs bool ff))
    (a_1.cases_on (id_rhs bool ff) (id_rhs bool tt))
  ```

  When the tactic tries to prove the goal `∀ x, myand ff x = ff`, it starts by `intros`,
  followed by unfolding the definition:
  ```lean
  ⊢ ff.cases_on
    (x.cases_on (id_rhs bool ff) (id_rhs bool ff))
    (x.cases_on (id_rhs bool ff) (id_rhs bool tt)) = ff
  ```

  At this point, it can make progress using `dsimp`. But then it gets stuck:
  ```lean
  ⊢ bool.rec (id_rhs bool ff) (id_rhs bool ff) x = ff
  ```

  Next, it can introduce a case split on `x`. At this point, it has to prove two
  goals:
  ```lean
  ⊢ bool.rec (id_rhs bool ff) (id_rhs bool ff) ff = ff
  ⊢ bool.rec (id_rhs bool ff) (id_rhs bool ff) tt = ff
  ```

  Now, however, both goals can be discharged using `refl`.
-/
namespace tactic
open expr
namespace unfold_cases
/--
  Given an equation `f x = y`, this tactic tries to infer an expression that can be
  used to do distinction by cases on to make progress.

  Pre-condition: assumes that the outer-most application cannot be beta-reduced
  (e.g. `whnf` or `dsimp`).
-/
meta def find_splitting_expr : expr → tactic expr
| `(@ite _ %%cond %%dec_inst _ _ = _) := pure `(@decidable.em %%cond %%dec_inst)
| `(%%(app x y) = _) := pure y
| e := fail!"expected an expression of the form: f x = y. Got:\n{e}"

/--
  Tries to finish the current goal using the `inner` tactic. If the tactic
  fails, it tries to find an expression on which to do a distinction by
  cases and calls itself recursively.

  The order of operations is significant. Because the unfolding can potentially
  be infinite, it is important to apply the `inner` tactic at every step.

  Notice, that if the `inner` tactic succeeds, the recursive unfolding is stopped.
-/
meta def unfold_cases_core (inner : interactive.itactic) : tactic unit :=
inner <|>
(do split_ifs [], all_goals unfold_cases_core, skip) <|>
do
  tgt ← target,
  e ← find_splitting_expr tgt,
  focus1 $ do
    cases e,
    all_goals $ (dsimp_target >> unfold_cases_core) <|> skip,
    skip

/--
  Given a target of the form `⊢ f x₁ ... xₙ = y`, unfolds `f` using a delta reduction.
-/
meta def unfold_tgt : expr → tactic unit
| `(%%l@(app _ _) = %%r) :=
  match l.get_app_fn with
  | const n ls := delta_target [n]
  | e := fail!"couldn't unfold:\n{e}"
  end
| e := fail!"expected an expression of the form: f x = y. Got:\n{e}"
end unfold_cases

namespace interactive
open unfold_cases

/--
  This tactic unfolds the definition of a function or `match` expression.
  Then it recursively introduces a distinction by cases. The decision what expression
  to do the distinction on is driven by the pattern matching expression.

  A typical use case is using `unfold_cases { refl }` to collapse cases that need to be
  considered in a pattern matching.

  ```lean
  have h : foo x = y, by unfold_cases { refl },
  rw h,
  ```

  The tactic expects a goal in the form of an equation, possibly universally quantified.

  We can prove a theorem, even if the various case do not directly correspond to the
  function definition. Here is an example application of the tactic:

  ```lean
  def foo : ℕ → ℕ → ℕ
  | 0     0 := 17
  | (n+2) 17 := 17
  | 1     0 := 23
  | 0     (n+18) := 15
  | 0     17 := 17
  | 1     17 := 17
  | _     (n+18) := 27
  | _     _ := 15

  example : ∀ x, foo x 17 = 17 :=
  begin
    unfold_cases { refl },
  end
  ```

  The compiler generates 57 cases for `foo`. However, when we look at the definition, we see
  that whenever the function is applied to `17` in the second argument, it returns `17`.

  Proving this property consists of merely considering all the cases, eliminating invalid ones
  and applying `refl` on the ones which remain.

  Further examples can be found in `test/unfold_cases.lean`.
-/
meta def unfold_cases (inner : itactic) : tactic unit := focus1 $ do
  tactic.intros,
  tgt ← target,
  unfold_tgt tgt,
  try dsimp_target,
  unfold_cases_core inner

add_tactic_doc
{ name       := "unfold_cases",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.unfold_cases],
  tags       := ["induction", "case bashing"] }

end interactive
end tactic


/-
Copyright (c) 2021 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner
-/
import Lean
import Mathlib.Logic.Nonempty

/-!
# Once-per-file cache for tactics

This file defines cache data structures for tactics
that are initialized the first time they are accessed.
Since Lean 4 starts one process per file,
these caches are once-per-file
and can for example be used to cache information
about the imported modules.

The `Cache α` data structure is
the most generic version we define.
It is created using `Cache.mk f`
where `f : MetaM α` performs
the initialization of the cache:
```
initialize numberOfImports : Cache Nat ← Cache.mk do
  (← getEnv).imports.size

-- (does not work in the same module where the cache is defined)
#eval show MetaM Nat from numberOfImports.get
```

The `DeclCache α` data structure computes
a fold over the environment's constants:
`DeclCache.mk empty f` constructs such a cache
where `empty : α` and `f : Name → ConstantInfo → α → MetaM α`.
The result of the constants in the imports is cached
between tactic invocations,
while for constants defined in the same file
`f` is evaluated again every time.
This kind of cache can be used e.g.
to populate discrimination trees.
-/

open Lean Meta

namespace Mathlib.Tactic

/-- Once-per-file cache. -/
def Cache (α : Type) :=
  IO.Ref <| Sum (MetaM α) <|
    Task <| Except Exception α

instance : Nonempty (Cache α) :=
  inferInstanceAs <| Nonempty (IO.Ref _)

/-- Creates a cache with an initialization function. -/
def Cache.mk (init : MetaM α) : IO (Cache α) :=
  IO.mkRef <| Sum.inl init

/--
Access the cache.
Calling this function for the first time
will initialize the cache with the function
provided in the constructor.
-/
def Cache.get [Monad m] [MonadEnv m] [MonadLog m] [MonadOptions m] [MonadLiftT BaseIO m]
    [MonadExcept Exception m] (cache : Cache α) : m α := do
  let t ← match ← show BaseIO _ from ST.Ref.get cache with
    | Sum.inr t => pure t
    | Sum.inl init =>
      let env ← getEnv
      let fileName ← getFileName
      let fileMap ← getFileMap
      let options ← getOptions -- TODO: sanitize options?
      -- Default heartbeats to a reasonable value.
      -- otherwise librarySearch times out on mathlib
      -- TODO: add customization option
      let options := Core.maxHeartbeats.set options <|
        options.get? Core.maxHeartbeats.name |>.getD 1000000
      let res ← EIO.asTask do
        let metaCtx : Meta.Context := {}
        let metaState : Meta.State := {}
        let coreCtx : Core.Context := {options, fileName, fileMap}
        let coreState : Core.State := {env}
        pure (← ((init ‹_›).run ‹_› ‹_›).run ‹_›).1.1
      show BaseIO _ from cache.set (Sum.inr res)
      pure res
  match t.get with
    | Except.ok res => pure res
    | Except.error err => throw err

/--
Cached fold over the environment's declarations,
where a given function is applied to `α` for every constant.
-/
def DeclCache (α : Type) :=
  Cache α × (Name → ConstantInfo → α → MetaM α)

instance : Nonempty (DeclCache α) :=
  inferInstanceAs <| Nonempty (_ × _)

/--
Creates a `DeclCache`.
The cached structure `α` is initialized with `empty`,
and then `addDecl` is called for every constant in the environment.
Calls to `addDecl` for imported constants are cached.
-/
def DeclCache.mk (profilingName : String) (empty : α)
    (addDecl : Name → ConstantInfo → α → MetaM α) : IO (DeclCache α) := do
  let cache ← Cache.mk do
    profileitM Exception profilingName (← getOptions) do
    let mut a := empty
    for (n, c) in (← getEnv).constants.map₁.toList do
      a ← addDecl n c a
    return a
  pure (cache, addDecl)

/--
Access the cache.
Calling this function for the first time
will initialize the cache with the function
provided in the constructor.
-/
def DeclCache.get (cache : DeclCache α) : MetaM α := do
  let mut a ← cache.1.get
  for (n, c) in (← getEnv).constants.map₂.toList do
    a ← cache.2 n c a
  return a


import category_theory.preadditive.functor_category

import pseudo_normed_group.FP
import locally_constant.SemiNormedGroup
import locally_constant.Vhat

/-!

# The category of locally constant maps

Various constructions of pseudo-normed groups of locally constant functions.

## Main definitions

- `LC V`: the functor sending a profinite set `S` to the locally constant
  functions from `S` to `V`
- `LCFP V r' c n`: the functor sending a profinitely filtered pseudo-normed
  group with T⁻¹ to V(M_c^n), the locally constant functions from M_c^n to V.

-/
namespace category_theory
namespace nat_trans

@[simp] lemma op_comp {C D} [category C] [category D]
  {F G H : C ⥤ D} {α : F ⟶ G} {β : G ⟶ H} :
  nat_trans.op (α ≫ β) = nat_trans.op β ≫ nat_trans.op α := rfl

end nat_trans
end category_theory

open_locale classical nnreal big_operators
noncomputable theory
local attribute [instance] type_pow

open SemiNormedGroup opposite Profinite pseudo_normed_group category_theory breen_deligne
open profinitely_filtered_pseudo_normed_group

universe variable u
variables (r : ℝ≥0) (V : SemiNormedGroup) (r' : ℝ≥0)
variables (c c₁ c₂ c₃ c₄ : ℝ≥0) (l m n : ℕ)

/-- `LC V n` is the functor that sends a profinite set `S` to `V(S)` -/
def LC (V : SemiNormedGroup) : Profiniteᵒᵖ ⥤ SemiNormedGroup :=
LocallyConstant.obj V

namespace LC

lemma map_norm_noninc {M₁ M₂} (f : M₁ ⟶ M₂) : ((LC V).map f).norm_noninc :=
locally_constant.comap_hom_norm_noninc _ _

instance obj.normed_with_aut [normed_with_aut r V] [fact (0 < r)] (A : Profiniteᵒᵖ) :
  normed_with_aut r ((LC V).obj A) :=
SemiNormedGroup.normed_with_aut_LocallyConstant _ _ _

@[simps hom_app_apply inv_app_apply {fully_applied := ff}]
def T [normed_with_aut r V] : LC V ≅ LC V :=
LocallyConstant.map_iso normed_with_aut.T

lemma T_eq [normed_with_aut r V] [fact (0 < r)] (A) :
  (T r V).hom.app A = normed_with_aut.T.hom := rfl

lemma norm_T_le [normed_with_aut r V] [fact (0 < r)] (A) :
  ∥(LC.T r V).hom.app A∥ ≤ r :=
begin
  rw T_eq,
  refine normed_add_group_hom.op_norm_le_bound _ (nnreal.zero_le_coe) (λ v, _),
  exact le_of_eq (normed_with_aut.norm_T v)
end

@[simps {fully_applied := ff}]
def T_inv [normed_with_aut r V] [fact (0 < r)] : LC V ⟶ LC V :=
(LocallyConstant.map (normed_with_aut.T.inv : V ⟶ V) : _)

lemma T_inv_eq [normed_with_aut r V] [fact (0 < r)] : (T r V).inv = T_inv r V := rfl

lemma T_inv_eq' [normed_with_aut r V] [fact (0 < r)] (A) :
  (T_inv r V).app A = normed_with_aut.T.inv := rfl

lemma norm_T_inv_le [normed_with_aut r V] [fact (0 < r)] (A) :
  ∥(T_inv r V).app A∥ ≤ r⁻¹ :=
begin
  rw T_inv_eq',
  refine normed_add_group_hom.op_norm_le_bound _ (inv_nonneg.2 (nnreal.zero_le_coe)) (λ v, _),
  exact (normed_with_aut.norm_T_inv _ v).le
end

end LC

/-- The "functor" that sends `M` and `c` to `V((filtration M c)^n)` -/
def LCFP (V : SemiNormedGroup) (r' : ℝ≥0) (c : ℝ≥0) (n : ℕ) :
  (ProFiltPseuNormGrpWithTinv r')ᵒᵖ ⥤ SemiNormedGroup :=
(FiltrationPow r' c n).op ⋙ LC V

theorem LCFP_def (V : SemiNormedGroup) (r' : ℝ≥0) (c : ℝ≥0) (n : ℕ) :
  LCFP V r' c n = (FiltrationPow r' c n).op ⋙ LocallyConstant.obj V := rfl

namespace LCFP

lemma map_norm_noninc {M₁ M₂} (f : M₁ ⟶ M₂) : ((LCFP V r' c n).map f).norm_noninc :=
LC.map_norm_noninc _ _

@[simps {fully_applied := ff}]
def res (r' : ℝ≥0) (c₁ c₂ : ℝ≥0) [fact (c₂ ≤ c₁)] (n : ℕ) : LCFP V r' c₁ n ⟶ LCFP V r' c₂ n :=
(whisker_right (nat_trans.op (FiltrationPow.cast_le r' c₂ c₁ n)) (LocallyConstant.obj V) : _)

@[simp] lemma res_refl : res V r' c c n = 𝟙 _ :=
by { simp [res, FiltrationPow.cast_le_refl], refl }

lemma res_comp_res [h₁ : fact (c₃ ≤ c₂)] [h₂ : fact (c₂ ≤ c₁)] :
  res V r' c₁ c₂ n ≫ res V r' c₂ c₃ n = @res V r' c₁ c₃ ⟨le_trans h₁.1 h₂.1⟩ n :=
by simp only [res, ← whisker_right_comp, ← nat_trans.op_comp, FiltrationPow.cast_le_comp]

lemma res_norm_noninc [fact (c₂ ≤ c₁)] (M) : ((res V r' c₁ c₂ n).app M).norm_noninc :=
locally_constant.comap_hom_norm_noninc _ _

section Tinv
open profinitely_filtered_pseudo_normed_group_with_Tinv
variables [fact (0 < r')]

@[simps {fully_applied := ff}]
def Tinv [fact (c₂ ≤ r' * c₁)] : LCFP V r' c₁ n ⟶ LCFP V r' c₂ n :=
(whisker_right (nat_trans.op $ FiltrationPow.Tinv r' c₂ c₁ n) (LocallyConstant.obj V) : _)

lemma Tinv_def [fact (c₂ ≤ r' * c₁)] : Tinv V r' c₁ c₂ n =
  whisker_right (nat_trans.op $ FiltrationPow.Tinv r' c₂ c₁ n) (LC V) := rfl

lemma res_comp_Tinv
  [fact (c₂ ≤ c₁)] [fact (c₃ ≤ c₂)] [fact (c₂ ≤ r' * c₁)] [fact (c₃ ≤ r' * c₂)] :
  res V r' c₁ c₂ n ≫ Tinv V r' c₂ c₃ n = Tinv V r' c₁ c₂ n ≫ res V r' c₂ c₃ n :=
begin
  simp only [Tinv, res, ← whisker_right_comp, ← nat_trans.op_comp],
  refl
end

lemma Tinv_norm_noninc [fact (c₂ ≤ r' * c₁)] (M) : ((Tinv V r' c₁ c₂ n).app M).norm_noninc :=
locally_constant.comap_hom_norm_noninc _ _

end Tinv

section normed_with_aut

variables [normed_with_aut r V]

instance [fact (0 < r)] (M) : normed_with_aut r ((LCFP V r' c n).obj M) :=
LC.obj.normed_with_aut _ _ _

@[simps {fully_applied := ff}]
def T [fact (0 < r)] : LCFP V r' c n ≅ LCFP V r' c n :=
((whiskering_left _ _ _).obj _).map_iso $ LC.T _ _

@[simps app_apply {fully_applied := ff}]
def T_inv [fact (0 < r)] : LCFP V r' c n ⟶ LCFP V r' c n :=
(whisker_left _ (LC.T_inv r V) : _)

lemma T_inv_eq [fact (0 < r)] : (T r V r' c n).inv = T_inv r V r' c n := rfl

lemma T_inv_def [fact (0 < r)] :
  T_inv r V r' c n = (whisker_left  (FiltrationPow r' c n).op
      (LocallyConstant.map (normed_with_aut.T.inv : V ⟶ V)) : _) :=
rfl

end normed_with_aut

end LCFP

namespace breen_deligne

open LCFP

variables {l m n}

namespace basic_universal_map

variables (ϕ : basic_universal_map m n)

def eval_LCFP (c₁ c₂ : ℝ≥0) [ϕ.suitable c₂ c₁] : LCFP V r' c₁ n ⟶ LCFP V r' c₂ m :=
(whisker_right (nat_trans.op $ ϕ.eval_FP r' c₂ c₁) (LocallyConstant.obj V) : _)

def eval_LCFP' (c₁ c₂ : ℝ≥0) : LCFP V r' c₁ n ⟶ LCFP V r' c₂ m :=
if H : ϕ.suitable c₂ c₁
then by exactI (whisker_right (nat_trans.op $ ϕ.eval_FP r' c₂ c₁) (LocallyConstant.obj V) : _)
else 0

lemma eval_LCFP_eq_eval_LCFP' (h : ϕ.suitable c₂ c₁) :
  ϕ.eval_LCFP V r' c₁ c₂ = ϕ.eval_LCFP' V r' c₁ c₂ :=
by { delta eval_LCFP eval_LCFP', rw dif_pos h }

lemma eval_LCFP'_def [h : ϕ.suitable c₂ c₁] :
  ϕ.eval_LCFP' V r' c₁ c₂ =
    (whisker_right (nat_trans.op $ ϕ.eval_FP r' c₂ c₁) (LocallyConstant.obj V) : _) :=
dif_pos h

lemma eval_LCFP'_not_suitable (h : ¬ ϕ.suitable c₂ c₁) :
  ϕ.eval_LCFP' V r' c₁ c₂ = 0 :=
dif_neg h

lemma eval_LCFP'_comp (f : basic_universal_map m n) (g : basic_universal_map l m)
  [hf : f.suitable c₂ c₁] [hg : g.suitable c₃ c₂] :
  (basic_universal_map.comp f g).eval_LCFP' V r' c₁ c₃ = f.eval_LCFP' V r' c₁ c₂ ≫ g.eval_LCFP' V r' c₂ c₃ :=
begin
  haveI : (basic_universal_map.comp f g).suitable c₃ c₁ := suitable_comp c₂,
  simp only [eval_LCFP'_def, eval_FP_comp r' _ c₂, nat_trans.op_comp, whisker_right_comp]
end

lemma eval_LCFP_comp (f : basic_universal_map m n) (g : basic_universal_map l m)
  [hf : f.suitable c₂ c₁] [hg : g.suitable c₃ c₂] :
  @eval_LCFP V r' _ _ (basic_universal_map.comp f g) c₁ c₃ (suitable_comp c₂) =
    f.eval_LCFP V r' c₁ c₂ ≫ g.eval_LCFP V r' c₂ c₃ :=
by { simp only [eval_LCFP_eq_eval_LCFP'], apply eval_LCFP'_comp }

lemma res_comp_eval_LCFP
  [fact (c₂ ≤ c₁)] [fact (c₄ ≤ c₃)] [ϕ.suitable c₄ c₂] [ϕ.suitable c₃ c₁] :
  res V r' c₁ c₂ n ≫ ϕ.eval_LCFP V r' c₂ c₄ = ϕ.eval_LCFP V r' c₁ c₃ ≫ res V r' c₃ c₄ m :=
by simp only [res, eval_LCFP, ← whisker_right_comp, ← nat_trans.op_comp,
  cast_le_comp_eval_FP _ c₄ c₃ c₂ c₁]

lemma Tinv_comp_eval_LCFP [fact (0 < r')] [fact (c₂ ≤ r' * c₁)] [fact (c₄ ≤ r' * c₃)]
  [ϕ.suitable c₄ c₂] [ϕ.suitable c₃ c₁] :
  Tinv V r' c₁ c₂ n ≫ ϕ.eval_LCFP V r' c₂ c₄ = ϕ.eval_LCFP V r' c₁ c₃ ≫ Tinv V r' c₃ c₄ m :=
by simp only [Tinv, eval_LCFP, ← whisker_right_comp, ← nat_trans.op_comp,
  Tinv_comp_eval_FP _ _ c₄ c₃ c₂ c₁]

lemma T_inv_comp_eval_LCFP [normed_with_aut r V] [fact (0 < r)] [ϕ.suitable c₂ c₁] :
  T_inv r V r' c₁ n ≫ ϕ.eval_LCFP V r' c₁ c₂ = ϕ.eval_LCFP V r' c₁ c₂ ≫ T_inv r V r' c₂ m :=
begin
  ext M : 2,
  simp only [T_inv_def, eval_LCFP, nat_trans.comp_app,  whisker_right_app, whisker_left_app,
    nat_trans.naturality]
end

end basic_universal_map

namespace universal_map

open free_abelian_group

variables (ϕ : universal_map m n)

def eval_LCFP [ϕ.suitable c₂ c₁] : LCFP V r' c₁ n ⟶ LCFP V r' c₂ m :=
∑ g : {g : basic_universal_map m n // g ∈ ϕ.support},
  begin
    haveI := suitable_of_mem_support ϕ c₂ c₁ g g.2,
    exact coeff (g : basic_universal_map m n) ϕ • (basic_universal_map.eval_LCFP V r' g c₁ c₂)
  end

def eval_LCFP' : LCFP V r' c₁ n ⟶ LCFP V r' c₂ m :=
∑ g in ϕ.support, coeff g ϕ • (g.eval_LCFP' V r' c₁ c₂)

lemma eval_LCFP_eq_eval_LCFP' (h : ϕ.suitable c₂ c₁) :
  ϕ.eval_LCFP V r' c₁ c₂ = ϕ.eval_LCFP' V r' c₁ c₂ :=
begin
  simp only [eval_LCFP, eval_LCFP', basic_universal_map.eval_LCFP_eq_eval_LCFP',
    subtype.val_eq_coe],
  symmetry,
  apply finset.sum_subtype ϕ.support (λ _, iff.rfl),
end

@[simp] lemma eval_LCFP'_of (f : basic_universal_map m n) :
  eval_LCFP' V r' c₁ c₂ (of f) = f.eval_LCFP' V r' c₁ c₂ :=
by simp only [eval_LCFP', support_of, coeff_of_self, one_smul, finset.sum_singleton]

@[simp] lemma eval_LCFP_of (f : basic_universal_map m n) [f.suitable c₂ c₁] :
  eval_LCFP V r' c₁ c₂ (of f) = f.eval_LCFP V r' c₁ c₂ :=
by rw [eval_LCFP_eq_eval_LCFP', eval_LCFP'_of, basic_universal_map.eval_LCFP_eq_eval_LCFP']

@[simp] lemma eval_LCFP'_zero :
  (0 : universal_map m n).eval_LCFP' V r' c₁ c₂ = 0 :=
by rw [eval_LCFP', support_zero, finset.sum_empty]

@[simp] lemma eval_LCFP_zero :
  (0 : universal_map m n).eval_LCFP V r' c₁ c₂ = 0 :=
by rw [eval_LCFP_eq_eval_LCFP', eval_LCFP'_zero]

@[simp] lemma eval_LCFP'_neg (f : universal_map m n) :
  eval_LCFP' V r' c₁ c₂ (-f) = -f.eval_LCFP' V r' c₁ c₂ :=
by simp only [eval_LCFP', add_monoid_hom.map_neg, finset.sum_neg_distrib, neg_smul, support_neg]

@[simp] lemma eval_LCFP_neg (f : universal_map m n) [f.suitable c₂ c₁] :
  eval_LCFP V r' c₁ c₂ (-f) = -f.eval_LCFP V r' c₁ c₂ :=
by simp only [eval_LCFP_eq_eval_LCFP', eval_LCFP'_neg]

lemma eval_LCFP'_add (f g : universal_map m n) :
  eval_LCFP' V r' c₁ c₂ (f + g) = f.eval_LCFP' V r' c₁ c₂ + g.eval_LCFP' V r' c₁ c₂ :=
begin
  simp only [eval_LCFP'],
  rw finset.sum_subset (support_add f g), -- two goals
  simp only [add_monoid_hom.map_add _ f g, add_smul],
  convert finset.sum_add_distrib using 2, -- three goals
  apply finset.sum_subset (finset.subset_union_left _ _), swap,
  apply finset.sum_subset (finset.subset_union_right _ _),
  all_goals { rintros x - h, rw not_mem_support_iff at h, simp [h] },
end

lemma eval_LCFP_add (f g : universal_map m n) [f.suitable c₂ c₁] [g.suitable c₂ c₁] :
  eval_LCFP V r' c₁ c₂ (f + g) = f.eval_LCFP V r' c₁ c₂ + g.eval_LCFP V r' c₁ c₂ :=
by simp only [eval_LCFP_eq_eval_LCFP', eval_LCFP'_add]

lemma eval_LCFP_sub (f g : universal_map m n) [f.suitable c₂ c₁] [g.suitable c₂ c₁] :
  eval_LCFP V r' c₁ c₂ (f - g) = f.eval_LCFP V r' c₁ c₂ - g.eval_LCFP V r' c₁ c₂ :=
by simp only [sub_eq_add_neg, eval_LCFP_add, eval_LCFP_neg]

lemma eval_LCFP'_comp_of (g : basic_universal_map m n) (f : basic_universal_map l m)
  [hg : g.suitable c₂ c₁] [hf : f.suitable c₃ c₂] :
  eval_LCFP' V r' c₁ c₃ ((comp (of g)) (of f)) =
    eval_LCFP' V r' c₁ c₂ (of g) ≫ eval_LCFP' V r' c₂ c₃ (of f) :=
begin
  simp only [comp_of, eval_LCFP'_of],
  haveI hfg : (basic_universal_map.comp g f).suitable c₃ c₁ := basic_universal_map.suitable_comp c₂,
  rw ← basic_universal_map.eval_LCFP'_comp,
end

open category_theory category_theory.limits category_theory.preadditive

lemma eval_LCFP'_comp (g : universal_map m n) (f : universal_map l m)
  [hg : g.suitable c₂ c₁] [hf : f.suitable c₃ c₂] :
  (comp g f).eval_LCFP' V r' c₁ c₃ = g.eval_LCFP' V r' c₁ c₂ ≫ f.eval_LCFP' V r' c₂ c₃ :=
begin
  unfreezingI { revert hf },
  apply free_abelian_group.induction_on_free_predicate
    (suitable c₂ c₁) (suitable_free_predicate c₂ c₁) g hg; unfreezingI { clear_dependent g },
  { intros h₂,
    simp only [eval_LCFP'_zero, zero_comp, pi.zero_apply,
      add_monoid_hom.zero_apply, add_monoid_hom.map_zero] },
  { intros g hg hf,
    -- now do another nested induction on `f`
    apply free_abelian_group.induction_on_free_predicate
      (suitable c₃ c₂) (suitable_free_predicate c₃ c₂) f hf; unfreezingI { clear_dependent f },
    { simp only [eval_LCFP'_zero, comp_zero, add_monoid_hom.map_zero] },
    { intros f hf,
      rw suitable_of_iff at hf hg,
      resetI,
      apply eval_LCFP'_comp_of },
    { intros f hf IH,
      simp only [IH, eval_LCFP'_neg, add_monoid_hom.map_neg, comp_neg] },
    { rintros (f₁ : universal_map l m) (f₂ : universal_map l m) hf₁ hf₂ IH₁ IH₂, resetI,
      haveI Hg₁f : (comp (of g) f₁).suitable c₃ c₁ := suitable.comp c₂,
      haveI Hg₂f : (comp (of g) f₂).suitable c₃ c₁ := suitable.comp c₂,
      simp only [add_monoid_hom.map_add, eval_LCFP'_add, IH₁, IH₂, comp_add] } },
  { intros g hg IH hf, resetI, specialize IH,
    simp only [IH, add_monoid_hom.map_neg, eval_LCFP'_neg,
      add_monoid_hom.neg_apply, neg_inj, neg_comp] },
  { rintros (g₁ : universal_map m n) (g₂ : universal_map m n) hg₁ hg₂ IH₁ IH₂ hf, resetI,
    haveI Hg₁f : (comp g₁ f).suitable c₃ c₁ := suitable.comp c₂,
    haveI Hg₂f : (comp g₂ f).suitable c₃ c₁ := suitable.comp c₂,
    simp only [add_monoid_hom.map_add, add_monoid_hom.add_apply, eval_LCFP'_add, IH₁, IH₂, add_comp] }
end

lemma eval_LCFP_comp (g : universal_map m n) (f : universal_map l m)
  [hg : g.suitable c₂ c₁] [hf : f.suitable c₃ c₂] :
  @eval_LCFP V r' c₁ c₃ _ _ (comp g f) (suitable.comp c₂) =
    g.eval_LCFP V r' c₁ c₂ ≫ f.eval_LCFP V r' c₂ c₃ :=
by { simp only [eval_LCFP_eq_eval_LCFP'], apply eval_LCFP'_comp }

lemma res_comp_eval_LCFP [fact (c₂ ≤ c₁)] [fact (c₄ ≤ c₃)] [ϕ.suitable c₃ c₁] [ϕ.suitable c₄ c₂] :
  res V r' c₁ c₂ n ≫ ϕ.eval_LCFP V r' c₂ c₄ = ϕ.eval_LCFP V r' c₁ c₃ ≫ res V r' c₃ c₄ m :=
begin
  simp only [eval_LCFP, comp_sum, sum_comp, comp_zsmul, zsmul_comp],
  apply finset.sum_congr rfl,
  rintros ⟨g, hg⟩ -,
  haveI : g.suitable c₃ c₁ := suitable_of_mem_support ϕ _ _ g hg,
  haveI : g.suitable c₄ c₂ := suitable_of_mem_support ϕ _ _ g hg,
  simp only [subtype.coe_mk, g.res_comp_eval_LCFP V r' c₁ c₂ c₃ c₄],
end

lemma Tinv_comp_eval_LCFP [fact (0 < r')] [fact (c₂ ≤ r' * c₁)] [fact (c₄ ≤ r' * c₃)]
  [ϕ.suitable c₃ c₁] [ϕ.suitable c₄ c₂] :
  Tinv V r' c₁ c₂ n ≫ ϕ.eval_LCFP V r' c₂ c₄ = ϕ.eval_LCFP V r' c₁ c₃ ≫ Tinv V r' c₃ c₄ m :=
begin
  simp only [eval_LCFP, comp_sum, sum_comp, comp_zsmul, zsmul_comp],
  apply finset.sum_congr rfl,
  rintros ⟨g, hg⟩ -,
  haveI : g.suitable c₃ c₁ := suitable_of_mem_support ϕ _ _ g hg,
  haveI : g.suitable c₄ c₂ := suitable_of_mem_support ϕ _ _ g hg,
  congr' 1, apply basic_universal_map.Tinv_comp_eval_LCFP V r',
end

lemma T_inv_comp_eval_LCFP [normed_with_aut r V] [fact (0 < r)] [ϕ.suitable c₂ c₁] :
  T_inv r V r' c₁ n ≫ ϕ.eval_LCFP V r' c₁ c₂ =
    ϕ.eval_LCFP V r' c₁ c₂ ≫ T_inv r V r' c₂ m :=
begin
  simp only [eval_LCFP, comp_sum, sum_comp, comp_zsmul, zsmul_comp],
  apply finset.sum_congr rfl,
  rintros ⟨g, hg⟩ -,
  haveI : g.suitable c₂ c₁ := suitable_of_mem_support ϕ _ _ g hg,
  congr' 1,
  apply basic_universal_map.T_inv_comp_eval_LCFP r V r',
end

lemma norm_eval_LCFP_le [normed_with_aut r V] [fact (0 < r)] [ϕ.suitable c₂ c₁]
  (N : ℕ) (h : ϕ.bound_by N) (M) :
  ∥(ϕ.eval_LCFP V r' c₁ c₂).app M∥ ≤ N :=
begin
  rw [eval_LCFP_eq_eval_LCFP', eval_LCFP'],
  have : (∑ (g : basic_universal_map m n) in support ϕ, (coeff g ϕ).nat_abs : ℝ) ≤ N,
  { exact_mod_cast h },
  simp only [← nat_trans.app_hom_apply, add_monoid_hom.map_sum, add_monoid_hom.map_zsmul],
  refine le_trans (norm_sum_le_of_le ϕ.support _) this,
  intros g hg,
  have aux := ϕ.suitable_of_mem_support c₂ c₁ g hg,
  refine le_trans (norm_zsmul_le _ _) _,
  suffices : ∥(nat_trans.app_hom M) (basic_universal_map.eval_LCFP' V r' g c₁ c₂)∥ ≤ 1,
  { have aux₁ : ∥(coeff g) ϕ∥ = ↑(((coeff g) ϕ).nat_abs),
    { rw [@coe_coe ℕ ℤ ℝ _ _ _, ← int.abs_eq_nat_abs, int.cast_abs],
    refl },
    rw aux₁,
    exact mul_le_of_le_one_right ((coeff g) ϕ).nat_abs.cast_nonneg this },
  rw [← g.eval_LCFP_eq_eval_LCFP' V r' c₁ c₂, basic_universal_map.eval_LCFP],
  { apply normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1,
    exact locally_constant.comap_hom_norm_noninc _ _, exact aux },
end

end universal_map

end breen_deligne


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import logic.function.basic
import tactic.lint
import tactic.norm_cast

/-!
# Typeclass for a type `F` with an injective map to `A → B`

This typeclass is primarily for use by homomorphisms like `monoid_hom` and `linear_map`.

## Basic usage of `fun_like`

A typical type of morphisms should be declared as:
```
structure my_hom (A B : Type*) [my_class A] [my_class B] :=
(to_fun : A → B)
(map_op' : ∀ {x y : A}, to_fun (my_class.op x y) = my_class.op (to_fun x) (to_fun y))

namespace my_hom

variables (A B : Type*) [my_class A] [my_class B]

-- This instance is optional if you follow the "Hom class" design below:
instance : fun_like (my_hom A B) A (λ _, B) :=
{ coe := my_hom.to_fun, coe_injective' := λ f g h, by cases f; cases g; congr' }

/-- Helper instance for when there's too many metavariables to apply `to_fun.to_coe_fn` directly. -/
instance : has_coe_to_fun (my_hom A B) := to_fun.to_coe_fn

@[simp] lemma to_fun_eq_coe {f : my_hom A B} : f.to_fun = (f : A → B) := rfl

@[ext] theorem ext {f g : my_hom A B} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

/-- Copy of a `my_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : my_hom A B) (f' : A → B) (h : f' = ⇑f) : my_hom A B :=
{ to_fun := f',
  map_op' := h.symm ▸ f.map_op' }

end my_hom
```

This file will then provide a `has_coe_to_fun` instance and various
extensionality and simp lemmas.

## Hom classes extending `fun_like`

The `fun_like` design provides further benefits if you put in a bit more work.
The first step is to extend `fun_like` to create a class of those types satisfying
the axioms of your new type of morphisms.
Continuing the example above:

```
/-- `my_hom_class F A B` states that `F` is a type of `my_class.op`-preserving morphisms.
You should extend this class when you extend `my_hom`. -/
class my_hom_class (F : Type*) (A B : out_param $ Type*) [my_class A] [my_class B]
  extends fun_like F A (λ _, B) :=
(map_op : ∀ (f : F) (x y : A), f (my_class.op x y) = my_class.op (f x) (f y))

@[simp] lemma map_op {F A B : Type*} [my_class A] [my_class B] [my_hom_class F A B]
  (f : F) (x y : A) : f (my_class.op x y) = my_class.op (f x) (f y) :=
my_hom_class.map_op

-- You can replace `my_hom.fun_like` with the below instance, or keep both:
instance : my_hom_class (my_hom A B) A B :=
{ coe := my_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_op := my_hom.map_op' }

-- [Insert `has_coe_to_fun`, `to_fun_eq_coe`, `ext` and `copy` here]
```

The second step is to add instances of your new `my_hom_class` for all types extending `my_hom`.
Typically, you can just declare a new class analogous to `my_hom_class`:

```
structure cooler_hom (A B : Type*) [cool_class A] [cool_class B]
  extends my_hom A B :=
(map_cool' : to_fun cool_class.cool = cool_class.cool)

class cooler_hom_class (F : Type*) (A B : out_param $ Type*) [cool_class A] [cool_class B]
  extends my_hom_class F A B :=
(map_cool : ∀ (f : F), f cool_class.cool = cool_class.cool)

@[simp] lemma map_cool {F A B : Type*} [cool_class A] [cool_class B] [cooler_hom_class F A B]
  (f : F) : f cool_class.cool = cool_class.cool :=
my_hom_class.map_op

-- You can also replace `my_hom.fun_like` with the below instance:
instance : cool_hom_class (cool_hom A B) A B :=
{ coe := cool_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_op := cool_hom.map_op',
  map_cool := cool_hom.map_cool' }

-- [Insert `has_coe_to_fun`, `to_fun_eq_coe`, `ext` and `copy` here]
```

Then any declaration taking a specific type of morphisms as parameter can instead take the
class you just defined:
```
-- Compare with: lemma do_something (f : my_hom A B) : sorry := sorry
lemma do_something {F : Type*} [my_hom_class F A B] (f : F) : sorry := sorry
```

This means anything set up for `my_hom`s will automatically work for `cool_hom_class`es,
and defining `cool_hom_class` only takes a constant amount of effort,
instead of linearly increasing the work per `my_hom`-related declaration.

-/

-- This instance should have low priority, to ensure we follow the chain
-- `fun_like → has_coe_to_fun`
attribute [instance, priority 10] coe_fn_trans

/-- The class `fun_like F α β` expresses that terms of type `F` have an
injective coercion to functions from `α` to `β`.

This typeclass is used in the definition of the homomorphism typeclasses,
such as `zero_hom_class`, `mul_hom_class`, `monoid_hom_class`, ....
-/
class fun_like (F : Sort*) (α : out_param Sort*) (β : out_param $ α → Sort*) :=
(coe : F → Π a : α, β a)
(coe_injective' : function.injective coe)

section dependent

/-! ### `fun_like F α β` where `β` depends on `a : α` -/

variables (F α : Sort*) (β : α → Sort*)

namespace fun_like

variables {F α β} [i : fun_like F α β]

include i

@[priority 100, -- Give this a priority between `coe_fn_trans` and the default priority
  nolint dangerous_instance] -- `α` and `β` are out_params, so this instance should not be dangerous
instance : has_coe_to_fun F (λ _, Π a : α, β a) := { coe := fun_like.coe }

theorem coe_injective : function.injective (coe_fn : F → Π a : α, β a) :=
fun_like.coe_injective'

@[simp, norm_cast]
theorem coe_fn_eq {f g : F} : (f : Π a : α, β a) = (g : Π a : α, β a) ↔ f = g :=
⟨λ h, @coe_injective _ _ _ i _ _ h, λ h, by cases h; refl⟩

theorem ext' {f g : F} (h : (f : Π a : α, β a) = (g : Π a : α, β a)) : f = g :=
coe_injective h

theorem ext'_iff {f g : F} : f = g ↔ ((f : Π a : α, β a) = (g : Π a : α, β a)) :=
coe_fn_eq.symm

theorem ext (f g : F) (h : ∀ (x : α), f x = g x) : f = g :=
coe_injective (funext h)

theorem ext_iff {f g : F} : f = g ↔ (∀ x, f x = g x) :=
coe_fn_eq.symm.trans function.funext_iff

protected lemma congr_fun {f g : F} (h₁ : f = g) (x : α) : f x = g x :=
congr_fun (congr_arg _ h₁) x

end fun_like

end dependent

section non_dependent

/-! ### `fun_like F α (λ _, β)` where `β` does not depend on `a : α` -/

variables {F α β : Sort*} [i : fun_like F α (λ _, β)]

include i

namespace fun_like

protected lemma congr {f g : F} {x y : α} (h₁ : f = g) (h₂ : x = y) : f x = g y :=
congr (congr_arg _ h₁) h₂

protected lemma congr_arg (f : F) {x y : α} (h₂ : x = y) : f x = f y :=
congr_arg _ h₂

end fun_like

end non_dependent


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.basic
import Mathlib.data.list.basic
import Mathlib.algebra.star.basic
import Mathlib.PostPort

universes u_1 u_2 u_4 u_5 u_3

namespace Mathlib

/-!
# Free monoid over a given alphabet

## Main definitions

* `free_monoid α`: free monoid over alphabet `α`; defined as a synonym for `list α`
  with multiplication given by `(++)`.
* `free_monoid.of`: embedding `α → free_monoid α` sending each element `x` to `[x]`;
* `free_monoid.lift`: natural equivalence between `α → M` and `free_monoid α →* M`
* `free_monoid.map`: embedding of `α → β` into `free_monoid α →* free_monoid β` given by `list.map`.
-/

/-- Free monoid over a given alphabet. -/
def free_add_monoid (α : Type u_1) :=
  List α

namespace free_monoid

protected instance Mathlib.free_add_monoid.add_monoid {α : Type u_1} : add_monoid (free_add_monoid α) :=
  add_monoid.mk (fun (x y : free_add_monoid α) => x ++ y) sorry [] sorry sorry

protected instance inhabited {α : Type u_1} : Inhabited (free_monoid α) :=
  { default := 1 }

theorem one_def {α : Type u_1} : 1 = [] :=
  rfl

theorem Mathlib.free_add_monoid.add_def {α : Type u_1} (xs : List α) (ys : List α) : xs + ys = xs ++ ys :=
  rfl

/-- Embeds an element of `α` into `free_monoid α` as a singleton list. -/
def of {α : Type u_1} (x : α) : free_monoid α :=
  [x]

theorem of_def {α : Type u_1} (x : α) : of x = [x] :=
  rfl

theorem of_injective {α : Type u_1} : function.injective of :=
  fun (a b : α) => list.head_eq_of_cons_eq

/-- Recursor for `free_monoid` using `1` and `of x * xs` instead of `[]` and `x :: xs`. -/
def rec_on {α : Type u_1} {C : free_monoid α → Sort u_2} (xs : free_monoid α) (h0 : C 1) (ih : (x : α) → (xs : free_monoid α) → C xs → C (of x * xs)) : C xs :=
  list.rec_on xs h0 ih

theorem hom_eq {α : Type u_1} {M : Type u_4} [monoid M] {f : free_monoid α →* M} {g : free_monoid α →* M} (h : ∀ (x : α), coe_fn f (of x) = coe_fn g (of x)) : f = g := sorry

/-- Equivalence between maps `α → M` and monoid homomorphisms `free_monoid α →* M`. -/
def lift {α : Type u_1} {M : Type u_4} [monoid M] : (α → M) ≃ (free_monoid α →* M) :=
  equiv.mk (fun (f : α → M) => monoid_hom.mk (fun (l : free_monoid α) => list.prod (list.map f l)) sorry sorry)
    (fun (f : free_monoid α →* M) (x : α) => coe_fn f (of x)) sorry sorry

@[simp] theorem Mathlib.free_add_monoid.lift_symm_apply {α : Type u_1} {M : Type u_4} [add_monoid M] (f : free_add_monoid α →+ M) : coe_fn (equiv.symm free_add_monoid.lift) f = ⇑f ∘ free_add_monoid.of :=
  rfl

theorem lift_apply {α : Type u_1} {M : Type u_4} [monoid M] (f : α → M) (l : free_monoid α) : coe_fn (coe_fn lift f) l = list.prod (list.map f l) :=
  rfl

theorem Mathlib.free_add_monoid.lift_comp_of {α : Type u_1} {M : Type u_4} [add_monoid M] (f : α → M) : ⇑(coe_fn free_add_monoid.lift f) ∘ free_add_monoid.of = f :=
  equiv.symm_apply_apply free_add_monoid.lift f

@[simp] theorem Mathlib.free_add_monoid.lift_eval_of {α : Type u_1} {M : Type u_4} [add_monoid M] (f : α → M) (x : α) : coe_fn (coe_fn free_add_monoid.lift f) (free_add_monoid.of x) = f x :=
  congr_fun (free_add_monoid.lift_comp_of f) x

@[simp] theorem lift_restrict {α : Type u_1} {M : Type u_4} [monoid M] (f : free_monoid α →* M) : coe_fn lift (⇑f ∘ of) = f :=
  equiv.apply_symm_apply lift f

theorem comp_lift {α : Type u_1} {M : Type u_4} [monoid M] {N : Type u_5} [monoid N] (g : M →* N) (f : α → M) : monoid_hom.comp g (coe_fn lift f) = coe_fn lift (⇑g ∘ f) := sorry

theorem hom_map_lift {α : Type u_1} {M : Type u_4} [monoid M] {N : Type u_5} [monoid N] (g : M →* N) (f : α → M) (x : free_monoid α) : coe_fn g (coe_fn (coe_fn lift f) x) = coe_fn (coe_fn lift (⇑g ∘ f)) x :=
  iff.mp monoid_hom.ext_iff (comp_lift g f) x

/-- The unique monoid homomorphism `free_monoid α →* free_monoid β` that sends
each `of x` to `of (f x)`. -/
def map {α : Type u_1} {β : Type u_2} (f : α → β) : free_monoid α →* free_monoid β :=
  monoid_hom.mk (list.map f) sorry sorry

@[simp] theorem map_of {α : Type u_1} {β : Type u_2} (f : α → β) (x : α) : coe_fn (map f) (of x) = of (f x) :=
  rfl

theorem Mathlib.free_add_monoid.lift_of_comp_eq_map {α : Type u_1} {β : Type u_2} (f : α → β) : (coe_fn free_add_monoid.lift fun (x : α) => free_add_monoid.of (f x)) = free_add_monoid.map f :=
  free_add_monoid.hom_eq fun (x : α) => rfl

theorem map_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} (g : β → γ) (f : α → β) : map (g ∘ f) = monoid_hom.comp (map g) (map f) :=
  hom_eq fun (x : α) => rfl

protected instance star_monoid {α : Type u_1} : star_monoid (free_monoid α) :=
  star_monoid.mk list.reverse_append

@[simp] theorem star_of {α : Type u_1} (x : α) : star (of x) = of x :=
  rfl

/-- Note that `star_one` is already a global simp lemma, but this one works with dsimp too -/
@[simp] theorem star_one {α : Type u_1} : star 1 = 1 :=
  rfl


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.has_limits
import category_theory.products.basic
import category_theory.functor.currying

/-!
# A Fubini theorem for categorical limits

We prove that $lim_{J × K} G = lim_J (lim_K G(j, -))$ for a functor `G : J × K ⥤ C`,
when all the appropriate limits exist.

We begin working with a functor `F : J ⥤ K ⥤ C`. We'll write `G : J × K ⥤ C` for the associated
"uncurried" functor.

In the first part, given a coherent family `D` of limit cones over the functors `F.obj j`,
and a cone `c` over `G`, we construct a cone over the cone points of `D`.
We then show that if `c` is a limit cone, the constructed cone is also a limit cone.

In the second part, we state the Fubini theorem in the setting where limits are
provided by suitable `has_limit` classes.

We construct
`limit_uncurry_iso_limit_comp_lim F : limit (uncurry.obj F) ≅ limit (F ⋙ lim)`
and give simp lemmas characterising it.
For convenience, we also provide
`limit_iso_limit_curry_comp_lim G : limit G ≅ limit ((curry.obj G) ⋙ lim)`
in terms of the uncurried functor.

## Future work

The dual statement.
-/

universes v u

open category_theory

namespace category_theory.limits

variables {J K : Type v} [small_category J] [small_category K]
variables {C : Type u} [category.{v} C]

variables (F : J ⥤ K ⥤ C)

/--
A structure carrying a diagram of cones over the functors `F.obj j`.
-/
-- We could try introducing a "dependent functor type" to handle this?
structure diagram_of_cones :=
(obj : Π j : J, cone (F.obj j))
(map : Π {j j' : J} (f : j ⟶ j'), (cones.postcompose (F.map f)).obj (obj j) ⟶ obj j')
(id : ∀ j : J, (map (𝟙 j)).hom = 𝟙 _ . obviously)
(comp : ∀ {j₁ j₂ j₃ : J} (f : j₁ ⟶ j₂) (g : j₂ ⟶ j₃),
  (map (f ≫ g)).hom = (map f).hom ≫ (map g).hom . obviously)

variables {F}

/--
Extract the functor `J ⥤ C` consisting of the cone points and the maps between them,
from a `diagram_of_cones`.
-/
@[simps]
def diagram_of_cones.cone_points (D : diagram_of_cones F) :
  J ⥤ C :=
{ obj := λ j, (D.obj j).X,
  map := λ j j' f, (D.map f).hom,
  map_id' := λ j, D.id j,
  map_comp' := λ j₁ j₂ j₃ f g, D.comp f g, }

/--
Given a diagram `D` of limit cones over the `F.obj j`, and a cone over `uncurry.obj F`,
we can construct a cone over the diagram consisting of the cone points from `D`.
-/
@[simps]
def cone_of_cone_uncurry
  {D : diagram_of_cones F} (Q : Π j, is_limit (D.obj j))
  (c : cone (uncurry.obj F)) :
  cone (D.cone_points) :=
{ X := c.X,
  π :=
  { app := λ j, (Q j).lift
    { X := c.X,
      π :=
      { app := λ k, c.π.app (j, k),
        naturality' := λ k k' f,
        begin
          dsimp, simp only [category.id_comp],
          have := @nat_trans.naturality _ _ _ _ _ _ c.π (j, k) (j, k') (𝟙 j, f),
          dsimp at this,
          simp only [category.id_comp, category_theory.functor.map_id, nat_trans.id_app] at this,
          exact this,
        end } },
    naturality' := λ j j' f, (Q j').hom_ext
    begin
      dsimp,
      intro k,
      simp only [limits.cone_morphism.w, limits.cones.postcompose_obj_π, limits.is_limit.fac_assoc,
        limits.is_limit.fac, nat_trans.comp_app, category.id_comp, category.assoc],
      have := @nat_trans.naturality _ _ _ _ _ _ c.π (j, k) (j', k) (f, 𝟙 k),
      dsimp at this,
      simp only [category.id_comp, category.comp_id,
        category_theory.functor.map_id, nat_trans.id_app] at this,
      exact this,
    end, } }.

/--
`cone_of_cone_uncurry Q c` is a limit cone when `c` is a limit cone.`
-/
def cone_of_cone_uncurry_is_limit
  {D : diagram_of_cones F} (Q : Π j, is_limit (D.obj j))
  {c : cone (uncurry.obj F)} (P : is_limit c) :
  is_limit (cone_of_cone_uncurry Q c) :=
{ lift := λ s, P.lift
  { X := s.X,
    π :=
    { app := λ p, s.π.app p.1 ≫ (D.obj p.1).π.app p.2,
      naturality' := λ p p' f,
      begin
        dsimp, simp only [category.id_comp, category.assoc],
        rcases p with ⟨j, k⟩,
        rcases p' with ⟨j', k'⟩,
        rcases f with ⟨fj, fk⟩,
        dsimp,
        slice_rhs 3 4 { rw ←nat_trans.naturality, },
        slice_rhs 2 3 { rw ←(D.obj j).π.naturality, },
        simp only [functor.const_obj_map, category.id_comp, category.assoc],
        have w := (D.map fj).w k',
        dsimp at w,
        rw ←w,
        have n := s.π.naturality fj,
        dsimp at n,
        simp only [category.id_comp] at n,
        rw n,
        simp,
      end, } },
  fac' := λ s j,
  begin
    apply (Q j).hom_ext,
    intro k,
    simp,
  end,
  uniq' := λ s m w,
  begin
    refine P.uniq { X := s.X, π := _, } m _,
    rintro ⟨j, k⟩,
    dsimp,
    rw [←w j],
    simp,
  end, }

section
variables (F)
variables [has_limits_of_shape K C]

/--
Given a functor `F : J ⥤ K ⥤ C`, with all needed limits,
we can construct a diagram consisting of the limit cone over each functor `F.obj j`,
and the universal cone morphisms between these.
-/
@[simps]
noncomputable def diagram_of_cones.mk_of_has_limits : diagram_of_cones F :=
{ obj := λ j, limit.cone (F.obj j),
  map := λ j j' f, { hom := lim.map (F.map f), }, }

-- Satisfying the inhabited linter.
noncomputable instance diagram_of_cones_inhabited : inhabited (diagram_of_cones F) :=
⟨diagram_of_cones.mk_of_has_limits F⟩

@[simp]
lemma diagram_of_cones.mk_of_has_limits_cone_points :
  (diagram_of_cones.mk_of_has_limits F).cone_points = (F ⋙ lim) :=
rfl

variables [has_limit (uncurry.obj F)]
variables [has_limit (F ⋙ lim)]

/--
The Fubini theorem for a functor `F : J ⥤ K ⥤ C`,
showing that the limit of `uncurry.obj F` can be computed as
the limit of the limits of the functors `F.obj j`.
-/
noncomputable def limit_uncurry_iso_limit_comp_lim : limit (uncurry.obj F) ≅ limit (F ⋙ lim) :=
begin
  let c := limit.cone (uncurry.obj F),
  let P : is_limit c := limit.is_limit _,
  let G := diagram_of_cones.mk_of_has_limits F,
  let Q : Π j, is_limit (G.obj j) := λ j, limit.is_limit _,
  have Q' := cone_of_cone_uncurry_is_limit Q P,
  have Q'' := (limit.is_limit (F ⋙ lim)),
  exact is_limit.cone_point_unique_up_to_iso Q' Q'',
end

@[simp, reassoc]
lemma limit_uncurry_iso_limit_comp_lim_hom_π_π {j} {k} :
  (limit_uncurry_iso_limit_comp_lim F).hom ≫ limit.π _ j ≫ limit.π _ k = limit.π _ (j, k) :=
begin
  dsimp [limit_uncurry_iso_limit_comp_lim, is_limit.cone_point_unique_up_to_iso,
    is_limit.unique_up_to_iso],
  simp,
end

@[simp, reassoc]
lemma limit_uncurry_iso_limit_comp_lim_inv_π {j} {k} :
  (limit_uncurry_iso_limit_comp_lim F).inv ≫ limit.π _ (j, k) = limit.π _ j ≫ limit.π _ k :=
begin
  rw [←cancel_epi (limit_uncurry_iso_limit_comp_lim F).hom],
  simp,
end
end

section

variables (F) [has_limits_of_shape J C] [has_limits_of_shape K C]
-- With only moderate effort these could be derived if needed:
variables [has_limits_of_shape (J × K) C] [has_limits_of_shape (K × J) C]

/-- The limit of `F.flip ⋙ lim` is isomorphic to the limit of `F ⋙ lim`. -/
noncomputable
def limit_flip_comp_lim_iso_limit_comp_lim : limit (F.flip ⋙ lim) ≅ limit (F ⋙ lim) :=
(limit_uncurry_iso_limit_comp_lim _).symm ≪≫
  has_limit.iso_of_nat_iso (uncurry_obj_flip _) ≪≫
  (has_limit.iso_of_equivalence (prod.braiding _ _)
    (nat_iso.of_components (λ _, by refl) (by tidy))) ≪≫
  limit_uncurry_iso_limit_comp_lim _

@[simp, reassoc]
lemma limit_flip_comp_lim_iso_limit_comp_lim_hom_π_π (j) (k) :
  (limit_flip_comp_lim_iso_limit_comp_lim F).hom ≫ limit.π _ j ≫ limit.π _ k =
  limit.π _ k ≫ limit.π _ j :=
by { dsimp [limit_flip_comp_lim_iso_limit_comp_lim], simp, dsimp, simp, } -- See note [dsimp, simp]

@[simp, reassoc]
lemma limit_flip_comp_lim_iso_limit_comp_lim_inv_π_π (k) (j) :
  (limit_flip_comp_lim_iso_limit_comp_lim F).inv ≫ limit.π _ k ≫ limit.π _ j =
  limit.π _ j ≫ limit.π _ k :=
by { dsimp [limit_flip_comp_lim_iso_limit_comp_lim], simp, dsimp, simp, dsimp, simp, }

end

section
variables (G : J × K ⥤ C)

section
variables [has_limits_of_shape K C]
variables [has_limit G]
variables [has_limit ((curry.obj G) ⋙ lim)]

/--
The Fubini theorem for a functor `G : J × K ⥤ C`,
showing that the limit of `G` can be computed as
the limit of the limits of the functors `G.obj (j, _)`.
-/
noncomputable def limit_iso_limit_curry_comp_lim : limit G ≅ limit ((curry.obj G) ⋙ lim) :=
begin
  have i : G ≅ uncurry.obj ((@curry J _ K _ C _).obj G) := currying.symm.unit_iso.app G,
  haveI : limits.has_limit (uncurry.obj ((@curry J _ K _ C _).obj G)) :=
    has_limit_of_iso i,
  transitivity limit (uncurry.obj ((@curry J _ K _ C _).obj G)),
  apply has_limit.iso_of_nat_iso i,
  exact limit_uncurry_iso_limit_comp_lim ((@curry J _ K _ C _).obj G),
end

@[simp, reassoc]
lemma limit_iso_limit_curry_comp_lim_hom_π_π {j} {k} :
  (limit_iso_limit_curry_comp_lim G).hom ≫ limit.π _ j ≫ limit.π _ k = limit.π _ (j, k) :=
by simp [limit_iso_limit_curry_comp_lim, is_limit.cone_point_unique_up_to_iso,
  is_limit.unique_up_to_iso]

@[simp, reassoc]
lemma limit_iso_limit_curry_comp_lim_inv_π {j} {k} :
  (limit_iso_limit_curry_comp_lim G).inv ≫ limit.π _ (j, k) = limit.π _ j ≫ limit.π _ k :=
begin
  rw [←cancel_epi (limit_iso_limit_curry_comp_lim G).hom],
  simp,
end
end

section
variables [has_limits C] -- Certainly one could weaken the hypotheses here.

open category_theory.prod

/--
A variant of the Fubini theorem for a functor `G : J × K ⥤ C`,
showing that $\lim_k \lim_j G(j,k) ≅ \lim_j \lim_k G(j,k)$.
-/
noncomputable
def limit_curry_swap_comp_lim_iso_limit_curry_comp_lim :
  limit ((curry.obj (swap K J ⋙ G)) ⋙ lim) ≅ limit ((curry.obj G) ⋙ lim) :=
calc
  limit ((curry.obj (swap K J ⋙ G)) ⋙ lim)
      ≅ limit (swap K J ⋙ G) : (limit_iso_limit_curry_comp_lim _).symm
  ... ≅ limit G : has_limit.iso_of_equivalence (braiding K J) (iso.refl _)
  ... ≅ limit ((curry.obj G) ⋙ lim) : limit_iso_limit_curry_comp_lim _

@[simp]
lemma limit_curry_swap_comp_lim_iso_limit_curry_comp_lim_hom_π_π {j} {k} :
  (limit_curry_swap_comp_lim_iso_limit_curry_comp_lim G).hom ≫ limit.π _ j ≫ limit.π _ k =
   limit.π _ k ≫ limit.π _ j :=
begin
  dsimp [limit_curry_swap_comp_lim_iso_limit_curry_comp_lim],
  simp only [iso.refl_hom, braiding_counit_iso_hom_app, limits.has_limit.iso_of_equivalence_hom_π,
    iso.refl_inv, limit_iso_limit_curry_comp_lim_hom_π_π, eq_to_iso_refl, category.assoc],
  erw [nat_trans.id_app], -- Why can't `simp` do this`?
  dsimp, simp,
end

@[simp]
lemma limit_curry_swap_comp_lim_iso_limit_curry_comp_lim_inv_π_π {j} {k} :
  (limit_curry_swap_comp_lim_iso_limit_curry_comp_lim G).inv ≫ limit.π _ k ≫ limit.π _ j =
   limit.π _ j ≫ limit.π _ k :=
begin
  dsimp [limit_curry_swap_comp_lim_iso_limit_curry_comp_lim],
  simp only [iso.refl_hom, braiding_counit_iso_hom_app, limits.has_limit.iso_of_equivalence_inv_π,
    iso.refl_inv, limit_iso_limit_curry_comp_lim_hom_π_π, eq_to_iso_refl, category.assoc],
  erw [nat_trans.id_app], -- Why can't `simp` do this`?
  dsimp, simp,
end

end

end

end category_theory.limits


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Jannis Limperg

! This file was ported from Lean 3 source module control.ulift
! leanprover-community/mathlib commit 99e8971dc62f1f7ecf693d75e75fbbabd55849de
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/

import Mathlib.Mathport.Rename

/-!
# Monadic instances for `ULift` and `PLift`

In this file we define `Monad` and `IsLawfulMonad` instances on `PLift` and `ULift`. -/

universe u v

namespace PLift

variable {α : Sort u} {β : Sort v}

/-- Functorial action. -/
protected def map (f : α → β) (a : PLift α) : PLift β :=
  PLift.up (f a.down)
#align plift.map PLift.map

@[simp]
theorem map_up (f : α → β) (a : α) : (PLift.up a).map f = PLift.up (f a) :=
  rfl
#align plift.map_up PLift.map_up

/-- Embedding of pure values. -/
@[simp]
protected def pure : α → PLift α :=
  up
#align plift.pure PLift.pure

/-- Applicative sequencing. -/
protected def seq (f : PLift (α → β)) (x : Unit → PLift α) : PLift β :=
  PLift.up (f.down (x ()).down)
#align plift.seq PLift.seq

@[simp]
theorem seq_up (f : α → β) (x : α) : (PLift.up f).seq (fun _ => PLift.up x) = PLift.up (f x) :=
  rfl
#align plift.seq_up PLift.seq_up

/-- Monadic bind. -/
protected def bind (a : PLift α) (f : α → PLift β) : PLift β :=
  f a.down
#align plift.bind PLift.bind

@[simp]
theorem bind_up (a : α) (f : α → PLift β) : (PLift.up a).bind f = f a :=
  rfl
#align plift.bind_up PLift.bind_up

instance : Monad PLift where
  map := @PLift.map
  pure := @PLift.pure
  seq := @PLift.seq
  bind := @PLift.bind

instance : LawfulFunctor PLift where
  id_map := @fun _ ⟨_⟩ => rfl
  comp_map := @fun _ _ _ _ _ ⟨_⟩ => rfl
  map_const := @fun _ _ => rfl

instance : LawfulApplicative PLift where
  seqLeft_eq := @fun _ _ _ _ => rfl
  seqRight_eq := @fun _ _ _ _ => rfl
  pure_seq := @fun _ _ _ ⟨_⟩ => rfl
  map_pure := @fun _ _ _ _ => rfl
  seq_pure := @fun _ _ ⟨_⟩ _ => rfl
  seq_assoc := @fun _ _ _ ⟨_⟩ ⟨_⟩ ⟨_⟩ => rfl

instance : LawfulMonad PLift where
  bind_pure_comp := @fun _ _ _ ⟨_⟩ => rfl
  bind_map := @fun _ _ ⟨_⟩ ⟨_⟩ => rfl
  pure_bind := @fun _ _ _ _ => rfl
  bind_assoc := @fun _ _ _ ⟨_⟩ _ _ => rfl

@[simp]
theorem rec.constant {α : Sort u} {β : Type v} (b : β) :
    (@PLift.rec α (fun _ => β) fun _ => b) = fun _ => b := rfl

#align plift.rec.constant PLift.rec.constant

end PLift

namespace ULift

variable {α : Type u} {β : Type v}

/-- Functorial action. -/
protected def map (f : α → β) (a : ULift α) : ULift β :=
  ULift.up.{u} (f a.down)
#align ulift.map ULift.map

@[simp]
theorem map_up (f : α → β) (a : α) : (ULift.up.{u} a).map f = ULift.up.{u} (f a) :=
  rfl
#align ulift.map_up ULift.map_up

/-- Embedding of pure values. -/
@[simp]
protected def pure : α → ULift α :=
  up
#align ulift.pure ULift.pure

/-- Applicative sequencing. -/
protected def seq {α β} (f : ULift (α → β)) (x : Unit → ULift α) : ULift β :=
  ULift.up.{u} (f.down (x ()).down)
#align ulift.seq ULift.seq

@[simp]
theorem seq_up (f : α → β) (x : α) : (ULift.up f).seq (fun _ => ULift.up x) = ULift.up (f x) :=
  rfl
#align ulift.seq_up ULift.seq_up

/-- Monadic bind. -/
protected def bind (a : ULift α) (f : α → ULift β) : ULift β :=
  f a.down
#align ulift.bind ULift.bind

@[simp]
theorem bind_up (a : α) (f : α → ULift β) : (ULift.up a).bind f = f a :=
  rfl
#align ulift.bind_up ULift.bind_up

instance : Monad ULift where
  map := @ULift.map
  pure := @ULift.pure
  seq := @ULift.seq
  bind := @ULift.bind

instance : LawfulFunctor ULift where
  id_map := @fun _ ⟨_⟩ => rfl
  comp_map := @fun _ _ _ _ _ ⟨_⟩ => rfl
  map_const := @fun _ _ => rfl

instance : LawfulApplicative ULift where
  seqLeft_eq := @fun _ _ _ _ => rfl
  seqRight_eq := @fun _ _ _ _ => rfl
  pure_seq := @fun _ _ _ ⟨_⟩ => rfl
  map_pure := @fun _ _ _ _ => rfl
  seq_pure := @fun _ _ ⟨_⟩ _ => rfl
  seq_assoc := @fun _ _ _ ⟨_⟩ ⟨_⟩ ⟨_⟩ => rfl

instance : LawfulMonad ULift where
  bind_pure_comp := @fun _ _ _ ⟨_⟩ => rfl
  bind_map := @fun _ _ ⟨_⟩ ⟨_⟩ => rfl
  pure_bind := @fun _ _ _ _ => rfl
  bind_assoc := @fun _ _ _ ⟨_⟩ _ _ => rfl

@[simp]
theorem rec.constant {α : Type u} {β : Sort v} (b : β) :
     (@ULift.rec α (fun _ => β) fun _ => b) = fun _ => b := rfl

#align ulift.rec.constant ULift.rec.constant

end ULift


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Scott Morrison

! This file was ported from Lean 3 source module tactic.simp_result
! leanprover-community/mathlib commit 3c11bd771ef17197a9e9fcd4a3fabfa2804d950c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Core

/-!
# simp_result

`dsimp_result` and `simp_result` are a pair of tactics for
applying `dsimp` or `simp` to the result produced by other tactics.

As examples, tactics which use `revert` and `intro`
may insert additional `id` terms in the result they produce.
If there is some reason these are undesirable
(e.g. the result term needs to be human-readable, or
satisfying syntactic rather than just definitional properties),
wrapping those tactics in `dsimp_result`
can remove the `id` terms "after the fact".

Similarly, tactics using `subst` and `rw` will nearly always introduce `eq.rec` terms,
but sometimes these will be easy to remove,
for example by simplifying using `eq_rec_constant`.
This is a non-definitional simplification lemma,
and so wrapping these tactics in `simp_result` will result
in a definitionally different result.

There are several examples in the associated test file,
demonstrating these interactions with `revert` and `subst`.

These tactics should be used with some caution.
You should consider whether there is any real need for the simplification of the result,
and whether there is a more direct way of producing the result you wanted,
before relying on these tactics.

Both are implemented in terms of a generic `intercept_result` tactic,
which allows you to run an arbitrary tactic and modify the returned results.
-/

namespace Tactic

/-- `intercept_result m t`
attempts to run a tactic `t`,
intercepts any results `t` assigns to the goals,
and runs `m : expr → tactic expr` on each of the expressions
before assigning the returned values to the original goals.

Because `intercept_result` uses `unsafe.type_context.assign` rather than `unify`,
if the tactic `m` does something unreasonable
you may produce terms that don't typecheck,
possibly with mysterious error messages.
Be careful!
-/
unsafe def intercept_result {α} (m : expr → tactic expr) (t : tactic α) : tactic α := do
  let gs
    ←-- Replace the goals with copies.
      get_goals
  let gs' ← gs.mapM fun g => infer_type g >>= mk_meta_var
  set_goals gs'
  let a
    ←-- Run the tactic on the copied goals.
      t
  (-- Run `m` on the produced terms,
          gs
          gs').mapM
      fun ⟨g, g'⟩ => do
      let g' ← instantiate_mvars g'
      let g'' ← with_local_goals' gs <| m g'
      -- and assign to the original goals.
          -- (We have to use `assign` here, as `unify` and `exact` are apparently
          -- unreliable about which way they do the assignment!)
          unsafe.type_context.run <|
          unsafe.type_context.assign g g''
  pure a
#align tactic.intercept_result tactic.intercept_result

/-- `dsimp_result t`
attempts to run a tactic `t`,
intercepts any results it assigns to the goals,
and runs `dsimp` on those results
before assigning the simplified values to the original goals.
-/
unsafe def dsimp_result {α} (t : tactic α) (cfg : DsimpConfig := { failIfUnchanged := false })
    (no_defaults := false) (attr_names : List Name := []) (hs : List simp_arg_type := []) :
    tactic α :=
  intercept_result (fun g => g.dsimp cfg no_defaults attr_names hs) t
#align tactic.dsimp_result tactic.dsimp_result

/-- `simp_result t`
attempts to run a tactic `t`,
intercepts any results `t` assigns to the goals,
and runs `simp` on those results
before assigning the simplified values to the original goals.
-/
unsafe def simp_result {α} (t : tactic α) (cfg : SimpConfig := { failIfUnchanged := false })
    (discharger : tactic Unit := failed) (no_defaults := false) (attr_names : List Name := [])
    (hs : List simp_arg_type := []) : tactic α :=
  intercept_result (fun g => Prod.fst <$> g.simp cfg discharger no_defaults attr_names hs) t
#align tactic.simp_result tactic.simp_result

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- `dsimp_result { tac }`
attempts to run a tactic block `tac`,
intercepts any results the tactic block would have assigned to the goals,
and runs `dsimp` on those results
before assigning the simplified values to the original goals.

You can use the usual interactive syntax for `dsimp`, e.g.
`dsimp_result only [a, b, c] with attr { tac }`.
-/
unsafe def dsimp_result (no_defaults : parse only_flag) (hs : parse simp_arg_list)
    (attr_names : parse with_ident_list) (t : itactic) : itactic :=
  tactic.dsimp_result t { failIfUnchanged := false } no_defaults attr_names hs
#align tactic.interactive.dsimp_result tactic.interactive.dsimp_result

/-- `simp_result { tac }`
attempts to run a tactic block `tac`,
intercepts any results the tactic block would have assigned to the goals,
and runs `simp` on those results
before assigning the simplified values to the original goals.

You can use the usual interactive syntax for `simp`, e.g.
`simp_result only [a, b, c] with attr { tac }`.
-/
unsafe def simp_result (no_defaults : parse only_flag) (hs : parse simp_arg_list)
    (attr_names : parse with_ident_list) (t : itactic) : itactic :=
  tactic.simp_result t { failIfUnchanged := false } failed no_defaults attr_names hs
#align tactic.interactive.simp_result tactic.interactive.simp_result

/-- `simp_result { tac }`
attempts to run a tactic block `tac`,
intercepts any results the tactic block would have assigned to the goals,
and runs `simp` on those results
before assigning the simplified values to the original goals.

You can use the usual interactive syntax for `simp`, e.g.
`simp_result only [a, b, c] with attr { tac }`.

`dsimp_result { tac }` works similarly, internally using `dsimp`
(and so only simplifiying along definitional lemmas).
-/
add_tactic_doc
  { Name := "simp_result"
    category := DocCategory.tactic
    declNames := [`` simp_result, `` dsimp_result]
    tags := ["simplification"] }

end Interactive

end Tactic


/-
Copyright (c) 2018 Reid Barton All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison, David Wärn
-/
import category_theory.full_subcategory
import category_theory.products.basic
import category_theory.pi.basic
import category_theory.category.basic
import combinatorics.quiver.connected_component

/-!
# Groupoids

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

We define `groupoid` as a typeclass extending `category`,
asserting that all morphisms have inverses.

The instance `is_iso.of_groupoid (f : X ⟶ Y) : is_iso f` means that you can then write
`inv f` to access the inverse of any morphism `f`.

`groupoid.iso_equiv_hom : (X ≅ Y) ≃ (X ⟶ Y)` provides the equivalence between
isomorphisms and morphisms in a groupoid.

We provide a (non-instance) constructor `groupoid.of_is_iso` from an existing category
with `is_iso f` for every `f`.

## See also

See also `category_theory.core` for the groupoid of isomorphisms in a category.
-/

namespace category_theory

universes v v₂ u u₂ -- morphism levels before object levels. See note [category_theory universes].

/-- A `groupoid` is a category such that all morphisms are isomorphisms. -/
class groupoid (obj : Type u) extends category.{v} obj : Type (max u (v+1)) :=
(inv       : Π {X Y : obj}, (X ⟶ Y) → (Y ⟶ X))
(inv_comp' : ∀ {X Y : obj} (f : X ⟶ Y), comp (inv f) f = id Y . obviously)
(comp_inv' : ∀ {X Y : obj} (f : X ⟶ Y), comp f (inv f) = id X . obviously)

restate_axiom groupoid.inv_comp'
restate_axiom groupoid.comp_inv'

/--
A `large_groupoid` is a groupoid
where the objects live in `Type (u+1)` while the morphisms live in `Type u`.
-/
abbreviation large_groupoid (C : Type (u+1)) : Type (u+1) := groupoid.{u} C
/--
A `small_groupoid` is a groupoid
where the objects and morphisms live in the same universe.
-/
abbreviation small_groupoid (C : Type u) : Type (u+1) := groupoid.{u} C

section

variables {C : Type u} [groupoid.{v} C] {X Y : C}

@[priority 100] -- see Note [lower instance priority]
instance is_iso.of_groupoid (f : X ⟶ Y) : is_iso f :=
⟨⟨groupoid.inv f, groupoid.comp_inv f, groupoid.inv_comp f⟩⟩

@[simp]

/-- `groupoid.inv` is involutive. -/
@[simps] def groupoid.inv_equiv : (X ⟶ Y) ≃ (Y ⟶ X) :=
⟨groupoid.inv, groupoid.inv, λ f, by simp, λ f, by simp⟩

@[priority 100]
instance groupoid_has_involutive_reverse : quiver.has_involutive_reverse C :=
{ reverse' := λ X Y f, groupoid.inv f,
  inv' := λ X Y f, by { dsimp [quiver.reverse], simp, } }

@[simp] lemma groupoid.reverse_eq_inv (f : X ⟶ Y) : quiver.reverse f = groupoid.inv f := rfl

instance functor_map_reverse {D : Type*} [groupoid D] (F : C ⥤ D) :
  F.to_prefunctor.map_reverse :=
{ map_reverse' := λ X Y f, by
  simp only [quiver.reverse, quiver.has_reverse.reverse', groupoid.inv_eq_inv,
               functor.to_prefunctor_map, functor.map_inv], }

variables (X Y)

/-- In a groupoid, isomorphisms are equivalent to morphisms. -/
def groupoid.iso_equiv_hom : (X ≅ Y) ≃ (X ⟶ Y) :=
{ to_fun := iso.hom,
  inv_fun := λ f, ⟨f, groupoid.inv f⟩,
  left_inv := λ i, iso.ext rfl,
  right_inv := λ f, rfl }

variables (C)

/-- The functor from a groupoid `C` to its opposite sending every morphism to its inverse. -/
@[simps] noncomputable def groupoid.inv_functor : C ⥤ Cᵒᵖ :=
{ obj := opposite.op,
  map := λ {X Y} f, (inv f).op }

end

section

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

/-- A category where every morphism `is_iso` is a groupoid. -/
noncomputable
def groupoid.of_is_iso (all_is_iso : ∀ {X Y : C} (f : X ⟶ Y), is_iso f) : groupoid.{v} C :=
{ inv := λ X Y f, inv f }

/-- A category with a unique morphism between any two objects is a groupoid -/
def groupoid.of_hom_unique (all_unique : ∀ {X Y : C}, unique (X ⟶ Y)) : groupoid.{v} C :=
{ inv := λ X Y f, all_unique.default }

end

instance induced_category.groupoid {C : Type u} (D : Type u₂) [groupoid.{v} D] (F : C → D) :
   groupoid.{v} (induced_category D F) :=
{ inv       := λ X Y f, groupoid.inv f,
  inv_comp' := λ X Y f, groupoid.inv_comp f,
  comp_inv' := λ X Y f, groupoid.comp_inv f,
  .. induced_category.category F }

section

instance groupoid_pi {I : Type u} {J : I → Type u₂} [∀ i, groupoid.{v} (J i)] :
  groupoid.{max u v} (Π i : I, J i) :=
{ inv := λ (x y : Π i, J i) (f : Π i, x i ⟶ y i), (λ i : I, groupoid.inv (f i)), }

instance groupoid_prod {α : Type u} {β : Type v} [groupoid.{u₂} α] [groupoid.{v₂} β] :
  groupoid.{max u₂ v₂} (α × β) :=
{ inv := λ (x y : α × β) (f : x ⟶ y), (groupoid.inv f.1, groupoid.inv f.2) }

end

end category_theory


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import logic.function.basic
import tactic.lint
import tactic.norm_cast

/-!
# Typeclass for a type `F` with an injective map to `A → B`

This typeclass is primarily for use by homomorphisms like `monoid_hom` and `linear_map`.

## Basic usage of `fun_like`

A typical type of morphisms should be declared as:
```
structure my_hom (A B : Type*) [my_class A] [my_class B] :=
(to_fun : A → B)
(map_op' : ∀ {x y : A}, to_fun (my_class.op x y) = my_class.op (to_fun x) (to_fun y))

namespace my_hom

variables (A B : Type*) [my_class A] [my_class B]

-- This instance is optional if you follow the "morphism class" design below:
instance : fun_like (my_hom A B) A (λ _, B) :=
{ coe := my_hom.to_fun, coe_injective' := λ f g h, by cases f; cases g; congr' }

/-- Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly. -/
instance : has_coe_to_fun (my_hom A B) (λ _, A → B) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : my_hom A B} : f.to_fun = (f : A → B) := rfl

@[ext] theorem ext {f g : my_hom A B} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

/-- Copy of a `my_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : my_hom A B) (f' : A → B) (h : f' = ⇑f) : my_hom A B :=
{ to_fun := f',
  map_op' := h.symm ▸ f.map_op' }

end my_hom
```

This file will then provide a `has_coe_to_fun` instance and various
extensionality and simp lemmas.

## Morphism classes extending `fun_like`

The `fun_like` design provides further benefits if you put in a bit more work.
The first step is to extend `fun_like` to create a class of those types satisfying
the axioms of your new type of morphisms.
Continuing the example above:

```
/-- `my_hom_class F A B` states that `F` is a type of `my_class.op`-preserving morphisms.
You should extend this class when you extend `my_hom`. -/
class my_hom_class (F : Type*) (A B : out_param $ Type*) [my_class A] [my_class B]
  extends fun_like F A (λ _, B) :=
(map_op : ∀ (f : F) (x y : A), f (my_class.op x y) = my_class.op (f x) (f y))

@[simp] lemma map_op {F A B : Type*} [my_class A] [my_class B] [my_hom_class F A B]
  (f : F) (x y : A) : f (my_class.op x y) = my_class.op (f x) (f y) :=
my_hom_class.map_op

-- You can replace `my_hom.fun_like` with the below instance:
instance : my_hom_class (my_hom A B) A B :=
{ coe := my_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_op := my_hom.map_op' }

-- [Insert `has_coe_to_fun`, `to_fun_eq_coe`, `ext` and `copy` here]
```

The second step is to add instances of your new `my_hom_class` for all types extending `my_hom`.
Typically, you can just declare a new class analogous to `my_hom_class`:

```
structure cooler_hom (A B : Type*) [cool_class A] [cool_class B]
  extends my_hom A B :=
(map_cool' : to_fun cool_class.cool = cool_class.cool)

class cooler_hom_class (F : Type*) (A B : out_param $ Type*) [cool_class A] [cool_class B]
  extends my_hom_class F A B :=
(map_cool : ∀ (f : F), f cool_class.cool = cool_class.cool)

@[simp] lemma map_cool {F A B : Type*} [cool_class A] [cool_class B] [cooler_hom_class F A B]
  (f : F) : f cool_class.cool = cool_class.cool :=
my_hom_class.map_op

-- You can also replace `my_hom.fun_like` with the below instance:
instance : cool_hom_class (cool_hom A B) A B :=
{ coe := cool_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_op := cool_hom.map_op',
  map_cool := cool_hom.map_cool' }

-- [Insert `has_coe_to_fun`, `to_fun_eq_coe`, `ext` and `copy` here]
```

Then any declaration taking a specific type of morphisms as parameter can instead take the
class you just defined:
```
-- Compare with: lemma do_something (f : my_hom A B) : sorry := sorry
lemma do_something {F : Type*} [my_hom_class F A B] (f : F) : sorry := sorry
```

This means anything set up for `my_hom`s will automatically work for `cool_hom_class`es,
and defining `cool_hom_class` only takes a constant amount of effort,
instead of linearly increasing the work per `my_hom`-related declaration.

-/

-- This instance should have low priority, to ensure we follow the chain
-- `fun_like → has_coe_to_fun`
attribute [instance, priority 10] coe_fn_trans

/-- The class `fun_like F α β` expresses that terms of type `F` have an
injective coercion to functions from `α` to `β`.

This typeclass is used in the definition of the homomorphism typeclasses,
such as `zero_hom_class`, `mul_hom_class`, `monoid_hom_class`, ....
-/
class fun_like (F : Sort*) (α : out_param Sort*) (β : out_param $ α → Sort*) :=
(coe : F → Π a : α, β a)
(coe_injective' : function.injective coe)

section dependent

/-! ### `fun_like F α β` where `β` depends on `a : α` -/

variables (F α : Sort*) (β : α → Sort*)

namespace fun_like

variables {F α β} [i : fun_like F α β]

include i

@[priority 100, -- Give this a priority between `coe_fn_trans` and the default priority
  nolint dangerous_instance] -- `α` and `β` are out_params, so this instance should not be dangerous
instance : has_coe_to_fun F (λ _, Π a : α, β a) := { coe := fun_like.coe }

@[simp]

theorem coe_injective : function.injective (coe_fn : F → Π a : α, β a) :=
fun_like.coe_injective'

@[simp, norm_cast]
theorem coe_fn_eq {f g : F} : (f : Π a : α, β a) = (g : Π a : α, β a) ↔ f = g :=
⟨λ h, @coe_injective _ _ _ i _ _ h, λ h, by cases h; refl⟩

theorem ext' {f g : F} (h : (f : Π a : α, β a) = (g : Π a : α, β a)) : f = g :=
coe_injective h

theorem ext'_iff {f g : F} : f = g ↔ ((f : Π a : α, β a) = (g : Π a : α, β a)) :=
coe_fn_eq.symm

theorem ext (f g : F) (h : ∀ (x : α), f x = g x) : f = g :=
coe_injective (funext h)

theorem ext_iff {f g : F} : f = g ↔ (∀ x, f x = g x) :=
coe_fn_eq.symm.trans function.funext_iff

protected lemma congr_fun {f g : F} (h₁ : f = g) (x : α) : f x = g x :=
congr_fun (congr_arg _ h₁) x

lemma ne_iff {f g : F} : f ≠ g ↔ ∃ a, f a ≠ g a :=
ext_iff.not.trans not_forall

lemma exists_ne {f g : F} (h : f ≠ g) : ∃ x, f x ≠ g x :=
ne_iff.mp h

end fun_like

end dependent

section non_dependent

/-! ### `fun_like F α (λ _, β)` where `β` does not depend on `a : α` -/

variables {F α β : Sort*} [i : fun_like F α (λ _, β)]

include i

namespace fun_like

protected lemma congr {f g : F} {x y : α} (h₁ : f = g) (h₂ : x = y) : f x = g y :=
congr (congr_arg _ h₁) h₂

protected lemma congr_arg (f : F) {x y : α} (h₂ : x = y) : f x = f y :=
congr_arg _ h₂

end fun_like

end non_dependent