Attempt at proving pureNTEq
This commit is contained in:
parent
bf605e09fe
commit
93d075a6d3
|
@ -61,6 +61,7 @@ module _ {ℓc ℓc' ℓd ℓd'}
|
|||
record IsFunctor (F : RawFunctor) : 𝓤 where
|
||||
open RawFunctor F public
|
||||
field
|
||||
-- TODO Really ought to be preserves identity or something like this.
|
||||
isIdentity : IsIdentity
|
||||
isDistributive : IsDistributive
|
||||
|
||||
|
|
|
@ -534,13 +534,61 @@ module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} where
|
|||
Req = Functor≡ rawEq
|
||||
|
||||
open NaturalTransformation ℂ ℂ
|
||||
postulate
|
||||
pureNTEq : (λ i → NaturalTransformation F.identity (Req i))
|
||||
|
||||
pureTEq : M.RawMonad.pureT (backRaw (forth m)) ≡ pureT
|
||||
pureTEq = funExt (λ X → refl)
|
||||
|
||||
-- TODO: Make equaility principle for natural transformations that allows
|
||||
-- us to only focus on the data-part but for heterogeneous paths!
|
||||
--
|
||||
-- It should be something like (but not exactly because this is ill-typed!)
|
||||
--
|
||||
-- P : I → Set -- A family that varies over natural transformations.
|
||||
-- θ : P i0
|
||||
-- η : P i1
|
||||
NaturalTransformation~≡ : ∀ {F G} {P : I → Set _} {θ η : NaturalTransformation F G} → proj₁ θ ≡ proj₁ η → _ [ θ ≡ η ]
|
||||
NaturalTransformation~≡ = {!!}
|
||||
|
||||
pureNTEq : (λ i → NaturalTransformation F.identity (Req i))
|
||||
[ M.RawMonad.pureNT (backRaw (forth m)) ≡ pureNT ]
|
||||
pureNTEq = res
|
||||
where
|
||||
Base = Transformation F.identity R
|
||||
base : Base
|
||||
base = M.RawMonad.pureT (backRaw (forth m))
|
||||
target : Base
|
||||
target = pureT
|
||||
-- No matter what the proof of naturality is (whether it'd be at `base`
|
||||
-- or at `target` propositionality of naturality means that we can prove
|
||||
-- two natural transformations equal just by focusing on the data-part.
|
||||
d : {nat : Natural F.identity R base}
|
||||
→ (λ i → NaturalTransformation F.identity R)
|
||||
[ (base , nat)
|
||||
≡ (target , nat)
|
||||
]
|
||||
d = NaturalTransformation≡ F.identity R pureTEq
|
||||
-- I think that `d` should be the "base-case" somehow in my
|
||||
-- path-induction but I don't know how to define a suitable type-family.
|
||||
D : (y : Base) → ({!!} ≡ y) → Set _
|
||||
D y eq = {!!}
|
||||
res
|
||||
: (λ i → NaturalTransformation F.identity (Req i))
|
||||
[ M.RawMonad.pureNT (backRaw (forth m)) ≡ pureNT ]
|
||||
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
||||
[ M.RawMonad.joinNT (backRaw (forth m)) ≡ joinNT ]
|
||||
res = pathJ D d base pureTEq {!!}
|
||||
|
||||
joinTEq : M.RawMonad.joinT (backRaw (forth m)) ≡ joinT
|
||||
joinTEq = funExt (λ X → begin
|
||||
M.RawMonad.joinT (backRaw (forth m)) X ≡⟨⟩
|
||||
KM.join ≡⟨⟩
|
||||
joinT X ∘ Rfmap 𝟙 ≡⟨ cong (λ φ → joinT X ∘ φ) R.isIdentity ⟩
|
||||
joinT X ∘ 𝟙 ≡⟨ proj₁ ℂ.isIdentity ⟩
|
||||
joinT X ∎)
|
||||
|
||||
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
||||
[ M.RawMonad.joinNT (backRaw (forth m)) ≡ joinNT ]
|
||||
joinNTEq = NaturalTransformation~≡ joinTEq
|
||||
|
||||
backRawEq : backRaw (forth m) ≡ M.Monad.raw m
|
||||
-- stuck
|
||||
M.RawMonad.R (backRawEq i) = Req i
|
||||
M.RawMonad.pureNT (backRawEq i) = pureNTEq i
|
||||
M.RawMonad.joinNT (backRawEq i) = joinNTEq i
|
||||
|
|
Loading…
Reference in a new issue