使用类型族,我们可以在一个类型上定义函数 fold ,并且该类型的基础代数表示为 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 函数。通过考虑代数数据类型的每个值字段, 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 或映射的功能。 I 想要的是一个类型级函数,用于处理函数和值的元组,以生成上述的curried版本。因此,我想写一些近似于以下类型函数的东西:
Curry :: Product -> Type -> Type
Curry () m = m
Curry (a × as) m = a -> (Curry as m b)
如果是这样,我们可以从底层代数生成一个curried折叠函数。例如:
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 -tuple的正确表示可能类似于类型级长度索引的类型列表。这可能吗?
编辑:为了完整起见,我目前尝试解决方案的方法如下。我使用空数据类型来表示类型的产品,并键入族来表示上面的函数 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
答案 0 :(得分:4)
好的,如果我理解正确,你可以创造不方便的折叠,但想要有方便的咖喱折叠。
以下是如何将此作为单独步骤的说明。是的,它也可以一次完成,我之前做过类似的事情。但是,我认为单独的阶段可以更清楚地发生了什么。
我们需要以下语言扩展程序:
{-# 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
编辑:我现在看到你实际上只是询问有关外层的问题。然后你只需要一个类,但可以使用相同的想法。我使用这个例子是因为我曾经为基于产品的通用编程库编写了一些东西,之前需要两个级别的currying,并且首先想到你处于相同的设置。
答案 1 :(得分:3)
好的,我认为我的另一个答案实际上并不是你问题的答案。对不起。
在最终代码中,比较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没有任何有意义的方法来检测你的意思。代理也可以在这里提供帮助。
答案 2 :(得分:1)
类型级别列表正是您所需要的!你非常接近,但是你需要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