用 GHC 类型级别文字替换自建的 Naturals

Replacing self built Naturals with GHC type level literals

我写了一些代码,采用异构列表并对其进行索引。

{-# Language GADTs, FunctionalDependencies, MultiParamTypeClasses, KindSignatures, DataKinds, TypeOperators, FlexibleInstances, UndecidableInstances #-}

import Data.Kind

data Nat = Z | S Nat

data Natural a where
  Zero :: Natural 'Z
  Succ :: Natural a -> Natural ('S a)

data HList a where
  EmptyList :: HList '[]
  Cons :: a -> HList b -> HList (a ': b)

class IndexType (n :: Nat) (a :: [Type]) (b :: Type) | n a -> b where
  index :: (Natural n) -> (HList a) -> b

instance IndexType 'Z (a ': b) a where
  index _ (Cons a _) = a

instance IndexType a b c => IndexType ('S a) (d ': b) c where
  index (Succ a) (Cons _ b) = index a b

为此,我实现了自己的 NatNatural 类型。 Nat 的存在只是为了提升到 Kind 级别,而 Natural 的存在是为了实现 Nat -> Type.

的种类

现在我更愿意使用 GHC.TypeLits' Nat 类而不是我自己的类,但是当我尝试翻译我的代码时,我开始在理解方面遇到障碍。

我想构建我的 IndexType class 并且声明行没有任何变化

class IndexType (n :: Nat) (a :: [Type]) (b :: Type) | n a -> b where

既然GHC.TypeLits也有自己的Nat种。但是 GHC.TypeLits 没有替代我看到的 Natural,也就是说我缺少 Nat -> Type 之类的东西。现在我可以构建一个等效的

data Natural a = Natural

但这本质上等同于 Proxy 类型,所以我可以直接使用它。

{-# Language GADTs, FunctionalDependencies, MultiParamTypeClasses, KindSignatures, DataKinds, TypeOperators, FlexibleInstances, UndecidableInstances #-}

import Data.Kind
import GHC.TypeLits
import Data.Proxy

data HList a where
  EmptyList :: HList '[]
  Cons :: a -> HList b -> HList (a ': b)

class IndexType (n :: Nat) (a :: [Type]) (b :: Type) | n a -> b where
  index :: (Proxy n) -> (HList a) -> b

现在 IndexType class 的第一个实例很简单了:

instance IndexType 0 (a ': b) a where
  index _ (Cons a _) = a

然而第二个开始让我困惑。第一行好像是

instance IndexType a b c => IndexType (1 + a) (d ': b) c where

但是在第二行我不知道如何替换原始代码中的SuccProxy 的数据构造函数是 Proxy 所以我想它必须使用那个构造函数所以我必须写这样的东西:

  index Proxy (Cons _ b) = index a b

但现在我正在凭空提取 a 的定义。我想它必须是另一个 Proxy,因为索引采用 Proxy,但我不知道如何强制它成为正确的类型。

这个怎么样?

class IndexType (n :: Nat) (a :: [Type]) (c :: Type) | n a -> c where           
  index ::  (Proxy n) -> (HList a) -> c                                         
instance IndexType 0  (a ': b) a where                                          
  index _ (Cons a _) = a                                                        
instance {-# OVERLAPS #-} (IndexType (a-1) b c) => IndexType a (d ': b) c where 
  index _ (Cons _ b) = index (Proxy @(a-1)) b                                   

这将使用一些额外的扩展,包括 ScopedTypeVariablesTypeApplications。 PoC(在 GHC 8.2.2 上测试):

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Foo where
import Data.Kind
import GHC.TypeLits
import Data.Proxy

data HList a where
  EmptyList :: HList '[]
  Cons :: a -> HList b -> HList (a ': b)

class IndexType (n :: Nat) (a :: [Type]) (c :: Type) | n a -> c where
  index ::  (Proxy n) -> (HList a) -> c
instance IndexType 0  (a ': b) a where
  index _ (Cons a _) = a
instance {-# OVERLAPS #-} (IndexType (a-1) b c) => IndexType a (d ': b) c where
  index _ (Cons _ b) = index (Proxy @(a-1)) b

list :: HList '[Int, Bool]
list = Cons (5 :: Int) (Cons True EmptyList)
int :: Int
int = index (Proxy @0) list
bool :: Bool
bool = index (Proxy @1) list