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

! This file was ported from Lean 3 source module tactic.suggest
! leanprover-community/mathlib commit 1463f592a0a5aa3b73972c9ed333ee7a9ddb8e6b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Bool.Basic
import Mathbin.Data.Mllist
import Mathbin.Tactic.SolveByElim

/-!
# `suggest` and `library_search`

`suggest` and `library_search` are a pair of tactics for applying lemmas from the library to the
current goal.

* `suggest` prints a list of `exact ...` or `refine ...` statements, which may produce new goals
* `library_search` prints a single `exact ...` which closes the goal, or fails
-/

namespace Tactic

open Native

namespace Suggest

open SolveByElim

-- TODO this is a hack; if you suspect more cases here would help, please report them
/-- Map a name (typically a head symbol) to a "canonical" definitional synonym.
Given a name `n`, we want a name `n'` such that a sufficiently applied
expression with head symbol `n` is always definitionally equal to an expression
with head symbol `n'`.
Thus, we can search through all lemmas with a result type of `n'`
to solve a goal with head symbol `n`.

For example, `>` is mapped to `<` because `a > b` is definitionally equal to `b < a`,
and `not` is mapped to `false` because `¬ a` is definitionally equal to `p → false`
The default is that the original argument is returned, so `<` is just mapped to `<`.

`normalize_synonym` is called for every lemma in the library, so it needs to be fast.
-/
unsafe def normalize_synonym : Name → Name
  | `gt => `has_lt.lt
  | `ge => `has_le.le
  | `monotone => `has_le.le
  | `not => `false
  | n => n
#align tactic.suggest.normalize_synonym tactic.suggest.normalize_synonym

-- We may want to tweak this further?
/-- Compute the head symbol of an expression, then normalise synonyms.

