Question

这是我正在尝试的但它没有编译：

Microsoft Visual Studio

编译错误：

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}

import Data.Text as T
import Data.Int (Int64)

type family Incoming validationResult baseType
type instance Incoming Validated baseType = baseType
type instance Incoming ValidationErrors baseType = Either [T.Text] baseType

data Validated
data ValidationErrors

data Tag = Tag {unTag :: T.Text} deriving (Eq, Show)

data NewTag f = NewTag
  {
    ntClientId :: Incoming f Int64
  , ntTag :: Incoming f Tag
  }

deriving instance (Show baseType) => Show (Incoming Validated baseType)
deriving instance (Show baseType) => Show (Incoming ValidationErrors baseType)

Answer 1

这里有两个问题。第一个是GHC告诉你的。基本上，你不能拥有一个依赖于类型族的实例（类型族可以存在，但只有当它获得的所有参数都是具体类型时）。一旦你允许这种情况，各种不好的事情就会开始发生，其中最重要的是，你的类型家族的右手边可以打电话给其他类型的家庭。

通常，可以通过将类型族应用程序移动到约束来解决此类问题：

deriving instance (Show baseType, i ~ Incoming Validated baseType) => Show i
deriving instance (Show baseType, i ~ Incoming ValidationErrors baseType) => Show i

这样做实际上会使第二个问题显而易见：你的实例头太过笼统。

那就是说，我不确定是否还有什么可以解决的 - 只是摆脱衍生线。您希望第一个归结为：在给定Show basetype约束（完全没有意义）的情况下派生Show basetype的实例。第二个同样毫无意义 - Either已经有Show的实例。

Answer 2

这不能成功。这是问题所在：

Incoming Validated        (Either [T.Text] Int) ~ Either [T.Text] Int
Incoming ValidationErrors Int                   ~ Either [T.Text] Int

现在，如果你想要一个Show (Either [T.Text] Int)，你有三个选择：

instance (Show a, Show b) => Show (Either a b) -- from Prelude
instance Show baseType    => Show (Incoming Validated baseType)
instance Show baseType    => Show (Incoming ValidationErrors baseType)

其中任何一个都是有效的实例，GHC需要实例的全局唯一性。实际上，问题在于类型族不是单射的，因此只是因为您知道需要instance TyCls A，GHC无法生成会产生TyFam B1 B2 B3的应用程序A - 这样的应用程序甚至可能不是唯一的！

有几种方法可以解决这个问题。

您真的需要Show个实例吗？也许您需要的就是想要使用它的函数的Show 约束。例如：
```
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
-- But not FlexibleInstances

deriving instance (Show (Incoming f Int64), Show (Incoming f Tag))
  => Show (NewTag f)
```
GHC将在任何地方传播这些限制，但最终用户始终可以满足这些限制。如果f永远是具体类型，它们将完全消失！

您真的希望Incoming事物与基类型无法区分吗？如果没有，你可以在这里使用GADT：

