封闭类型族的归纳定义

Question

这或多或少是我想要实现的功能：

{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE InstanceSigs           #-}
{-# LANGUAGE KindSignatures         #-}
{-# LANGUAGE PolyKinds              #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeInType             #-}

type family ReturnType arr where
  ReturnType (a -> b) = ReturnType b
  ReturnType a = a

type family ReplaceReturnType t r where
  ReplaceReturnType (a -> b) r = a -> ReplaceReturnType b r
  ReplaceReturnType _ r = r

class CollectArgs f where
  collectArgs :: ((forall r. ReplaceReturnType f r -> r) -> ReturnType f) -> f

instance CollectArgs f => CollectArgs (a -> f) where
  collectArgs :: ((forall r. (a -> ReplaceReturnType f r) -> r) -> ReturnType f) -> a -> f
  collectArgs f a = collectArgs (\ap -> f (\k -> ap (k a)))

instance (ReturnType a ~ a, ReplaceReturnType a dummy ~ dummy) => CollectArgs a where
  collectArgs :: ((forall r. ReplaceReturnType a r -> r) -> a) -> a
  collectArgs f = f id

我最终想做的是编写在传入参数数量上具有多态性的函数，同时它们不必是类型 class 定义的一部分（对应于printf var args 样式）。所以，例如：

wrapsVariadicFunction :: (CollectArgs f) => f -> Int -> f
wrapsVariadicFunction f config = collectArgs $ \apply -> 
  if odd config 
    then error "odd config... are you nuts?!"
    else apply f

只是 f 的 return 类型可能不会与 wrapsVariadicFunction 的类型共生。

现在，在一个完美的世界中，我可以将类型 class 与封闭类型系列（封闭类型 class，可以这么说）相关联，这很容易实现，因为连接 ReplaceReturnType a r ~ r 就很清楚了。

由于我无法说明这种联系，因此可以理解，GHC 8.2.1 不清楚：

    * Could not deduce: ReplaceReturnType a r ~ r
      from the context: (ReturnType a ~ a,
                         ReplaceReturnType a dummy ~ dummy)
        bound by the instance declaration
      `r' is a rigid type variable bound by
        a type expected by the context:
          forall r. ReplaceReturnType a r -> r
      Expected type: ReplaceReturnType a r -> r
        Actual type: r -> r
    * In the first argument of `f', namely `id'
      In the expression: f id
      In an equation for `collectArgs': collectArgs f = f id
    * Relevant bindings include
        f :: (forall r. ReplaceReturnType a r -> r) -> a
        collectArgs :: ((forall r. ReplaceReturnType a r -> r) -> a) -> a
   |
29 |   collectArgs f = f id
   |

这里的解决方案是在实例上下文中对 dummy 进行普遍量化，但这是不可能的（但是，根据我在 ICFP 上看到的情况判断）。而且真的很麻烦

因此，这里的实际问题是：如何将值级别定义与封闭类型系列相关联，就像封闭类型 class 一样？或者这是不可能的，因为类型不能再被删除了？如果是这样，还有其他解决方法吗？

Answer 1

使这些类型类看起来像是重叠的标准技巧是向类型类添加第二个参数，该参数在每个实例中都是不同的，并且可以从其他参数中计算出其值。

提炼到其核心的想法如下（我们需要一些可怕的扩展，例如 UndecidableInstances，但这没关系：我们正在编写完整的程序）：

{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE KindSignatures         #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE UndecidableInstances   #-}

type family IsBase arr :: Bool where
  IsBase (a -> b) = 'False
  IsBase a        = 'True

class SillyId a b where
  sillyId :: IsBase a ~ b => a -> a

instance SillyId b (IsBase b) => SillyId (a -> b) 'False where
  sillyId f = \x -> sillyId (f x)

instance SillyId b 'True where
  sillyId t = t

现在，在你的情况下它有点复杂，因为你不仅希望这个额外的参数进行分派，你还希望其他类型级别的函数基于它来减少。诀窍就是……根据调度定义这些函数！

当然，类型级别 Bool 将不再适用：您需要保留所有信息。因此，您将得到 IsArrow:

而不是 IsBase

{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE InstanceSigs           #-}
{-# LANGUAGE KindSignatures         #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE UndecidableInstances   #-}

type family IsArrow arr :: Either (*, *) * where
  IsArrow (a -> b) = 'Left '(a, b)
  IsArrow a        = 'Right a

type family ReturnType arr where
  ReturnType ('Left '(a, b)) = ReturnType (IsArrow b)
  ReturnType ('Right a)      = a

type family ReplaceReturnType t r where
  ReplaceReturnType ('Left '(a, b)) r = a -> ReplaceReturnType (IsArrow b) r
  ReplaceReturnType _               r = r

class CollectArgs f (f' :: Either (*, *) *) where
  collectArgs :: IsArrow f ~ f' => ((forall r. ReplaceReturnType f' r -> r) -> ReturnType f') -> f

instance CollectArgs f (IsArrow f) => CollectArgs (a -> f) ('Left '(a, f)) where
  collectArgs :: ((forall r. (a -> ReplaceReturnType (IsArrow f) r) -> r) -> ReturnType (IsArrow f)) -> a -> f
  collectArgs g a = collectArgs (\ap -> g (\k -> ap (k a)))

instance CollectArgs a ('Right a) where
  collectArgs :: IsArrow a ~ 'Right a => ((forall r. ReplaceReturnType (IsArrow a) r -> r) -> a) -> a
  collectArgs f = f id

瞧瞧。您当然可以为 ReplaceReturnType (IsArrow a) r 定义类型同义词以使符号更轻松，但这就是它的要点。

封闭类型族的归纳定义

Inductive definition over closed type family

haskell

typeclass

ghc

type-families