咖喱产品类型

Question

使用类型族，我们可以在一个类型上定义函数fold，该类型的底层代数表示为函数和常量值的n元组。这允许定义在 Foldable 类型类中定义的通用 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 函数。 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 函数。这意味着用户不能轻松地部分应用 fold 或 mapped 函数。 I 想要的是一个类型级别的函数，它可以对函数和值的元组进行柯里化，以生成上述的柯里化版本。因此，我想写一些近似于以下类型函数的东西：

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

如果是这样，我们可以从底层代数生成一个柯里化折叠函数。例如：

  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。此解决方案似乎适用于 map 函数，但不适用于 fold 函数。我相信，但不确定，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

Answer 1

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

以下是如何作为一个单独的步骤实现此目的的说明。是的，它也可以一次完成，我以前做过类似的事情。但是，我认为单独的阶段可以更清楚地了解正在发生的事情。

我们需要以下语言扩展：

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

我们有一个嵌套的产品类型，我们想要对两个级别都进行咖喱。我为此定义了两个类型类，一个用于每一层。 （用一个更通用的功能可能是可行的，在这种情况下我没有尝试过。）

class CurryInner a where
  type CurryI a k :: *
  curryI   :: (a -> b) -> CurryI a b
  uncurryI :: CurryI a b -> a -> b

class CurryOuter a where
  type CurryO a k :: *
  curryO   :: (a -> b) -> CurryO a b
  uncurryO :: CurryO a b -> (a -> b) -- not really required here

每个类型类都实现了 curried 和 uncurried 类型之间的同构。类型类看起来相同，但CurryOuter 将为外部嵌套元组的每个组件调用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

编辑：我现在看到您实际上只是在询问外层的柯里化。然后你只需要一个类，但可以使用相同的想法。我使用这个示例是因为我之前为基于积和的通用编程库编写了一些东西，该库之前需要两个级别的柯里化，并且起初认为您处于相同的设置中。

Answer 2

好的，我认为我的其他答案实际上并不能真正回答您的问题。很抱歉。

在您的最终代码中，比较fold 和map 的类型：

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 的情况并非如此，因为类型族不必是单射的，因此不容易反转。因此，通过查看您使用 fold 的特定类型，GHC 无法推断出 m 是什么。

这个问题的标准解决方案是使用代理参数来修复m的类型，通过定义

data Proxy m = P

然后给fold这个类型：

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

您必须调整实例以获取和丢弃代理参数。然后你可以使用：

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

或类似地在集合上调用 fold 函数。

要更清楚地了解 GHC 难以解决这种情况的原因，请考虑这个玩具示例：

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 没有任何有意义的方法来检测您所指的实例。代理在这里也会有所帮助。

Answer 3

类型级列表正是您所需要的！您已经非常接近了，但您需要 DataKinds 和 ScopedTypeVariables 的全部功能才能正常工作：

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