约束实例



假设我们有以下内容:

{-# 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

最新更新