Haskell 咖喱产品类型

使用类型族，我们可以定义一个类型上的函数折叠，以及该类型的底层代数（表示为函数和常量值的n元组）。这允许定义在可折叠类型类中定义的通用foldr函数：

import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Set as S
import qualified Data.Map as M

class Foldable m where
  type Algebra m b :: *
  fold :: Algebra m b -> m -> b

instance (Ord a) => Foldable (Set a) where
  type Algebra (Set a) b = (b, a -> b -> b)
  fold = uncurry $ flip S.fold

instance (Ord k) => Foldable (Map k a) where
  type Algebra (Map k a) b = (b, k -> a -> b -> b)
  fold = uncurry $ flip M.foldWithKey

类似地，约束类型允许定义广义映射函数。map函数与fmap的不同之处在于，它考虑了代数数据类型的每个值字段：

class Mappable m where
  type Contains m     :: *
  type Mapped   m r b :: Constraint
  map :: (Mapped m r b) => (Contains m -> b) -> m -> r

instance (Ord a) => Mappable (Set a) where
  type Contains (Set a)     = a
  type Mapped   (Set a) r b = (Ord b, r ~ Set b)
  map = S.map

instance (Ord k) => Mappable (Map k a) where
  type Contains (Map k a)     = (k, a)
  type Mapped   (Map k a) r b = (Ord k, r ~ Map k b)
  map = M.mapWithKey . curry

从用户的角度来看，这两种功能都不是特别友好的。特别是，这两种技术都不允许定义curried函数。这意味着用户无法轻松地部分应用折叠或映射功能。我想要的是一个类型级别的函数，它转换函数和值的元组，以便生成上述的转换版本。因此，我想写一些近似于以下类型函数的东西：

Curry :: Product -> Type -> Type
Curry ()       m = m
Curry (a × as) m = a -> (Curry as m b)

如果是这样的话，我们可以从底层代数生成一个curried fold函数。例如：

  fold :: Curry (Algebra [a] b) ([a] -> b)
