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