{-# OPTIONS --safe --warning=error --cubical --without-K #-}

open import Agda.Primitive
open import Cubical.Core.Everything
open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Isomorphism
open import Naturals
open import Basic

module File1 where

{-
Let's define the integers. Answers can be found in commit 4d7aad52e014daeb48fe5fb6854d3b6e0080012a.

If you want to learn how to type something, remember the Emacs action is M-x describe-char with the cursor on a character.
-}
data ℤ : Set where
  pos : ℕ → ℤ
  neg : ℕ → ℤ
  congZero : pos 0 ≡ neg 0

{-
A bit odd! We defined an integer to be "a natural tagged as positive", "a natural tagged as negative", or "a witness that pos 0 = neg 0".
This is obvious nonsense (how can two things be equal if they were made from different constructors?! what even does it mean for "pos 0 ≡ neg 0" to be an integer?!) until you let go of your preconceptions about what it means for two things to be equal.
-}

-- Just to help you realise how odd this is, we'll use some new Cubical definitions to manifest a really weird element of ℤ which is neither a `pos` nor a `neg`. Don't worry too much about this for now.
oddThing : ℤ
oddThing = congZero i1

-- Even odder, the integer we just made is equal to 0. Think how strange this is: it's not built using the only constructor that could build `pos 0`, but it's still equal to `pos 0`.
oddThing2 : pos 0 ≡ oddThing
oddThing2 = congZero

{-
Add 1 to an integer. The first cases are easy, but the last case is very odd and we will discuss it in detail.
-}
incr : ℤ → ℤ
incr (pos x) = pos (succ x)
incr (neg zero) = pos 1
incr (neg (succ x)) = neg x

-- First of all, we have in scope an "integer" `congZero` which is of type `pos 0 ≡ neg 0` - huh?!
incr (congZero i) = {!!}
{-
This one looks different from the non-cubical world.

Goal: ℤ
———— Boundary ——————————————————————————————————————————————
i = i0 ⊢ pos 1
i = i1 ⊢ pos 1
————————————————————————————————————————————————————————————
i : I
———— Constraints ———————————————————————————————————————————
pos 1 = ?0 (i = i1) : ℤ
pos 1 = ?0 (i = i0) : ℤ

The constraints look pretty normal, telling you that goal 0 needs to be equal to `pos 1`.
But there's stuff about this `i : I` here. What's that?

Recall that Cubical alters the definition of ≡. Given any element of X, an element of X ≡ Y contains content for how that element corresponds to a Y, and vice versa.
Homotopy type theory, and Cubical Agda, prefer to think of a more general structure on top of that data, though: not only can we go from an X to a Y, but we also store *how* we get there.
More abstractly, we store how to traverse a path from X to Y. The `i` here is telling us where along that path we are; the template goes from the special symbol `i0` to the special symbol `i1`, and `i` is notionally somewhere between those two points.

This gives some nice composability properties: if we know that X ≡ Y and that Y ≡ Z, we can compose the two paths to get a path X ≡ Z.
Cubical Agda's great innovation is that all this has computational content: proofs about X can be transported along the path to obtain for free proofs about Z.

Having told Agda that `incr (pos x) = pos (succ x)`, it can infer that `incr (pos 0) = pos 1`.
So our goal of constructing a path `incr congZero : incr (pos 0) ≡ incr (neg 0)` is in fact the requirement to construct a path `pos 1 ≡ incr (neg 0)`.
Similarly, we told it that `incr (neg 0) = pos 1`, so our path `incr congZero` is actually of type `pos 1 ≡ pos 1`
The `I` from the goal is the template of the path `congZero n` which we are trying to construct from `pos 1` to `pos 1`.
The `i0` and `i1` are the templates for the start and end points of the path, i.e. they both indicate `pos 1`.

What we really wanted to write here was `incr congZero`. For reasons I don't understand, Agda doesn't accept this.
We are forced to descend to the level of actually implementing the path from `pos 1` to `pos 1` by telling Agda where each `i` goes, even though there's an obvious way (`refl`) to specify the entire path at once.

Agda can automatically infer the correct hole-fill, but you can try it with `pos 1`.
-}

{-
Let's show that successors of naturals are nonzero.
We do this using a new technique that only makes sense in Cubical-land.

Given a path from `succ a` to `0`, we need to show False.
The assumed member of `succ a ≡ 0` is a path that tells us how to get from `succ a` to `0` in a way that is preserved by function application.
That is, it tells us how to show `f (succ a) ≡ f 0` for any `f`. (The function `subst` captures this ability to move functions from one end of a path to the other.)
So if we pick `f` appropriately so that it outputs `False` at 0 but something else (anything else, as long as we can construct it!) at `succ a`, we will be done.
-}
succNonzero : {a : ℕ} → succ a ≡ 0 → False
succNonzero {a} sa=0 = subst f sa=0 {!!}
  where
    f : ℕ → Set
    f zero = False
    f (succ i) = {!!}

{-
Let's show that these equality things aren't *too* weird. We'll show that even though `pos 0` is equal to `congZero i1`, it's actually the *only* other `pos` which is equal to `congZero i1`. (You'd hope this would be the case; otherwise we'd have several `pos` being equal to each other.)

Cubical Agda gives us a magical way to do this. Recall that we can move functions along paths (the `subst` from above, which lets us take an `x ≡ y` and an `f` to get `f x → f y`); we can actually also do the same thing viewed as transforming the *entire path* `x ≡ y` using `f` into `f x ≡ f y`.
This is the function `cong`.

If we can somehow create a function that "strips off `pos`", then that function can transform the path `pos a ≡ pos b` into a path `a ≡ b`.
-}
toNat : ℤ → ℕ
toNat z = {!!}

posInjective : {a b : ℕ} → pos a ≡ pos b → a ≡ b
posInjective pr = cong toNat pr

{-
Finally, we can use the injectivity of `pos` in the obvious way to prove that only `pos 0` is `congZero i1`.
-}
notTooOdd : (n : ℕ) → (pos n ≡ congZero i1) → n ≡ 0
notTooOdd zero pr = refl
notTooOdd (succ n) pr = posInjective (pr ∙ sym congZero)

{-
Let's show that `pos` is injective in a different way, inspired by how you might do this kind of thing in a non-Cubical world. We'll go by induction, which means the interesting case will be `pos (succ a) ≡ pos (succ b) → pos a ≡ pos b`.

This is a classic example of moving a path wholesale along a function; in this case, the function is "decrement".
-}
decr : ℤ → ℤ -- TODO hole this
decr z = {!!}

posDecr : {a b : ℕ} → pos (succ a) ≡ pos (succ b) → pos a ≡ pos b
posDecr {a} {b} pr = cong decr pr

posInjective' : {a b : ℕ} → pos a ≡ pos b → a ≡ b
-- The two easy cases first
posInjective' {zero} {zero} x = refl
posInjective' {succ a} {succ b} x = cong succ (posInjective (posDecr x))
{-
We need to transform `pos zero ≡ pos (succ b)` into `zero ≡ succ b`.
We could do this using the proof of `posInjective` - moving the path along `toNat` - but it is also interesting to construct the path `zero ≡ succ b` manually using `subst`.

To use `subst`, we need to construct a function from ℤ which is "a type we can populate" at `pos zero` (i.e. at one end of the path), and `zero ≡ succ b` at `pos (succ b)` (i.e. at the other end of the path); then we will be able to move from the populated type to `zero ≡ succ b` using that function.

These two are quite hard!
-}
posInjective' {zero} {succ b} x = subst t x {!!}
  where
    t : ℤ → Set
    t z = {!!}
posInjective' {succ a} {zero} x = subst t x {!!}
  where
    t : ℤ → Set
    t z = {!!}

{-
What does equality mean on the level of types, rather than values?
Univalence, the axiom which Cubical provides computational meaning to, basically says "identity really means isomorphism".
I will gloss over a lot of detail there, but here is a witness to `ℤ ≡ ℤ` that is not `refl`!
-}
incrDecrInverse1 : (a : ℤ) → incr (decr a) ≡ a
incrDecrInverse1 (pos zero) = sym congZero
incrDecrInverse1 (pos (succ x)) = refl
incrDecrInverse1 (neg x) = refl
{-
The remaining case is worth talking about.
We need a path from incr (decr (congZero j)) to congZero j.
That is, we need a path from incr (neg 1) to congZero j; i.e. from neg 0 to congZero j.
We already have a path from neg 0 to pos 0 - namely `sym congZero`.
But `sym congZero` goes from `neg 0` to every point along `sym congZero` - and `congZero j` is also a point along `sym congZero`, because `sym` just means "reverse the path"!
So we can get the path we need by truncating `sym congZero`, using the `∧` ("min") operation (a special builtin primitive in Cubical).
The path, parameterised by `i` with `j` fixed, is "go backwards (`sym`) along `congZero` to the min of `i` and where `j` lies on this path (`~ j`), but then don't go any further".
Here, `~` means essentially "negate"; if you got to position `i` travelling forward on path `p`, then you got to position `~ i` travelling backward on path `sym p`.

This is probably best done if you draw a little picture.
-}
incrDecrInverse1 (congZero j) i = sym congZero (i ∧ (~ j))

incrDecrInverse2 : (a : ℤ) → decr (incr a) ≡ a
incrDecrInverse2 x = {!!}

incrIso : ℤ ≡ ℤ
incrIso = isoToPath (iso incr decr incrDecrInverse1 incrDecrInverse2)

{-
Unexpected! Cubical has let us prove that ℤ ≡ ℤ in a very nonstandard way. What use is this? Who knows.
-}


{-
  This is mostly for convenience, when working with ideals
  (which are defined for general rings) in a commutative ring.
-}
{-# OPTIONS --safe #-}
module Cubical.Algebra.CommRing.Ideal where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Function
open import Cubical.Foundations.HLevels
open import Cubical.Foundations.Powerset

open import Cubical.Data.Nat using (ℕ ; zero ; suc)
open import Cubical.Data.FinData

open import Cubical.Algebra.CommRing.Base
open import Cubical.Algebra.Ring.Ideal renaming (IdealsIn to IdealsInRing)
open import Cubical.Algebra.Ring.BigOps
open import Cubical.Algebra.RingSolver.ReflectionSolving

private
  variable
    ℓ : Level

IdealsIn : (R : CommRing ℓ) → Type _
IdealsIn R = IdealsInRing (CommRing→Ring R)

module _ (Ring@(R , str) : CommRing ℓ) where
  open CommRingStr str
  makeIdeal : (I : R → hProp ℓ)
              → (+-closed : {x y : R} → x ∈ I → y ∈ I → (x + y) ∈ I)
              → (0r-closed : 0r ∈ I)
              → (·-closedLeft : {x : R} → (r : R) → x ∈ I → r · x ∈ I)
              → IdealsIn (R , str)
  makeIdeal I +-closed 0r-closed ·-closedLeft = I ,
    (record
       { +-closed = +-closed
       ; -closed = λ x∈I → subst-∈ I (useSolver _)
                             (·-closedLeft (- 1r) x∈I)
       ; 0r-closed = 0r-closed
       ; ·-closedLeft = ·-closedLeft
       ; ·-closedRight = λ r x∈I →
                       subst-∈ I
                             (·-comm r _)
                             (·-closedLeft r x∈I)
       })
       where useSolver : (x : R) → - 1r · x ≡ - x
             useSolver = solve Ring

-- better?
module _ (R' : CommRing ℓ) where
 private R = fst R'
 open CommRingStr (snd R')
 open Sum (CommRing→Ring R')

 record isCommIdeal (I : ℙ R) : Type ℓ where
  constructor
   makeIsCommIdeal
  field
   +Closed : ∀ {x y : R} → x ∈ I → y ∈ I → (x + y) ∈ I
   contains0 : 0r ∈ I
   ·Closed : ∀ {x : R} (r : R) → x ∈ I → r · x ∈ I

 open isCommIdeal
 isPropIsCommIdeal : (I : ℙ R) → isProp (isCommIdeal I)
 +Closed (isPropIsCommIdeal I ici₁ ici₂ i) x∈I y∈I =
         I _ .snd (ici₁ .+Closed x∈I y∈I) (ici₂ .+Closed x∈I y∈I) i
 contains0 (isPropIsCommIdeal I ici₁ ici₂ i) = I 0r .snd (ici₁ .contains0) (ici₂ .contains0) i
 ·Closed (isPropIsCommIdeal I ici₁ ici₂ i) r x∈I =
         I _ .snd (ici₁ .·Closed r x∈I) (ici₂ .·Closed r x∈I) i

 CommIdeal : Type _
 CommIdeal = Σ[ I ∈ ℙ R ] isCommIdeal I

 ∑Closed : (I : CommIdeal) {n : ℕ} (V : FinVec R n)
         → (∀ i → V i ∈ fst I) → ∑ V ∈ fst I
 ∑Closed I {n = zero} _ _ = I .snd .contains0
 ∑Closed I {n = suc n} V h = I .snd .+Closed (h zero) (∑Closed I (V ∘ suc) (h ∘ suc))


{-# OPTIONS --without-K #-}
module sets.finite.core where

open import sum
open import function.isomorphism
open import sets.nat
open import sets.fin

IsOfSize : ∀ {i} → Set i → ℕ → Set i
IsOfSize A n = A ≅ Fin n

IsFinite : ∀ {i} → Set i → Set i
IsFinite A = Σ ℕ (IsOfSize A)

mk-is-finite : ∀ {i n}{A : Set i}
             → (A ≅ Fin n)
             → IsFinite A
mk-is-finite {n = n} enum = n , enum

fin-is-finite : ∀ {n} → IsFinite (Fin n)
fin-is-finite {n} = mk-is-finite refl≅

⊎-of-size : ∀ {i j n m}{A : Set i}{B : Set j}
          → IsOfSize A n
          → IsOfSize B m
          → IsOfSize (A ⊎ B) (n + m)
⊎-of-size isoA isoB = ⊎-ap-iso isoA isoB ·≅ fin-sum

⊎-finite : ∀ {i j}{A : Set i}{B : Set j}
         → IsFinite A → IsFinite B
         → IsFinite (A ⊎ B)
⊎-finite (_ , fA) (_ , fB) = mk-is-finite (⊎-of-size fA fB)

×-of-size : ∀ {i j n m}{A : Set i}{B : Set j}
          → IsOfSize A n
          → IsOfSize B m
          → IsOfSize (A × B) (n * m)
×-of-size isoA isoB = ×-ap-iso isoA isoB ·≅ fin-prod

×-finite : ∀ {i j}{A : Set i}{B : Set j}
         → IsFinite A → IsFinite B
         → IsFinite (A × B)
×-finite (_ , fA) (_ , fB) = mk-is-finite (×-of-size fA fB)


{-# OPTIONS --cubical --no-import-sorts --safe #-}
module Cubical.HITs.Rationals.SigmaQ.Base where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.HLevels

open import Cubical.HITs.Ints.QuoInt

open import Cubical.Data.Nat as ℕ hiding (_·_)
open import Cubical.Data.NatPlusOne
open import Cubical.Data.Sigma

open import Cubical.Data.Nat.GCD
open import Cubical.Data.Nat.Coprime

-- ℚ as the set of coprime pairs in ℤ × ℕ₊₁

ℚ : Type₀
ℚ = Σ[ (a , b) ∈ ℤ × ℕ₊₁ ] areCoprime (abs a , ℕ₊₁→ℕ b)

isSetℚ : isSet ℚ
isSetℚ = isSetΣ (isSet× isSetℤ (subst isSet 1+Path isSetℕ)) (λ _ → isProp→isSet isPropIsGCD)

signedPair : Sign → ℕ × ℕ₊₁ → ℤ × ℕ₊₁
signedPair s (a , b) = (signed s a , b)

[_] : ℤ × ℕ₊₁ → ℚ
[ signed s a , b ] = signedPair s (toCoprime (a , b)) , toCoprimeAreCoprime (a , b)
[ posneg i   , b ] = (posneg i , 1) , toCoprimeAreCoprime (0 , b)

[]-cancelʳ : ∀ ((a , b) : ℤ × ℕ₊₁) k → [ a · pos (ℕ₊₁→ℕ k) , b ·₊₁ k ] ≡ [ a , b ]
[]-cancelʳ (signed s zero    , b) k =
  Σ≡Prop (λ _ → isPropIsGCD) (λ i → signed-zero spos s i , 1)
[]-cancelʳ (signed s (suc a) , b) k =
  Σ≡Prop (λ _ → isPropIsGCD) (λ i → signedPair (·S-comm s spos i)
                                               (toCoprime-cancelʳ (suc a , b) k i))
[]-cancelʳ (posneg i ,         b) k j =
  isSet→isSet' isSetℚ ([]-cancelʳ (pos zero , b) k) ([]-cancelʳ (neg zero , b) k)
                      (λ i → [ posneg i · pos (ℕ₊₁→ℕ k) , b ·₊₁ k ]) (λ i → [ posneg i , b ]) i j

-- Natural number and negative integer literals for ℚ

open import Cubical.Data.Nat.Literals public

instance
  fromNatℚ : HasFromNat ℚ
  fromNatℚ = record { Constraint = λ _ → Unit ; fromNat = λ n → (pos n , 1) , oneGCD n }

instance
  fromNegℚ : HasFromNeg ℚ
  fromNegℚ = record { Constraint = λ _ → Unit ; fromNeg = λ n → (neg n , 1) , oneGCD n }


module plfa-code.Lists where

import Relation.Binary.PropositionalEquality as Eq
open Eq using (_≡_; refl; sym; trans; cong)
open Eq.≡-Reasoning
open import Data.Bool using (Bool; true; false; T; _∧_; _∨_; not)
open import Data.Nat using (ℕ; zero; suc; _+_; _*_; _∸_; _≤_; s≤s; z≤n)
open import Data.Nat.Properties using
  (+-assoc; +-identityˡ; +-identityʳ; *-assoc; *-identityˡ; *-identityʳ)
open import Relation.Nullary using (¬_; Dec; yes; no)
open import Data.Product using (_×_; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
open import Function using (_∘_)
open import Level using (Level)
open import plfa-code.Isomorphism using (_≃_; _⇔_)

data List (A : Set) : Set where
  []  : List A
  _∷_ : A → List A → List A

infixr 5 _∷_

_ : List ℕ
_ = 0 ∷ 1 ∷ 2 ∷ []

data List′ : Set → Set where
  []′  : ∀ {A : Set} → List′ A
  _∷′_ : ∀ {A : Set} → A → List′ A → List′ A

_ : List ℕ
_ = _∷_ {ℕ} 0 (_∷_ {ℕ} 1 (_∷_ {ℕ} 2 ([] {ℕ})))

{-# BUILTIN LIST List #-}

pattern [_] z = z ∷ []
pattern [_,_] y z = y ∷ z ∷ []
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
pattern [_,_,_,_] w x y z = w ∷ x ∷ y ∷ z ∷ []
pattern [_,_,_,_,_] v w x y z = v ∷ w ∷ x ∷ y ∷ z ∷ []
pattern [_,_,_,_,_,_] u v w x y z = u ∷ v ∷ w ∷ x ∷ y ∷ z ∷ []

infixr 5 _++_

_++_ : ∀ {A : Set} → List A → List A → List A
[]       ++ ys  =  ys
(x ∷ xs) ++ ys  =  x ∷ (xs ++ ys)

_ : [ 0 , 1 , 2 ] ++ [ 3 , 4 ] ≡ [ 0 , 1 , 2 , 3 , 4 ]
_ = -- refl
  begin
    0 ∷ 1 ∷ 2 ∷ [] ++ 3 ∷ 4 ∷ []
  ≡⟨⟩
    0 ∷ (1 ∷ 2 ∷ [] ++ 3 ∷ 4 ∷ [])
  ≡⟨⟩
    0 ∷ 1 ∷ (2 ∷ [] ++ 3 ∷ 4 ∷ [])
  ≡⟨⟩
    0 ∷ 1 ∷ 2 ∷ ([] ++ 3 ∷ 4 ∷ [])
  ≡⟨⟩
    0 ∷ 1 ∷ 2 ∷ 3 ∷ 4 ∷ []
  ∎

++-assoc : ∀ {A : Set} (xs ys zs : List A)
  → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs)
++-assoc [] ys zs = -- refl
  begin
    ([] ++ ys) ++ zs
  ≡⟨⟩
    ys ++ zs
  ≡⟨⟩
    [] ++ (ys ++ zs)
  ∎
++-assoc (x ∷ xs) ys zs = -- cong (_∷_ x) (++-assoc xs ys zs)
  begin
    (x ∷ xs ++ ys) ++ zs
  ≡⟨⟩
    x ∷ (xs ++ ys) ++ zs
  ≡⟨⟩
    x ∷ ((xs ++ ys) ++ zs)
  ≡⟨ cong (x ∷_) (++-assoc xs ys zs) ⟩
    x ∷ (xs ++ (ys ++ zs))
  ≡⟨⟩
    x ∷ xs ++ (ys ++ zs)
  ∎

++-identityˡ : ∀ {A : Set} (xs : List A) → [] ++ xs ≡ xs
++-identityˡ xs = -- refl
  begin
    [] ++ xs
  ≡⟨⟩
    xs
  ∎

++-identityʳ : ∀ {A : Set} (xs : List A) → xs ++ [] ≡ xs
++-identityʳ [] = -- refl
  begin
    [] ++ []
  ≡⟨⟩
    []
  ∎
++-identityʳ (x ∷ xs) = -- cong (_∷_ x) (++-identityʳ xs)
  begin
   (x ∷ xs) ++ []
  ≡⟨⟩
    x ∷ (xs ++ [])
  ≡⟨ cong (x ∷_) (++-identityʳ xs) ⟩
   x ∷ xs
  ∎

length : ∀ {A : Set} → List A → ℕ
length []       = zero
length (x ∷ xs) = suc (length xs)

_ : length [ 0 , 1 , 2 ] ≡ 3
_ = -- refl
  begin
    length (0 ∷ 1 ∷ 2 ∷ [])
  ≡⟨⟩
    suc (length (1 ∷ 2 ∷ []))
  ≡⟨⟩
    suc (suc (length (2 ∷ [])))
  ≡⟨⟩
    suc (suc (suc (length {ℕ} [])))
  ≡⟨⟩
    suc (suc (suc zero))
  ∎

length-++ : ∀ {A : Set} (xs ys : List A)
  → length (xs ++ ys) ≡ length xs + length ys
length-++ {A} [] ys = -- refl
  begin
    length ([] ++ ys)
  ≡⟨⟩
    length ys
  ≡⟨⟩
    length {A} [] + length ys
  ∎
length-++ {A} (x ∷ xs) ys = -- cong suc (length-++ xs ys)
  begin
    length ((x ∷ xs) ++ ys)
  ≡⟨⟩
    suc (length (xs ++ ys))
  ≡⟨ cong suc (length-++ xs ys) ⟩
    suc (length xs + length ys)
  ≡⟨⟩
    length (x ∷ xs) + length ys
  ∎

reverse : ∀ {A : Set} → List A → List A
reverse [] = []
reverse (x ∷ xs) = reverse xs ++ [ x ]

_ : reverse [ 0 , 1 , 2 ] ≡ [ 2 , 1 , 0 ]
_ =
  begin
    reverse (0 ∷ 1 ∷ 2 ∷ [])
  ≡⟨⟩
    reverse (1 ∷ 2 ∷ []) ++ [ 0 ]
  ≡⟨⟩
    (reverse (2 ∷ []) ++ [ 1 ]) ++ [ 0 ]
  ≡⟨⟩
    ((reverse [] ++ [ 2 ]) ++ [ 1 ]) ++ [ 0 ]
  ≡⟨⟩
    (([] ++ [ 2 ]) ++ [ 1 ]) ++ [ 0 ]
  ≡⟨⟩
    (([] ++ 2 ∷ []) ++ 1 ∷ []) ++ 0 ∷ []
  ≡⟨⟩
    (2 ∷ [] ++ 1 ∷ []) ++ 0 ∷ []
  ≡⟨⟩
    2 ∷ ([] ++ 1 ∷ []) ++ 0 ∷ []
  ≡⟨⟩
    (2 ∷ 1 ∷ []) ++ 0 ∷ []
  ≡⟨⟩
    2 ∷ (1 ∷ [] ++ 0 ∷ [])
  ≡⟨⟩
    2 ∷ 1 ∷ ([] ++ 0 ∷ [])
  ≡⟨⟩
    2 ∷ 1 ∷ 0 ∷ []
  ≡⟨⟩
    [ 2 , 1 , 0 ]
  ∎

---------- practice ----------
reverse-++-commute : ∀ {A : Set} {xs ys : List A}
  → reverse (xs ++ ys) ≡ reverse ys ++ reverse xs
reverse-++-commute {_} {[]} {[]} = refl
reverse-++-commute {_} {[]} {y ∷ ys} = sym (++-identityʳ (reverse ys ++ [ y ]))
reverse-++-commute {_} {x ∷ xs} {ys} =
  begin
    reverse ((x ∷ xs) ++ ys)
  ≡⟨⟩
    reverse (x ∷ (xs ++ ys))
  ≡⟨⟩
    reverse (xs ++ ys) ++ [ x ]
  ≡⟨ cong (_++ [ x ]) (reverse-++-commute {_} {xs} {ys}) ⟩
    (reverse ys ++ reverse xs) ++ [ x ]
  ≡⟨ ++-assoc (reverse ys) (reverse xs) [ x ] ⟩
    reverse ys ++ reverse xs ++ [ x ]
  ≡⟨ cong (reverse ys ++_) (sym refl) ⟩
    reverse ys ++ reverse ([ x ] ++ xs)
  ≡⟨⟩
    reverse ys ++ reverse (x ∷ xs)
  ∎

reverse-involutive : ∀ {A : Set} {xs : List A}
  → reverse (reverse xs) ≡ xs
reverse-involutive {_} {[]} = refl
reverse-involutive {_} {x ∷ xs} =
  begin
    reverse (reverse (x ∷ xs))
  ≡⟨⟩
    reverse (reverse xs ++ [ x ])
  ≡⟨ reverse-++-commute {_} {reverse xs} {[ x ]} ⟩
    reverse [ x ] ++ reverse (reverse xs)
  ≡⟨ cong (reverse [ x ] ++_) reverse-involutive ⟩
    [ x ] ++ xs
  ≡⟨⟩
    x ∷ xs
  ∎

------------------------------

shunt : ∀ {A : Set} → List A → List A → List A
shunt [] ys = ys
shunt (x ∷ xs) ys = shunt xs (x ∷ ys)

shunt-reverse : ∀ {A : Set} (xs ys : List A)
  → shunt xs ys ≡ (reverse xs) ++ ys
shunt-reverse [] ys = -- refl
  begin
    shunt [] ys
  ≡⟨⟩
    reverse [] ++ ys
  ∎
shunt-reverse (x ∷ xs) ys =
  begin
    shunt (x ∷ xs) ys
  ≡⟨⟩
    shunt xs (x ∷ ys)
  ≡⟨ shunt-reverse xs (x ∷ ys) ⟩
    reverse xs ++ (x ∷ ys)
  ≡⟨⟩
    reverse xs ++ ([ x ] ++ ys)
  ≡⟨ sym (++-assoc (reverse xs) [ x ] ys) ⟩
    (reverse xs ++ [ x ]) ++ ys
  ≡⟨⟩
    reverse (x ∷ xs) ++ ys
  ∎

reverse′ : ∀ {A : Set} → List A → List A
reverse′ xs = shunt xs []

reverses : ∀ {A : Set} (xs : List A)
  → reverse′ xs ≡ reverse xs
reverses xs =
  begin
    reverse′ xs
  ≡⟨⟩
    shunt xs []
  ≡⟨ shunt-reverse xs [] ⟩
    reverse xs ++ []
  ≡⟨ ++-identityʳ (reverse xs) ⟩
    reverse xs
  ∎

_ : reverse′ [ 0 , 1 , 2 ] ≡ [ 2 , 1 , 0 ]
_ =
  begin
    reverse′ (0 ∷ 1 ∷ 2 ∷ [])
  ≡⟨⟩
    shunt (0 ∷ 1 ∷ 2 ∷ []) []
  ≡⟨⟩
    shunt (1 ∷ 2 ∷ []) (0 ∷ [])
  ≡⟨⟩
    shunt (2 ∷ []) (1 ∷ 0 ∷ [])
  ≡⟨⟩
    shunt [] (2 ∷ 1 ∷ 0 ∷ [])
  ≡⟨⟩
    2 ∷ 1 ∷ 0 ∷ []
  ∎

map : ∀ {A B : Set} → (A → B) → List A → List B
map f [] = []
map f (x ∷ xs) = f x ∷ map f xs

_ : map suc [ 0 , 1 , 2 ] ≡ [ 1 , 2 , 3 ]
_ =
  begin
    map suc (0 ∷ 1 ∷ 2 ∷ [])
  ≡⟨⟩
    suc 0 ∷ map suc (1 ∷ 2 ∷ [])
  ≡⟨⟩
    suc 0 ∷ suc 1 ∷ map suc (2 ∷ [])
  ≡⟨⟩
    suc 0 ∷ suc 1 ∷ suc 2 ∷ map suc []
  ≡⟨⟩
    suc 0 ∷ suc 1 ∷ suc 2 ∷ []
  ≡⟨⟩
    1 ∷ 2 ∷ 3 ∷ []
  ∎

sucs : List ℕ → List ℕ
sucs = map suc

_ : sucs [ 0 , 1 , 2 ] ≡ [ 1 , 2 , 3 ]
_ =
  begin
    sucs [ 0 , 1 , 2 ]
  ≡⟨⟩
    map suc [ 0 , 1 , 2 ]
  ≡⟨⟩
    [ 1 , 2 , 3 ]
  ∎
---------- practice ----------
open plfa-code.Isomorphism using (extensionality)

map-compose : ∀ {A B C : Set} {f : A → B} {g : B → C}
  → map (g ∘ f) ≡ map g ∘ map f
map-compose {A} {B} {C} {f} {g} = extensionality hf
  where
  hf : (xs : List A) → map (g ∘ f) xs ≡ map g (map f xs)
  hf [] = refl
  hf (x ∷ xs) = cong ((g (f x)) ∷_) (hf xs)

map-++-commute : ∀ {A B : Set} {f : A → B} {xs ys : List A}
  →  map f (xs ++ ys) ≡ map f xs ++ map f ys
map-++-commute {A} {B} {f} {[]} {ys} = refl
map-++-commute {A} {B} {f} {x ∷ xs} {ys} =
  cong ((f x) ∷_) (map-++-commute {_} {_} {f} {xs} {ys})

data Tree (A B : Set) : Set where
  leaf : A → Tree A B
  node : Tree A B → B → Tree A B → Tree A B

map-Tree : ∀ {A B C D : Set}
  → (A → C) → (B → D) → Tree A B → Tree C D
map-Tree f g (leaf a) = leaf (f a)
map-Tree f g (node tree b tree₁) = node (map-Tree f g tree) (g b) (map-Tree f g tree₁)

------------------------------

foldr : ∀ {A B : Set} → (A → B → B) → B → List A → B
foldr _⊗_ e       []  =  e
foldr _⊗_ e (x ∷ xs)  =  x ⊗ (foldr _⊗_ e xs)

_ : foldr _+_ 0 [ 1 , 2 , 3 , 4 ] ≡ 10
_ =
  begin
    foldr _+_ 0 (1 ∷ 2 ∷ 3 ∷ 4 ∷ [])
  ≡⟨⟩
    1 + foldr _+_ 0 (2 ∷ 3 ∷ 4 ∷ [])
  ≡⟨⟩
    1 + (2 + foldr _+_ 0 (3 ∷ 4 ∷ []))
  ≡⟨⟩
    1 + (2 + (3 + foldr _+_ 0 (4 ∷ [])))
  ≡⟨⟩
    1 + (2 + (3 + (4 + foldr _+_ 0 [])))
  ≡⟨⟩
    1 + (2 + (3 + (4 + 0)))
  ∎

sum : List ℕ → ℕ
sum = foldr _+_ 0

_ : sum [ 1 , 2 , 3 , 4 ] ≡ 10
_ =
  begin
    sum [ 1 , 2 , 3 , 4 ]
  ≡⟨⟩
    foldr _+_ 0 [ 1 , 2 , 3 , 4 ]
  ≡⟨⟩
    10
  ∎

---------- practice ----------
product : List ℕ → ℕ
product = foldr _*_ 1

_ : product [ 1 , 2 , 3 , 4 ] ≡ 24
_ = refl

foldr-++ : ∀ {A B : Set} (_⊗_ : A → B → B) (e : B) (xs ys : List A) →
  foldr _⊗_ e (xs ++ ys) ≡ foldr _⊗_ (foldr _⊗_ e ys) xs
foldr-++ _⊗_ e []       ys = refl
foldr-++ _⊗_ e (x ∷ xs) ys = cong (x ⊗_) (foldr-++ _⊗_ e xs ys)

map-is-foldr : ∀ {A B : Set} {f : A → B} →
  map f ≡ foldr (λ x xs → f x ∷ xs) []
map-is-foldr {A} {_} {f} = extensionality hf
  where
  hf : (l : List A) → map f l ≡ foldr (λ x xs → f x ∷ xs) [] l
  hf [] = refl
  hf (x ∷ xs) = cong (f x ∷_) (hf xs)

fold-Tree : ∀ {A B C : Set}
  → (A → C) → (C → B → C → C) → Tree A B → C
fold-Tree f g (leaf a)            = f a
fold-Tree f g (node tree b tree₁) = g (fold-Tree f g tree) b (fold-Tree f g tree₁)

downFrom : ℕ → List ℕ
downFrom zero     =  []
downFrom (suc n)  =  n ∷ downFrom n

_ : downFrom 3 ≡ [ 2 , 1 , 0 ]
_ = refl

open Data.Nat.Properties using
  (*-distribʳ-+; *-distribʳ-∸; m∸n+n≡m; m≤m+n;
   +-comm; *-comm; +-identityʳ; *-identityˡ)
open Eq using (cong₂)

2n≡n+n : ∀ n → 2 * n ≡ n + n
2n≡n+n zero = refl
2n≡n+n (suc n) = cong (λ x → suc (n + suc x)) (+-identityʳ n)

n≤n*n : ∀ n → n ≤ n * n
n≤n*n zero    = z≤n
n≤n*n (suc n) = s≤s (m≤m+n n (n * suc n))

sum-downFrom : ∀ (n : ℕ)
  → sum (downFrom n) * 2 ≡ n * (n ∸ 1)
sum-downFrom zero    = refl
sum-downFrom (suc n) =
  begin
    sum (downFrom (suc n)) * 2
  ≡⟨⟩
    (n + sum (downFrom n)) * 2
  ≡⟨ *-distribʳ-+ 2 n (sum (downFrom n)) ⟩
    n * 2 + sum (downFrom n) * 2
  ≡⟨ cong (n * 2 +_) (sum-downFrom n) ⟩
    n * 2 + n * (n ∸ 1)
  ≡⟨ cong₂ _+_ (*-comm n 2) (*-comm n (n ∸ 1)) ⟩
    2 * n + (n ∸ 1) * n
  ≡⟨ cong (2 * n +_) (*-distribʳ-∸ n n 1) ⟩
    2 * n + (n * n ∸ 1 * n)
  ≡⟨ cong₂ (λ a b → a + (n * n ∸ b)) (2n≡n+n n) (*-identityˡ n) ⟩
    n + n + (n * n ∸ n)
  ≡⟨ +-comm (n + n) (n * n ∸ n) ⟩
    n * n ∸ n + (n + n)
  ≡⟨ sym (+-assoc (n * n ∸ n) n n) ⟩
    n * n ∸ n + n + n
  ≡⟨ cong (_+ n) (m∸n+n≡m (n≤n*n n)) ⟩
    n * n + n
  ≡⟨ +-comm (n * n) n ⟩
    n + n * n
  ≡⟨⟩
    (suc n) * (suc n ∸ 1)
  ∎

------------------------------

record IsMonoid {A : Set} (_⊗_ : A → A → A) (e : A) : Set where
  field
    assoc : ∀ (x y z : A) → (x ⊗ y) ⊗ z ≡ x ⊗ (y ⊗ z)
    identityˡ : ∀ (x : A) → e ⊗ x ≡ x
    identityʳ : ∀ (x : A) → x ⊗ e ≡ x

open IsMonoid

+-monoid : IsMonoid _+_ 0
+-monoid =
  record
    { assoc = +-assoc
    ; identityˡ = +-identityˡ
    ; identityʳ = +-identityʳ
    }

*-monoid : IsMonoid _*_ 1
*-monoid =
  record
    { assoc = *-assoc
    ; identityˡ = *-identityˡ
    ; identityʳ = *-identityʳ
    }

++-monoid : ∀ {A : Set} → IsMonoid {List A} _++_ []
++-monoid =
  record
    { assoc = ++-assoc
    ; identityˡ = ++-identityˡ
    ; identityʳ = ++-identityʳ
    }

foldr-monoid : ∀ {A : Set} (_⊗_ : A → A → A) (e : A) → IsMonoid _⊗_ e →
  ∀ (xs : List A) (y : A) → foldr _⊗_ y xs ≡ foldr _⊗_ e xs ⊗ y
foldr-monoid _⊗_ e ⊗-monoid [] y = -- sym (identityˡ ⊗-monoid y)
  begin
    foldr _⊗_ y []
  ≡⟨⟩
    y
  ≡⟨ sym (identityˡ ⊗-monoid y) ⟩
    (e ⊗ y)
  ≡⟨⟩
    foldr _⊗_ e [] ⊗ y
  ∎
foldr-monoid _⊗_ e ⊗-monoid (x ∷ xs) y =
  begin
    foldr _⊗_ y (x ∷ xs)
  ≡⟨⟩
    x ⊗ (foldr _⊗_ y xs)
  ≡⟨ cong (x ⊗_) (foldr-monoid _⊗_ e ⊗-monoid xs y) ⟩
    x ⊗ ((foldr _⊗_ e xs) ⊗ y)
  ≡⟨ sym (assoc ⊗-monoid x (foldr _⊗_ e xs) y) ⟩
    (x ⊗ (foldr _⊗_ e xs)) ⊗ y
  ∎

foldr-monoid-++ : ∀ {A : Set} (_⊗_ : A → A → A) (e : A) → IsMonoid _⊗_ e →
  ∀ (xs ys : List A) → foldr _⊗_ e (xs ++ ys) ≡ foldr _⊗_ e xs ⊗ foldr _⊗_ e ys
foldr-monoid-++ _⊗_ e monoid-⊗ xs ys =
  begin
    foldr _⊗_ e (xs ++ ys)
  ≡⟨ foldr-++ _⊗_ e xs ys ⟩
    foldr _⊗_ (foldr _⊗_ e ys) xs
  ≡⟨ foldr-monoid _⊗_ e monoid-⊗ xs (foldr _⊗_ e ys) ⟩
    foldr _⊗_ e xs ⊗ foldr _⊗_ e ys
  ∎

---------- practice ----------
foldl : ∀ {A B : Set} → (B → A → B) → B → List A → B
foldl _⊗_ e       []  =  e
foldl _⊗_ e (x ∷ xs)  =  foldl _⊗_ (e ⊗ x) xs

foldl-monoid : ∀ {A : Set} (_⊗_ : A → A → A) (e : A) → IsMonoid _⊗_ e →
  ∀ (xs : List A) (y : A) → foldl _⊗_ y xs ≡ y ⊗ foldl _⊗_ e xs
foldl-monoid _⊗_ e ⊗-monoid []       y = sym (identityʳ ⊗-monoid y)
foldl-monoid _⊗_ e ⊗-monoid (x ∷ xs) y =
  begin
    foldl _⊗_ y (x ∷ xs)
  ≡⟨⟩
    foldl _⊗_ (y ⊗ x) xs
  ≡⟨ foldl-monoid _⊗_ e ⊗-monoid xs (y ⊗ x) ⟩
    (y ⊗ x) ⊗ (foldl _⊗_ e xs)
  ≡⟨ assoc ⊗-monoid y x (foldl _⊗_ e xs) ⟩
    y ⊗ (x ⊗ foldl _⊗_ e xs)
  ≡⟨ sym (cong (y ⊗_) (foldl-monoid _⊗_ e ⊗-monoid xs x)) ⟩
    y ⊗ (foldl _⊗_ x xs)
  ≡⟨ sym (cong (λ z → y ⊗ foldl _⊗_ z xs) (identityˡ ⊗-monoid x)) ⟩
    y ⊗ (foldl _⊗_ (e ⊗ x) xs)
  ≡⟨⟩
    y ⊗ foldl _⊗_ e (x ∷ xs)
  ∎

foldr-monoid-foldl : ∀ {A : Set} (_⊗_ : A → A → A) (e : A) → IsMonoid _⊗_ e →
  ∀ (xs : List A) → foldr _⊗_ e xs ≡ foldl _⊗_ e xs
foldr-monoid-foldl _⊗_ e ⊗-monoid []       = refl
foldr-monoid-foldl _⊗_ e ⊗-monoid (x ∷ xs) =
  begin
    foldr _⊗_ e (x ∷ xs)
  ≡⟨⟩
    (x ⊗ foldr _⊗_ e xs)
  ≡⟨ cong (x ⊗_) (foldr-monoid-foldl _⊗_ e ⊗-monoid xs) ⟩
    (x ⊗ foldl _⊗_ e xs)
  ≡⟨ sym (foldl-monoid _⊗_ e ⊗-monoid xs x) ⟩
    foldl _⊗_ x xs
  ≡⟨ cong (λ a → foldl _⊗_ a xs) (sym (identityˡ ⊗-monoid x)) ⟩
    foldl _⊗_ (e ⊗ x) xs
  ≡⟨⟩
    foldl _⊗_ e (x ∷ xs)
  ∎

------------------------------

data All {A : Set} (P : A → Set) : List A → Set where
  []  : All P []
  _∷_ : ∀ {x : A} {xs : List A} → P x → All P xs → All P (x ∷ xs)

_ : All (_≤ 2) [ 0 , 1 , 2 ]
_ = z≤n ∷ s≤s z≤n ∷ s≤s (s≤s z≤n) ∷ []

data Any {A : Set} (P : A → Set) : List A → Set where
  here  : ∀ {x : A} {xs : List A} → P x → Any P (x ∷ xs)
  there : ∀ {x : A} {xs : List A} → Any P xs → Any P (x ∷ xs)

_∈_ : ∀ {A : Set} (x : A) (xs : List A) → Set
x ∈ xs = Any (x ≡_) xs

_∉_ : ∀ {A : Set} (x : A) (xs : List A) → Set
x ∉ xs = ¬ (x ∈ xs)

_ : 0 ∈ [ 0 , 1 , 0 , 2 ]
_ = here refl

_ : 0 ∈ [ 0 , 1 , 0 , 2 ]
_ = there (there (here refl))

not-in : 3 ∉ [ 0 , 0 , 0 , 2 ]
not-in (here ())
not-in (there (here ()))
not-in (there (there (here ())))
not-in (there (there (there (here ()))))
not-in (there (there (there (there ()))))

All-++-⇔ : ∀ {A : Set} {P : A → Set} (xs ys : List A) →
  All P (xs ++ ys) ⇔ (All P xs × All P ys)
All-++-⇔ xs ys =
  record
    { to   = to xs ys
    ; from = from xs ys
    }
  where

  to : ∀ {A : Set} {P : A → Set} (xs ys : List A) →
    All P (xs ++ ys) → (All P xs × All P ys)
  to [] ys Pys = ⟨ [] , Pys ⟩
  to (x ∷ xs) ys (Px ∷ Pxs++ys) with to xs ys Pxs++ys
  ... | ⟨ Pxs , Pys ⟩ = ⟨ Px ∷ Pxs , Pys ⟩

  from : ∀ { A : Set} {P : A → Set} (xs ys : List A) →
    All P xs × All P ys → All P (xs ++ ys)
  from [] ys ⟨ [] , Pys ⟩ = Pys
  from (x ∷ xs) ys ⟨ Px ∷ Pxs , Pys ⟩ = Px ∷ (from xs ys ⟨ Pxs , Pys ⟩)

---------- practice ----------
open import Data.Sum using (_⊎_; inj₁; inj₂)
open Data.Product using (proj₁; proj₂)
open import Data.Empty using (⊥-elim)

Any-++-⇔ : ∀ {A : Set} {P : A → Set} (xs ys : List A) →
  Any P (xs ++ ys) ⇔ (Any P xs ⊎ Any P ys)
Any-++-⇔ {A} {P} xs ys =
  record
  { to   = to xs ys
  ; from = from xs ys
  }
  where
  to : ∀ (xs ys : List A) →
    Any P (xs ++ ys) → Any P xs ⊎ Any P ys
  to []       ys Pys = inj₂ Pys
  to (x ∷ xs) ys (here Px)       = inj₁ (here Px)
  to (x ∷ xs) ys (there ∃Pxs++ys) with to xs ys ∃Pxs++ys
  ...                                | inj₁ ∃Pxs = inj₁ (there ∃Pxs)
  ...                                | inj₂ ∃Pys = inj₂ ∃Pys
  from : ∀ (xs ys : List A) →
    Any P xs ⊎ Any P ys → Any P (xs ++ ys)
  from [] ys (inj₂ ∃Pys) = ∃Pys
  from (x ∷ xs) ys (inj₁ (here Px))    = here Px
  from (x ∷ xs) ys (inj₁ (there ∃Pxs)) = there (from xs ys (inj₁ ∃Pxs))
  from (x ∷ xs) ys (inj₂ ∃Pys)         = there (from xs ys (inj₂ ∃Pys))

All-++-≃ : ∀ {A : Set} {P : A → Set} (xs ys : List A) →
  All P (xs ++ ys) ≃ (All P xs × All P ys)
All-++-≃ {A} {P} xs ys =
  record
  { to      = to      xs ys
  ; from    = from    xs ys
  ; from∘to = from∘to xs ys
  ; to∘from = to∘from xs ys
  }
  where
  to : ∀ (xs ys : List A) → All P (xs ++ ys) → (All P xs × All P ys)
  to xs ys = _⇔_.to (All-++-⇔ xs ys)

  from : ∀ (xs ys : List A) → All P xs × All P ys → All P (xs ++ ys)
  from xs ys = _⇔_.from (All-++-⇔ xs ys)

  from∘to : ∀ (xs ys : List A) (Pxs++ys : All P (xs ++ ys))
    → from xs ys (to xs ys Pxs++ys) ≡ Pxs++ys
  from∘to [] ys Pxs++ys = refl
  from∘to (x ∷ xs) ys (Px ∷ Pxs++ys) = -- cong (Px ∷_) (from∘to xs ys Pxs++ys)
    begin
      from (x ∷ xs) ys (to (x ∷ xs) ys (Px ∷ Pxs++ys))
    ≡⟨⟩
      from (x ∷ xs) ys ⟨ Px ∷ proj₁ t , proj₂ t ⟩
    ≡⟨⟩
      Px ∷ from xs ys ⟨ proj₁ t , proj₂ t ⟩
    ≡⟨⟩
      Px ∷ from xs ys (to xs ys Pxs++ys)
    ≡⟨ cong (Px ∷_) (from∘to xs ys Pxs++ys) ⟩
      Px ∷ Pxs++ys
    ∎
    where t = to xs ys Pxs++ys

  to∘from : ∀ (xs ys : List A) (Pxs×Pys : All P xs × All P ys)
    → to xs ys (from xs ys Pxs×Pys) ≡ Pxs×Pys
  to∘from [] ys ⟨ [] , Pys ⟩ = refl
  to∘from (x ∷ xs) ys ⟨ Px ∷ Pxs , Pys ⟩ =
  -- cong (λ k → ⟨ Px ∷ (proj₁ k) , proj₂ k ⟩) (to∘from xs ys ⟨ Pxs , Pys ⟩)
    begin
      to (x ∷ xs) ys (from (x ∷ xs) ys ⟨ Px ∷ Pxs , Pys ⟩)
    ≡⟨⟩
      to (x ∷ xs) ys (Px ∷ (from xs ys ⟨ Pxs , Pys ⟩))
    ≡⟨⟩
      ⟨ Px ∷ (proj₁ tf) , (proj₂ tf) ⟩
    ≡⟨ cong (λ k → ⟨ Px ∷ (proj₁ k) , proj₂ k ⟩) (to∘from xs ys ⟨ Pxs , Pys ⟩) ⟩
      ⟨ Px ∷ (proj₁ ⟨ Pxs , Pys ⟩) , (proj₂ ⟨ Pxs , Pys ⟩) ⟩
    ≡⟨⟩
      ⟨ Px ∷ Pxs , Pys ⟩
    ∎
    where tf = (to xs ys (from xs ys ⟨ Pxs , Pys ⟩))

_∘′_ : ∀ {ℓ₁ ℓ₂ ℓ₃ : Level} {A : Set ℓ₁} {B : Set ℓ₂} {C : Set ℓ₃}
  → (B → C) → (A → B) → A → C
(g ∘′ f) x  =  g (f x)

¬Any≃All¬ : ∀ {A : Set} (P : A → Set) (xs : List A)
  → (¬_ ∘′ Any P) xs ≃ All (¬_ ∘′ P) xs
¬Any≃All¬ {A} P xs =
  record
  { to      = to xs
  ; from    = from xs
  ; from∘to = from∘to xs
  ; to∘from = to∘from xs
  }
  where
  to : (xs : List A) → (¬_ ∘′ Any P) xs → All (¬_ ∘′ P) xs
  to []       ¬Any = []
  to (x ∷ xs) ¬Any = (λ Px → ¬Any (here Px)) ∷ to xs (λ Pxs → ¬Any (there Pxs))
  from : (xs : List A) → All (¬_ ∘′ P) xs → (¬_ ∘′ Any P) xs
  from (x ∷ xs) (¬Px ∷ All¬) (here Px) = ¬Px Px
  from (x ∷ xs) (¬Px ∷ All¬) (there AnyP) = from xs All¬ AnyP

  from∘to : (xs : List A) → ∀ (¬Any) → from xs (to xs ¬Any) ≡ ¬Any
  from∘to xs ¬Any = extensionality λ AnyP → ⊥-elim (¬Any AnyP)

  to∘from : (xs : List A) → ∀ (All¬) → to xs (from xs All¬) ≡ All¬
  to∘from [] [] = refl
  to∘from (x ∷ xs) (¬Px ∷ ¬Pxs) = cong (¬Px ∷_) (to∘from xs ¬Pxs)

-- ¬All≃Any¬ : ∀ {A : Set} (P : A → Set) (xs : List A)
--  → (¬_ ∘′ All P) xs ≃ Any (¬_ ∘′ P) xs
-- doesn't hold, because we couldn't use
-- ((¬_ ∘′ All P) xs) to construct a (Any (¬_ ∘′ P) xs)

------------------------------

all : ∀ {A : Set} → (A → Bool) → List A → Bool
all p  =  foldr _∧_ true ∘ map p

Decidable : ∀ {A : Set} → (A → Set) → Set
Decidable {A} P  =  ∀ (x : A) → Dec (P x)

All? : ∀ {A : Set} {P : A → Set} → Decidable P → Decidable (All P)
All? P? []                                 = yes []
All? P? (x ∷ xs) with P? x   | All? P? xs
...                 | yes Px | yes p₁      = yes (Px ∷ p₁)
...                 | no ¬Px | _           = no λ{ (Px ∷ Pxs) → ¬Px Px}
...                 | _      | no ¬Pxs     = no λ{ (Px ∷ Pxs) → ¬Pxs Pxs}

---------- practice ----------
any : ∀ {A : Set} → (A → Bool) → List A → Bool
any p  =  foldr _∨_ false ∘ map p

Any? : ∀ {A : Set} {P : A → Set} → Decidable P → Decidable (Any P)
Any? P? [] = no (λ ())
Any? P? (x ∷ xs) with P? x   | Any? P? xs
Any? P? (x ∷ xs)    | yes Px | _        = yes (here Px)
Any? P? (x ∷ xs)    | _      | yes ∃Pxs = yes (there ∃Pxs)
Any? P? (x ∷ xs)    | no ¬Px | no ¬∃Pxs = no λ{ (here Px) → ¬Px Px
                                              ; (there ∃Px) → ¬∃Pxs ∃Px
                                              }

open import plfa-code.Quantifiers using (∀-extensionality)

-- the implicit argument x is too difficult to deal with ..
-- so I replace it with explicit

All-∀ : ∀ {A : Set} {P : A → Set} (xs : List A) →
  All P xs ≃ (∀ (x) → x ∈ xs → P x)
All-∀ {A} {P} xs =
  record
  { to      = to xs
  ; from    = from xs
  ; from∘to = from∘to xs
  ; to∘from = to∘from xs
  }
  where
  to : ∀ (xs : List A) → All P xs → (∀ (x) → x ∈ xs → P x)
  to (x₁ ∷ xs) (Px₁ ∷  _ ) .x₁ (here refl)  = Px₁
  to (x₁ ∷ xs) ( _  ∷ Pxs) x   (there x∈xs) = to xs Pxs x x∈xs

  from : ∀ (xs : List A) → (∀ (x) → x ∈ xs → P x) → All P xs
  from []       f = []
  from (x ∷ xs) f = f x (here refl) ∷ from xs (λ x₁ → (f x₁) ∘ there)

  from∘to : ∀ (xs : List A) → (Pxs : All P xs) → from xs (to xs Pxs) ≡ Pxs
  from∘to []       []         = refl
  from∘to (x ∷ xs) (Px ∷ Pxs) = cong (Px ∷_) (from∘to xs Pxs)

  to∘from : ∀ (xs : List A) → ∀ (f) → to xs (from xs f) ≡ f
  to∘from [] f = ∀-extensionality (to [] []) f
    (λ x → ∀-extensionality (to [] [] x) (f x) λ ())
  to∘from (x ∷ xs) f = ∀-extensionality (to (x ∷ xs) (from (x ∷ xs) f)) f
    (λ x₁ → ∀-extensionality (to (x ∷ xs) (from (x ∷ xs) f) x₁) (f x₁)
      λ{ (here refl) → refl
       ; (there x₁∈xs) → cong (λ g → g x₁ x₁∈xs)
                (to∘from xs (λ x₂ → (f x₂) ∘ there))
       }
    )

-- Emmmm..., "∃[ x ∈ xs ] P x" is not a valid type, I guess its real
-- meaning is like below

Any-∃ : {A : Set} {P : A → Set} (xs : List A) →
  Any P xs ≃ ∃[ x ] (x ∈ xs × P x)
Any-∃ {A} {P} xs =
  record
  { to      = to xs
  ; from    = from xs
  ; from∘to = from∘to xs
  ; to∘from = to∘from xs
  }
  where
  to : ∀ (xs : List A) → Any P xs → ∃[ x ] (x ∈ xs × P x)
  to (x ∷ xs) (here Px)         = ⟨ x , ⟨ here refl , Px ⟩ ⟩
  to (x ∷ xs) (there AnyP) with to xs AnyP
  ... | ⟨ x₁ , ⟨ x₁∈xs , Px ⟩ ⟩ = ⟨ x₁ , ⟨ there x₁∈xs , Px ⟩ ⟩

  from : ∀ (xs : List A) → ∃[ x ] (x ∈ xs × P x) → Any P xs
  from (x ∷ xs) ⟨ .x , ⟨ here refl   , Px  ⟩ ⟩ = here Px
  from (x ∷ xs) ⟨ x₁ , ⟨ there x₁∈xs , Px₁ ⟩ ⟩ = there (from xs ⟨ x₁ , ⟨ x₁∈xs , Px₁ ⟩ ⟩)

  from∘to : ∀ (xs : List A) → (AnyP : Any P xs)
    → from xs (to xs AnyP) ≡ AnyP
  from∘to (x ∷ xs) (here x₁)    = refl
  from∘to (x ∷ xs) (there AnyP) = cong there (from∘to xs AnyP)

  to∘from : ∀ (xs : List A) → ∀ ∃Pxs → to xs (from xs ∃Pxs) ≡ ∃Pxs
  to∘from (x ∷ xs) ⟨ .x , ⟨ here refl   , Px  ⟩ ⟩ = refl
  to∘from (x ∷ xs) ⟨ x₁ , ⟨ there x₁∈xs , Px₁ ⟩ ⟩
    = cong (λ a → ⟨ proj₁ a , ⟨ there (proj₁ (proj₂ a)) , proj₂ (proj₂ a) ⟩ ⟩)
           (to∘from xs ⟨ x₁ , ⟨ x₁∈xs , Px₁ ⟩ ⟩)

filter? : ∀ {A : Set} {P : A → Set}
  → (P? : Decidable P) → List A → ∃[ ys ]( All P ys )
filter? P? [] = ⟨ [] , [] ⟩
filter? P? (x ∷ xs) with P? x   | filter? P? xs
...                    | yes Px | ⟨ ys , Pys ⟩  = ⟨ (x ∷ ys) , (Px ∷ Pys) ⟩
...                    | no ¬Px | ∃ys-Pys       = ∃ys-Pys


{-# OPTIONS --without-K #-}
module sets.vec where

open import sets.vec.core public
open import sets.vec.properties public
open import sets.vec.dependent public


{-# OPTIONS --show-implicit #-}
-- {-# OPTIONS -v tc.polarity:10 #-}
module Issue44 where

data Ty : Set where
  ι : Ty
  _⇒_ : Ty -> Ty -> Ty

data Con : Set where
  ε : Con
  _<_ : Con -> Ty -> Con

data Var : Con -> Ty -> Set where
  vZ : forall {Γ σ} -> Var (Γ < σ) σ
  vS : forall {Γ σ}{τ : Ty} -> Var Γ σ -> Var (Γ < τ) σ

{-
stren : forall {Γ σ} -> Var Γ σ -> Con
stren (vZ {Γ}) = Γ
stren (vS {τ = τ} v) = stren v < τ

_/_ : forall Γ {σ} -> Var Γ σ -> Con
Γ / v = stren v
-}

-- However if I make stren a local function:

_/_ : forall Γ {σ} -> Var Γ σ -> Con
Γ / v = stren v where
  stren : forall {Γ σ} -> Var Γ σ -> Con
  stren (vZ {Γ}) = Γ
  stren (vS {τ = τ} v) = stren v < τ

thin : forall {Γ σ τ}(v : Var Γ σ) -> Var (Γ / v) τ -> Var Γ τ
thin vZ v' = vS v'
thin (vS v) vZ = vZ
thin (vS v) (vS v') = vS (thin v v')


{-# OPTIONS --without-K --rewriting #-}

open import lib.Basics
open import lib.types.Group
open import lib.groups.Homomorphism
open import lib.groups.TensorProduct

module lib.types.CRing where

-- 1-approximation of commutative rings without higher coherence conditions.
record CRingStructure {i} (El : Type i)
  : Type i where
  constructor ring-structure
  field
    add-group-struct : GroupStructure El

  open GroupStructure add-group-struct

  zero : El
  zero = ident

  add : El → El → El
  add = comp

  neg : El → El
  neg = inv

  field
    add-comm    : ∀ a b → add a b == add b a
    one         : El
    mult        : El → El → El
    mult-unit-l : ∀ a → mult one a == a
    mult-assoc  : ∀ a b c → mult (mult a b) c == mult a (mult b c)
    mult-comm   : ∀ a b → mult a b == mult b a
    distr-l     : ∀ a b c → mult (add a b) c == add (mult a c) (mult b c)

  private
    infix 80 _⊕_
    _⊕_ = add
    infix 90 _⊗_
    _⊗_ = mult

  add-assoc : ∀ a b c → (a ⊕ b) ⊕ c == a ⊕ (b ⊕ c)
  add-assoc = assoc

  abstract
    mult-unit-r : ∀ a → a ⊗ one == a
    mult-unit-r a =
      a ⊗ one  =⟨ mult-comm a one ⟩
      one ⊗ a  =⟨ mult-unit-l a ⟩
      a        =∎

    distr-r : ∀ a b c → a ⊗ (b ⊕ c) == a ⊗ b ⊕ a ⊗ c
    distr-r a b c =
      a ⊗ (b ⊕ c)    =⟨ mult-comm a (add b c) ⟩
      (b ⊕ c) ⊗ a    =⟨ distr-l b c a ⟩
      b ⊗ a ⊕ c ⊗ a  =⟨ (mult-comm b a) |in-ctx (λ x → add x (mult c a)) ⟩
      a ⊗ b ⊕ c ⊗ a  =⟨ (mult-comm c a) |in-ctx (add (mult a b)) ⟩
      a ⊗ b ⊕ a ⊗ c  =∎

    mult-zero-l : ∀ a → zero ⊗ a == zero
    mult-zero-l a =
      cancel-l (zero ⊗ a) $
        zero ⊗ a ⊕ zero ⊗ a  =⟨ ! (distr-l zero zero a) ⟩
        (zero ⊕ zero) ⊗ a    =⟨ unit-l zero |in-ctx (λ x → x ⊗ a) ⟩
        zero ⊗ a             =⟨ ! (unit-r (zero ⊗ a)) ⟩
        zero ⊗ a ⊕ zero      =∎

    mult-zero-r : ∀ a → a ⊗ zero == zero
    mult-zero-r a =
      a ⊗ zero  =⟨ mult-comm a zero ⟩
      zero ⊗ a  =⟨ mult-zero-l a ⟩
      zero      =∎

record CRing i : Type (lsucc i) where
  constructor ring
  field
    El : Type i
    {{El-level}} : has-level 0 El
    ring-struct : CRingStructure El
  open CRingStructure ring-struct public

  add-group : Group i
  add-group = group El add-group-struct

  add-abgroup : AbGroup i
  add-abgroup = add-group , add-comm

  mult-hom : El → add-group →ᴳ add-group
  mult-hom g = group-hom (mult g) (distr-r g)

  mult-hom-zero : mult-hom zero == cst-hom
  mult-hom-zero = group-hom= (λ= mult-zero-l)

  private
    module R⊗R = TensorProduct add-abgroup add-abgroup
    module UP = R⊗R.UniversalProperty add-abgroup

    mult-bilinear-map : UP.BilinearMap
    mult-bilinear-map =
      record
      { bmap = mult
      ; linearity-l = distr-l
      ; linearity-r = distr-r
      }

  mult-hom' : R⊗R.grp →ᴳ add-group
  mult-hom' = UP.extend mult-bilinear-map

  mult-hom'-β : ∀ a b → GroupHom.f mult-hom' (a R⊗R.⊗ b) == mult a b
  mult-hom'-β = UP.extend-β mult-bilinear-map

Ring₀ : Type (lsucc lzero)
Ring₀ = CRing lzero


module local where

data Nat : Set where
  zero : Nat
  suc  : Nat -> Nat

infixr 15 _::_

data List (A : Set) : Set where
  nil  : List A
  _::_ : A -> List A -> List A

reverse : {A : Set} -> List A -> List A
reverse {A} xs = rev xs nil
  where
    rev : List A -> List A -> List A
    rev  nil      ys = ys
    rev (x :: xs) ys = rev xs (x :: ys)

postulate
  xs : List Nat


{-# OPTIONS --without-K #-}
module function.extensionality where

open import function.extensionality.core public
open import function.extensionality.proof public
open import function.extensionality.strong public
  using (strong-funext; strong-funext-iso)
open import function.extensionality.computation public

open import equality.core
open import function.isomorphism
open import function.overloading

-- extensionality for functions of implicit arguments
impl-funext : ∀ {i j}{X : Set i}{Y : X → Set j}
          → {f g : {x : X} → Y x}
          → ((x : X) → f {x} ≡ g {x})
          → (λ {x} → f {x}) ≡ g
impl-funext h = ap (apply impl-iso) (funext h)


{-# OPTIONS --universe-polymorphism #-}
-- {-# OPTIONS --verbose tc.rec:15 #-}
-- {-# OPTIONS --verbose tc.records.ifs:15 #-}
-- {-# OPTIONS --verbose tc.constr.findInScope:15 #-}
-- {-# OPTIONS --verbose tc.term.args.ifs:15 #-}

module 05-equality-std2 where

open import Relation.Binary
open import Data.Bool hiding (_≟_)

open DecSetoid {{...}}

test = isDecEquivalence
test2 = false ≟ false


------------------------------------------------------------------------
-- The Agda standard library
--
-- Component functions of permutations found in `Data.Fin.Permutation`
------------------------------------------------------------------------

{-# OPTIONS --without-K --safe #-}

module Data.Fin.Permutation.Components where

open import Data.Fin
open import Data.Fin.Properties
open import Data.Nat as ℕ using (zero; suc; _∸_)
import Data.Nat.Properties as ℕₚ
open import Data.Product using (proj₂)
open import Relation.Nullary using (yes; no)
open import Relation.Binary.PropositionalEquality
open import Algebra.FunctionProperties using (Involutive)
open ≡-Reasoning

--------------------------------------------------------------------------------
--  Functions
--------------------------------------------------------------------------------

-- 'tranpose i j' swaps the places of 'i' and 'j'.

transpose : ∀ {n} → Fin n → Fin n → Fin n → Fin n
transpose i j k with k ≟ i
... | yes _ = j
... | no  _ with k ≟ j
...   | yes _ = i
...   | no  _ = k

-- reverse i = n ∸ 1 ∸ i

reverse : ∀ {n} → Fin n → Fin n
reverse {zero}  ()
reverse {suc n} i  = inject≤ (n ℕ- i) (ℕₚ.n∸m≤n (toℕ i) (suc n))

--------------------------------------------------------------------------------
--  Properties
--------------------------------------------------------------------------------

transpose-inverse : ∀ {n} (i j : Fin n) {k} →
                    transpose i j (transpose j i k) ≡ k
transpose-inverse i j {k} with k ≟ j
... | yes p rewrite ≡-≟-identity _≟_ {a = i} refl = sym p
... | no ¬p with k ≟ i
transpose-inverse i j {k} | no ¬p | yes q with j ≟ i
... | yes r = trans r (sym q)
... | no ¬r rewrite ≡-≟-identity _≟_ {a = j} refl = sym q
transpose-inverse i j {k} | no ¬p | no ¬q
  rewrite proj₂ (≢-≟-identity _≟_ ¬q)
        | proj₂ (≢-≟-identity _≟_ ¬p) = refl

reverse-prop : ∀ {n} → (i : Fin n) → toℕ (reverse i) ≡ n ∸ suc (toℕ i)
reverse-prop {zero} ()
reverse-prop {suc n} i = begin
  toℕ (inject≤ (n ℕ- i) _)  ≡⟨ toℕ-inject≤ _ _ ⟩
  toℕ (n ℕ- i)              ≡⟨ toℕ‿ℕ- n i ⟩
  n ∸ toℕ i                 ∎

reverse-involutive : ∀ {n} → Involutive _≡_ (reverse {n})
reverse-involutive {zero}  ()
reverse-involutive {suc n} i = toℕ-injective (begin
  toℕ (reverse (reverse i)) ≡⟨ reverse-prop (reverse i) ⟩
  n ∸ (toℕ (reverse i))     ≡⟨ cong (n ∸_) (reverse-prop i) ⟩
  n ∸ (n ∸ (toℕ i))         ≡⟨ ℕₚ.m∸[m∸n]≡n (ℕₚ.≤-pred (toℕ<n i)) ⟩
  toℕ i                     ∎)

reverse-suc : ∀ {n}{i : Fin n} → toℕ (reverse (suc i)) ≡ toℕ (reverse i)
reverse-suc {n} {i} = begin
  toℕ (reverse (suc i))      ≡⟨ reverse-prop (suc i) ⟩
  suc n ∸ suc (toℕ (suc i))  ≡⟨⟩
  n ∸ toℕ (suc i)            ≡⟨⟩
  n ∸ suc (toℕ i)            ≡⟨ sym (reverse-prop i) ⟩
  toℕ (reverse i)            ∎


module Verifier where

open import Definitions
open import NatEquality using (_≟_ ; equality-disjoint)

check1 : (m n : ℕ) → Equal? m n
check1 = _≟_

check2 : (m n : ℕ) → m ≡ n → m ≢ n → ⊥
check2 = equality-disjoint


{-# OPTIONS --without-K --safe #-}

module Data.Binary.Proofs.Semantics where

open import Relation.Binary.PropositionalEquality
open import Data.Binary.Operations.Unary
open import Data.Binary.Proofs.Unary
open import Data.Binary.Definitions
open import Data.Binary.Operations.Semantics
open import Data.Nat as ℕ using (ℕ; suc; zero)
open import Relation.Binary.PropositionalEquality.FasterReasoning
import Data.Nat.Properties as ℕ
open import Function
open import Data.Nat.Reasoning

2*-distrib : ∀ x y → 2* (x ℕ.+ y) ≡ 2* x ℕ.+ 2* y
2*-distrib x y =
  begin
    2* (x ℕ.+ y)
  ≡⟨⟩
    (x ℕ.+ y) ℕ.+ (x ℕ.+ y)
  ≡⟨ ℕ.+-assoc x y (x ℕ.+ y)  ⟩
    x ℕ.+ (y ℕ.+ (x ℕ.+ y))
  ≡⟨ x +≫ ℕ.+-comm y (x ℕ.+ y) ⟩
    x ℕ.+ ((x ℕ.+ y) ℕ.+ y)
  ≡⟨ x +≫ ℕ.+-assoc x y y ⟩
    x ℕ.+ (x ℕ.+ (y ℕ.+ y))
  ≡˘⟨ ℕ.+-assoc x x _ ⟩
    2* x ℕ.+ 2* y
  ∎

s2*-distrib : ∀ x y → I ∷⇓ (x ℕ.+ y) ≡ suc (2* x ℕ.+ 2* y)
s2*-distrib x y = cong suc (2*-distrib x y)


module Excercises where

open import Library
open import Core/Category

SmallType : Category (mk (ℓ-suc ℓ-zero) ℓ-zero)
SmallType = record
  { Obj   = Set
  ; _⇒_   = λ (X Y : Set) → (X → Y)
  ; id    = λ (X : Set) → (λ x → x)
  ; _∘_   = λ {X Y Z : Set} (g : Y → Z) (f : X → Y) → (λ x → g (f x))
  ; idl   = ≡-refl
  ; idr   = ≡-refl
  ; assoc = ≡-refl
  }


{-# OPTIONS --rewriting --confluence-check #-}

open import Agda.Builtin.List
open import Agda.Builtin.Nat
open import Agda.Builtin.Equality
open import Agda.Builtin.Equality.Rewrite

variable
  A B : Set
  x y z : A
  xs ys zs : List A
  f : A → B
  m n : Nat

cong : (f : A → B) → x ≡ y → f x ≡ f y
cong f refl = refl

trans : x ≡ y → y ≡ z → x ≡ z
trans refl refl = refl

+zero : m + zero ≡ m
+zero {zero} = refl
+zero {suc m} = cong suc +zero

suc+zero : suc m + zero ≡ suc m
suc+zero = +zero

+suc : m + (suc n) ≡ suc (m + n)
+suc {zero} = refl
+suc {suc m} = cong suc +suc

zero+suc : zero + (suc n) ≡ suc n
zero+suc = refl

suc+suc : (suc m) + (suc n) ≡ suc (suc (m + n))
suc+suc = cong suc +suc

{-# REWRITE +zero +suc suc+zero zero+suc suc+suc #-}

map : (A → B) → List A → List B
map f [] = []
map f (x ∷ xs) = (f x) ∷ (map f xs)

_++_ : List A → List A → List A
[] ++ ys = ys
(x ∷ xs) ++ ys = x ∷ (xs ++ ys)

++-[] : xs ++ [] ≡ xs
++-[] {xs = []} = refl
++-[] {xs = x ∷ xs} = cong (_∷_ x) ++-[]

∷-++-[] : (x ∷ xs) ++ [] ≡ x ∷ xs
∷-++-[] = ++-[]

map-id : map (λ x → x) xs ≡ xs
map-id {xs = []} = refl
map-id {xs = x ∷ xs} = cong (_∷_ x) map-id

map-id-∷ : map (λ x → x) (x ∷ xs) ≡ x ∷ xs
map-id-∷ = map-id

{-# REWRITE ++-[] ∷-++-[] #-}
{-# REWRITE map-id map-id-∷ #-}