{-# LANGUAGE GADTs, FlexibleInstances #-}

-- ...

data Incoming :: * -> * -> * where
  IncomingValidated        :: baseType
                           -> Incoming Validated baseType
  IncomingValidationErrors :: Either [T.Text] baseType
                           -> Incoming ValidationErrors baseType

-- ...

deriving instance Show (NewTag Validated)
deriving instance Show (NewTag ValidationErrors)

这里的缺点是双重的：首先，你必须在你使用这些的地方进行模式匹配;第二，你不能（至少在GHC 7.10上）对GADT StandaloneDeriving实例使用Show，你需要手工编写它们：

    -- deriving instance Show baseType => Show (Incoming Validated baseType)
    instance Show baseType => Show (Incoming Validated baseType) where
      show (IncomingValidated bt) = "IncomingValidated " ++ show bt

    -- deriving instance Show baseType => Show (Incoming ValidationErrors baseType)
    instance Show baseType => Show (Incoming ValidationErrors baseType) where
      show (IncomingValidationErrors e) = "IncomingValidationErrors " ++ show e

这些都是一个很好的解决方案;选项（1）是你已经做的最小的改变，所以我可能会先走到第一步。

另一个注意事项：在现代（7.10 +）GHC中，我们可以清理代码中的某些内容。现在，您有两个地方，您的代码允许太多的灵活性。

您可以考虑NewTag Bool或NewTag ()类型的值，或......。
Incoming类型系列打开 - 任何人都可以添加type instance Incoming Bool baseType = Maybe baseType或Incoming () () = Int或......

您只想在那里考虑Validated或ValidationErrors，并且您已经编写了所有可能的类型系列实例！ GHC提供了两个用于改进此功能的功能：DataKinds和封闭式系列。对于封闭式家庭，您可以写

type family Incoming validationResult baseType where
  Incoming Validated        baseType = baseType
  Incoming ValidationErrors baseType = Either [T.Text] baseType

现在，已关闭 - 其他人无法添加新案例。这解决了＃2。

对于＃1，如果我们打开DataKinds，GHC会自动将我们的值构造函数提升到类型级别！就像我们拥有Int :: *一样，我们有'False :: Bool - '向GHC表明我们处于类型级别。添加此功能如下所示：

{-# LANGUAGE DataKinds #-}

-- ...

data ValidationResult = Validated | ValidationErrors
                      deriving (Eq, Ord, Enum, Bounded, Show, Read)

---- EITHER:
---- Option (1), with a type family
-- The only change here is to add tick marks!
type family Incoming validationResult baseType where
  Incoming 'Validated        baseType = baseType
  Incoming 'ValidationErrors baseType = Either [T.Text] baseType

---- OR:
---- Option (2), with a GADT
-- Here, we change the kind signature and add tick marks
data Incoming :: ValidationResult -> * -> * where
    IncomingValidated        :: baseType
                             -> Incoming 'Validated baseType
    IncomingValidationErrors :: Either [T.Text] baseType
                             -> Incoming 'ValidationErrors baseType

我们还可以根据需要添加种类签名 - type family Incoming (validationResult :: ValidationResult) (baseType :: *) :: * where …或data NewTag (f :: ValidationResult) = …，但这些会被推断出来，因此是可选的。

如果刻度真的让你烦恼，你可以使用以下技巧，我从GHC源代码中选择：

type Validated        = 'Validated
type ValidationErrors = 'ValidationErrors

好的，还有一个类型级别有趣的东西，因为我无法抗拒:-)让我们再次考虑选项（1），类型系列。我们必须在任何地方提供这个恼人的(Show (Incoming f Int64), Show (Incoming f Tag))约束，这有点笨重，特别是如果我们想要抽象它 - 生成一个Eq实例，它是相同的，但用Eq代替Show。如果还有更多字段会怎么样？

如果我们启用ConstraintKinds，我们可以抽象超过约束。这是这样的：

{-# LANGUAGE ConstraintKinds #-}

import GHC.Exts (Constraint)

type NewTagFieldsAre (c :: * -> Constraint) f =
  (c (Incoming f Int64), c (Incoming f Tag))

（我们需要那种签名，所以GHC认为这不会产生普通的元组。）然后我们可以指定

deriving instance NewTagFieldsAre Eq   f => Eq   (NewTag f)
deriving instance NewTagFieldsAre Ord  f => Ord  (NewTag f)
deriving instance NewTagFieldsAre Show f => Show (NewTag f)
deriving instance NewTagFieldsAre Read f => Read (NewTag f)

一切都短得多！

将这一切放在一起，这是类型族的选项（1）。唯一与此不同的是，我整合了我所做的更改，稍微重新格式化了一些内容，并进行了一些其他基于品味的更改。

{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies,
             ConstraintKinds, DataKinds, StandaloneDeriving #-}

import Data.Text as T
import Data.Int (Int64)
import GHC.Exts (Constraint)

data Tag = Tag { unTag :: T.Text } deriving (Eq, Ord, Show, Read)

data ValidationResult = Validated | ValidationErrors
                      deriving (Eq, Ord, Enum, Bounded, Show, Read)

type family Incoming (vres :: ValidationResult) (base :: *) :: * where
  Incoming 'Validated        base = base
  Incoming 'ValidationErrors base = Either [T.Text] base

data NewTag f = NewTag { ntClientId :: Incoming f Int64
                       , ntTag      :: Incoming f Tag }

type NewTagFieldsAre (c :: * -> Constraint) f =
  (c (Incoming f Int64), c (Incoming f Tag))

deriving instance NewTagFieldsAre Eq   f => Eq   (NewTag f)
deriving instance NewTagFieldsAre Ord  f => Ord  (NewTag f)
deriving instance NewTagFieldsAre Show f => Show (NewTag f)
deriving instance NewTagFieldsAre Read f => Read (NewTag f)

为了完整起见，GADT选项：

{-# LANGUAGE GADTs, FlexibleInstances, TypeFamilies, DataKinds,
             StandaloneDeriving #-}

import Data.Text as T
import Data.Int (Int64)

data Tag = Tag { unTag :: T.Text } deriving (Eq, Ord, Show, Read)

data ValidationResult = Validated | ValidationErrors
                      deriving (Eq, Ord, Enum, Bounded, Show, Read)

data Incoming :: ValidationResult -> * -> * where
  IncomingValidated        :: base
                           -> Incoming Validated base
  IncomingValidationErrors :: Either [T.Text] base
                           -> Incoming ValidationErrors base

instance Eq base => Eq (Incoming Validated base) where
  IncomingValidated x == IncomingValidated y = x == y

instance Eq base => Eq (Incoming ValidationErrors base) where
  IncomingValidationErrors ex == IncomingValidationErrors ey = ex == ey

instance Ord base => Ord (Incoming Validated base) where
  IncomingValidated x `compare` IncomingValidated y = x `compare` y

instance Ord base => Ord (Incoming ValidationErrors base) where
  IncomingValidationErrors ex `compare` IncomingValidationErrors ey = ex `compare` ey

instance Show base => Show (Incoming Validated base) where
  show (IncomingValidated x) = "IncomingValidated " ++ show x

instance Show base => Show (Incoming ValidationErrors base) where
  show (IncomingValidationErrors ex) = "IncomingValidationErrors " ++ show ex

-- `Show` properly handling precedence, along with the `Read` instance, are left
-- as an exercise for the interested reader.

data NewTag f = NewTag { ntClientId :: Incoming f Int64
                       , ntTag      :: Incoming f Tag }

deriving instance Eq   (NewTag Validated)
deriving instance Eq   (NewTag ValidationErrors)
deriving instance Ord  (NewTag Validated)
deriving instance Ord  (NewTag ValidationErrors)
deriving instance Show (NewTag Validated)
deriving instance Show (NewTag ValidationErrors)

需要手动派生实例真的拖了下来！

如何派生类型系列记录的实例

2 个答案: