haskell - 咖喱产品类型

Question

使用类型族，我们可以定义函数折叠类型和该类型的底层代数，表示为函数和常量值的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函数与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

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

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包含 final 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