将元素的实例提升到具有功能依赖性的类型级列表实例

问题描述 投票：0回答：1

假设我有一个 

Coproduct
数据类型，其构造函数具有类型 
Coproduct :: [*] -> *
。我也有课

class MyFun s x | x -> s where
  myFun :: s -> x

每当我有一个包含某种类型 

xs
的类型列表 
x
时，我想获取 
instance MyFun s x => MyFun s (Coproduct xs)

形式的实例

我的尝试

我写了以下类型系列：

type family SplitAt (x :: a) (xs :: [a]) :: ([a], [a]) where
  SplitAt x '[] = '( '[] , '[] )
  SplitAt x (x ': q) = '( '[], q)
  SplitAt x (y ': q) = '( y ': Fst (SplitAt x q), Snd (SplitAt y q))

type family ConcatWith (x :: a) (s :: ([a], [a])) :: [a] where
  ConcatWith x '( '[], xs) = x ': xs
  ConcatWith x '(y ': q, xs) = y ': ConcatWith x '(q, xs)

type family Fst (p :: (a, b)) :: a where
  Fst '(a, b) = a

type family Snd (p :: (a, b)) :: b where
  Snd '(a, b) = b

尝试1： 现在我想写以下实例：

instance (MyFun s x, b ~ ConcatWith x (SplitAt x xs)) => MyFun s (Coproduct b) where
  myFun = -- irrelevant code after this

但是，我收到此错误：

Illegal instance declaration for ‘MyFun s 
(Coproduct b)’
        The liberal coverage condition fails in class 
‘MyFun’
          for functional dependency: ‘m -> s’
        Reason: lhs type ‘Coproduct b’ does not 
determine rhs type ‘s’
        Un-determined variable: s
    • In the instance declaration for ‘MyFun s 
(Coproduct b)’

我明白为什么会出现此错误：GHC 无法看到列表 

b
必须在某处包含 
x
，因此无法检索从 
x
实例继承的功能依赖项。

尝试2： 我还尝试使用 

TypeFamilies
扩展来实现同样的事情，通过编写 

class MyFun x where
  type ArgMyFun x
  myFun :: ArgMyFun x -> x

instance (MyFun x, b ~  ConcatWith x (SplitAt x xs)) => MyFun (Coproduct b) where
  type ArgMyFun (Coproduct (ConcatWith b)) = ArgMyFun x
  myFun = -- ...

但是，这（可以理解）再次失败了

error:
    The RHS of an associated type declaration 
mentions out-of-scope variable ‘x’
      All such variables must be bound on the LHS

再次，错误消息再清楚不过了，我明白为什么这不起作用。

黑客1：

我设法找到的唯一（糟糕的）解决方法是以下函数依赖实例：

instance (MyFun s x)
  => MyFun s (Either x (Coproduct xs)) where
  myFun x = --...

人为地将 

x
显式放入类型中，然后仅使用 
Right
的 
Either
部分。然而，这显然很丑陋，也不是我的目标。

haskell functional-dependencies type-families data-kinds typelist
1个回答
0
投票

函数依赖关系不能很好地工作，你应该避免它们。例如，以下程序使用重叠实例为 

ElemDep
实现了一个可能的 
Coproduct
实例，而 
main
示例说明了 GHC 会很乐意让您违反函数依赖关系。 （我认为这是issue 10675的一个例子。）

{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}

type Coproduct :: [*] -> *
data Coproduct tys where
  Inject :: x -> Coproduct (x:xs)
  Reject :: Coproduct xs -> Coproduct (x:xs)
deriving instance (Show x, Show (Coproduct xs)) => Show (Coproduct (x:xs))
deriving instance (Show (Coproduct '[]))

class ElemDep x xs | xs -> x where
  inject :: x -> xs
instance {-# OVERLAPPING #-} ElemDep x (Coproduct (x ': xs)) where
  inject = Inject
instance {-# OVERLAPPABLE #-} ElemDep x (Coproduct xs) => ElemDep x (Coproduct (y ': xs)) where
  inject = Reject . inject

main = do
  print (inject 15    :: Coproduct '[Int, Bool])
  print (inject False :: Coproduct '[Int, Bool])

即使在评论中进行了所有讨论之后，我仍然认为我不明白你想要做什么，但是如果你遇到某种情况，每种可能的 

Coproduct xs
在 
x
中都有一个特定的 
xs
您想为您的 
ElemDep
类选择，我认为最好的选择是使用类型系列：

class ElemDep xs where
  type family Injector xs
  inject :: Injector xs -> xs

并且重要的是，编写一个完整的类型程序，通过遵循独立类型系列以编程方式计算给定 

x
的适当 
Coproduct xs
：

-- instance for coproducts
instance ElemDep (Coproduct xs) where
  type Injector (Coproduct xs) = CoproductInjector xs

-- delegated injector type for coproducts
type CoproductInjector :: [*] -> *
type family CoproductInjector xs where
  CoproductInjector ((x, y) ': xs) = (x, y)
  CoproductInjector (Bool ': x ': xs) = x
  CoproductInjector (x ': xs) = CoproductInjector xs

此示例查找列表中的第一对，或 

Bool
类型后面的第一个类型。这当然是无稽之谈，但它说明您可以编写任何类型的合理类型程序来完成这项工作。即使是详尽的案例列表也可能是一种选择：

type CoproductInjector :: [*] -> *
type family CoproductInjector xs where
  CoproductInjector '[Int, Bool] = Int
  CoproductInjector '[Bool] = Bool
  CoproductInjector '[Bool, Int] = Int

（你肯定不能做的一件事是编写一个类型程序来查找第一个具有

x
实例的类型
MyFun
。类型不能根据实例的存在或不存在来计算。你'我必须想出一些其他类型级别的方法来确定
x
。）

无论如何，一旦你解决了这个问题，就可以编写一个合理的实例。您需要一个辅助类，基本上是我的第一个示例的变体，没有fundep，并且针对联产品量身定制：

class CoproductElemDep x xs where
  coproductInject :: x -> Coproduct xs
instance {-# OVERLAPPING #-} CoproductElemDep x (x ': xs) where
  coproductInject = Inject
instance {-# OVERLAPPABLE #-} CoproductElemDep x xs => CoproductElemDep x (y ': xs) where
  coproductInject = Reject . coproductInject

然后可以写出 

Coproduct
的 
ElemDep
实例：

instance (CoproductElemDep (CoproductInjector xs) xs) => ElemDep (Coproduct xs) where
  type Injector (Coproduct xs) = CoproductInjector xs
  inject = coproductInject

完整代码，带有一些示例：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}

type Coproduct :: [*] -> *
data Coproduct tys where
  Inject :: x -> Coproduct (x:xs)
  Reject :: Coproduct xs -> Coproduct (x:xs)
deriving instance (Show x, Show (Coproduct xs)) => Show (Coproduct (x:xs))
deriving instance (Show (Coproduct '[]))

class ElemDep xs where
  type family Injector xs
  inject :: Injector xs -> xs

class CoproductElemDep x xs where
  coproductInject :: x -> Coproduct xs
instance {-# OVERLAPPING #-} CoproductElemDep x (x ': xs) where
  coproductInject = Inject
instance {-# OVERLAPPABLE #-} CoproductElemDep x xs => CoproductElemDep x (y ': xs) where
  coproductInject = Reject . coproductInject

instance (CoproductElemDep (CoproductInjector xs) xs) => ElemDep (Coproduct xs) where
  type Injector (Coproduct xs) = CoproductInjector xs
  inject = coproductInject

-- type program to find x to inject into coproducts
type CoproductInjector :: [*] -> *
type family CoproductInjector xs where
  CoproductInjector ((x, y) ': xs) = (x, y)
  CoproductInjector (Bool ': x ': xs) = x
  CoproductInjector (x ': xs) = CoproductInjector xs

-- other instances for injection
instance ElemDep Double where
  type Injector Double = Int
  inject = fromIntegral

main = do
  -- injects Int into Double
  print (inject 8     :: Double)
  -- injects (Int,Int) into Coproduct (first pair)
  print (inject (1,2) :: Coproduct '[Double, (Char,String,Bool), (Int,Int), Bool, Double])
  -- injects String into Coproduct (first type after Bool)
  print (inject "hello" :: Coproduct '[Int, Bool, String, Bool, Double])
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.