import util.data.option
import util.data.nat
import util.logic

universes u u' v w

structure nonterm (α : Type u) :=
  (run : ℕ → option α)
  (consistent : ∀ i j x, i ≤ j → run i = some x → run j = some x)

open nat function

namespace nonterm

section instances

variables {α β γ : Type u}

def run_to (m : nonterm α) (n : ℕ) (x : α) :=
m.run n = some x

def yields (x : nonterm α) (y : α) : Prop :=
∃ i, run_to x i y

infix ` ~> `:55 := yields

protected def pure (x : α) : nonterm α :=
{ run := λ i, some x
, consistent := by { introv h h', apply h' } }

protected def bind (x : nonterm α) (f : α → nonterm β) : nonterm β :=
{ run := λ i, x.run i >>= λ j, (f j).run i
, consistent :=
  begin
    introv h h',
    destruct x.run i,
    { intro h₂, rw h₂ at h', contradiction },
    { intros z h₂,
      simp [h₂,bind,option.bind] at h',
      simp [x.consistent _ _ _ h h₂,bind,option.bind],
      apply (f z).consistent _ _ _ h h' }
  end }

instance : has_bind nonterm := ⟨ @nonterm.bind ⟩
instance : has_pure nonterm := ⟨ @nonterm.pure ⟩

protected lemma run_to_bind (i : ℕ) (x : nonterm α) (f : α → nonterm β) (v : β)
: run_to (x >>= f) i v ↔ (∃ v', run_to x i v' ∧ run_to (f v') i v) :=
sorry

lemma pure_yields (v : α)
: pure v ~> v :=
begin
  unfold yields,
  existsi 0,
  unfold run_to, refl
end

lemma yields_bind {x : nonterm α} {f : α → nonterm β} (v' : α) (v : β)
  (H₀ : x ~> v')
  (H₁ : f v' ~> v)
: (x >>= f) ~> v :=
begin
  simp [bind,nonterm.bind,yields,run_to] at *,
  cases H₀ with i H₀,
  cases H₁ with j H₁,
  existsi max i j,
  have H₂ := x.consistent i (max i j) v' (le_max_left _ _) H₀,
  simp [H₂,option.bind],
  apply (f v').consistent _ _ v _ H₁,
  apply le_max_right
end

lemma id_map (x : nonterm α)
: x >>= pure ∘ id = x :=
begin
  cases x,
  unfold has_bind.bind nonterm.bind nonterm.run,
  tactic.congr,
  apply funext, intro i,
  unfold function.comp id,
  apply @bind_pure α option,
end

lemma pure_bind (x : α) (f : α → nonterm β)
: pure x >>= f = f x :=
begin
  unfold pure bind nonterm.bind has_pure.pure nonterm.pure nonterm.run option.bind,
  destruct (f x),
  introv h, simp [h],
end

lemma bind_assoc (x : nonterm α) (f : α → nonterm β) (g : β → nonterm γ)
: x >>= f >>= g = x >>= (λ i, f i >>= g) :=
begin
  cases x,
  unfold bind nonterm.bind nonterm.run,
  tactic.congr,
  apply funext, intro i,
  destruct (x_run i),
  { intro h, simp [h,option.bind], },
  { intros x h, simp [h,option.bind] }
end

def diverge : nonterm α :=
{ run := λ _, none
, consistent := by { intros, contradiction } }

lemma run_diverge (x : α)
: ¬ diverge ~> x :=
begin
  unfold yields, intro H,
  cases H with i H,
  unfold diverge run_to nonterm.run at H,
  contradiction,
end

def assert (p : Prop) [decidable p] : nonterm (plift p) :=
if H : p then pure ⟨ H ⟩ else diverge

protected lemma ext (x y : nonterm α)
  (h : ∀ i v, run_to x i v ↔ run_to y i v)
: x = y :=
begin
  cases x with x Hx, cases y with y Hy,
  tactic.congr,
  apply funext, intro i,
  unfold run_to at h,
  destruct (x i),
  destruct (y i),
  { intros h₀ h₁, rw [h₀,h₁] },
  { intros x' h₀ h₁,
    unfold nonterm.run at h,
    rw [← h i x',h₁] at h₀,
    contradiction },
  { intros x' h₀,
    unfold nonterm.run at h,
    rw h₀,
    rw [h i x'] at h₀,
    rw h₀ },
end

protected def le (x y : nonterm α) : Prop :=
∀ i v, run_to x i v → run_to y i v

instance : has_le (nonterm α) :=
⟨ nonterm.le ⟩

protected lemma le_refl (x : nonterm α)
: x ≤ x :=
begin
  cases x,
  intros i j H, apply H,
end

protected lemma le_trans (x y z : nonterm α)
  (h₀ : x ≤ y)
  (h₁ : y ≤ z)
: x ≤ z :=
begin
  intros i v h₂,
  apply h₁,
  apply h₀ _ _ h₂,
end

protected lemma le_antisymm (x y : nonterm α)
  (h₀ : x ≤ y)
  (h₁ : y ≤ x)
: x = y :=
begin
  cases x with x hx,
  cases y with y hy,
  tactic.congr,
  apply funext, intro i,
  destruct (y i),
  destruct (x i),
  { intros h₂ h₃, simp [h₂,h₃] },
  { intros v h₂ h₃, rw h₂,
    symmetry, apply h₀, apply h₂ },
  { intros v h₂, rw h₂,
    apply h₁, apply h₂ },
end

instance : partial_order (nonterm α) :=
{ le := nonterm.le
, le_refl := nonterm.le_refl
, le_trans := nonterm.le_trans
, le_antisymm := nonterm.le_antisymm }

lemma le_bottom (x : nonterm α)
: diverge ≤ x :=
by { intros i v h, unfold diverge run_to at h, contradiction }

def orelse_run (x y : nonterm α) : ℕ → option α
 | 0 := x.run 0 <|> y.run 0
 | (succ i) := orelse_run i <|> x.run (succ i) <|> y.run (succ i)

protected def orelse (x y : nonterm α) : nonterm α :=
{ run := λ i, nonterm.orelse_run x y i
, consistent :=
  begin
    intros i j v Hij h,
    rw [← nat.add_sub_cancel_left i j,nat.add_sub_assoc Hij],
    generalize : j - i = k,
    induction k with k,
    { apply h },
    { dsimp [add_succ,nonterm.orelse_run],
      simp [k_ih] }
  end }

instance : has_orelse nonterm :=
⟨ @nonterm.orelse ⟩

end instances

end nonterm

class has_mono (m : Type u → Type v)
extends monad m :=
  (le : ∀ {α}, partial_order (m α))
  (input_t  : Type v)
  (result_t : Type u → Type v)
  (run_to : ∀ {α}, m α → ℕ → input_t → result_t α → Prop)
  (run_to_imp_run_to_of_le : ∀ {α} (x y : m α) i v₀ v,
     x ≤ y → run_to x i v₀ v → run_to y i v₀ v)

export has_mono (run_to input_t result_t run_to_imp_run_to_of_le)

instance fix_partial_order {m α} [has_mono m] : partial_order (m α) :=
has_mono.le _

section monotonic

variable {m : Type v → Type w}
variable [has_mono m]
variable {α : Type u}
variable {β : Type v}

section mono1

variable f : (α → m β) → (α → m β)

def monotonic := ∀ n v v',
  ∀ (v1 v2 : α → m β),
    (∀ x, v1 x ≤ v2 x) →
    (∀ x, run_to (f v1 x) v n v' →
          run_to (f v2 x) v n v')

end mono1

variable {γ : Type u'}

variable f : (α → γ → m β) → α → γ → m β

def monotonic2 :=
monotonic (λ rec, uncurry' $ f $ curry rec)

end monotonic

instance : monad nonterm :=
{ pure := @nonterm.pure
, bind := @nonterm.bind }

instance : is_lawful_monad nonterm :=
{ bind_assoc := @nonterm.bind_assoc
, pure_bind := @nonterm.pure_bind
, id_map := @nonterm.id_map }

instance : has_mono.{u} nonterm :=
{ le := by apply_instance
, to_monad := by apply_instance
, result_t := λ α, α
, input_t  := ulift unit
, run_to := λ α x y z, nonterm.run_to x y
, run_to_imp_run_to_of_le := by { introv _ h, cases x, cases y, apply h } }

namespace nonterm

section fix

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

parameter f : (α → nonterm β) → (α → nonterm β)
parameter f_monotonic : monotonic f

def fix_aux : ℕ → α → nonterm β
 | 0 := f (λ _, diverge)
 | (succ n) := f (fix_aux n)

include f_monotonic

lemma fix_consistent (steps n : ℕ) (x : α) (y : β)
  (h : run_to (fix_aux n x) steps y )
  (n' : ℕ)
  (hn : n ≤ n')
: run_to (fix_aux n' x) steps y :=
begin
  revert steps n' x y,
  induction n with n ; intros steps n' x y h hn,
  { unfold fix_aux at h,
    induction n' with n',
    { simp [fix_aux], apply h },
    { simp [fix_aux], revert h,
      apply f_monotonic, exact ⟨ () ⟩,
      intro,
      apply le_bottom } },
  { have hn' := le_of_succ_le hn,
    simp [fix_aux] at h,
    induction n' with n',
    { cases not_lt_zero _ hn },
    { have hnn' := le_of_succ_le_succ hn,
      simp [fix_aux] at *,
      revert h,
      apply f_monotonic,
      exact ⟨ () ⟩,
      intros z i yy hh,
      apply n_ih i n' z _ hh hnn' } }
end

protected def fix (x : α) : nonterm β :=
{ run := λ i, (fix_aux i x).run i
, consistent :=
  begin
    introv h _,
    apply nonterm.consistent _ _ _ _ h,
    apply fix_consistent ; assumption,
  end }

lemma unroll_a (x : α)
: nonterm.fix x ≤ f nonterm.fix x :=
begin
  intros i v,
  dunfold nonterm.fix,
  unfold run_to nonterm.run,
  induction i with i,
  { unfold fix_aux,
    apply f_monotonic, exact ⟨ () ⟩,
    intro, apply le_bottom, },
  { unfold fix_aux,
    apply f_monotonic, exact ⟨ () ⟩,
    intros x j v hh,
    dunfold run_to nonterm.fix nonterm.run,
    cases le_total i j with Hij Hji,
    { apply nonterm.consistent _ _ _ _ Hij, admit
      /- unfold fix nonterm.run, apply hh -/ },
    { admit } }
end

lemma unroll_b (x : α) (v : β)
  (h : f fix x ~> v)
: fix x ~> v :=
begin
  cases h with i h,
  unfold yields, existsi (succ i),
  dunfold run_to fix nonterm.run fix_aux,
  apply nonterm.consistent _ i,
  { apply le_succ },
  revert h, apply f_monotonic,
  exact ⟨ () ⟩,
  intros x j v,
  dunfold run_to fix nonterm.run,
  induction j with j,
  { intro h,
    induction i with i,
    { apply h },
    unfold fix_aux, admit },
  admit,
end

end fix

end nonterm

section monotonic

parameters {α : Type u} {β γ φ : Type v}
open nonterm

section

parameters f' : (α → nonterm β) → α → nonterm β
parameters g' : (α → nonterm β) → α → β → nonterm β
parameters Hf' : monotonic (λ rec x, f' rec x)
parameters Hg' : ∀ y, monotonic (λ rec x, g' rec x y)
include Hf' Hg'

protected lemma bind_monotonic
: monotonic (λ rec x, f' rec x >>= g' rec x) :=
begin
  intros i₀ i y v1 v2 Hlt x,
  simp only [has_mono.run_to,nonterm.run_to_bind],
  apply exists_imp_exists,
  intros v',
  apply and.imp,
  { apply Hf' ⟨ () ⟩, apply Hlt },
  { apply Hg' _ ⟨ () ⟩, apply Hlt }
end
end

section

parameters {m : Type v → Type w}
parameters f  : α → m γ
parameters hf : has_mono m
include hf

lemma pure_monotonic
: monotonic (λ rec, f) :=
by { introv Hlt x H, apply H }

end
section

parameters f  : α → nonterm γ
parameters g  : (α → nonterm β) → α → γ → nonterm β
parameters Hg  : ∀ y, monotonic (λ rec x, g rec x y)

include Hg

protected lemma bind_monotonic'
: monotonic (λ rec x, f x >>= g rec x) :=
begin
  intros i₀ i y v1 v2 Hlt x,
  simp only [has_mono.run_to,nonterm.run_to_bind],
  apply exists_imp_exists,
  intros v',
  apply and.imp_right,
  apply Hg _ ⟨ () ⟩, apply Hlt
end
end

parameter {m : Type v → Type u}
parameter [has_mono m]

section

parameters {f' : α → α}

lemma rec_monotonic
: monotonic (λ rec x, (rec (f' x) : m β)) :=
begin
  intros i₀ i y v1 v2 Hlt x,
  apply run_to_imp_run_to_of_le, apply Hlt
end
end

section

parameter {p : α → Prop}
parameter [decidable_pred p]
parameter {t : (α → m β) → α → m β}
parameter {f : (α → m β) → α → m β}

open plift

parameter Ht : monotonic t
parameter Hf : monotonic f
include Ht Hf

lemma dite_monotonic
: monotonic (λ (rec : α → m β) x, dite (p x) (λ _, t rec x) (λ _, f rec x)) :=
begin
  intros i₀ i y v1 v2 Hlt x,
  simp,
  by_cases h : p x,
  { simp [dif_pos h], apply Ht, apply Hlt },
  { simp [dif_neg h], apply Hf, apply Hlt },
end

lemma ite_monotonic
: monotonic (λ (rec : α → m β) x, ite (p x) (t rec x) (f rec x)) :=
begin
  have h := dite_monotonic,
  simp [dif_eq_if] at h,
  apply h,
end

end

end monotonic

section tactic

open tactic

meta def parse_monotonic : expr → tactic unit
 | `(monotonic %%f) := return ()
 | `(monotonic2 %%f) := return ()
 | `(auto_param %%e₀ %%e₁) := `[unfold auto_param] >> target >>= parse_monotonic
 | _ := fail "expecting monotonic"

meta def prove_monotonicity : tactic unit := do
target >>= parse_monotonic,
t ← target >>= instantiate_mvars,
solve1
( `[apply rec_monotonic]
<|>
  `[apply pure_monotonic]
<|>
  (do `[apply ite_monotonic],
      solve1 (prove_monotonicity),
      solve1 (prove_monotonicity))
<|>
  (do `[apply dite_monotonic],
      solve1 prove_monotonicity,
      solve1 prove_monotonicity)
<|>
  (do `[apply has_fix.bind_monotonic'],
      solve1 (intro1 >> prove_monotonicity))
<|>
  (do `[apply has_fix.bind_monotonic],
      solve1 prove_monotonicity,
      solve1 (intro1 >> prove_monotonicity))
<|>
  fail (to_fmt "can't prove: " ++ to_fmt t))

end tactic

class has_fix (m : Type u → Type v) extends has_mono m :=
  (mfix : ∀ {α : Type v} {β : Type u} (f : (α → m β) → α → m β), monotonic f → α → m β)
  (pre_fixpoint : ∀ {α β} (f : (α → m β) → α → m β) (h : monotonic f) (x : α),
      mfix f h x ≤ f (mfix f h) x)
  (bind_monotonic :
   ∀ {α : Type v} {β} (f' : (α → m β) → α → m β)
           (g' : (α → m β) → α → β → m β),
     monotonic (λ rec x, f' rec x) →
     (∀ y, monotonic (λ rec x, g' rec x y)) →
     monotonic (λ rec x, f' rec x >>= g' rec x))
  (bind_monotonic' :
   ∀ {α : Type v} {β γ} (f : α → m γ)
             (g : (α → m β) → α → γ → m β),
     (∀ y, monotonic (λ rec x, g rec x y)) →
     monotonic (λ rec x, f x >>= g rec x))

export has_fix (mfix)

section monotonic2

variable {m : Type v → Type (max u u')}
variable [has_fix m]
variable {α : Type u}
variable {β : Type v}
variable {γ : Type u'}

variable f : (α → γ → m β) → α → γ → m β

def mfix2 (h : monotonic2 f) (x : α) (y : γ) : m β :=
mfix (λ rec, uncurry' $ f $ curry rec) h (x, y)

end monotonic2

notation `fix`  f := mfix  f (by prove_monotonicity)
notation `fix2` f := mfix2 f (by prove_monotonicity)

instance : has_fix nonterm :=
  { to_has_mono := by apply_instance
  , mfix := @nonterm.fix
  , pre_fixpoint := @nonterm.unroll_a
  , bind_monotonic  := @bind_monotonic
  , bind_monotonic' := @bind_monotonic' }

export has_fix (mfix pre_fixpoint bind_monotonic bind_monotonic')

section setoid

parameter {α : Type u}

def same_result (x y : nonterm α) : Prop :=
∀ i, x ~> i ↔ y ~> i

local infix ` ≺ `:50 := same_result

variables {x y z : nonterm α}

lemma res_refl
: x ≺ x := by { intro, refl }

lemma res_symmetry
  (h : x ≺ y)
: y ≺ x := by { intro, simp [h i] }

lemma res_trans
  (h₀ : x ≺ y)
  (h₁ : y ≺ z)
: x ≺ z := by { intro, simp [h₀ i,h₁ i] }

instance : setoid (nonterm α) :=
 { r := same_result
 , iseqv := mk_equivalence _ @res_refl @res_symmetry @res_trans  }

end setoid

def partial (α : Type u) := quot (@same_result α)

class monad_fix (m : Type u → Type v) extends has_fix m :=
  (unroll_mfix : ∀ {α β} (f : (α → m β) → α → m β) (h : monotonic f) (x : α),
      f (mfix f h) x = mfix f h x)


--import week_8.ideas.Z1
import week_8.ideas.distrub_mul_action_hom.Z1 -- do I need all of this?
import week_8.ideas.Z1

/-

# A crash course in H¹(G,M)

We stick to the conventions that `G` is a group (or even
a monoid, we never use inversion) and that `M` is a `G`-module,
that is, an additive abelian group with a `G`-action.

The quotient group `H1 G M`, written `H¹(G,M)` by mathematicians,
is the main definition in this file.  It's the quotient
of `Z1 G M` by the range of a certain map from `M` called
the coboundary map.

The first two theorems we shall prove about it here
are that it is functorial (i.e. a map `φ : M →+[G] N` gives
rise to a map `φ.H1 : H1 G M →+ H1 G N`), and exact in the
middle (i.e. if `0 → M → N → P → 0` is a short exact sequence
of `G`-modules then the sequence `H1 G M →+ H1 G N →+ H1 G P`
is exact).

Further work would be to verify "inf-res", otherwise known
as the beginning of the long exact
sequence of terms of low degree in the Hochschild-Serre
spectral sequence for group cohomology (i.e.
`0 → H¹(G/N, Aᴺ) → H¹(G, A) → H¹(N, A)` ) and of course one
could go on to define n-cocycles and n-coboundaries (please
get in touch if you're interested in doing this -- I have
ideas about how to set it all up) and to
construct the Hochschild-Serre spectral sequence itself.
I have no doubt that these kinds of results could be turned
into a research paper.

Let's start with a definition of `H1 G M`.
-/

section cochain_map

variables (G M : Type) [monoid G] [add_comm_group M]
  [distrib_mul_action G M]

def cochain_map : M →+ Z1 G M :=
{ to_fun := λ m, { to_fun := λ g, g • m - m, is_cocycle' := begin
  simp [mul_smul, smul_sub],
end},
  map_zero' := begin
    ext g,
    simp,
  end,
  map_add' := begin
    intros,
    ext g,
    simp,
    abel,
  end }

@[simp] lemma cochain_map_apply (m : M) (g : G) :
  cochain_map G M m g = g • m - m := rfl

end cochain_map

-- question : do we have cokernels? If A B are abelian groups and
-- `f : A → B` is a group hom, how do I make the type coker f`

-- Lean has inbuilt quotients of additive abelian groups by subgroups
@[derive add_comm_group]
def H1 (G M : Type) [monoid G] [add_comm_group M]
  [distrib_mul_action G M] : Type :=
quotient_add_group.quotient ((cochain_map G M).range)

section quotient_stuff

variables {G M : Type} [monoid G] [add_comm_group M]
  [distrib_mul_action G M]

def Z1.quotient : Z1 G M →+ H1 G M :=
quotient_add_group.mk' _

lemma H1.ker_quotient : (Z1.quotient).ker = (cochain_map G M).range :=
quotient_add_group.ker_mk _

end quotient_stuff

namespace H1

variables {G M : Type} [monoid G] [add_comm_group M]
  [distrib_mul_action G M]

@[elab_as_eliminator]
def induction_on {p : H1 G M → Prop}
  (IH : ∀ z : Z1 G M, p (z.quotient)) (h : H1 G M) : p h :=
quot.induction_on h IH

end H1

/-
We have just defined `H1 G M` as a quotient group, and told Lean
to figure out (or "derive") the obvious abelian group structure
on it, which it did.

What we need to do now is to show that if `φ : M →+[G] N` is a `G`-module
hom then `φ` induces a map `H1 G M → H1 G N`. To prove this we will
need to figure out how to define maps from and to quotient group structures.
Just like last week, this is simply a matter of learning the API for the
definition `quotient_add_group.quotient`.

TODO -- make the definition
-/

namespace distrib_mul_action_hom

local notation `Z1'` := _root_.Z1

open add_subgroup

variables {G M N : Type}
  [monoid G] [add_comm_group M] [add_comm_group N]
  [distrib_mul_action G M] [distrib_mul_action G N]

def H1 (φ : M →+[G] N) : H1 G M →+ H1 G N :=
-- We use `quotient_add_group.map` to define this map
-- by saying that it is a descent of the map `φ.Z1_hom`
quotient_add_group.map ((cochain_map G M).range) ((cochain_map G N).range)
  φ.Z1
-- We now have to supply the proof that the map on cocycles induces
-- a map on cohomology, i.e. that it sends coboundaries to coboundaries
begin
  rintro ⟨c, hc⟩ ⟨m, hm⟩,
  use φ m,
  ext g,
  simp [← hm],
end

def H1_spec (φ : M →+[G] N) (f : Z1' G M) :
  φ.H1 (f.quotient) = (φ.Z1 f).quotient := rfl

-- why isn't this there??
-- ask in Zulip
instance : add_comm_group (M →+[G] N) :=
{ add := λ a b, ({ to_fun := λ m, a m + b m,
    map_smul' := by simp,
    map_zero' := by simp,
    map_add' := by { intros, simp [map_add], abel} }),
  add_assoc := sorry,--by {intros, ext m, simp only [add_comm_group.add], dsimp, },--abel}, -- missing coe_add simp lemma?
  zero := { to_fun := λ m, 0,
    map_smul' := by simp,
    map_zero' := by simp,
    map_add' := by simp },
  zero_add := sorry,
  add_zero := sorry,
  neg := λ a, { to_fun := λ m, -(a m),
    map_smul' := by simp,
    map_zero' := by simp,
    map_add' := by { intros, simp [map_neg], abel} },
  add_left_neg := sorry,
  add_comm := sorry }

-- API for instance
@[simp] lemma zero_val (m : M) : (0 : M →+[G] N) m = 0 := rfl

end distrib_mul_action_hom

section exactness

variables {G M N P : Type}
  [monoid G]
  [add_comm_group M] [distrib_mul_action G M]
  [add_comm_group N] [distrib_mul_action G N]
  [add_comm_group P] [distrib_mul_action G P]
(φ : M →+[G] N) (z : Z1 G M)

example (α β : Type) [setoid α] [setoid β]
  (f : α → β) (h : (has_equiv.equiv ⇒ has_equiv.equiv) f f) (a : α) :
  quotient.map f h (⟦a⟧) = ⟦f a⟧ := quotient.map_mk f h a

lemma Z1.H1_map_mk (φ : M →+[G] N) : φ.H1 (z.quotient) =
  (φ.Z1 z).quotient :=
rfl

open function

open add_monoid_hom

-- right now will work around with sets

theorem H1_hom_middle_exact (φ : M →+[G] N)
  (ψ : N →+[G] P) (hse : is_short_exact φ ψ) :
  φ.H1.range = ψ.H1.ker :=
begin
  -- need to prove a range is a kernel,
  ext k,
  -- let k be a cohomology class, an element of H^1(G,N).
  -- we're supposed to be proving that we're in a range
  -- if and only if we're in a kernel
  -- I can't see how to do it directly with rewrites
  -- so I'm going to split
  split,
  { rintro ⟨x, rfl⟩,
    refine x.induction_on _, clear x,
    intros z,
    -- should have some map commutes lemma
    rw Z1.H1_map_mk,
    rw mem_ker,
    rw Z1.H1_map_mk,
    convert Z1.quotient.map_zero,
    rw φ.map_comp,
    have hψφ : ψ.comp φ = (0 : M →+[G] P),
    { ext m,
      simp * at * },
    rw ← mem_ker,
    rw hψφ,

    sorry
    -- rw is_exact_def' at he,
    -- rw mem_ker,
    -- refl
    },
  { -- this is the trickier way. What is the maths proof?
/-

I use set theory language
Say k ∈ H¹(N) and H¹(ψ)(k) = 0. Need to find c in H¹(M) such that
H¹(φ)(c) = k. Lift k to a cocycle x in Z¹(N). Need to pull back
x along φ. Can modify x by a coboundary to get λ g, x g + g n - n
So let's see if we can turn "H¹(ψ)(k)=0" into the existence
of a magic `n0` such that ∀ g, ψ (x g + g n0 - n0) = 0

-/
    rw mem_ker,
    -- why isn't this better
    refine H1.induction_on _ k, clear k,
    intros z hz,
    rw Z1.H1_map_mk at hz,
    rw ← mem_ker at hz,
    -- rw Z1.ker_quotient at hz,
    -- cases hz with y hy,
    -- rw Z1.ext_iff at hy,
    -- simp_rw cochain_map_apply at hy,
    -- simp_rw ψ.Z1_spec at hy,
    -- rw is_exact_def at he,
    -- cases hψ y with x hx,
    -- let w : G → N := λ g, z g - (g • x - x),
    -- have crucial : ∀ (g : G), ψ (z g - (g • x - x)) = 0,
    -- { simp [hy, hx] },

    -- note "crucial" above
    rw H1.ker_quotient at hz,
    cases hz with p hp,
    rw Z1.ext_iff at hp,
    simp at hp, -- yes
    rw mem_range,
    /-
    ∃ (x : H1 G M), ⇑(φ.H1) x = ⇑Z1.quotient z -/
    --refine ⟨_, _⟩, swap,
    -- ⊢ ⇑(φ.H1) ?m_1 = ⇑Z1.quotient z
    -- Idea : I want to apply the universal property
    -- for H¹(φ) but this is of the form

    refine ⟨Z1.quotient (_ : Z1 G M), _⟩, swap, --working backwards
    { rw Z1.H1_map_mk,
      sorry },
    -- this next goal might randomly disappear, it's not a prop
    -- it's `⊢ H1 G M`
    sorry }
end

end exactness

#where

#check H1.induction_on
/-
H1.induction_on : ∀ {G M : Type} [_inst_1 : monoid G]
[_inst_2 : add_comm_group M] [_inst_3 : distrib_mul_action G M]
{p : H1 G M → Prop},
(∀ (z : Z1 G M), p (⇑Z1.quotient z)) → ∀ (h : H1 G M), p h
-/