Move proof to category definition

This commit is contained in:
Frederik Hanghøj Iversen 2018-02-26 20:31:47 +01:00
parent 5b5d21f777
commit 101b2639e1

View file

@ -30,8 +30,13 @@ module Monoidal {a b : Level} ( : Category a b) where
η : Transformation F.identity R η : Transformation F.identity R
η = proj₁ ηNatTrans η = proj₁ ηNatTrans
ηNat : Natural F.identity R η
ηNat = proj₂ ηNatTrans
μ : Transformation F[ R R ] R μ : Transformation F[ R R ] R
μ = proj₁ μNatTrans μ = proj₁ μNatTrans
μNat : Natural F[ R R ] R μ
μNat = proj₂ μNatTrans
private private
module R = Functor R module R = Functor R
@ -42,6 +47,7 @@ module Monoidal {a b : Level} ( : Category a b) where
IsInverse = {X : Object} IsInverse = {X : Object}
μ X η (R.func* X) 𝟙 μ X η (R.func* X) 𝟙
× μ X R.func→ (η X) 𝟙 × μ X R.func→ (η X) 𝟙
IsNatural' = {X Y f} μ Y R.func→ f η X f
record IsMonad (raw : RawMonad) : Set where record IsMonad (raw : RawMonad) : Set where
open RawMonad raw public open RawMonad raw public
@ -49,6 +55,19 @@ module Monoidal {a b : Level} ( : Category a b) where
isAssociative : IsAssociative isAssociative : IsAssociative
isInverse : IsInverse isInverse : IsInverse
private
module R = Functor R
module = Category
isNatural' : IsNatural'
isNatural' {X} {Y} {f} = begin
μ Y R.func→ f η X ≡⟨ sym .isAssociative
μ Y (R.func→ f η X) ≡⟨ cong (λ φ μ Y φ) (sym (ηNat f))
μ Y (η (R.func* Y) f) ≡⟨ .isAssociative
μ Y η (R.func* Y) f ≡⟨ cong (λ φ φ f) (proj₁ isInverse)
𝟙 f ≡⟨ proj₂ .isIdentity
f
record Monad : Set where record Monad : Set where
field field
raw : RawMonad raw : RawMonad
@ -202,11 +221,7 @@ module _ {a b : Level} { : Category a b} where
isNatural {X} {Y} f = begin isNatural {X} {Y} f = begin
bind f pure ≡⟨⟩ bind f pure ≡⟨⟩
bind f η X ≡⟨⟩ bind f η X ≡⟨⟩
μ Y R.func→ f η X ≡⟨ sym .isAssociative μ Y R.func→ f η X ≡⟨ isNatural'
μ Y (R.func→ f η X) ≡⟨ cong (λ φ μ Y φ) (sym (ηN f))
μ Y (η (R.func* Y) f) ≡⟨ .isAssociative
μ Y η (R.func* Y) f ≡⟨ cong (λ φ φ f) (proj₁ isInverse)
𝟙 f ≡⟨ proj₂ .isIdentity
f f
where where
open NaturalTransformation open NaturalTransformation