约束实例

Constraining instances

假设我们有以下内容:

{-# 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 (.)

但加法下的"Ints"也是一种类别,如果我们假设"a"和"b"都是Void,例如: 数据基本整数 类型实例 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