由类型类组合的类型上的多态函数

Question

考虑这样的域逻辑：三种类型的用户：平民、军人和退伍军人。它们每个都有"name"，存储在不同的属性中。

任务是编写一个函数，接受每种类型，并返回平民的"C"字符、退伍军人的"V"字符和军人的"S"字符。

我有这样的记录声明：

data ServiceMemberInfo = ServiceMemberInfo { smname::String }
data VeteranInfo = VeteranInfo { vname::String }
data CivilianInfo = CivilianInfo { cname::String }

我的第一个想法是通过这样的类型类将它们组合起来：

class UserLetter a where
  userLetter :: a -> Char

并实现实例：

instance UserLetter ServiceMemberInfo where
  userLetter _ = 'S'
instance UserLetter VeteranInfo where
  userLetter _ = 'V'
instance UserLetter CivilianInfo where
  userLetter _ = 'C'

在这种情况下，userLetter是我想要的函数。但我真的很想写这样的东西（没有类型类）

userLetter1 :: UserLetter a => a -> Char
userLetter1 (CivilianInfo _) = 'C'
userLetter1 (ServiceMemberInfo _) = 'S'
userLetter1 (VeteranInfo _) = 'V'

引发编译错误："a"是绑定的刚性类型变量

另一种方法是使用ADT:

data UserInfo = ServiceMemberInfo { smname::String }
              | VeteranInfo { vname::String }
              | CivilianInfo { cname::String }

然后userLetter1声明变得显而易见：

userLetter1 :: UserInfo -> Char
userLetter1 (CivilianInfo _) = 'C'
userLetter1 (ServiceMemberInfo _) = 'S'
userLetter1 (VeteranInfo _) = 'V'

但是，比方说，我不能控制ServiceMemberInfo（和其他）声明。如何定义userLetter1？

有没有一种方法可以用现有的ServiceMemberInfo（和其他）类型声明一个ADT？

Answer 1

可以使用现有的类型类来实现这一点，并通过定义返回适当字符串的type-level函数，然后选择与类型-level对应的术语-level字符串，来满足模式匹配之类的语法要求。下面是一个完整的工作示例：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
import GHC.TypeLits
import Data.Proxy
data ServiceMemberInfo = ServiceMemberInfo { smname::String }
data       VeteranInfo =       VeteranInfo {  vname::String }
data      CivilianInfo =      CivilianInfo {  cname::String }
type family Label x :: Symbol
type instance Label ServiceMemberInfo = "S"
type instance Label       VeteranInfo = "V"
type instance Label      CivilianInfo = "C"
label :: forall a. KnownSymbol (Label a) => a -> String
label x = symbolVal (Proxy :: Proxy (Label a))

我们可以在ghci:中看到它

*Main> label (ServiceMemberInfo "")
"S"

然而，这个解决方案有很多不喜欢的地方：它需要许多扩展；它很复杂（因此将是一个维护问题）；从某种意义上说，它是通过only的方式来解决底层类型中的设计问题的，通过消除已经产生的技术债务会更好地解决这个问题。

Answer 2

我会重新定义数据类型，如下所示：

newtype UserInfo = User { type :: UserType, name :: String } 
data UserType = Civilian | ServiceMember | Veteran

但是，如果您真的无法更改原始数据类型，那么您可以使用ViewPattern和可选的PatternSynonyms:执行以下操作

{-# LANGUAGE PatternSynonyms, ViewPatterns, StandaloneDeriving, DeriveDataTypeable #-} 
import Data.Typeable 
data ServiceMemberInfo = ServiceMemberInfo { smname::String }
data VeteranInfo = VeteranInfo { vname::String }
data CivilianInfo = CivilianInfo { cname::String }
deriving instance Typeable ServiceMemberInfo
deriving instance Typeable VeteranInfo
deriving instance Typeable CivilianInfo
pattern ServiceMemberInfo_ x <- (cast -> Just (ServiceMemberInfo x))
pattern VeteranInfo_ x <- (cast -> Just (VeteranInfo x))
pattern CivilianInfo_ x <- (cast -> Just (CivilianInfo x))
type UserLetter = Typeable 
-- without pattern synonyms
userLetter :: UserLetter a => a -> Char
userLetter (cast -> Just (CivilianInfo{})) = 'C'
userLetter (cast -> Just (ServiceMemberInfo{})) = 'S'
userLetter (cast -> Just (VeteranInfo{})) = 'V'
userLetter _ = error "userLetter"
-- with pattern synonyms
userLetter1 :: UserLetter a => a -> Char
userLetter1 (CivilianInfo_ _) = 'C'
userLetter1 (ServiceMemberInfo_ _) = 'S'
userLetter1 (VeteranInfo_ _) = 'V'
userLetter1 _ = error "userLetter"

这不是很安全，因为您可以用任何Typeable调用userLetter（这就是一切）；定义一个类似的类可能会更好（但需要做更多的工作）

class Typeable a => UserLetter a 
instance UserLetter ServiceMemberInfo 
...

Answer 3

“有没有一种方法可以用现有的ServiceMemberInfo（和其他）类型声明一个ADT”

为什么，当然有！

data UserInfo = ServiceMemberUserInfo ServiceMemberInfo
              | VeteranUserInfo VeteranInfo
              | CivilianUserInfo CivilianInfo

然后userLetter1 :: UserInfo -> Char可以像以前一样定义，但您仍然保留ServiceMemberInfo、VeteranInfo和CivilianInfo的单独记录定义。

您也可以将其作为“匿名变体类型”：

type (+) = Either
type UserInfo = ServiceMemberInfo + VeteranInfo + CivilianInfo

然后你可以定义

userLetter1 :: UserInfo -> Char
userLetter1 (Left (Left _)) = 'C'
userLetter1 (Left (Right _)) = 'S'
userLetter1 (Right _) = 'V'

显然，这并不是真正可取的：匿名构造函数的描述性要低得多。