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

Question

Consider such domain logic: three types of users: Civilians, ServiceMembers and Veterans. Each of them has 'name', stored in different attributes.

Task is to write a function, accepting each of the types and returning 'C' char for Civilians, 'V' char for Veterans and 'S' char for ServiceMembers.

I have such record declarations:

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

My first idea was to combine them by such typeclass:

class UserLetter a where
  userLetter :: a -> Char

And implement instances:

instance UserLetter ServiceMemberInfo where
  userLetter _ = 'S'

instance UserLetter VeteranInfo where
  userLetter _ = 'V'

instance UserLetter CivilianInfo where
  userLetter _ = 'C'

In this case, userLetter is a function I wanted. But I really would like to write something like that (without typeclasses)

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

which throws compilation error: 'a' is a rigid type variable bound by

Another way is to use ADT:

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

Then userLetter1 declaration becomes obvious:

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

But, lets say, I don't have control over ServiceMemberInfo (and others) declarations. How userLetter1 can be defined?

Is there a way to declare one ADT with existing ServiceMemberInfo (and others) types?

Answer 1

It is possible to use existing type-classes to do this, and meet the pattern-matching-like syntax requirements you have, by defining a type -level function which returns the appropriate string, then picking the term-level string that corresponds to the type-level one. Here's a complete working example:

{-# 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))

We can see it go in ghci:

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

However, there's a lot not to like about this solution: it requires many extensions; it's complicated (hence will be a maintenance problem); and it is in some sense done this way only to paper over a design problem in the underlying types, which would be better served by eliminating the technical debt you've incurred already.

Answer 2

I would just redefine the datatypes like so:

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

But if you really can't change the original datatypes, then you can do something like the following with ViewPattern and optiononally 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"

This isn't very safe because you can call userLetter with any Typeable (which is everything); it could be better (but more work) to define a class like:

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

Answer 3

“Is there a way to declare one ADT with existing ServiceMemberInfo (and others) types?”

Why, sure there is!

data UserInfo = ServiceMemberUserInfo ServiceMemberInfo
              | VeteranUserInfo VeteranInfo
              | CivilianUserInfo CivilianInfo

Then userLetter1 :: UserInfo -> Char can be defined as before, but you still keep the seperate record definitions of ServiceMemberInfo , VeteranInfo and CivilianInfo .

Instead of declaring this as a new named ADT, you can also make it an “anonymous variant type”:

type (+) = Either

type UserInfo = ServiceMemberInfo + VeteranInfo + CivilianInfo

Then you can define

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

Clearly, this is not really preferrable: the anonymous constructors are much less descriptive.