This is only used when analysing the goal, so it is okay to do more expensive analysis here.
-/
unsafe def allowed_head_symbols : expr → List Name
  |-- We first have a various "customisations":
    --   Because in `ℕ` `a.succ ≤ b` is definitionally `a < b`,
    --   we add some special cases to allow looking for `<` lemmas even when the goal has a `≤`.
    --   Note we only do this in the `ℕ` case, for performance.
    q(@LE.le ℕ _ (Nat.succ _) _) =>
    [`has_le.le, `has_lt.lt]
  | q(@GE.ge ℕ _ _ (Nat.succ _)) => [`has_le.le, `has_lt.lt]
  | q(@LE.le ℕ _ 1 _) => [`has_le.le, `has_lt.lt]
  | q(@GE.ge ℕ _ _ 1) => [`has_le.le, `has_lt.lt]
  |-- These allow `library_search` to search for lemmas of type `¬ a = b` when proving `a ≠ b`
    --   and vice-versa.
    q(_ ≠ _) =>
    [`false, `ne]
  | q(¬_ = _) => [`ne, `false]
  |-- And then the generic cases:
      expr.pi
      _ _ _ t =>
    allowed_head_symbols t
  | expr.app f _ => allowed_head_symbols f
  | expr.const n _ => [normalize_synonym n]
  | _ => [`_]
#align tactic.suggest.allowed_head_symbols tactic.suggest.allowed_head_symbols

/-- A declaration can match the head symbol of the current goal in four possible ways:
* `ex`  : an exact match
* `mp`  : the declaration returns an `iff`, and the right hand side matches the goal
* `mpr` : the declaration returns an `iff`, and the left hand side matches the goal
* `both`: the declaration returns an `iff`, and the both sides match the goal
-/
inductive HeadSymbolMatch
  | ex
  | mp
  | mpr
  | both
  deriving DecidableEq, Inhabited
#align tactic.suggest.head_symbol_match Tactic.Suggest.HeadSymbolMatch

open HeadSymbolMatch

/-- a textual representation of a `head_symbol_match`, for trace debugging. -/
def HeadSymbolMatch.toString : HeadSymbolMatch → String
  | ex => "exact"
  | mp => "iff.mp"
  | mpr => "iff.mpr"
  | both => "iff.mp and iff.mpr"
#align tactic.suggest.head_symbol_match.to_string Tactic.Suggest.HeadSymbolMatch.toString

-- failed to format: unknown constant 'term.pseudo.antiquot'
/-- Determine if, and in which way, a given expression matches the specified head symbol. -/ unsafe
  def
    match_head_symbol
    ( hs : name_set ) : expr → Option HeadSymbolMatch
    | expr.pi _ _ _ t => match_head_symbol t
      |
        q( $ ( a ) ↔ $ ( b ) )
        =>
        if
          hs . contains `iff
          then
          some ex
          else
          match
            ( match_head_symbol a , match_head_symbol b )
            with
            | ( some ex , some ex ) => some both
              | ( some ex , _ ) => some mpr
              | ( _ , some ex ) => some mp
              | _ => none
      | expr.app f _ => match_head_symbol f
      | expr.const n _ => if hs . contains ( normalize_synonym n ) then some ex else none
      | _ => if hs . contains `_ then some ex else none
#align tactic.suggest.match_head_symbol tactic.suggest.match_head_symbol

/-- A package of `declaration` metadata, including the way in which its type matches the head symbol
which we are searching for. -/
unsafe structure decl_data where
  d : declaration
  n : Name
  m : HeadSymbolMatch
  l : ℕ
#align tactic.suggest.decl_data tactic.suggest.decl_data

-- cached length of name
-- We used to check here for private declarations, or declarations with certain suffixes.
-- It turns out `apply` is so fast, it's better to just try them all.
/-- Generate a `decl_data` from the given declaration if
it matches the head symbol `hs` for the current goal.
-/
unsafe def process_declaration (hs : name_set) (d : declaration) : Option decl_data :=
  let n := d.to_name
  if !d.is_trusted || n.is_internal then none
  else (fun m => ⟨d, n, m, n.length⟩) <$> match_head_symbol hs d.type
#align tactic.suggest.process_declaration tactic.suggest.process_declaration

/-- Retrieve all library definitions with a given head symbol. -/
unsafe def library_defs (hs : name_set) : tactic (List decl_data) := do
  trace_if_enabled `suggest f! "Looking for lemmas with head symbols {hs}."
  let env ← get_env
  let defs := env.decl_filter_map (process_declaration hs)
  let-- Sort by length; people like short proofs
  defs := defs.qsort fun d₁ d₂ => d₁.l ≤ d₂.l
  trace_if_enabled `suggest f! "Found {defs} relevant lemmas:"
  trace_if_enabled `suggest <| defs fun ⟨d, n, m, l⟩ => (n, m)
  return defs
#align tactic.suggest.library_defs tactic.suggest.library_defs

/--
We unpack any element of a list of `decl_data` corresponding to an `↔` statement that could apply
in both directions into two separate elements.

This ensures that both directions can be independently returned by `suggest`,
and avoids a problem where the application of one direction prevents
the application of the other direction. (See `exp_le_exp` in the tests.)
-/
unsafe def unpack_iff_both : List decl_data → List decl_data
  | [] => []
  | ⟨d, n, both, l⟩ :: L => ⟨d, n, mp, l⟩ :: ⟨d, n, mpr, l⟩ :: unpack_iff_both L
  | ⟨d, n, m, l⟩ :: L => ⟨d, n, m, l⟩ :: unpack_iff_both L
#align tactic.suggest.unpack_iff_both tactic.suggest.unpack_iff_both

/-- An extension to the option structure for `solve_by_elim`.
* `compulsory_hyps` specifies a list of local hypotheses which must appear in any solution.
  These are useful for constraining the results from `library_search` and `suggest`.
* `try_this` is a flag (default: `tt`) that controls whether a "Try this:"-line should be traced.
-/
unsafe structure suggest_opt extends opt where
  compulsory_hyps : List expr := []
  try_this : Bool := true
#align tactic.suggest.suggest_opt tactic.suggest.suggest_opt

/-- Convert a `suggest_opt` structure to a `opt` structure suitable for `solve_by_elim`,
by setting the `accept` parameter to require that all complete solutions
use everything in `compulsory_hyps`.
-/
unsafe def suggest_opt.mk_accept (o : suggest_opt) : opt :=
  { o with
    accept := fun gs =>
      o.accept gs >>
        (guard <| o.compulsory_hyps.all fun h => gs.any fun g => g.contains_expr_or_mvar h) }
#align tactic.suggest.suggest_opt.mk_accept tactic.suggest.suggest_opt.mk_accept

-- Implementation note: as this is used by both `library_search` and `suggest`,
-- we first run `solve_by_elim` separately on the independent goals,
-- whether or not `close_goals` is set,
-- and then run `solve_by_elim { all_goals := tt }`,
-- requiring that it succeeds if `close_goals = tt`.
/-- Apply the lemma `e`, then attempt to close all goals using
`solve_by_elim opt`, failing if `close_goals = tt`
and there are any goals remaining.

Returns the number of subgoals which were closed using `solve_by_elim`.
-/
unsafe def apply_and_solve (close_goals : Bool) (opt : suggest_opt := { }) (e : expr) : tactic ℕ :=
  do
  trace_if_enabled `suggest f! "Trying to apply lemma: {e}"
  apply e opt
  trace_if_enabled `suggest f! "Applied lemma: {e}"
  let ng ← num_goals
  -- Phase 1
      -- Run `solve_by_elim` on each "safe" goal separately, not worrying about failures.
      -- (We only attempt the "safe" goals in this way in Phase 1.
      -- In Phase 2 we will do backtracking search across all goals,
      -- allowing us to guess solutions that involve data or unify metavariables,
      -- but only as long as we can finish all goals.)
      -- If `compulsory_hyps` is non-empty, we skip this phase and defer to phase 2.
      try
      (guard (opt = []) >> any_goals (independent_goal >> solve_by_elim opt))
  -- Phase 2
        done >>
        return ng <|>
      do
      (-- If there were any goals that we did not attempt solving in the first phase
                -- (because they weren't propositional, or contained a metavariable)
                -- as a second phase we attempt to solve all remaining goals at once
                -- (with backtracking across goals).
                guard
                (opt ≠ []) <|>
              any_goals (success_if_fail independent_goal) >> skip) >>
            solve_by_elim
              { opt with backtrack_all_goals := tt } <|>-- and fail unless `close_goals = ff`
            guard
            ¬close_goals
      let ng' ← num_goals
      return (ng - ng')
#align tactic.suggest.apply_and_solve tactic.suggest.apply_and_solve

/--
Apply the declaration `d` (or the forward and backward implications separately, if it is an `iff`),
and then attempt to solve the subgoal using `apply_and_solve`.

Returns the number of subgoals successfully closed.
-/
unsafe def apply_declaration (close_goals : Bool) (opt : suggest_opt := { }) (d : decl_data) :
    tactic ℕ :=
  let tac := apply_and_solve close_goals opt
  do
  let (e, t) ← decl_mk_const d.d
  match d with
    | ex => tac e
    | mp => do
      let l ← iff_mp_core e t
      tac l
    | mpr => do
      let l ← iff_mpr_core e t
      tac l
    | both => undefined
#align tactic.suggest.apply_declaration tactic.suggest.apply_declaration

-- we use `unpack_iff_both` to ensure this isn't reachable
/-- An `application` records the result of a successful application of a library lemma. -/
unsafe structure application where
  StateM : tactic_state
  script : String
  decl : Option declaration
  num_goals : ℕ
  hyps_used : List expr
#align tactic.suggest.application tactic.suggest.application

end Suggest

open SolveByElim

open Suggest

initialize
  registerTraceClass.1 `suggest

-- Trace a list of all relevant lemmas
-- Call `apply_declaration`, then prepare the tactic script and
-- count the number of local hypotheses used.
private unsafe def apply_declaration_script (g : expr) (hyps : List expr) (opt : suggest_opt := { })
    (d : decl_data) : tactic application :=
  -- (This tactic block is only executed when we evaluate the mllist,
    -- so we need to do the `focus1` here.)
    retrieve <|
    focus1 do
      apply_declaration ff opt d
      let g
        ←-- This `instantiate_mvars` is necessary so that we count used hypotheses correctly.
            instantiate_mvars
            g
      guard <| opt fun h => h g
      let ng ← num_goals
      let s ← read
      let m ← tactic_statement g
      return
          { StateM := s
            decl := d
            script := m
            num_goals := ng
            hyps_used := hyps fun h => h g }
#align tactic.apply_declaration_script tactic.apply_declaration_script

-- implementation note: we produce a `tactic (mllist tactic application)` first,
-- because it's easier to work in the tactic monad, but in a moment we squash this
-- down to an `mllist tactic application`.
private unsafe def suggest_core' (opt : suggest_opt := { }) : tactic (ListM tactic application) :=
  do
  let g :: _ ← get_goals
  let hyps ← local_context
  (-- Check if `solve_by_elim` can solve the goal immediately:
        -- This `instantiate_mvars` is necessary so that we count used hypotheses correctly.
        retrieve
        do
        focus1 <| solve_by_elim opt
        let s ← read
        let m ← tactic_statement g
        let g ← instantiate_mvars g
        guard (opt fun h => h g)
        return <|
            mllist.of_list
              [⟨s, m, none, 0,
                  hyps fun h => h g⟩]) <|>-- Otherwise, let's actually try applying library lemmas.
    do
      let t
        ←-- Collect all definitions with the correct head symbol
            infer_type
            g
      let defs ← unpack_iff_both <$> library_defs (name_set.of_list <| allowed_head_symbols t)
      let defs : mllist tactic _ := mllist.of_list defs
      let-- Try applying each lemma against the goal,
      -- recording the tactic script as a string,
      -- the number of remaining goals,
      -- and number of local hypotheses used.
      results := defs (apply_declaration_script g hyps opt)
      let symm_state
        ←-- Now call `symmetry` and try again.
            -- (Because we are using `mllist`, this is essentially free if we've already found a lemma.)
            retrieve <|
            try_core <| symmetry >> read
      let results_symm :=
        match symm_state with
        | some s => defs fun d => retrieve <| set_state s >> apply_declaration_script g hyps opt d
        | none => mllist.nil
      return (results results_symm)
#align tactic.suggest_core' tactic.suggest_core'

/-- The core `suggest` tactic.
It attempts to apply a declaration from the library,
then solve new goals using `solve_by_elim`.

It returns a list of `application`s consisting of fields:
* `state`, a tactic state resulting from the successful application of a declaration from
  the library,
* `script`, a string of the form `Try this: refine ...` or `Try this: exact ...` which will
  reproduce that tactic state,
* `decl`, an `option declaration` indicating the declaration that was applied
  (or none, if `solve_by_elim` succeeded),
* `num_goals`, the number of remaining goals, and
* `hyps_used`, the number of local hypotheses used in the solution.
-/
unsafe def suggest_core (opt : suggest_opt := { }) : ListM tactic application :=
  (ListM.monad_lift (suggest_core' opt)).join
#align tactic.suggest_core tactic.suggest_core

/-- See `suggest_core`.

Returns a list of at most `limit` `application`s,
sorted by number of goals, and then (reverse) number of hypotheses used.
-/
unsafe def suggest (limit : Option ℕ := none) (opt : suggest_opt := { }) :
    tactic (List application) := do
  let results := suggest_core opt
  let L
    ←-- Get the first n elements of the successful lemmas
        if h : limit.isSome then results.take (Option.get h)
      else results.force
  -- Sort by number of remaining goals, then by number of hypotheses used.
      return <|
      L fun d₁ d₂ => d₁ < d₂ ∨ d₁ = d₂ ∧ d₁ ≥ d₂
#align tactic.suggest tactic.suggest

/-- Returns a list of at most `limit` strings, of the form `Try this: exact ...` or
`Try this: refine ...`, which make progress on the current goal using a declaration
from the library.
-/
unsafe def suggest_scripts (limit : Option ℕ := none) (opt : suggest_opt := { }) :
    tactic (List String) := do
  let L ← suggest limit opt
  return <| L application.script
#align tactic.suggest_scripts tactic.suggest_scripts

/-- Returns a string of the form `Try this: exact ...`, which closes the current goal.
-/
unsafe def library_search (opt : suggest_opt := { }) : tactic String :=
  (suggest_core opt).firstM fun a => do
    guard (a = 0)
    write a
    return a
#align tactic.library_search tactic.library_search

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
open SolveByElim

initialize
  registerTraceClass.1 `silence_suggest

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
-- Turn off `Try this: exact/refine ...` trace messages for `suggest`
/-- `suggest` tries to apply suitable theorems/defs from the library, and generates
a list of `exact ...` or `refine ...` scripts that could be used at this step.
It leaves the tactic state unchanged. It is intended as a complement of the search
function in your editor, the `#find` tactic, and `library_search`.

`suggest` takes an optional natural number `num` as input and returns the first `num`
(or less, if all possibilities are exhausted) possibilities ordered by length of lemma names.
The default for `num` is `50`.
For performance reasons `suggest` uses monadic lazy lists (`mllist`). This means that
`suggest` might miss some results if `num` is not large enough. However, because
`suggest` uses monadic lazy lists, smaller values of `num` run faster than larger values.

You can add additional lemmas to be used along with local hypotheses
after the application of a library lemma,
using the same syntax as for `solve_by_elim`, e.g.
```
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  suggest [add_lt_add], -- Says: `Try this: exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end
```
You can also use `suggest with attr` to include all lemmas with the attribute `attr`.
-/
unsafe def suggest (n : parse (parser.optional (with_desc "n" small_nat)))
    (hs : parse simp_arg_list) (attr_names : parse with_ident_list)
    (use : parse <| tk "using" *> many ident_ <|> return []) (opt : suggest_opt := { }) :
    tactic Unit := do
  let (lemma_thunks, ctx_thunk) ← mk_assumption_set false hs attr_names
  let use ← use.mapM get_local
  let L ←
    tactic.suggest_scripts (n.getD 50)
        { opt with
          compulsory_hyps := use
          lemma_thunks := some lemma_thunks
          ctx_thunk }
  if !opt || is_trace_enabled_for `silence_suggest then skip
    else if L = 0 then fail "There are no applicable declarations" else L trace >> skip
#align tactic.interactive.suggest tactic.interactive.suggest

/-- `suggest` lists possible usages of the `refine` tactic and leaves the tactic state unchanged.
It is intended as a complement of the search function in your editor, the `#find` tactic, and
`library_search`.

`suggest` takes an optional natural number `num` as input and returns the first `num` (or less, if
all possibilities are exhausted) possibilities ordered by length of lemma names.
The default for `num` is `50`.

`suggest using h₁ h₂` will only show solutions that make use of the local hypotheses `h₁` and `h₂`.

For performance reasons `suggest` uses monadic lazy lists (`mllist`). This means that `suggest`
might miss some results if `num` is not large enough. However, because `suggest` uses monadic
lazy lists, smaller values of `num` run faster than larger values.

An example of `suggest` in action,

```lean
example (n : nat) : n < n + 1 :=
begin suggest, sorry end
```

prints the list,

```lean
Try this: exact nat.lt.base n
Try this: exact nat.lt_succ_self n
Try this: refine not_le.mp _
Try this: refine gt_iff_lt.mp _
Try this: refine nat.lt.step _
Try this: refine lt_of_not_ge _
...
```
-/
add_tactic_doc
  { Name := "suggest"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.suggest]
    tags := ["search", "Try this"] }

-- Turn off `Try this: exact ...` trace message for `library_search`
initialize
  registerTraceClass.1 `silence_library_search

/-- `library_search` is a tactic to identify existing lemmas in the library. It tries to close the
current goal by applying a lemma from the library, then discharging any new goals using
`solve_by_elim`.

If it succeeds, it prints a trace message `exact ...` which can replace the invocation
of `library_search`.

Typical usage is:
```lean
example (n m k : ℕ) : n * (m - k) = n * m - n * k :=
by library_search -- Try this: exact mul_tsub n m k
```

`library_search using h₁ h₂` will only show solutions
that make use of the local hypotheses `h₁` and `h₂`.

By default `library_search` only unfolds `reducible` definitions
when attempting to match lemmas against the goal.
Previously, it would unfold most definitions, sometimes giving surprising answers, or slow answers.
The old behaviour is still available via `library_search!`.

You can add additional lemmas to be used along with local hypotheses
after the application of a library lemma,
using the same syntax as for `solve_by_elim`, e.g.
```
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  library_search [add_lt_add], -- Says: `Try this: exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end
```
You can also use `library_search with attr` to include all lemmas with the attribute `attr`.
-/
unsafe def library_search (semireducible : parse <| optional (tk "!")) (hs : parse simp_arg_list)
    (attr_names : parse with_ident_list) (use : parse <| tk "using" *> many ident_ <|> return [])
    (opt : suggest_opt := { }) : tactic Unit := do
  let (lemma_thunks, ctx_thunk) ← mk_assumption_set false hs attr_names
  let use ← use.mapM get_local
  (tactic.library_search
          { opt with
            compulsory_hyps := use
            backtrack_all_goals := tt
            lemma_thunks := some lemma_thunks
            ctx_thunk
            md :=
              if semireducible then Tactic.Transparency.semireducible
              else Tactic.Transparency.reducible } >>=
        if !opt || is_trace_enabled_for `silence_library_search then fun _ => skip else trace) <|>
      fail
        "`library_search` failed.\nIf you aren't sure what to do next, you can also\ntry `library_search!`, `suggest`, or `hint`.\n\nPossible reasons why `library_search` failed:\n* `library_search` will only apply a single lemma from the library,\n  and then try to fill in its hypotheses from local hypotheses.\n* If you haven't already, try stating the theorem you want in its own lemma.\n* Sometimes the library has one version of a lemma\n  but not a very similar version obtained by permuting arguments.\n  Try replacing `a + b` with `b + a`, or `a - b < c` with `a < b + c`,\n  to see if maybe the lemma exists but isn't stated quite the way you would like.\n* Make sure that you have all the side conditions for your theorem to be true.\n  For example you won't find `a - b + b = a` for natural numbers in the library because it's false!\n  Search for `b ≤ a → a - b + b = a` instead.\n* If a definition you made is in the goal,\n  you won't find any theorems about it in the library.\n  Try unfolding the definition using `unfold my_definition`.\n* If all else fails, ask on https://leanprover.zulipchat.com/,\n  and maybe we can improve the library and/or `library_search` for next time."
#align tactic.interactive.library_search tactic.interactive.library_search

add_tactic_doc
  { Name := "library_search"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.library_search]
    tags := ["search", "Try this"] }

end Interactive

/-- Invoking the hole command `library_search` ("Use `library_search` to complete the goal") calls
the tactic `library_search` to produce a proof term with the type of the hole.

Running it on

```lean
example : 0 < 1 :=
{!!}
```

produces

```lean
example : 0 < 1 :=
nat.one_pos
```
-/
@[hole_command]
unsafe def library_search_hole_cmd : hole_command
    where
  Name := "library_search"
  descr := "Use `library_search` to complete the goal."
  action _ := do
    let script ← library_search
    -- Is there a better API for dropping the 'Try this: exact ' prefix on this string?
        return
        [((script "Try this: exact ").getD script, "by library_search")]
#align tactic.library_search_hole_cmd tactic.library_search_hole_cmd

add_tactic_doc
  { Name := "library_search"
    category := DocCategory.hole_cmd
    declNames := [`tactic.library_search_hole_cmd]
    tags := ["search", "Try this"] }

end Tactic


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.preserves.shapes.binary_products
import category_theory.limits.preserves.shapes.products
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.finite_products
import category_theory.pempty
import logic.equiv.fin

/-!
# Constructing finite products from binary products and terminal.

If a category has binary products and a terminal object then it has finite products.
If a functor preserves binary products and the terminal object then it preserves finite products.

# TODO

Provide the dual results.
Show the analogous results for functors which reflect or create (co)limits.
-/

universes v u u'

noncomputable theory
open category_theory category_theory.category category_theory.limits
namespace category_theory

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

/--
Given `n+1` objects of `C`, a fan for the last `n` with point `c₁.X` and a binary fan on `c₁.X` and
`f 0`, we can build a fan for all `n+1`.

In `extend_fan_is_limit` we show that if the two given fans are limits, then this fan is also a
limit.
-/
@[simps {rhs_md := semireducible}]
def extend_fan {n : ℕ} {f : fin (n+1) → C}
  (c₁ : fan (λ (i : fin n), f i.succ))
  (c₂ : binary_fan (f 0) c₁.X) :
  fan f :=
fan.mk c₂.X
begin
  refine fin.cases _ _,
  { apply c₂.fst },
  { intro i, apply c₂.snd ≫ c₁.π.app ⟨i⟩ },
end

/--
Show that if the two given fans in `extend_fan` are limits, then the constructed fan is also a
limit.
-/
def extend_fan_is_limit {n : ℕ} (f : fin (n+1) → C)
  {c₁ : fan (λ (i : fin n), f i.succ)} {c₂ : binary_fan (f 0) c₁.X}
  (t₁ : is_limit c₁) (t₂ : is_limit c₂) :
  is_limit (extend_fan c₁ c₂) :=
{ lift := λ s,
  begin
    apply (binary_fan.is_limit.lift' t₂ (s.π.app ⟨0⟩) _).1,
    apply t₁.lift ⟨_, discrete.nat_trans (λ ⟨i⟩, s.π.app ⟨i.succ⟩)⟩
  end,
  fac' := λ s ⟨j⟩,
  begin
    apply fin.induction_on j,
    { apply (binary_fan.is_limit.lift' t₂ _ _).2.1 },
    { rintro i -,
      dsimp only [extend_fan_π_app],
      rw [fin.cases_succ, ← assoc, (binary_fan.is_limit.lift' t₂ _ _).2.2, t₁.fac],
      refl }
  end,
  uniq' := λ s m w,
  begin
    apply binary_fan.is_limit.hom_ext t₂,
    { rw (binary_fan.is_limit.lift' t₂ _ _).2.1,
      apply w ⟨0⟩ },
    { rw (binary_fan.is_limit.lift' t₂ _ _).2.2,
      apply t₁.uniq ⟨_, _⟩,
      rintro ⟨j⟩,
      rw assoc,
      dsimp only [discrete.nat_trans_app, extend_fan_is_limit._match_1],
      rw ← w ⟨j.succ⟩,
      dsimp only [extend_fan_π_app],
      rw fin.cases_succ }
  end }

section
variables [has_binary_products C] [has_terminal C]

/--
If `C` has a terminal object and binary products, then it has a product for objects indexed by
`fin n`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_product_fin :
  Π (n : ℕ) (f : fin n → C), has_product f
| 0 := λ f,
  begin
    letI : has_limits_of_shape (discrete (fin 0)) C :=
      has_limits_of_shape_of_equivalence (discrete.equivalence.{0} fin_zero_equiv'.symm),
    apply_instance,
  end
| (n+1) := λ f,
  begin
    haveI := has_product_fin n,
    apply has_limit.mk ⟨_, extend_fan_is_limit f (limit.is_limit _) (limit.is_limit _)⟩,
  end

/--
If `C` has a terminal object and binary products, then it has limits of shape
`discrete (fin n)` for any `n : ℕ`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_limits_of_shape_fin (n : ℕ) :
  has_limits_of_shape (discrete (fin n)) C :=
{ has_limit := λ K,
begin
  letI := has_product_fin n (λ n, K.obj ⟨n⟩),
  let : discrete.functor (λ n, K.obj ⟨n⟩) ≅ K := discrete.nat_iso (λ ⟨i⟩, iso.refl _),
  apply has_limit_of_iso this,
end }

/-- If `C` has a terminal object and binary products, then it has finite products. -/
lemma has_finite_products_of_has_binary_and_terminal : has_finite_products C :=
⟨λ J 𝒥, begin
  resetI,
  apply has_limits_of_shape_of_equivalence (discrete.equivalence (fintype.equiv_fin J)).symm,
  refine has_limits_of_shape_fin (fintype.card J),
end⟩

end

section preserves
variables (F : C ⥤ D)
variables [preserves_limits_of_shape (discrete walking_pair) F]
variables [preserves_limits_of_shape (discrete.{0} pempty) F]
variables [has_finite_products.{v} C]

/--
If `F` preserves the terminal object and binary products, then it preserves products indexed by
`fin n` for any `n`.
-/
noncomputable def preserves_fin_of_preserves_binary_and_terminal  :
  Π (n : ℕ) (f : fin n → C), preserves_limit (discrete.functor f) F
| 0 := λ f,
  begin
    letI : preserves_limits_of_shape (discrete (fin 0)) F :=
      preserves_limits_of_shape_of_equiv.{0 0}
        (discrete.equivalence fin_zero_equiv'.symm) _,
    apply_instance,
  end
| (n+1) :=
  begin
    haveI := preserves_fin_of_preserves_binary_and_terminal n,
    intro f,
    refine preserves_limit_of_preserves_limit_cone
      (extend_fan_is_limit f (limit.is_limit _) (limit.is_limit _)) _,
    apply (is_limit_map_cone_fan_mk_equiv _ _ _).symm _,
    let := extend_fan_is_limit (λ i, F.obj (f i))
              (is_limit_of_has_product_of_preserves_limit F _)
              (is_limit_of_has_binary_product_of_preserves_limit F _ _),
    refine is_limit.of_iso_limit this _,
    apply cones.ext _ _,
    apply iso.refl _,
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply (category.id_comp _).symm },
    { rintro i -,
      dsimp only [extend_fan_π_app, iso.refl_hom, fan.mk_π_app],
      rw [fin.cases_succ, fin.cases_succ],
      change F.map _ ≫ _ = 𝟙 _ ≫ _,
      rw [id_comp, ←F.map_comp],
      refl }
  end

/--
If `F` preserves the terminal object and binary products, then it preserves limits of shape
`discrete (fin n)`.
-/
def preserves_shape_fin_of_preserves_binary_and_terminal (n : ℕ) :
  preserves_limits_of_shape (discrete (fin n)) F :=
{ preserves_limit := λ K,
  begin
    let : discrete.functor (λ n, K.obj ⟨n⟩) ≅ K := discrete.nat_iso (λ ⟨i⟩, iso.refl _),
    haveI := preserves_fin_of_preserves_binary_and_terminal F n (λ n, K.obj ⟨n⟩),
    apply preserves_limit_of_iso_diagram F this,
  end }

/-- If `F` preserves the terminal object and binary products then it preserves finite products. -/
def preserves_finite_products_of_preserves_binary_and_terminal
  (J : Type) [fintype J] :
  preserves_limits_of_shape (discrete J) F :=
begin
  classical,
  let e := fintype.equiv_fin J,
  haveI := preserves_shape_fin_of_preserves_binary_and_terminal F (fintype.card J),
  apply preserves_limits_of_shape_of_equiv.{0 0}
    (discrete.equivalence e).symm,
end

end preserves

/--
Given `n+1` objects of `C`, a cofan for the last `n` with point `c₁.X`
and a binary cofan on `c₁.X` and `f 0`, we can build a cofan for all `n+1`.

In `extend_cofan_is_colimit` we show that if the two given cofans are colimits,
then this cofan is also a colimit.
-/
@[simps {rhs_md := semireducible}]
def extend_cofan {n : ℕ} {f : fin (n+1) → C}
  (c₁ : cofan (λ (i : fin n), f i.succ))
  (c₂ : binary_cofan (f 0) c₁.X) :
  cofan f :=
cofan.mk c₂.X
begin
  refine fin.cases _ _,
  { apply c₂.inl },
  { intro i,
    apply c₁.ι.app ⟨i⟩ ≫ c₂.inr },
end

/--
Show that if the two given cofans in `extend_cofan` are colimits,
then the constructed cofan is also a colimit.
-/
def extend_cofan_is_colimit {n : ℕ} (f : fin (n+1) → C)
  {c₁ : cofan (λ (i : fin n), f i.succ)} {c₂ : binary_cofan (f 0) c₁.X}
  (t₁ : is_colimit c₁) (t₂ : is_colimit c₂) :
  is_colimit (extend_cofan c₁ c₂) :=
{ desc := λ s,
  begin
    apply (binary_cofan.is_colimit.desc' t₂ (s.ι.app ⟨0⟩) _).1,
    apply t₁.desc ⟨_, discrete.nat_trans (λ i, s.ι.app ⟨i.as.succ⟩)⟩
  end,
  fac' := λ s,
  begin
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply (binary_cofan.is_colimit.desc' t₂ _ _).2.1 },
    { rintro i -,
      dsimp only [extend_cofan_ι_app],
      rw [fin.cases_succ, assoc, (binary_cofan.is_colimit.desc' t₂ _ _).2.2, t₁.fac],
      refl }
  end,
  uniq' := λ s m w,
  begin
    apply binary_cofan.is_colimit.hom_ext t₂,
    { rw (binary_cofan.is_colimit.desc' t₂ _ _).2.1,
      apply w ⟨0⟩ },
    { rw (binary_cofan.is_colimit.desc' t₂ _ _).2.2,
      apply t₁.uniq ⟨_, _⟩,
      rintro ⟨j⟩,
      dsimp only [discrete.nat_trans_app],
      rw ← w ⟨j.succ⟩,
      dsimp only [extend_cofan_ι_app],
      rw [fin.cases_succ, assoc], }
  end }

section
variables [has_binary_coproducts C] [has_initial C]

/--
If `C` has an initial object and binary coproducts, then it has a coproduct for objects indexed by
`fin n`.
This is a helper lemma for `has_cofinite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_coproduct_fin :
  Π (n : ℕ) (f : fin n → C), has_coproduct f
| 0 := λ f,
  begin
    letI : has_colimits_of_shape (discrete (fin 0)) C :=
      has_colimits_of_shape_of_equivalence (discrete.equivalence.{0} fin_zero_equiv'.symm),
    apply_instance,
  end
| (n+1) := λ f,
  begin
    haveI := has_coproduct_fin n,
    apply has_colimit.mk
      ⟨_, extend_cofan_is_colimit f (colimit.is_colimit _) (colimit.is_colimit _)⟩,
  end

/--
If `C` has an initial object and binary coproducts, then it has colimits of shape
`discrete (fin n)` for any `n : ℕ`.
This is a helper lemma for `has_cofinite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_colimits_of_shape_fin (n : ℕ) :
  has_colimits_of_shape (discrete (fin n)) C :=
{ has_colimit := λ K,
begin
  letI := has_coproduct_fin n (λ n, K.obj ⟨n⟩),
  let : K ≅ discrete.functor (λ n, K.obj ⟨n⟩) := discrete.nat_iso (λ ⟨i⟩, iso.refl _),
  apply has_colimit_of_iso this,
end }

/-- If `C` has an initial object and binary coproducts, then it has finite coproducts. -/
lemma has_finite_coproducts_of_has_binary_and_terminal : has_finite_coproducts C :=
⟨λ J 𝒥, begin
  resetI,
  apply has_colimits_of_shape_of_equivalence (discrete.equivalence (fintype.equiv_fin J)).symm,
  refine has_colimits_of_shape_fin (fintype.card J),
end⟩

end

section preserves
variables (F : C ⥤ D)
variables [preserves_colimits_of_shape (discrete walking_pair) F]
variables [preserves_colimits_of_shape (discrete.{0} pempty) F]
variables [has_finite_coproducts.{v} C]

/--
If `F` preserves the initial object and binary coproducts, then it preserves products indexed by
`fin n` for any `n`.
-/
noncomputable def preserves_fin_of_preserves_binary_and_initial  :
  Π (n : ℕ) (f : fin n → C), preserves_colimit (discrete.functor f) F
| 0 := λ f,
  begin
    letI : preserves_colimits_of_shape (discrete (fin 0)) F :=
      preserves_colimits_of_shape_of_equiv.{0 0}
        (discrete.equivalence fin_zero_equiv'.symm) _,
    apply_instance,
  end
| (n+1) :=
  begin
    haveI := preserves_fin_of_preserves_binary_and_initial n,
    intro f,
    refine preserves_colimit_of_preserves_colimit_cocone
      (extend_cofan_is_colimit f (colimit.is_colimit _) (colimit.is_colimit _)) _,
    apply (is_colimit_map_cocone_cofan_mk_equiv _ _ _).symm _,
    let := extend_cofan_is_colimit (λ i, F.obj (f i))
              (is_colimit_of_has_coproduct_of_preserves_colimit F _)
              (is_colimit_of_has_binary_coproduct_of_preserves_colimit F _ _),
    refine is_colimit.of_iso_colimit this _,
    apply cocones.ext _ _,
    apply iso.refl _,
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply category.comp_id },
    { rintro i -,
      dsimp only [extend_cofan_ι_app, iso.refl_hom, cofan.mk_ι_app],
      rw [fin.cases_succ, fin.cases_succ],
      erw [comp_id, ←F.map_comp],
      refl, }
  end

/--
If `F` preserves the initial object and binary coproducts, then it preserves colimits of shape
`discrete (fin n)`.
-/
def preserves_shape_fin_of_preserves_binary_and_initial (n : ℕ) :
  preserves_colimits_of_shape (discrete (fin n)) F :=
{ preserves_colimit := λ K,
  begin
    let : discrete.functor (λ n, K.obj ⟨n⟩) ≅ K := discrete.nat_iso (λ ⟨i⟩, iso.refl _),
    haveI := preserves_fin_of_preserves_binary_and_initial F n (λ n, K.obj ⟨n⟩),
    apply preserves_colimit_of_iso_diagram F this,
  end }

/-- If `F` preserves the initial object and binary coproducts then it preserves finite products. -/
def preserves_finite_coproducts_of_preserves_binary_and_initial
  (J : Type) [fintype J] :
  preserves_colimits_of_shape (discrete J) F :=
begin
  classical,
  let e := fintype.equiv_fin J,
  haveI := preserves_shape_fin_of_preserves_binary_and_initial F (fintype.card J),
  apply preserves_colimits_of_shape_of_equiv.{0 0} (discrete.equivalence e).symm,
end

end preserves

end category_theory


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.abelian.basic
import category_theory.preadditive.opposite
import category_theory.limits.opposites

/-!
# The opposite of an abelian category is abelian.
-/

noncomputable theory

namespace category_theory

open category_theory.limits

variables (C : Type*) [category C] [abelian C]

local attribute [instance]
  has_finite_limits_of_has_equalizers_and_finite_products
  has_finite_colimits_of_has_coequalizers_and_finite_coproducts

instance : abelian Cᵒᵖ :=
{ normal_mono_of_mono := λ X Y f m, by exactI
    normal_mono_of_normal_epi_unop _ (normal_epi_of_epi f.unop),
  normal_epi_of_epi := λ X Y f m, by exactI
    normal_epi_of_normal_mono_unop _ (normal_mono_of_mono f.unop), }

section

variables {C} {X Y : C} (f : X ⟶ Y) {A B : Cᵒᵖ} (g : A ⟶ B)

-- TODO: Generalize (this will work whenever f has a cokernel)
-- (The abelian case is probably sufficient for most applications.)
/-- The kernel of `f.op` is the opposite of `cokernel f`. -/
@[simps]
def kernel_op_unop : (kernel f.op).unop ≅ cokernel f :=
{ hom := (kernel.lift f.op (cokernel.π f).op $ by simp [← op_comp]).unop,
  inv := cokernel.desc f (kernel.ι f.op).unop $
    by { rw [← f.unop_op, ← unop_comp, f.unop_op], simp },
  hom_inv_id' := begin
    rw [← unop_id, ← (cokernel.desc f _ _).unop_op, ← unop_comp],
    congr' 1,
    dsimp,
    ext,
    simp [← op_comp],
  end,
  inv_hom_id' := begin
    dsimp,
    ext,
    simp [← unop_comp],
  end }

-- TODO: Generalize (this will work whenever f has a kernel)
-- (The abelian case is probably sufficient for most applications.)
/-- The cokernel of `f.op` is the opposite of `kernel f`. -/
@[simps]
def cokernel_op_unop : (cokernel f.op).unop ≅ kernel f :=
{ hom := kernel.lift f (cokernel.π f.op).unop $
    by { rw [← f.unop_op, ← unop_comp, f.unop_op], simp },
  inv := (cokernel.desc f.op (kernel.ι f).op $ by simp [← op_comp]).unop,
  hom_inv_id' := begin
    rw [← unop_id, ← (kernel.lift f _ _).unop_op, ← unop_comp],
    congr' 1,
    dsimp,
    ext,
    simp [← op_comp],
  end,
  inv_hom_id' := begin
    dsimp,
    ext,
    simp [← unop_comp],
  end }

/-- The kernel of `g.unop` is the opposite of `cokernel g`. -/
@[simps]
def kernel_unop_op : opposite.op (kernel g.unop) ≅ cokernel g :=
(cokernel_op_unop g.unop).op

/-- The cokernel of `g.unop` is the opposite of `kernel g`. -/
@[simps]
def cokernel_unop_op : opposite.op (cokernel g.unop) ≅ kernel g :=
(kernel_op_unop g.unop).op

lemma cokernel.π_op : (cokernel.π f.op).unop =
  (cokernel_op_unop f).hom ≫ kernel.ι f ≫ eq_to_hom (opposite.unop_op _).symm :=
by simp [cokernel_op_unop]

lemma kernel.ι_op : (kernel.ι f.op).unop =
  eq_to_hom (opposite.unop_op _) ≫ cokernel.π f ≫ (kernel_op_unop f).inv :=
by simp [kernel_op_unop]

/-- The kernel of `f.op` is the opposite of `cokernel f`. -/
@[simps]
def kernel_op_op : kernel f.op ≅ opposite.op (cokernel f) :=
(kernel_op_unop f).op.symm

/-- The cokernel of `f.op` is the opposite of `kernel f`. -/
@[simps]
def cokernel_op_op : cokernel f.op ≅ opposite.op (kernel f) :=
(cokernel_op_unop f).op.symm

/-- The kernel of `g.unop` is the opposite of `cokernel g`. -/
@[simps]
def kernel_unop_unop : kernel g.unop ≅ (cokernel g).unop :=
(kernel_unop_op g).unop.symm

lemma kernel.ι_unop : (kernel.ι g.unop).op =
  eq_to_hom (opposite.op_unop _) ≫ cokernel.π g ≫ (kernel_unop_op g).inv :=
by simp

lemma cokernel.π_unop : (cokernel.π g.unop).op =
  (cokernel_unop_op g).hom ≫ kernel.ι g ≫ eq_to_hom (opposite.op_unop _).symm :=
by simp

/-- The cokernel of `g.unop` is the opposite of `kernel g`. -/
@[simps]
def cokernel_unop_unop : cokernel g.unop ≅ (kernel g).unop :=
(cokernel_unop_op g).unop.symm

/-- The opposite of the image of `g.unop` is the image of `g.` -/
def image_unop_op : opposite.op (image g.unop) ≅ image g :=
(abelian.image_iso_image _).op ≪≫ (cokernel_op_op _).symm ≪≫
  cokernel_iso_of_eq (cokernel.π_unop _) ≪≫ (cokernel_epi_comp _ _)
  ≪≫ (cokernel_comp_is_iso _ _) ≪≫ (abelian.coimage_iso_image' _)

/-- The opposite of the image of `f` is the image of `f.op`. -/
def image_op_op : opposite.op (image f) ≅ image f.op := image_unop_op f.op

/-- The image of `f.op` is the opposite of the image of `f`. -/
def image_op_unop : (image f.op).unop ≅ image f := (image_unop_op f.op).unop

/-- The image of `g` is the opposite of the image of `g.unop.` -/
def image_unop_unop : (image g).unop ≅ image g.unop := (image_unop_op g).unop

lemma image_ι_op_comp_image_unop_op_hom :
  (image.ι g.unop).op ≫ (image_unop_op g).hom = factor_thru_image g :=
begin
  dunfold image_unop_op,
  simp only [←category.assoc, ←op_comp, iso.trans_hom, iso.symm_hom, iso.op_hom, cokernel_op_op_inv,
    cokernel_comp_is_iso_hom, cokernel_epi_comp_hom, cokernel_iso_of_eq_hom_comp_desc_assoc,
    abelian.coimage_iso_image'_hom, eq_to_hom_refl, is_iso.inv_id,
    category.id_comp (cokernel.π (kernel.ι g))],
  simp only [category.assoc, abelian.image_iso_image_hom_comp_image_ι, kernel.lift_ι,
    quiver.hom.op_unop, cokernel.π_desc],
end

lemma image_unop_op_hom_comp_image_ι :
  (image_unop_op g).hom ≫ image.ι g = (factor_thru_image g.unop).op :=
by simp only [←cancel_epi (image.ι g.unop).op, ←category.assoc, image_ι_op_comp_image_unop_op_hom,
  ←op_comp, image.fac, quiver.hom.op_unop]

lemma factor_thru_image_comp_image_unop_op_inv :
  factor_thru_image g ≫ (image_unop_op g).inv = (image.ι g.unop).op :=
by rw [iso.comp_inv_eq, image_ι_op_comp_image_unop_op_hom]

lemma image_unop_op_inv_comp_op_factor_thru_image :
  (image_unop_op g).inv ≫ (factor_thru_image g.unop).op = image.ι g :=
by rw [iso.inv_comp_eq, image_unop_op_hom_comp_image_ι]

end

end category_theory


--  An abstract formalization of "isomorphism is equality up to relabeling"
-- -------------------------------------------------------------------------
--
-- See `README.md` for more info.
--
-- This file extends `Basic.lean` with definitions that are related to `Equiv` from mathlib.

import Structure.Basic
import Structure.Forgetfulness

import mathlib4_experiments.CoreExt
import mathlib4_experiments.Data.Equiv.Basic

open Morphisms
open Structure
open StructureFunctor
open Forgetfulness
open SetoidStructureEquiv

set_option autoBoundImplicitLocal false

universes u v

-- Define instances for `Equiv` to fit it into our more abstract framework.

namespace Equiv

def equivRel := RelationWithSetoid.relWithEq Equiv

instance genEquiv : IsEquivalence equivRel :=
{ refl  := Equiv.refl,
  symm  := Equiv.symm,
  trans := Equiv.trans }

theorem comp_congrArg {α β γ : Sort u} {f₁ f₂ : equivRel α β} {g₁ g₂ : equivRel β γ} (h₁ : f₁ ≈ f₂) (h₂ : g₁ ≈ g₂) :
  g₁ • f₁ ≈ g₂ • f₂ :=
let h := congr (congrArg Equiv.trans h₁) h₂;
h

theorem inv_congrArg {α β : Sort u} {f₁ f₂ : equivRel α β} (h₁ : f₁ ≈ f₂) :
  f₁⁻¹ ≈ f₂⁻¹ :=
congrArg Equiv.symm h₁

instance hasIso : HasIsomorphisms equivRel :=
{ comp_congrArg := comp_congrArg,
  inv_congrArg  := inv_congrArg,
  assoc         := Equiv.trans_assoc,
  leftId        := Equiv.trans_refl,
  rightId       := Equiv.refl_trans,
  leftInv       := Equiv.trans_symm,
  rightInv      := Equiv.symm_trans,
  invInv        := Equiv.symm_symm,
  compInv       := Equiv.symm_trans_symm,
  idInv         := @Equiv.refl_symm }

end Equiv

-- Now, `Equiv` gives us a structure for `Sort u`.

instance sortHasStructure : HasStructure (Sort u) := ⟨Equiv.equivRel⟩
def sortStructure : Structure := ⟨Sort u⟩

-- When using `sortStructure` to encode `Sort u` as a `Structure` with equivalences given by `Equiv`,
-- we also want to transport individual instances `a : α` of a type `α : Sort u` along an encoded
-- `Equiv`. Since the introductory description in `Basic.lean` contains precisely this operation, we
-- need to provide an abstraction for it.
--
-- `universeStructure` enables us to do exactly that: The function `instanceStructure`, which encodes
-- a given Lean type as a `Structure` with equivalence given by equality, is actually a functor from
-- `sortStructure` to `universeStructure`. This functor transports an `Equiv` between two types to a
-- `StructureEquiv` between the corresponding instance structures. And `StructureEquiv` provides the
-- necessary operation of transporting an instance of one structure to the other.
--
-- The benefit of this encoding is that `StructureEquiv` is much more general than the original
-- `Equiv` because many different objects can be encoded as instances of `Structure`.

-- An equivalence between instance structures is actually the same as `Equiv`.

def instanceStructureEquiv {α β : Sort u} (e : α ≃ β) : instanceStructure α ≃ instanceStructure β :=
{ toFun    := instanceStructureFunctor e.toFun,
  invFun   := instanceStructureFunctor e.invFun,
  isInv  := { leftInv  := { ext := e.leftInv,
                            nat := λ _ => proofIrrel _ _ },
              rightInv := { ext := e.rightInv,
                            nat := λ _ => proofIrrel _ _ },
              lrCompat := λ _ => proofIrrel _ _,
              rlCompat := λ _ => proofIrrel _ _ } }

namespace instanceStructureEquiv

@[simp] theorem instanceEquiv {α β : Sort u} (e : α ≃ β) (a : α) (b : β) :
  a ≃[instanceStructureEquiv e] b ↔ e.toFun a = b :=
Iff.rfl

theorem respectsEquiv {α β   : Sort u} {e₁ e₂ : α ≃ β} (h : e₁ = e₂) :
  instanceStructureEquiv e₁ ≈ instanceStructureEquiv e₂ :=
Setoid.of_Eq (congrArg instanceStructureEquiv h)

theorem respectsComp  {α β γ : Sort u} (e : α ≃ β) (f : β ≃ γ) :
  instanceStructureEquiv (Equiv.trans e f) ≈ StructureEquiv.trans (instanceStructureEquiv e) (instanceStructureEquiv f) :=
⟨{ toFunEquiv    := { ext := λ a => let c : instanceStructure γ := f.toFun  (e.toFun  a);
                                    let ⟨h⟩ := Setoid.refl c; h,
                      nat := λ _ => proofIrrel _ _ },
   invFunEquiv   := { ext := λ c => let a : instanceStructure α := e.invFun (f.invFun c);
                                    let ⟨h⟩ := Setoid.refl a; h,
                      nat := λ _ => proofIrrel _ _ },
   leftInvEquiv  := λ _ => proofIrrel _ _,
   rightInvEquiv := λ _ => proofIrrel _ _ }⟩

theorem respectsId    (α     : Sort u) :
  instanceStructureEquiv (Equiv.refl α) ≈ StructureEquiv.refl (instanceStructure α) :=
⟨{ toFunEquiv    := { ext := λ a => let ⟨h⟩ := Setoid.refl a; h,
                      nat := λ _ => proofIrrel _ _ },
   invFunEquiv   := { ext := λ a => let ⟨h⟩ := Setoid.refl a; h,
                      nat := λ _ => proofIrrel _ _ },
   leftInvEquiv  := λ _ => proofIrrel _ _,
   rightInvEquiv := λ _ => proofIrrel _ _ }⟩

theorem respectsInv   {α β   : Sort u} (e : α ≃ β) :
  instanceStructureEquiv (Equiv.symm e) ≈ StructureEquiv.symm (instanceStructureEquiv e) :=
⟨{ toFunEquiv    := { ext := λ b => let a : instanceStructure α := e.invFun b;
                                    let ⟨h⟩ := Setoid.refl a; h,
                      nat := λ _ => proofIrrel _ _ },
   invFunEquiv   := { ext := λ a => let b : instanceStructure β := e.toFun  a;
                                    let ⟨h⟩ := Setoid.refl b; h,
                      nat := λ _ => proofIrrel _ _ },
   leftInvEquiv  := λ _ => proofIrrel _ _,
   rightInvEquiv := λ _ => proofIrrel _ _ }⟩

end instanceStructureEquiv

def sortToStructureFunctor : StructureFunctor sortStructure universeStructure :=
{ map     := instanceStructure,
  functor := { mapEquiv  := instanceStructureEquiv,
               isFunctor := { respectsEquiv := instanceStructureEquiv.respectsEquiv,
                              respectsComp  := instanceStructureEquiv.respectsComp,
                              respectsId    := instanceStructureEquiv.respectsId,
                              respectsInv   := instanceStructureEquiv.respectsInv } } }

-- If we have an `Equiv` between two types where one has a structure, we can transport the structure
-- along that `Equiv`.

namespace EquivalentStructure

variable {α : Sort u} {β : Sort v} [h : HasStructure β] (e : α ≃ β)

def hasEquivalentStructure : HasStructure α :=
{ M       := λ x y => h.M (e.toFun x) (e.toFun y),
  hasIsos := { refl          := λ x => h.hasIsos.refl (e.toFun x),
               symm          := h.hasIsos.symm,
               trans         := h.hasIsos.trans,
               comp_congrArg := h.hasIsos.comp_congrArg,
               inv_congrArg  := h.hasIsos.inv_congrArg,
               assoc         := λ f g => h.hasIsos.assoc    f g,
               leftId        := λ f   => h.hasIsos.leftId   f,
               rightId       := λ f   => h.hasIsos.rightId  f,
               leftInv       := λ f   => h.hasIsos.leftInv  f,
               rightInv      := λ f   => h.hasIsos.rightInv f,
               invInv        := λ f   => h.hasIsos.invInv   f,
               compInv       := λ f g => h.hasIsos.compInv  f g,
               idInv         := λ x   => h.hasIsos.idInv    (e.toFun x) } }

def equivalentStructure := @defaultStructure α (hasEquivalentStructure e)

-- In particular, we can map equivalences in both directions.

def equivalentEquiv {x y : α} (f : iso (equivalentStructure e) x y) : e.toFun x ≃ e.toFun y := f

def equivalentEquivInv {x y : β} (f : x ≃ y) : iso (equivalentStructure e) (e.invFun x) (e.invFun y) :=
let h₁ := congr (congrArg h.M (e.rightInv x)) (e.rightInv y);
cast (congrArg BundledSetoid.α (Eq.symm h₁)) f

-- That gives us a `StructureEquiv` between the two structures.

def equivalentStructureDefEquivToFun : StructureFunctor (equivalentStructure e) (defaultStructure β) :=
{ map     := e.toFun,
  functor := { mapEquiv  := equivalentEquiv e,
               isFunctor := sorry } }

def equivalentStructureDefEquivInvFun : StructureFunctor (defaultStructure β) (equivalentStructure e) :=
{ map     := e.invFun,
  functor := { mapEquiv  := equivalentEquivInv e,
               isFunctor := sorry } }

def equivalentStructureDefEquiv : equivalentStructure e ≃ defaultStructure β :=
{ toFun  := equivalentStructureDefEquivToFun  e,
  invFun := equivalentStructureDefEquivInvFun e,
  isInv  := sorry }

end EquivalentStructure


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.indicator_function
import Mathlib.order.filter.at_top_bot
import Mathlib.PostPort

universes u_1 u_3 u_2

namespace Mathlib

/-!
# Indicator function and filters

Properties of indicator functions involving `=ᶠ` and `≤ᶠ`.

## Tags
indicator, characteristic, filter
-/

theorem indicator_eventually_eq {α : Type u_1} {M : Type u_3} [HasZero M] {s : set α} {t : set α} {f : α → M} {g : α → M} {l : filter α} (hf : filter.eventually_eq (l ⊓ filter.principal s) f g) (hs : filter.eventually_eq l s t) : filter.eventually_eq l (set.indicator s f) (set.indicator t g) := sorry

theorem indicator_union_eventually_eq {α : Type u_1} {M : Type u_3} [add_monoid M] {s : set α} {t : set α} {f : α → M} {l : filter α} (h : filter.eventually (fun (a : α) => ¬a ∈ s ∩ t) l) : filter.eventually_eq l (set.indicator (s ∪ t) f) (set.indicator s f + set.indicator t f) :=
  filter.eventually.mono h fun (a : α) (ha : ¬a ∈ s ∩ t) => set.indicator_union_of_not_mem_inter ha f

theorem indicator_eventually_le_indicator {α : Type u_1} {β : Type u_2} [HasZero β] [preorder β] {s : set α} {f : α → β} {g : α → β} {l : filter α} (h : filter.eventually_le (l ⊓ filter.principal s) f g) : filter.eventually_le l (set.indicator s f) (set.indicator s g) :=
  filter.eventually.mono (iff.mp filter.eventually_inf_principal h)
    fun (a : α) (h : a ∈ s → f a ≤ g a) => set.indicator_rel_indicator (le_refl 0) h

theorem tendsto_indicator_of_monotone {α : Type u_1} {β : Type u_2} {ι : Type u_3} [preorder ι] [HasZero β] (s : ι → set α) (hs : monotone s) (f : α → β) (a : α) : filter.tendsto (fun (i : ι) => set.indicator (s i) f a) filter.at_top
  (pure (set.indicator (set.Union fun (i : ι) => s i) f a)) := sorry

theorem tendsto_indicator_of_antimono {α : Type u_1} {β : Type u_2} {ι : Type u_3} [preorder ι] [HasZero β] (s : ι → set α) (hs : ∀ {i j : ι}, i ≤ j → s j ⊆ s i) (f : α → β) (a : α) : filter.tendsto (fun (i : ι) => set.indicator (s i) f a) filter.at_top
  (pure (set.indicator (set.Inter fun (i : ι) => s i) f a)) := sorry

theorem tendsto_indicator_bUnion_finset {α : Type u_1} {β : Type u_2} {ι : Type u_3} [HasZero β] (s : ι → set α) (f : α → β) (a : α) : filter.tendsto (fun (n : finset ι) => set.indicator (set.Union fun (i : ι) => set.Union fun (H : i ∈ n) => s i) f a)
  filter.at_top (pure (set.indicator (set.Union s) f a)) := sorry


import for_mathlib.homological_complex_op
import for_mathlib.homotopy_category

noncomputable theory

open opposite category_theory category_theory.limits

variables {ι : Type*} (c : complex_shape ι)

namespace complex_shape

@[simp]
lemma symm_next (i : ι) : c.symm.next i = c.prev i := rfl

@[simp]
lemma symm_prev (i : ι) : c.symm.prev i = c.next i := rfl

end complex_shape

namespace homological_complex

lemma op_functor_map_homotopy {ι C : Type*} {c : complex_shape ι} [category C] [preadditive C]
  {X Y : homological_complex C c}
  (f₁ f₂ : X ⟶ Y) (H : homotopy f₁ f₂) :
  homotopy
    (homological_complex.op_functor.map f₁.op)
    (homological_complex.op_functor.map f₂.op) :=
{ hom := λ i j, (H.hom j i).op,
  zero' := λ i j hij, by rw [H.zero j i hij, op_zero],
  comm := λ i, begin
    simp only [homological_complex.op_functor_map_f, quiver.hom.unop_op, H.comm i,
      op_add, add_left_inj],
    conv_lhs { rw add_comm, },
    refl,
  end, }

end homological_complex

namespace homotopy_category

variables {C : Type*} [category C] [preadditive C] {c}

def op_functor : (homotopy_category C c)ᵒᵖ ⥤ homotopy_category Cᵒᵖ c.symm :=
functor.left_op (category_theory.quotient.lift _
  (homological_complex.op_functor ⋙ homotopy_category.quotient Cᵒᵖ c.symm).right_op
(λ X Y f₁ f₂ h, begin
  dsimp only [functor.right_op],
  congr' 1,
  dsimp only [functor.comp_map],
  erw quotient.functor_map_eq_iff,
  refine ⟨homological_complex.op_functor_map_homotopy f₁ f₂ h.some⟩,
end))

def quotient_op_functor :
  (quotient C c).op ⋙ op_functor ≅ homological_complex.op_functor ⋙ quotient Cᵒᵖ c.symm :=
nat_iso.of_components (λ X, eq_to_iso (by refl))
(λ X Y f, by { dsimp, simpa only [category.comp_id, category.id_comp], })

def unop_functor : (homotopy_category Cᵒᵖ c)ᵒᵖ ⥤ homotopy_category C c.symm :=
functor.left_op (category_theory.quotient.lift _
  (homological_complex.unop_functor ⋙ homotopy_category.quotient C c.symm).right_op
(λ X Y f₁ f₂ h, begin
  dsimp only [functor.right_op],
  congr' 1,
  dsimp only [functor.comp_map],
  erw quotient.functor_map_eq_iff,
  let H := h.some,
  exact nonempty.intro
  { hom := λ i j, (H.hom j i).unop,
    zero' := λ i j hij, by rw [H.zero j i hij, unop_zero],
    comm := λ i, begin
      apply quiver.hom.op_inj,
      simp only [homological_complex.unop_functor_map_f, op_add, quiver.hom.op_unop,
        quiver.hom.unop_op, H.comm i],
      conv_lhs { congr, rw add_comm, },
      congr' 2,
    end, },
end))

def quotient_unop_functor :
  (quotient Cᵒᵖ c).op ⋙ unop_functor ≅ homological_complex.unop_functor ⋙ quotient C c.symm :=
nat_iso.of_components (λ X, eq_to_iso (by refl))
(λ X Y f, by { dsimp, simpa only [category.comp_id, category.id_comp], })

end homotopy_category


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.shift
import Mathlib.category_theory.concrete_category.default
import Mathlib.category_theory.pi.basic
import Mathlib.algebra.group.basic
import Mathlib.PostPort

universes w u v u_1

namespace Mathlib

/-!
# The category of graded objects

For any type `β`, a `β`-graded object over some category `C` is just
a function `β → C` into the objects of `C`.
We put the "pointwise" category structure on these, as the non-dependent specialization of
`category_theory.pi`.

We describe the `comap` functors obtained by precomposing with functions `β → γ`.

As a consequence a fixed element (e.g. `1`) in an additive group `β` provides a shift
functor on `β`-graded objects

When `C` has coproducts we construct the `total` functor `graded_object β C ⥤ C`,
show that it is faithful, and deduce that when `C` is concrete so is `graded_object β C`.
-/

namespace category_theory

/-- A type synonym for `β → C`, used for `β`-graded objects in a category `C`. -/
def graded_object (β : Type w) (C : Type u) := β → C

-- Satisfying the inhabited linter...

protected instance inhabited_graded_object (β : Type w) (C : Type u) [Inhabited C] :
    Inhabited (graded_object β C) :=
  { default := fun (b : β) => Inhabited.default }

/--
A type synonym for `β → C`, used for `β`-graded objects in a category `C`
with a shift functor given by translation by `s`.
-/
def graded_object_with_shift {β : Type w} [add_comm_group β] (s : β) (C : Type u) :=
  graded_object β C

namespace graded_object

protected instance category_of_graded_objects {C : Type u} [category C] (β : Type w) :
    category (graded_object β C) :=
  category_theory.pi fun (_x : β) => C

/--
The natural isomorphism comparing between
pulling back along two propositionally equal functions.
-/
def comap_eq (C : Type u) [category C] {β : Type w} {γ : Type w} {f : β → γ} {g : β → γ}
    (h : f = g) : pi.comap (fun (i : γ) => C) f ≅ pi.comap (fun (i : γ) => C) g :=
  iso.mk (nat_trans.mk fun (X : γ → C) (b : β) => eq_to_hom sorry)
    (nat_trans.mk fun (X : γ → C) (b : β) => eq_to_hom sorry)

theorem comap_eq_symm (C : Type u) [category C] {β : Type w} {γ : Type w} {f : β → γ} {g : β → γ}
    (h : f = g) : comap_eq C (Eq.symm h) = iso.symm (comap_eq C h) :=
  Eq.refl (comap_eq C (Eq.symm h))

theorem comap_eq_trans (C : Type u) [category C] {β : Type w} {γ : Type w} {f : β → γ} {g : β → γ}
    {h : β → γ} (k : f = g) (l : g = h) :
    comap_eq C (Eq.trans k l) = comap_eq C k ≪≫ comap_eq C l :=
  sorry

/--
The equivalence between β-graded objects and γ-graded objects,
given an equivalence between β and γ.
-/
def comap_equiv (C : Type u) [category C] {β : Type w} {γ : Type w} (e : β ≃ γ) :
    graded_object β C ≌ graded_object γ C :=
  equivalence.mk' (pi.comap (fun (_x : β) => C) ⇑(equiv.symm e)) (pi.comap (fun (_x : γ) => C) ⇑e)
    (comap_eq C sorry ≪≫ iso.symm (pi.comap_comp (fun (_x : β) => C) ⇑e ⇑(equiv.symm e)))
    (pi.comap_comp (fun (_x : γ) => C) ⇑(equiv.symm e) ⇑e ≪≫ comap_eq C sorry)

protected instance has_shift {C : Type u} [category C] {β : Type u_1} [add_comm_group β] (s : β) :
    has_shift (graded_object_with_shift s C) :=
  has_shift.mk (comap_equiv C (equiv.mk (fun (b : β) => b - s) (fun (b : β) => b + s) sorry sorry))

@[simp] theorem shift_functor_obj_apply {C : Type u} [category C] {β : Type u_1} [add_comm_group β]
    (s : β) (X : β → C) (t : β) :
    functor.obj (equivalence.functor (shift (graded_object_with_shift s C))) X t = X (t + s) :=
  rfl

@[simp] theorem shift_functor_map_apply {C : Type u} [category C] {β : Type u_1} [add_comm_group β]
    (s : β) {X : graded_object_with_shift s C} {Y : graded_object_with_shift s C} (f : X ⟶ Y)
    (t : β) :
    functor.map (equivalence.functor (shift (graded_object_with_shift s C))) f t = f (t + s) :=
  rfl

protected instance has_zero_morphisms {C : Type u} [category C] [limits.has_zero_morphisms C]
    (β : Type w) : limits.has_zero_morphisms (graded_object β C) :=
  limits.has_zero_morphisms.mk

@[simp] theorem zero_apply {C : Type u} [category C] [limits.has_zero_morphisms C] (β : Type w)
    (X : graded_object β C) (Y : graded_object β C) (b : β) : HasZero.zero b = 0 :=
  rfl

protected instance has_zero_object {C : Type u} [category C] [limits.has_zero_object C]
    [limits.has_zero_morphisms C] (β : Type w) : limits.has_zero_object (graded_object β C) :=
  limits.has_zero_object.mk (fun (b : β) => 0)
    (fun (X : graded_object β C) => unique.mk { default := fun (b : β) => 0 } sorry)
    fun (X : graded_object β C) => unique.mk { default := fun (b : β) => 0 } sorry

end graded_object

namespace graded_object

-- The universes get a little hairy here, so we restrict the universe level for the grading to 0.

-- Since we're typically interested in grading by ℤ or a finite group, this should be okay.

-- If you're grading by things in higher universes, have fun!

/--
The total object of a graded object is the coproduct of the graded components.
-/
def total (β : Type) (C : Type u) [category C] [limits.has_coproducts C] : graded_object β C ⥤ C :=
  functor.mk (fun (X : graded_object β C) => ∐ fun (i : ulift β) => X (ulift.down i))
    fun (X Y : graded_object β C) (f : X ⟶ Y) =>
      limits.sigma.map fun (i : ulift β) => f (ulift.down i)

/--
The `total` functor taking a graded object to the coproduct of its graded components is faithful.
To prove this, we need to know that the coprojections into the coproduct are monomorphisms,
which follows from the fact we have zero morphisms and decidable equality for the grading.
-/
protected instance total.category_theory.faithful (β : Type) (C : Type u) [category C]
    [limits.has_coproducts C] [limits.has_zero_morphisms C] : faithful (total β C) :=
  faithful.mk

end graded_object

namespace graded_object

protected instance category_theory.concrete_category (β : Type) (C : Type (u + 1))
    [large_category C] [concrete_category C] [limits.has_coproducts C]
    [limits.has_zero_morphisms C] : concrete_category (graded_object β C) :=
  concrete_category.mk (total β C ⋙ forget C)

protected instance category_theory.has_forget₂ (β : Type) (C : Type (u + 1)) [large_category C]
    [concrete_category C] [limits.has_coproducts C] [limits.has_zero_morphisms C] :
    has_forget₂ (graded_object β C) C :=
  has_forget₂.mk (total β C)

end Mathlib


import pseudo_normed_group.LC
import analysis.normed.group.hom_completion

/-!

# V-hat(M_c^n)

One of the key players in the proof of the main theorem of this repo is
the normed group V-hat(M-bar_r'(S)_{≤c}^n). This file constructs

## Key defintions

- `CLCP V n`: the functor that sends a profinite set `S` to `V-hat(S^n)`
- `CLFCP v r' c n`: the functor sending a profinitely-filtered `T⁻¹`-module `M`
   to `V-hat((M_c)^n)`

-/
open_locale classical nnreal
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 : ℕ)

/-- `CLC V n` is the functor that sends a profinite set `S` to `V-hat(S^n)` -/
def CLC (V : SemiNormedGroup) : Profiniteᵒᵖ ⥤ SemiNormedGroup :=
LC V ⋙ Completion

namespace CLC

lemma map_norm_noninc {M₁ M₂} (f : M₁ ⟶ M₂) : ((CLC V).map f).norm_noninc :=
Completion.map_norm_noninc $ LC.map_norm_noninc _ _

def T [normed_with_aut r V] [fact (0 < r)] : CLC V ≅ CLC V :=
((whiskering_right _ _ _).obj _).map_iso (LC.T r V)

lemma norm_T_le [normed_with_aut r V] [fact (0 < r)] (A) : ∥(T r V).hom.app A∥ ≤ r :=
le_trans (normed_group_hom.norm_completion _).le $ LC.norm_T_le _ _ _

def T_inv [normed_with_aut r V] [fact (0 < r)] : CLC V ⟶ CLC V :=
whisker_right (LC.T_inv r V) Completion

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

lemma norm_T_inv_le [normed_with_aut r V] [fact (0 < r)] (A) : ∥(T_inv r V).app A∥ ≤ r⁻¹ :=
le_trans (normed_group_hom.norm_completion _).le $ LC.norm_T_inv_le _ _ _

end CLC

/-- `CLFCP v r' c n` is the functor sending a profinitely-filtered `T⁻¹`-module `M`
   to `V-hat((M_c)^n)` -/
def CLCFP (V : SemiNormedGroup) (r' : ℝ≥0) (c : ℝ≥0) (n : ℕ) :
  (ProFiltPseuNormGrpWithTinv r')ᵒᵖ ⥤ SemiNormedGroup :=
(FiltrationPow r' c n).op ⋙ CLC V

theorem CLCFP_def (V : SemiNormedGroup) (r' : ℝ≥0) (c : ℝ≥0) (n : ℕ) :
  CLCFP V r' c n = LCFP V r' c n ⋙ Completion := rfl

namespace CLCFP

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

@[simps app]
def res [fact (c₂ ≤ c₁)] : CLCFP V r' c₁ n ⟶ CLCFP V r' c₂ n :=
(whisker_right (nat_trans.op $ FiltrationPow.cast_le r' c₂ c₁ n) (CLC V) : _)

lemma res_def [fact (c₂ ≤ c₁)] :
  res V r' c₁ c₂ n = whisker_right (nat_trans.op (FiltrationPow.cast_le r' c₂ c₁ n)) (CLC V) :=
rfl

lemma res_def' [fact (c₂ ≤ c₁)] (M : ProFiltPseuNormGrpWithTinv r') :
  (res V r' c₁ c₂ n).app (op M) =
  (CLC V).map ((Filtration.cast_le ((ProFiltPseuNormGrpWithTinv.Pow r' n).obj M) c₂ c₁)).op :=
rfl

lemma res_app' [fact (c₂ ≤ c₁)] (M : (ProFiltPseuNormGrpWithTinv r')ᵒᵖ) :
  (res V r' c₁ c₂ n).app M = (CLC V).map ((FiltrationPow.cast_le r' c₂ c₁ n).app (unop M)).op :=
rfl

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

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

lemma res_norm_noninc [fact (c₂ ≤ c₁)] (M) :
  ((res V r' c₁ c₂ n).app M).norm_noninc :=
Completion.map_norm_noninc $ LCFP.res_norm_noninc _ _ _ _ _ _

section Tinv
-- kmb commented out the next line
--open profinitely_filtered_pseudo_normed_group_with_Tinv
variables [fact (0 < r')] [fact (c₂ ≤ r' * c₁)]

-- @[simps obj {fully_applied := ff}]
def Tinv : CLCFP V r' c₁ n ⟶ CLCFP V r' c₂ n :=
(whisker_right (nat_trans.op $ FiltrationPow.Tinv r' c₂ c₁ n)
  (LocallyConstant.obj V ⋙ Completion) : _)
.

lemma Tinv_def : Tinv V r' c₁ c₂ n =
  (whisker_right (LCFP.Tinv V r' c₁ c₂ n) Completion : _) := rfl

lemma Tinv_def' : Tinv V r' c₁ c₂ n =
  whisker_right (nat_trans.op $ FiltrationPow.Tinv r' c₂ c₁ n) (CLC V) := rfl

lemma res_comp_Tinv [fact (c₂ ≤ c₁)] [fact (c₃ ≤ 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
  dsimp only [Tinv, res, CLC, LC],
  simp only [← whisker_right_comp, ← nat_trans.op_comp],
  refl
end

end Tinv

section T_inv

variables [normed_with_aut r V] [fact (0 < r)]

@[simps {fully_applied := ff}]
def T : CLCFP V r' c n ≅ CLCFP V r' c n :=
((whiskering_left _ _ _).obj (FiltrationPow r' c n).op).map_iso (CLC.T r V)

@[simps app_apply {fully_applied := ff}]
def T_inv : CLCFP V r' c n ⟶ CLCFP V r' c n :=
whisker_left (FiltrationPow r' c n).op (CLC.T_inv r V)

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

lemma T_inv_def : T_inv r V r' c n = (whisker_right (LCFP.T_inv r V r' c n) Completion : _) :=
rfl

lemma T_inv_app [fact (0 < r)] (M : (ProFiltPseuNormGrpWithTinv r')ᵒᵖ) :
  (T_inv r V r' c n).app M =
    (CLC.T_inv r V).app ((FiltrationPow r' c n).op.obj M) :=
rfl

lemma res_comp_T_inv [fact (c₂ ≤ c₁)] :
  res V r' c₁ c₂ n ≫ T_inv r V r' c₂ n =
    T_inv r V r' c₁ n ≫ res V r' c₁ c₂ n :=
begin
  ext M : 2,
  simp only [nat_trans.comp_app, res_app', T_inv_app],
  exact (CLC.T_inv r V).naturality _,
end

end T_inv

end CLCFP

namespace breen_deligne

open CLCFP
variables {l m n}

namespace universal_map

variables (ϕ ψ : universal_map m n)

def eval_CLCFP [ϕ.suitable c₂ c₁] : CLCFP V r' c₁ n ⟶ CLCFP V r' c₂ m :=
(whisker_right (ϕ.eval_LCFP V r' c₁ c₂) Completion : _)

lemma eval_CLCFP_of (f : basic_universal_map m n) [f.suitable c₂ c₁] :
  eval_CLCFP V r' c₁ c₂ (free_abelian_group.of f) =
  (whisker_right (nat_trans.op $ f.eval_FP r' c₂ c₁) (CLC V)) :=
by { rw [eval_CLCFP, eval_LCFP_of, basic_universal_map.eval_LCFP, whisker_right_twice], refl }

@[simp] lemma eval_CLCFP_zero :
  (0 : universal_map m n).eval_CLCFP V r' c₁ c₂ = 0 :=
begin
  simp only [eval_CLCFP, eval_LCFP_zero],
  ext x : 2,
  exact Completion.map_zero _ _
end

@[simp] lemma eval_CLCFP_add [ϕ.suitable c₂ c₁] [ψ.suitable c₂ c₁] :
  (ϕ + ψ : universal_map m n).eval_CLCFP V r' c₁ c₂ =
  ϕ.eval_CLCFP V r' c₁ c₂ + ψ.eval_CLCFP V r' c₁ c₂ :=
begin
  simp only [eval_CLCFP, eval_LCFP_add],
  ext x : 2,
  exact Completion.map_add
end

@[simp] lemma eval_CLCFP_sub [ϕ.suitable c₂ c₁] [ψ.suitable c₂ c₁] :
  (ϕ - ψ : universal_map m n).eval_CLCFP V r' c₁ c₂ =
  ϕ.eval_CLCFP V r' c₁ c₂ - ψ.eval_CLCFP V r' c₁ c₂ :=
begin
  simp only [eval_CLCFP, eval_LCFP_sub],
  ext x : 2,
  exact Completion.map_sub
end

open category_theory.limits

lemma eval_CLCFP_comp (g : universal_map m n) (f : universal_map l m)
  [hg : g.suitable c₂ c₁] [hf : f.suitable c₃ c₂] :
  @eval_CLCFP V r' c₁ c₃ _ _ (comp g f) (suitable.comp c₂) =
    g.eval_CLCFP V r' c₁ c₂ ≫ f.eval_CLCFP V r' c₂ c₃ :=
by simp only [eval_CLCFP, ← whisker_right_comp, eval_LCFP_comp V r' c₁ c₂ c₃]

lemma res_comp_eval_CLCFP
  [fact (c₂ ≤ c₁)] [ϕ.suitable c₄ c₂] [ϕ.suitable c₃ c₁] [fact (c₄ ≤ c₃)] :
  res V r' c₁ c₂ n ≫ ϕ.eval_CLCFP V r' c₂ c₄ =
    ϕ.eval_CLCFP V r' c₁ c₃ ≫ res V r' c₃ c₄ m :=
by { dsimp only [CLC, res], simp only [eval_CLCFP, ← whisker_right_comp, ← whisker_right_twice],
     congr' 1, apply res_comp_eval_LCFP }

lemma Tinv_comp_eval_CLCFP [fact (0 < r')] [fact (c₂ ≤ r' * c₁)] [fact (c₄ ≤ r' * c₃)]
  [ϕ.suitable c₃ c₁] [ϕ.suitable c₄ c₂] :
  Tinv V r' c₁ c₂ n ≫ ϕ.eval_CLCFP V r' c₂ c₄ =
    ϕ.eval_CLCFP V r' c₁ c₃ ≫ Tinv V r' c₃ c₄ m :=
by simp only [eval_CLCFP, Tinv_def, ← whisker_right_comp]; congr' 1; apply Tinv_comp_eval_LCFP

lemma T_inv_comp_eval_CLCFP [normed_with_aut r V] [fact (0 < r)] [ϕ.suitable c₂ c₁] :
  T_inv r V r' c₁ n ≫ ϕ.eval_CLCFP V r' c₁ c₂ =
    ϕ.eval_CLCFP V r' c₁ c₂ ≫ T_inv r V r' c₂ m :=
by simp only [eval_CLCFP, T_inv_def, ← whisker_right_comp, T_inv_comp_eval_LCFP]

lemma norm_eval_CLCFP_le [normed_with_aut r V] [fact (0 < r)] [ϕ.suitable c₂ c₁]
  (N : ℕ) (h : ϕ.bound_by N) (M) :
  ∥(ϕ.eval_CLCFP V r' c₁ c₂).app M∥ ≤ N :=
le_trans (normed_group_hom.norm_completion _).le $ norm_eval_LCFP_le _ _ _ _ _ _ _ h _

end universal_map

end breen_deligne


/- # Syntax

This chapter is concerned with the means to declare and operate on syntax
in Lean. Since there are a multitude of ways to operate on it, we will
not go into great detail about this yet and postpone quite a bit of this to
later chapters.

## Declaring Syntax

### Declaration helpers

Some readers might be familiar with the `infix` or even the `notation`
commands, for those that are not here is a brief recap:
-/

import Lean

-- XOR, denoted \oplus
infixl:60 " ⊕ " => fun l r => (!l && r) || (l && !r)

#eval true ⊕ true -- false
#eval true ⊕ false -- true
#eval false ⊕ true -- true
#eval false ⊕ false -- false

-- with `notation`, "left XOR"
notation:10 l:10 " LXOR " r:11 => (!l && r)

#eval true LXOR true -- false
#eval true LXOR false -- false
#eval false LXOR true -- true
#eval false LXOR false -- false

/- As we can see the `infixl` command allows us to declare a notation for
a binary operation that is infix, meaning that the operator is in between
the operands (as opposed to e.g. before which would be done using the `prefix` command).
The `l` at the end of `infixl` means that the notation is left associative so `a ⊕ b ⊕ c`
gets parsed as `(a ⊕ b) ⊕ c` as opposed to `a ⊕ (b ⊕ c)` (which would be achieved by `infixr`).
On the right hand side, it expects a function that operates on these two parameters
and returns some value. The `notation` command, on the other hand, allows us some more
freedom: we can just "mention" the parameters right in the syntax definition
and operate on them on the right hand side. It gets even better though, we can
in theory create syntax with 0 up to as many parameters as we wish using the
`notation` command, it is hence also often referred to as "mixfix" notation.

The two unintuitive parts about these two are:
- The fact that we are leaving spaces around our operators: " ⊕ ", " LXOR ".
  This is so that, when Lean pretty prints our syntax later on, it also
  uses spaces around the operators, otherwise the syntax would just be presented
  as `l⊕r` as opposed to `l ⊕ r`.
- The `60` and `10` right after the respective commands -- these denote the operator
  precedence, meaning how strong they bind to their arguments, let's see this in action:
-/

#eval true ⊕ false LXOR false -- false
#eval (true ⊕ false) LXOR false -- false
#eval true ⊕ (false LXOR false) -- true

/-!
As we can see, the Lean interpreter analyzed the first term without parentheses
like the second instead of the third one. This is because the `⊕` notation
has higher precedence than `LXOR` (`60 > 10` after all) and is thus evaluated before it.
This is also how you might implement rules like `*` being evaluated before `+`.

Lastly at the `notation` example there are also these `:precedence` bindings
at the arguments: `l:10` and `r:11`. This conveys that the left argument must have
precedence at least 10 or greater, and the right argument must have precedence at 11
or greater. The way the arguments are assigned their respective precedence is by looking at
the precedence of the rule that was used to parse them. Consider for example
`a LXOR b LXOR c`. Theoretically speaking this could be parsed in two ways:
1. `(a LXOR b) LXOR c`
2. `a LXOR (b LXOR c)`

Since the arguments in parentheses are parsed by the `LXOR` rule with precedence
10 they will appear as arguments with precedence 10 to the outer `LXOR` rule:
1. `(a LXOR b):10 LXOR c`
2. `a LXOR (b LXOR c):10`

However if we check the definition of `LXOR`: `notation:10 l:10 " LXOR " r:11`
we can see that the right hand side argument requires a precedence of at least 11
or greater, thus the second parse is invalid and we remain with: `(a LXOR b) LXOR c`
assuming that:
- `a` has precedence 10 or higher
- `b` has precedence 11 or higher
- `c` has precedence 11 or higher

Thus `LXOR` is a left associative notation. Can you make it right associative?

NOTE: If parameters of a notation are not explicitly given a precedence they will implicitly be tagged with precedence 0.

As a last remark for this section: Lean will always attempt to obtain the longest
matching parse possible, this has three important implications.
First a very intuitive one, if we have a right associative operator `^`
and Lean sees something like `a ^ b ^ c`, it will first parse the `a ^ b`
and then attempt to keep parsing (as long as precedence allows it) until
it cannot continue anymore. Hence Lean will parse this expression as `a ^ (b ^ c)`
(as we would expect it to).

Secondly, if we have a notation where precedence does not allow to figure
out how the expression should be parenthesized, for example:
-/

notation:65 lhs:65 " ~ " rhs:65 => (lhs - rhs)

/-!
An expression like `a ~ b ~ c` will be parsed as `a ~ (b ~ c)` because
Lean attempts to find the longest parse possible. As a general rule of thumb:
If precedence is ambiguous Lean will default to right associativity.
-/

#eval 5 ~ 3 ~ 3 -- 5 because this is parsed as 5 - (3 - 3)

/-!
Lastly, if we define overlapping notation such as:
-/

-- define `a ~ b mod rel` to mean that a and b are equivalent with respect to some equivalance relation rel
notation:65 a:65 " ~ " b:65 " mod " rel:65 => rel a b

/-!
Lean will prefer this notation over parsing `a ~ b` as defined above and
then erroring because it doesn't know what to do with `mod` and the
relation argument:
-/

#check 0 ~ 0 mod Eq -- 0 = 0 : Prop

/-!
This is again because it is looking for the longest possible parser which
in this case involves also consuming `mod` and the relation argument.
-/

/-!
### Free form syntax declarations
With the above `infix` and `notation` commands, you can get quite far with
declaring ordinary mathematical syntax already. Lean does however allow you to
introduce arbitrarily complex syntax as well. This is done using two main commands
`syntax` and `declare_syntax_cat`. A `syntax` command allows you add a new
syntax rule to an already existing so-called "syntax category". The most common syntax
categories are:
- `term`, this category will be discussed in detail in the elaboration chapter,
  for now you can think of it as "the syntax of everything that has a value"
- `command`, this is the category for top-level commands like `#check`, `def` etc.
- TODO: ...

Let's see this in action:
-/

syntax "MyTerm" : term

/-!
We can now write `MyTerm` in place of things like `1 + 1` and it will be
*syntactically* valid, this does not mean the code will compile yet,
it just means that the Lean parser can understand it:
-/

def Playground1.test := MyTerm
-- elaboration function for 'termMyTerm' has not been implemented
--   MyTerm

/-!
Implementing this so-called "elaboration function", which will actually
give meaning to this syntax in terms of Lean's fundamental `Expr` type,
is topic of the elaboration chapter.

The `notation` and `infix` commands are utilities that conveniently bundle syntax declaration
with macro definition (for more on macros, see the macro chapter),
where the contents left of the `=>` declare the syntax.
All the previously mentioned principles from `notation` and `infix` regarding precedence
fully apply to `syntax` as well.

We can, of course, also involve other syntax into our own declarations
in order to build up syntax trees. For example, we could try to build our
own little boolean expression language:
-/

namespace Playground2

-- The scoped modifier makes sure the syntax declarations remain in this `namespace`
-- because we will keep modifying this along the chapter
scoped syntax "⊥" : term -- ⊥ for false
scoped syntax "⊤" : term -- ⊤ for true
scoped syntax:40 term " OR " term : term
scoped syntax:50 term " AND " term : term
#check ⊥ OR (⊤ AND ⊥) -- elaboration function hasn't been implemented but parsing passes

end Playground2

/-!
While this does work, it allows arbitrary terms to the left and right of our
`AND` and `OR` operation. If we want to write a mini language that only accepts
our boolean language on a syntax level we will have to declare our own
syntax category on top. This is done using the `declare_syntax_cat` command:
-/

declare_syntax_cat boolean_expr
syntax "⊥" : boolean_expr -- ⊥ for false
syntax "⊤" : boolean_expr -- ⊤ for true
syntax:40 boolean_expr " OR " boolean_expr : boolean_expr
syntax:50 boolean_expr " AND " boolean_expr : boolean_expr

/-!
Now that we are working in our own syntax category, we are completely
disconnected from the rest of the system. And these cannot be used in place of
terms anymore:
-/

#check ⊥ AND ⊤ -- expected term

/-!
In order to integrate our syntax category into the rest of the system we will
have to extend an already existing one with new syntax, in this case we
will re-embed it into the `term` category:
-/

syntax "[Bool|" boolean_expr "]" : term
#check [Bool| ⊥ AND ⊤] -- elaboration function hasn't been implemented but parsing passes

/-!
### Syntax combinators
In order to declare more complex syntax, it is often very desirable to have
some basic operations on syntax already built-in, these include:

- helper parsers without syntax categories (i.e. not extendable)
- alternatives
- repetitive parts
- optional parts

While all of these do have an encoding based on syntax categories, this
can make things quite ugly at times, so Lean provides an easier way to do all
of these.

In order to see all of these in action, we will briefly define a simple
binary expression syntax.
First things first, declaring named parsers that don't belong to a syntax
category is quite similar to ordinary `def`s:
-/

syntax binOne := "O"
syntax binZero := "Z"

/-!
These named parsers can be used in the same positions as syntax categories
from above, their only difference to them is, that they are not extensible.
That is, they are directly expanded within syntax declarations,
and we cannot define new patterns for them as we would with proper syntax categories.
There does also exist a number of built-in named parsers that are generally useful,
most notably:
- `str` for string literals
- `num` for number literals
- `ident` for identifiers
- ... TODO: better list or link to compiler docs

Next up we want to declare a parser that understands digits, a binary digit is
either 0 or 1 so we can write:
-/

syntax binDigit := binZero <|> binOne

/-!
Where the `<|>` operator implements the "accept the left or the right" behaviour.
We can also chain them to achieve parsers that accept arbitrarily many, arbitrarly complex
other ones. Now we will define the concept of a binary number, usually this would be written
as digits directly after each other but we will instead use comma separated ones to showcase
the repetition feature:
-/

-- the "+" denotes "one or many", in order to achieve "zero or many" use "*" instead
-- the "," denotes the separator between the `binDigit`s, if left out the default separator is a space
syntax binNumber := binDigit,+

/-!
Since we can just use named parsers in place of syntax categories, we can now easily
add this to the `term` category:
-/

syntax "bin(" binNumber ")" : term
#check bin(Z, O, Z, Z, O) -- elaboration function hasn't been implemented but parsing passes
#check bin() -- fails to parse because `binNumber` is "one or many": expected 'O' or 'Z'

syntax binNumber' := binDigit,* -- note the *
syntax "emptyBin(" binNumber' ")" : term
#check emptyBin() -- elaboration function hasn't been implemented but parsing passes

/-!
Note that nothing is limiting us to only using one syntax combinator per parser,
we could also have written all of this inline:
-/

syntax "binCompact(" ("Z" <|> "O"),+ ")" : term
#check binCompact(Z, O, Z, Z, O) -- elaboration function hasn't been implemented but parsing passes

/-!
As a final feature, let's add an optional string comment that explains the binary
literal being declared:
-/

-- The (...)? syntax means that the part in parentheses is optional
syntax "binDoc(" (str ";")? binNumber ")" : term
#check binDoc(Z, O, Z, Z, O) -- elaboration function hasn't been implemented but parsing passes
#check binDoc("mycomment"; Z, O, Z, Z, O) -- elaboration function hasn't been implemented but parsing passes

/-!
## Operating on Syntax
As explained above, we will not go into detail in this chapter on how to teach
Lean about the meaning you want to give your syntax. We will, however, take a look
at how to write functions that operate on it. Like all things in Lean, syntax is
represented by the inductive type `Lean.Syntax`, on which we can operate. It does
contain quite some information, but most of what we are interested in, we can
condense in the following simplified view:
-/

namespace Playground2

inductive Syntax where
  | missing : Syntax
  | node (kind : Lean.SyntaxNodeKind) (args : Array Syntax) : Syntax
  | atom : String -> Syntax
  | ident : Lean.Name -> Syntax

end Playground2

/-!
Lets go through the definition one constructor at a time:
- `missing` is used when there is something the Lean compiler cannot parse,
  it is what allows Lean to have a syntax error in one part of the file but
  recover from it and try to understand the rest of it. This also means we pretty
  much don't care about this constructor.
- `node` is, as the name suggests, a node in the syntax tree. It has a so called
  `kind : SyntaxNodeKind` where `SyntaxNodeKind` is just a `Lean.Name`. Basically,
  each of our `syntax` declarations receives an automatically generated `SyntaxNodeKind`
  (we can also explicitly specify the name with `syntax (name := foo) ... : cat`) so
  we can tell Lean "this function is responsible for processing this specific syntax construct".
  Furthermore, like all nodes in a tree, it has children, in this case in the form of
  an `Array Syntax`.
- `atom` represents (with the exception of one) every syntax object that is at the bottom of the
  hierarchy. For example, our operators ` ⊕ ` and ` LXOR ` from above will be represented as
  atoms.
- `ident` is the mentioned exception to this rule. The difference between `ident` and `atom`
  is also quite obvious: an identifier has a `Lean.Name` instead of a `String` that represents it.
  Why a `Lean.Name` is not just a `String` is related to a concept called macro hygiene
  that will be discussed in detail in the macro chapter. For now, you can consider them
  basically equivalent.

### Constructing new `Syntax`
Now that we know how syntax is represented in Lean, we could of course write programs that
generate all of these inductive trees by hand, which would be incredibly tedious and is something
we most definitely want to avoid. Luckily for us there is quite an extensive API hidden inside the
`Lean.Syntax` namespace we can explore:
-/

open Lean
#check Syntax -- Syntax. autocomplete

/-!
The interesting functions for creating `Syntax` are the `Syntax.mk*` ones that allow us to create
both very basic `Syntax` objects like `ident`s but also more complex ones like `Syntax.mkApp`
which we can use to create the `Syntax` object that would amount to applying the function
from the first argument to the argument list (all given as `Syntax`) in the second one.
Let's see a few examples:
-/

-- Name literals are written with this little ` in front of the name
#eval Syntax.mkApp (mkIdent `Nat.add) #[Syntax.mkNumLit "1", Syntax.mkNumLit "1"] -- is the syntax of `Nat.add 1 1`
#eval mkNode `«term_+_» #[Syntax.mkNumLit "1", mkAtom "+", Syntax.mkNumLit "1"] -- is the syntax for `1 + 1`

-- note that the `«term_+_» is the auto-generated SyntaxNodeKind for the + syntax

/-
If you don't like this way of creating `Syntax` at all you are not alone.
However, there are a few things involved with the machinery of doing this in
a pretty and correct (the machinery is mostly about the correct part) way
which will be explained in the macro chapter.

### Matching on `Syntax`
Just like constructing `Syntax` is an important topic, especially
with macros, matching on syntax is equally (or in fact even more) interesting.
Luckily we don't have to match on the inductive type itself either: we can
instead use so-called "syntax patterns". They are quite simple, their syntax is just
`` `(the syntax I want to match on) ``. Let's see one in action:
-/

def isAdd11 : Syntax → Bool
  | `(Nat.add 1 1) => true
  | _ => false

#eval isAdd11 (Syntax.mkApp (mkIdent `Nat.add) #[Syntax.mkNumLit "1", Syntax.mkNumLit "1"]) -- true
#eval isAdd11 (Syntax.mkApp (mkIdent `Nat.add) #[mkIdent `foo, Syntax.mkNumLit "1"]) -- false

/-!
The next level with matches is to capture variables from the input instead
of just matching on literals, this is done with a slightly fancier-looking syntax:
-/

def isAdd : Syntax → Option (Syntax × Syntax)
  | `(Nat.add $x $y) => some (x, y)
  | _ => none

#eval isAdd (Syntax.mkApp (mkIdent `Nat.add) #[Syntax.mkNumLit "1", Syntax.mkNumLit "1"]) -- some ...
#eval isAdd (Syntax.mkApp (mkIdent `Nat.add) #[mkIdent `foo, Syntax.mkNumLit "1"]) -- some ...
#eval isAdd (Syntax.mkApp (mkIdent `Nat.add) #[mkIdent `foo]) -- none

/-!
### Typed Syntax
Note that `x` and `y` in this example are of type `` TSyntax `term ``, not `Syntax`.
Even though we are pattern matching on `Syntax` which, as we can see in the constructors,
is purely composed of types that are not `TSyntax`, so what is going on?
Basically the `` `() `` Syntax is smart enough to figure out the most general
syntax category the syntax we are matching might be coming from (in this case `term`).
It will then use the typed syntax type `TSyntax` which is parameterized
by the `Name` of the syntax category it came from. This is not only more
convenient for the programmer to see what is going on, it also has other
benefits. For Example if we limit the syntax category to just `num`
in the next example Lean will allow us to call `getNat` on the resulting
`` TSyntax `num `` directly without pattern matching or the option to panic:
-/

-- Now we are also explicitly marking the function to operate on term syntax
def isLitAdd : TSyntax `term → Option Nat
  | `(Nat.add $x:num $y:num) => some (x.getNat + y.getNat)
  | _ => none

#eval isLitAdd (Syntax.mkApp (mkIdent `Nat.add) #[Syntax.mkNumLit "1", Syntax.mkNumLit "1"]) -- some 2
#eval isLitAdd (Syntax.mkApp (mkIdent `Nat.add) #[mkIdent `foo, Syntax.mkNumLit "1"]) -- none

/-!
If you want to access the `Syntax` behind a `TSyntax` you can do this using
`TSyntax.raw` although the coercion machinery should just work most of the time.
We will see some further benefits of the `TSyntax` system in the macro chapter.

One last important note about the matching on syntax: In this basic
form it only works on syntax from the `term` category. If you want to use
it to match on your own syntax categories you will have to use `` `(category| ...)``.

### Mini Project
As a final mini project for this chapter we will declare the syntax of a mini
arithmetic expression language and a function of type `Syntax → Nat` to evaluate
it. We will see more about some of the concepts presented below in future
chapters.
-/

declare_syntax_cat arith

syntax num : arith
syntax arith "-" arith : arith
syntax arith "+" arith : arith
syntax "(" arith ")" : arith

partial def denoteArith : TSyntax `arith → Nat
  | `(arith| $x:num) => x.getNat
  | `(arith| $x:arith + $y:arith) => denoteArith x + denoteArith y
  | `(arith| $x:arith - $y:arith) => denoteArith x - denoteArith y
  | `(arith| ($x:arith)) => denoteArith x
  | _ => 0

-- You can ignore Elab.TermElabM, what is important for us is that it allows
-- us to use the ``(arith| (12 + 3) - 4)` notation to construct `Syntax`
-- instead of only being able to match on it like this.
def test : Elab.TermElabM Nat := do
  let stx ← `(arith| (12 + 3) - 4)
  pure (denoteArith stx)

#eval test -- 11

/-!
Feel free to play around with this example and extend it in whatever way
you want to. The next chapters will mostly be about functions that operate
on `Syntax` in some way.
-/

/-!
## More elaborate examples
### Using type classes for notations
We can use type classes in order to add notation that is extensible via
the type instead of the syntax system, this is for example how `+`
using the typeclasses `HAdd` and `Add` and other common operators in
Lean are generically defined.

For example, we might want to have a generic notation for subset notation.
The first thing we have to do is define a type class that captures
the function we want to build notation for.
-/

class Subset (α : Type u) where
  subset : α → α → Prop

/-!
The second step is to define the notation, what we can do here is simply
turn every instance of a `⊆` appearing in the code to a call to `Subset.subset`
because the type class resolution should be able to figure out which `Subset`
instance is referred to. Thus the notation will be a simple:
-/

-- precedence is arbitrary for this example
infix:50 " ⊆ " => Subset.subset

/-!
Let's define a simple theory of sets to test it:
-/

-- a `Set` is defined by the elements it contains
-- -> a simple predicate on the type of its elements
def Set (α : Type u) := α → Prop

def Set.mem (x : α) (X : Set α) : Prop := X x

-- Integrate into the already existing typeclass for membership notation
instance : Membership α (Set α) where
  mem := Set.mem

def Set.empty : Set α := λ _ => False

instance : Subset (Set α) where
  subset X Y := ∀ (x : α), x ∈ X → x ∈ Y

example : ∀ (X : Set α), Set.empty ⊆ X := by
  intro X x
  -- ⊢ x ∈ Set.empty → x ∈ X
  intro h
  exact False.elim h -- empty set has no members

/-!
### Binders
Because declaring syntax that uses variable binders used to be a rather
unintuitive thing to do in Lean 3, we'll take a brief look at how naturally
this can be done in Lean 4.

For this example we will define the well-known notation for the set
that contains all elements `x` such that some property holds:
`{x ∈ ℕ | x < 10}` for example.

First things first we need to extend the theory of sets from above slightly:
-/

-- the basic "all elements such that" function for the notation
def setOf {α : Type} (p : α → Prop) : Set α := p

/-!
Equipped with this function, we can now attempt to intuitively define a
basic version of our notation:
-/
notation "{ " x " | " p " }" => setOf (fun x => p)

#check { (x : Nat) | x ≤ 1 } -- { x | x ≤ 1 } : Set Nat

example : 1 ∈ { (y : Nat) | y ≤ 1 } := by simp[Membership.mem, Set.mem, setOf]
example : 2 ∈ { (y : Nat) | y ≤ 3 ∧ 1 ≤ y } := by simp[Membership.mem, Set.mem, setOf]

/-!
This intuitive notation will indeed deal with what we could throw at
it in the way we would expect it.

As to how one might extend this notation to allow more set-theoretic
things such as `{x ∈ X | p x}` and leave out the parentheses around
the bound variables, we refer the reader to the macro chapter.

## Exercises

1. Create an "urgent minus 💀" notation such that `5 * 8 💀 4` returns `20`, and `8 💀 6 💀 1` returns `3`.

**a)** Using `notation` command.
**b)** Using `infix` command.
**c)** Using `syntax` command.

Hint: multiplication in Lean 4 is defined as `infixl:70 " * " => HMul.hMul`.

2. Consider the following syntax categories: `term`, `command`, `tactic`; and 3 syntax rules given below. Make use of each of these newly defined syntaxes.

```
  syntax "good morning" : term
  syntax "hello" : command
  syntax "yellow" : tactic
```

3. Create a `syntax` rule that would accept the following commands:

- `red red red 4`
- `blue 7`
- `blue blue blue blue blue 18`

(So, either all `red`s followed by a number; or all `blue`s followed by a number; `red blue blue 5` - shouldn't work.)

Use the following code template:

```
syntax (name := colors) ...
-- our "elaboration function" that infuses syntax with semantics
@[command_elab colors] def elabColors : CommandElab := λ stx => Lean.logInfo "success!"
```

4. Mathlib has a `#help option` command that displays all options available in the current environment, and their descriptions. `#help option pp.r` will display all options starting with a "pp.r" substring.

Create a `syntax` rule that would accept the following commands:

- `#better_help option`
- `#better_help option pp.r`
- `#better_help option some.other.name`

Use the following template:

```
syntax (name := help) ...
-- our "elaboration function" that infuses syntax with semantics
@[command_elab help] def elabHelp : CommandElab := λ stx => Lean.logInfo "success!"
```

5. Mathlib has a ∑ operator. Create a `syntax` rule that would accept the following terms:

- `∑ x in { 1, 2, 3 }, x^2`
- `∑ x in { "apple", "banana", "cherry" }, x.length`

Use the following template:

```
import Std.Classes.SetNotation
import Std.Util.ExtendedBinder
syntax (name := bigsumin) ...
-- our "elaboration function" that infuses syntax with semantics
@[term_elab bigsumin] def elabSum : TermElab := λ stx tp => return mkNatLit 666
```

Hint: use the `Std.ExtendedBinder.extBinder` parser.
Hint: you need Std4 installed in your Lean project for these imports to work.

-/