假设我们有以下内容:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilyDependencies #-}
type family CategoryLikeT p_a_b = t | t -> p_a_b
type IsCategoryLike p t a b = (t ~ CategoryLikeT (p, a, b))
class CategoryLike p where
(>>>) ::
(
IsCategoryLike p t1 a b,
IsCategoryLike p t2 b c,
IsCategoryLike p t3 a c
) => t1 -> t2 -> t3
我们发现这个编译得很好:
f ::
(
CategoryLike p,
IsCategoryLike p t1 a b,
IsCategoryLike p t2 b c,
IsCategoryLike p t3 c d,
IsCategoryLike p t4 a d
) => t1 -> t2 -> t3 -> t4
f x y z = x >>> y >>> z
但是我们还没有定义任何实例。
data BasicFunction
type instance CategoryLikeT (BasicFunction, a, b) = a -> b
instance CategoryLike BasicFunction where
(>>>) = flip (.)
但是加法下的"整数"也有点像类别,如果我们假设"a"one_answers"b"都是Void
,例如:数据BasicInttype instance CategoryLikeT (BasicInt, Void, Void) = Int
instance CategoryLike BasicFunction where
(>>>) = (+)
当然,上述情况不起作用,因为在实例定义中没有对"a"或"b"的约束,因此不能保证>>>
获得所有相同的类型,因此(+)
不够通用。所以我考虑的是做以下事情:
type family CategoryConstraints p t a b
然后将IsCategoryLike
的定义添加如下:
type IsCategoryLike p t a b =
(t ~ CategoryLikeT (p, a, b), CategoryConstraints p t)
然后可以添加以下约束:
type instance CategoryConstraints BasicInt t = (t ~ Int)
但是现在我们有一个问题。f
不再工作,给出这个错误:
Could not deduce: CategoryConstraints p (CategoryLikeT (p, a, c)))
我们可以用两种方法来解决这个问题:
首先,将IsCategoryLike p t5 a c
添加到f
的约束中。但是对于更复杂的函数,这可能很快就会变得非常混乱,你必须为每个操作添加一个约束。还有一些琐碎的更改,比如将(x >>> y) >>> z
更改为x >>> (y >>> z)
,需要更改签名,当没有约束时,这是不需要的。
或者,可以完全省略类型签名,或者可以使用部分类型签名。
然而,我想保留完整的类型签名,而不让它增长和难以维护。人们能提出替代方法吗?
嗯…我不确定这是不是最好的方法,但这是对现有方法的直接改进。特别是,我认为使用关联类型使事情更清晰…
{-# LANGUAGE TypeFamilies,
ConstraintKinds,
FlexibleInstances,
TypeFamilyDependencies #-}
import GHC.Exts (Constraint)
class CategoryLike p where
type CategoryLikeT p a b = t | t -> p a b
type CategoryConstraints p a b :: Constraint
type CategoryConstraints p a b = ()
(>>>) :: (CategoryConstraints p a b, CategoryConstraints p b c, CategoryConstraints p a c)
=> CategoryLikeT p a b -> CategoryLikeT p b c -> CategoryLikeT p a c
data BasicFunction
instance CategoryLike BasicFunction where
type CategoryLikeT BasicFunction a b = a -> b
(>>>) = flip (.)
data BasicInt
instance CategoryLike BasicInt where
type CategoryLikeT BasicInt Int Int = Int
type CategoryConstraints BasicInt a b = (a ~ Int, b ~ Int)
(>>>) = (+)
所以,这就是f
现在的样子:(我用显式的forall来写它,因为这使它成为使用TypeApplications
的候选者)
f :: forall p a b c d. (
CategoryLike p,
CategoryConstraints p a b,
CategoryConstraints p b c,
CategoryConstraints p a c,
CategoryConstraints p a d,
CategoryConstraints p d b
) => CategoryLikeT p a d ->
CategoryLikeT p d b ->
CategoryLikeT p b c ->
CategoryLikeT p a c
f x y z = x >>> y >>> z
要使用它,我可以这样做(看起来非常好):
ghci> :set -XTypeApplications
ghci> :t f @BasicFunction (+1) id show
f @BasicFunction (+1) id show :: (Show a, Num a) => a -> [Char]
ghci> :t f @BasicInt 1 2 3
f @BasicInt 1 2 3 :: Int