≡ fold :: Curry (b, a -> b -> b) ([a] -> b)
≡ fold :: b -> (Curry (a -> b -> b)) ([a] -> b)
≡ fold :: b -> (a -> b -> b -> (Curry () ([a] -> b))
≡ fold :: b -> ((a -> b -> b) -> ([a] -> b))

  map :: (Mapped (Map k a) r b) => (Curry (Contains (Map k a)) b) -> Map k a -> r
≡ map :: (Mapped (Map k a) r b) => (Curry (k, a) b) -> Map k a -> r
≡ map :: (Mapped (Map k a) r b) => (k -> (Curry (a) b) -> Map k a -> r
≡ map :: (Mapped (Map k a) r b) => (k -> (a -> Curry () b)) -> Map k a -> r
≡ map :: (Mapped (Map k a) r b) => (k -> (a -> b)) -> Map k a -> r

我知道Haskell没有类型函数，n元组的正确表示可能类似于类型级别长度索引的类型列表。这可能吗

编辑：为了完整起见，我目前尝试的解决方案附在下面。我使用空数据类型来表示类型的产品，使用类型族来表示上述函数Curry。此解决方案似乎适用于贴图功能，但不适用于折叠功能。我相信，但不确定的是，在进行类型检查时，咖喱没有适当减少

data Unit
data Times a b

type family Curry a m :: *
type instance Curry Unit        m = m
type instance Curry (Times a l) m = a -> Curry l m

class Foldable m where
  type Algebra m b :: *
  fold :: Curry (Algebra m b) (m -> b)

instance (Ord a) => Foldable (Set a) where
  type Algebra (Set a) b = Times (a -> b -> b) (Times b Unit)
  fold = S.fold

instance (Ord k) => Foldable (Map k a) where
  type Algebra (Map k a) b = Times (k -> a -> b -> b) (Times b Unit)
  fold = M.foldWithKey

 class Mappable m where
   type Contains m     :: *
   type Mapped   m r b :: Constraint
   map :: (Mapped m r b) => Curry (Contains m) b -> m -> r

 instance (Ord a) => Mappable (Set a) where
   type Contains (Set a)     = Times a Unit
   type Mapped   (Set a) r b = (Ord b, r ~ Set b)
   map = S.map

 instance (Ord k) => Mappable (Map k a) where
   type Contains (Map k a)     = Times k (Times a Unit)
   type Mapped   (Map k a) r b = (Ord k, r ~ Map k b)
   map = M.mapWithKey

---

好的，如果我理解正确的话，你可以创建不方便的折叠，但是你想要方便的咖喱折叠

下面是如何作为一个单独的步骤实现这一点的说明。是的，它也可以一次完成，我以前也做过类似的事情。然而，我认为单独的阶段可以让事情变得更清楚

我们需要以下语言扩展：

{-# LANGUAGE TypeFamilies, TypeOperators, FlexibleInstances #-}

我使用以下产品和单元类型：

data U = U
data a :*: b = a :*: b

infixr 8 :*:

例如，假设我们有一个不方便的折叠列表：

type ListAlgType a r = (U -> r)
                   :*: (a :*: r :*: U -> r)
                   :*: U

inconvenientFold :: ListAlgType a r -> [a] -> r
inconvenientFold   (nil :*: cons :*: U) []       = nil U
inconvenientFold a@(nil :*: cons :*: U) (x : xs) = cons (x :*: inconvenientFold a xs :*: U)

我们有一个嵌套的产品类型，我们希望两个级别都使用。我为此定义了两个类型类，每个层一个。（使用一个更通用的函数可能是可行的，在这种情况下我还没有尝试过。）

每个类型类实现curried和uncurried类型之间的同构。类型类看起来相同，但是

curryout

将为外部嵌套元组的每个组件调用

CurryInner

这些例子相对简单：

instance CurryInner U where
  type CurryI U k = k
  curryI f   = f U
  uncurryI x = \ U -> x

instance CurryInner ts => CurryInner (t :*: ts) where
  type CurryI (t :*: ts) k = t -> CurryI ts k
  curryI f   = \ t -> curryI (\ ts -> f (t :*: ts))
  uncurryI f = \ (t :*: ts) -> uncurryI (f t) ts

instance CurryOuter U where
  type CurryO U k = k
  curryO f   = f U
  uncurryO x = \ U -> x

instance (CurryInner a, CurryOuter ts) => CurryOuter ((a -> b) :*: ts) where
  type CurryO ((a -> b) :*: ts) k = CurryI a b -> CurryO ts k
  curryO f   = \ t -> curryO (\ ts -> f (uncurryI t :*: ts))
  uncurryO f = \ (t :*: ts) -> uncurryO (f (curryI t)) ts

就这样。注意

*Main> :kind! CurryO (ListAlgType A R) ([A] -> R)
CurryO (ListAlgType A R) ([A] -> R) :: *
= R -> (A -> R -> R) -> [A] -> R

（适用于适当定义的占位符类型

A

和

R

）。我们可以按如下方式使用它：

*Main> curryO inconvenientFold 0 (+) [1..10]
55

---

编辑：我现在明白了，你实际上只是在问外层的问题。然后，您只需要一个类，但可以使用相同的想法。我之所以使用这个例子，是因为我为基于产品的泛型编程库的总和写了一些东西，它以前需要两个级别的currying，并且一开始认为您处于相同的设置中。

好的，我认为我的另一个答案实际上并不是您问题的答案。对不起

在最后的代码中，比较

折叠

和

映射

的类型：

fold :: Curry (Algebra m b) (m -> b)
map  :: (Mapped m r b) => Curry (Contains m) b -> m -> r

这里有很大的不同。

fold

的类型只是一个类型族应用程序，而

map

的类型包含最后的

m->r

，其中提到了类参数

m

。因此，在

map

的情况下，GHC很容易从上下文中了解要在哪种类型上实例化类

不幸的是，

fold

的情况并非如此，因为类型族不需要是内射的，因此不容易反转。因此，通过查看您使用的特定类型，GHC不可能推断出

m

是什么

此问题的标准解决方案是使用代理参数，通过定义

data Proxy m = P

然后将

折叠为该类型：

fold :: Proxy m -> Curry (Algebra m b) (m -> b)

class C a where
  type F a :: *
  f :: F a

instance C Bool where
  type F Bool = Char -> Char
  f = id

instance C () where
  type F () = Char -> Char
  f = toUpper

您必须调整实例以接受和放弃代理参数。然后您可以使用：

fold (P :: Proxy (Set Int)) (+) 0 (S.fromList [1..10])

或类似于调用集合上的折叠函数

为了更清楚地了解为什么GHC难以解决这种情况，请考虑这个玩具实例：
fold :: Proxy m -> Curry (Algebra m b) (m -> b)

class C a where
  type F a :: *
  f :: F a

instance C Bool where
  type F Bool = Char -> Char
  f = id

instance C () where
  type F () = Char -> Char
  f = toUpper

现在，如果您调用
f'x'
，GHC将无法检测您所指的实例。代理在这里也会有所帮助。
类型级别列表正是您所需要的！您已经非常接近了，但是您需要
数据种类
和
范围类型变量
的全部功能才能正常工作：

{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, FlexibleInstances, TypeFamilies, TypeOperators, ScopedTypeVariables #-}
import GHC.Exts (Constraint)
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Set as S
import qualified Data.Map as M

-- | A "multifunction" from a list of inhabitable types to an inhabitable type (curried from the start).  
type family (->>) (l :: [*]) (y :: *) :: *
type instance '[] ->> y = y
type instance (x ': xs) ->> y = x -> (xs ->> y)

class Foldable (m :: *) where
  type Algebra m (b :: *) :: [*]
  fold :: forall (b :: *). Algebra m b ->> (m -> b)

instance (Ord a) => Foldable (Set a) where
  type Algebra (Set a) b = '[(a -> b -> b), b]
  fold = S.fold :: forall (b :: *). (a -> b -> b) -> b -> Set a -> b

instance (Ord k) => Foldable (Map k a) where
  type Algebra (Map k a) b = '[(k -> a -> b -> b), b]
  fold = M.foldWithKey :: forall (b :: *). (k -> a -> b -> b) -> b -> Map k a -> b

class Mappable m where
  type Contains m :: [*]
  type Mapped m (b :: *) (r :: *) :: Constraint
  map :: forall (b :: *) (r :: *). Mapped m b r => (Contains m ->> b) -> m -> r

instance (Ord a) => Mappable (Set a) where
  type Contains (Set a) = '[a]
  type Mapped (Set a) b r = (Ord b, r ~ Set b)
  map = S.map :: forall (b :: *). (Ord b) => (a -> b) -> Set a -> Set b

instance (Ord k) => Mappable (Map k a) where
  type Contains (Map k a) = '[k, a]
  type Mapped (Map k a) b r = r ~ Map k b
  map = M.mapWithKey :: forall (b :: *). (k -> a -> b) -> Map k a -> Map k b

感谢您解释为什么map函数有效，但是fold函数无效。我看到Haskell邮件列表上有一些关于实现内射类型族的活动，所以也许将来GHC可以构建正确的反转引理。代理解决方案对我来说是可行的，虽然它不是最优的，但我理解为什么它是必要的。实际上，如果要折叠的参数的顺序不被认为是神圣不可侵犯的，那么在这种情况下不需要使用代理，因为将数据结构作为单独的参数传递到折叠可以达到相同的效果。因此，使用
fold:：m->Curry（代数mb）b
类型检查并按预期操作。然而，这个问题的一般解决方案是非常有用的。@danportin你是对的。通常可以通过微妙的方式调整类型来避免代理。我本不想说没有代理就不能完成折叠函数，只是说这种特殊类型的函数不能工作。我很感谢你的努力，但在Haskell平台发布的GHC版本中，这个解决方案不起作用。看来，如果科斯米库斯对这个问题的解释是正确的，那么它也不应该起作用。对我来说，它生成的类型错误与