存在GADT

时间:2019-03-05 07:56:29

标签: haskell gadt existential-type

是否有一种方便的方法来获取Ord(或Eq)的实例以比较GADT的任意两个值,而与类型参数无关。

在GADT中,type参数为phantom,仅用于将每个构造函数与类型相关联,例如GADT表示键/查询,类型参数是关联的值/结果的类型。

说明:

{-# LANGUAGE GADTs, Rank2Types #-}

data Car = Car   -- whatever
data Food = Food

data CarRental  = CarRental  {passengers :: Int, mileage :: Int}
  deriving (Eq, Ord)
data ErrandList = ErrandList {avoidJunkFood :: Bool}
  deriving (Eq, Ord)

data GetStuff a where
  RentACar :: CarRental  -> GetStuff Car
  BuyFood  :: ErrandList -> GetStuff Food

data Some t = forall a. Some (t a)

GetStuff是GADT,因此每个项目都与结果类型CarFood相关联。我可以在FreeFreeApplicative中使用它。我可能想检索出现在结构中的所有GetStuff。由于缺少Ord实例,我可以轻松构建[Some GetStuff],但不能轻松构建Set (Some GetStuff)

我看到了

data GetSomeStuff = RentSomeCar CarRental | BuySomeFood ErrandList
  deriving (Eq, Ord)

Some GetStuff是同构的(a在GetStuff中是幻像的),因此我可以通过编写以下同构来获得Eq,Ord以及其他名称:

existentialToUntyped :: Some GetStuff -> GetSomeStuff
untypedToExistential :: GetSomeStuff -> Some GetStuff

untypedToExistential (RentSomeCar x) = Some $ RentACar x
untypedToExistential (BuySomeFood x) = Some $ BuyFood x
existentialToUntyped (Some (RentACar x)) = RentSomeCar x
existentialToUntyped (Some (BuyFood x)) = BuySomeFood x

但是对于比GetStuff更大的协议来说很乏味。有没有GADT,有没有更好的方法?

此外,我打算在这一点上以“协议”类型(此处为GetStuff)编写参数化代码,在这里我想要一个签名,例如

queries :: SomeConstraint protocol => 
  FreeApplicative protocol 
  -> Set (Some protocol)

我可能需要做

myFunction :: Ord untyped => 
  Iso (Some protocol, untyped) 
  -> FreeApplicative protocol
  -> Set untyped

再次,有没有更好的方法?

1 个答案:

答案 0 :(得分:1)

从您的示例开始

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds, KindSignatures #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}

import Data.Type.Equality

data Car
data Food

data CarRental  = CarRental  {passengers :: Int, mileage :: Int}
  deriving (Eq, Ord)
data ErrandList = ErrandList {avoidJunkFood :: Bool}
  deriving (Eq, Ord)

data GetStuff a where
  RentACar :: CarRental  -> GetStuff Car
  BuyFood  :: ErrandList -> GetStuff Food

data Some t = forall a. Some (t a)

您需要编写一个实例 http://hackage.haskell.org/package/dependent-sum-0.4/docs/Data-GADT-Compare.html#t:GEq

class GEq f where
  geq :: f a -> f b -> Maybe (a :~: b)

然后,您将可以定义Eq (Some f)的实例

instance GEq f => Eq (Some f) where
    Some fa == Some fb = case geq fa fb of
        Just Refl -> True
        Nothing   -> False

手动编写实例是重复的,但并不可怕。 请注意,我的写法没有“抓住全部”的最后一种情况。

instance GEq GetStuff where
  geq (RentACar x) z = case z of
    RentACar x' -> if x == x' then Just Refl else Nothing
    _           -> Nothing

  geq (BuyFood x) z = case z of
    BuyFood x' -> if x == x' then Just Refl else Nothing
    _          -> Nothing

对于GCompare的GADT,有一个Ord类。

因此问题减少到“如何自动推导GEqGCompare”。 我认为对于特殊的GADT,例如您的GetStuff,您可以 编写快速n脏TH来生成代码。

我能想到的

Generic之类的替代方法需要您 在GetStuff之间编写转换函数, 如果您需要编写更多通用函数,则可能是一个胜利。 让我们也探索一下。首先我们定义一个通用表示 我们感兴趣的GADT:

data Sum (cs :: [(*, *)]) a where
  Z :: a :~: c -> b -> Sum ( '(c, b) ': cs) a
  S :: Sum cs a -> Sum (c ': cs) a

我们可以在GetStuffSum之间进行转换。 我们需要为每个GADT编写代码,这是 O(n),其中n是构造函数计数。

type GetStuffCode =
  '[ '(Car, CarRental)
  ,  '(Food, ErrandList)
  ]

toSum :: GetStuff a -> Sum GetStuffCode a
toSum (RentACar x) = Z Refl x
toSum (BuyFood x)  = S (Z Refl x)

fromSum :: Sum GetStuffCode a -> GetStuff a
fromSum (Z Refl x)     = RentACar x
fromSum (S (Z Refl x)) = BuyFood x
fromSum (S (S x))      = case x of {} -- silly GHC requires this :)

现在,由于我们有通用表示形式Sum,因此我们可以编写通用表示形式 功能。平等,GGEq代表通用Gadt平等 该类看起来像GEq,但是我们使用Sum作为参数。

class GGEq code where
  ggeq :: Sum code a -> Sum code b -> Maybe (a :~: b)

我们需要两个实例,分别是nil和cons codes

instance GGEq '[] where
  ggeq x _ = case x of {}

instance (Eq b, '(x, b) ~ c, GGEq cs) => GGEq (c ': cs) where
  ggeq (Z Refl x) (Z Refl y) = if x == y then Just Refl else Nothing
  ggeq (S x)      (S y)      = ggeq x y

  ggeq (Z _ _) (S _)   = Nothing
  ggeq (S _)  (Z _ _) = Nothing

使用这种机制为geq编写GetStuff很简单:

geq1 :: GetStuff a -> GetStuff b -> Maybe (a :~: b)
geq1 x y = ggeq (toSum x) (toSum y)