类型结合类型的多态函数
考虑这样的领域逻辑：三种类型的用户：平民，服务成员和退伍军人。 每个人都有'名字'，存储在不同的属性中。
任务是编写一个函数，接受每种类型，并返回平民的'C'字符，退伍军人的'V'字符和ServiceMembers的'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？
可以使用现有的类型来做到这一点，并且通过定义一个返回适当字符串的类型级函数，然后选择对应于该类的字符级别字符串来满足您拥有的模式匹配类语法要求类型一级。 这是一个完整的工作示例：
{-# 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"
但是，有很多不喜欢这种解决方案：它需要很多扩展; 它很复杂（因此将是一个维护问题）; 从某种意义上说，这样做只是为了解决基础类型中的设计问题，通过消除已经发生的技术债务可以更好地解决问题。
我只是重新定义数据类型，如下所示：
newtype UserInfo = User { type :: UserType, name :: String }
data UserType = Civilian | ServiceMember | Veteran
但是，如果您确实无法更改原始数据类型，那么您可以使用ViewPattern和optionalon 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
...
“有没有办法用现有的ServiceMemberInfo（和其他）类型声明一个ADT？”
为什么，当然有！
data UserInfo = ServiceMemberUserInfo ServiceMemberInfo
| VeteranUserInfo VeteranInfo
| CivilianUserInfo CivilianInfo
然后userLetter1 :: UserInfo -> Char可以像之前一样定义，但是您仍然保持ServiceMemberInfo ， VeteranInfo和CivilianInfo的单独记录定义。
您可以将其作为“匿名变体类型”，而不是将其声明为新的命名ADT：
type (+) = Either
type UserInfo = ServiceMemberInfo + VeteranInfo + CivilianInfo
然后你可以定义
userLetter1 :: UserInfo -> Char
userLetter1 (Left (Left _)) = 'C'
userLetter1 (Left (Right _)) = 'S'
userLetter1 (Right _) = 'V'
显然，这并不是真正的可取之处：匿名构造函数的描述性较差。
链接地址: http://www.djcxy.com/p/43537.html