Real World Haskell - Chapter 6. Using Typeclasses

本文深入探讨Haskell中的类型类概念,通过具体实例展示如何使用类型类来提高代码复用性和灵活性。文章覆盖基本类型类定义、内置类型类、序列化应用、以及如何避免类型类实例冲突等内容。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

 

 

 

 

Chapter 6. Using Typeclasses

 

class 声明Typeclass 就是声明一组函数。

 

The Need for Typeclasses

 

Color 相等测试(后面有改进版)

 

data Color = Red | Green | Blue

 

colorEq :: Color -> Color -> Bool

colorEq Red Red = True

colorEq Green Green = True

colorEq Blue Blue = True

colorEq _ _ = False

 

cc = colorEq Red Red  -- >True

dd = colorEq Red Green  -- >False

 

String 相等测试

 

stringEq :: [Char] -> [Char] -> Bool

 

stringEq [] [] = True

stringEq (x:xs) (y:ys) = x == y && stringEq xs ys

stringEq _ _ = False

 

现在你看到了,我们要写不同的函数来对不同的类型作相等测试,不仅效率低而且讨人厌。

 

如果可以用“== 操作符来比较任何东西就会方便得多。


 

What Are Typeclasses?

 

Typeclasses 定义了一组函数,这些函数对于给定的不同类据类型有不同的实现。Typeclasses 可能看起来像OO 中的对象,但实际上它们相当不同。

 

让我们用Typeclasses 来解决前面的困境。作为开始,我们必须定义Typeclasses 本身。

 

我们需要一个函数,它不在乎其参数类型是什么。这是我们的第一个Typeclasses 定义:

 

class BasicEq a where

    isEqual :: a -> a -> Bool

 

这里我们声明了一个名为BasicEq typeclass,而a BasicEq 的实例。

 

class 是定义typeclass 的关键字。注意了,它和OO 的类没有任何关系。

 

实例化typeclass 的类型

 

instance BasicEq Bool where

    isEqual True True = True

    isEqual False False = True

    isEqual _ _ = False

 

定义不相等函数也可能是有用的

 

class BasicEq2 a where

    isEqual2 :: a -> a -> Bool

    isNotEqual2 :: a -> a -> Bool

   

这里两个函数的定义循环依赖,必须且只须定义其中一个

 

class BasicEq3 a where

    isEqual3 :: a -> a -> Bool

    isEqual3 x y = not (isNotEqual3 x y)

 

    isNotEqual3 :: a -> a -> Bool

    isNotEqual3 x y = not (isEqual3 x y)

 

如不给出定义,这两函数会引发无限循环。

 

 

内置typeclass Eq 的定义

{-

class Eq a where

    (==), (/=) :: a -> a -> Bool  -- 亮点,有相同签名的两函数可以一起定义

 

        -- Minimal complete definition:

        -- (==) or (/=)

    x /= y = not (x == y)

    x == y = not (x /= y)

-}

 

Declaring Typeclass Instances

 

Color 相等测试

 

instance BasicEq3 Color where

    isEqual3 Red Red = True

    isEqual3 Green Green = True

    isEqual3 Blue Blue = True

    isEqual3 _ _ = False

 

这里isNotEqual3 这里没有给出定义,所以编译器自动使用Typeclass 声明isNotEqual3 时的默入定义。


 

Important Built-in Typeclasses

 

Haskell Prelude 包定义了一些标准typeclass

 

typeclass Haskell 语言的重要核心。

 

Show

 

Show 是一个typeclass ,用于将values 转成Strings

 

类型类Show 最重要的函数是show

 

{-

ghci> :type show

show :: (Show a) => a -> String

 

ghci> show 1

"1"

ghci> show [1, 2, 3]

"[1,2,3]"

ghci> show (1, 2)

"(1,2)"

-}

 

{-

ghci> putStrLn (show 1)

1

ghci> putStrLn (show [1,2,3])

[1,2,3]

 

ghci> show "Hello!"

"/"Hello!/""

ghci> putStrLn (show "Hello!")

"Hello!"

ghci> show ['H', 'i']

"/"Hi/""

ghci> putStrLn (show "Hi")

"Hi"

ghci> show "Hi, /"Jane/""

"/"Hi, ///"Jane///"/""

ghci> putStrLn (show "Hi, /"Jane/"")

"Hi, /"Jane/""

-}

 

为自已的类型定义Show 实例

 

instance Show Color where

    show Red = "Red"

    show Green = "Green"

    show Blue = "Blue"

 

show Red  -- >"Red"


 

Read

 

Read 这个typeclass Show 本质上相反。它定义了一些函数,这些函数接受一个String,解析它,并返回任意类型的数据(就是你用来实例化的那个类型)Read 最有用的函数是read

 

{-

main = do

        putStrLn "Please enter a Double:"

        inpStr <- getLine  -- 读入一行

        let inpDouble = (read inpStr)::Double

        putStrLn ("Twice " ++ show inpDouble ++ " is " ++ show (inpDouble * 2))

-}

 

(read inpStr)::Double 类似于“显示类型转换”,因为read 的返回值是a read String => a

 

ghci 在内部使用show 来显示结果。

 

instance Read Color where

    readsPrec _ value =

        tryParse [("Red", Red), ("Green", Green), ("Blue", Blue)]

        where tryParse [] = []

              tryParse ((attempt, result):xs) =

                    if (take (length attempt) value) == attempt

                        then [(result, drop (length attempt) value)]

                        else tryParse xs

 

{-

ghci> (read "Red")::Color

Red

ghci> (read "Green")::Color

Green

ghci> (read "Blue")::Color

Blue

ghci> (read "[Red]")::[Color]

[Red]

ghci> (read "[Red,Red,Blue]")::[Color]

[Red,Red,Blue]

ghci> (read "[Red, Red, Blue]")::[Color]

*** Exception: Prelude.read: no parse

-}

 

Parsec Read 更易用,Read 通常只用于简单任务。(参见第16章)


 

Serialization with read and show

 

read show 是进行序列化的极好工具。show 生成人和机器都可读的输出。

 

String 处理通常是lazy 的,所以read show 可以用来处理相当大的数据结构。

 

先写文件,文件名是“test”,内容是“[Just 5,Nothing,Nothing,Just 8,Just 9]

 

{-

ghci> let d1 = [Just 5, Nothing, Nothing, Just 8, Just 9]::[Maybe Int]

ghci> putStrLn (show d1)

[Just 5,Nothing,Nothing,Just 8,Just 9]

ghci> writeFile "test" (show d1)  -- 亮点,写文件的方法

-}

 

然后再读回来

 

{-

ghci> input <- readFile "test"

"[Just 5,Nothing,Nothing,Just 8,Just 9]"

ghci> let d2 = read input  -- 亮点,读文件的方法

<interactive>:1:9:

Ambiguous type variable `a' in the constraint:

`Read a' arising from a use of `read' at <interactive>:1:9-18

Probable fix: add a type signature that fixes these type variable(s)

ghci> let d2 = (read input)::[Maybe Int]

ghci> print d1

[Just 5,Nothing,Nothing,Just 8,Just 9]

ghci> print d2

[Just 5,Nothing,Nothing,Just 8,Just 9]

ghci> d1 == d2

True

-}

 

{-

ghci> putStrLn $ show [("hi", 1), ("there", 3)]  -- 亮点,用“$ 操作符当括号

[("hi",1),("there",3)]

ghci> putStrLn $ show [[1, 2, 3], [], [4, 0, 1], [], [503]]

[[1,2,3],[],[4,0,1],[],[503]]

ghci> putStrLn $ show [Left 5, Right "three", Left 0, Right "nine"]

[Left 5,Right "three",Left 0,Right "nine"]

ghci> putStrLn $ show [Left 0, Right [1, 2, 3], Left 5, Right []]

[Left 0,Right [1,2,3],Left 5,Right []]

-}

 

Numeric Types

 

Haskell 的数值类型非常强大。你可以使用从32 位到64 位的整数,还有任意精度的比例数。“+ 可以适用于所有这些数值。这是使用typeclass 实现的。你也可以定义自已的数值类型,并使它们成为Haskell 中的fist-class citizens

 

Equality, Ordering, and Comparisons

 

== 和“/= 定义于Eq class

 

>= 和“<= 定义于Ord class

 

Ord 的任何实例都可以用Data.List.sort 排序。

 

几乎所有Haskell 的类型都是Eq 的实例,Ord 的实例也接近这么多。


 

Automatic Derivation

 

对一些简单的数据类型,Haskell 编译器可以自动为我们继承实例,包括Read Show Bounded Enum Eq Ord

 

使用deriving 关键字自动继承typeclass 实例

 

data Color = Red | Green | Blue

     deriving (Read, Show, Eq, Ord)

 

{-

ghci> show Red

"Red"

ghci> (read "Red")::Color

Red

ghci> (read "[Red,Red,Blue]")::[Color]

[Red,Red,Blue]

ghci> (read "[Red, Red, Blue]")::[Color]

[Red,Red,Blue]

ghci> Red == Red

True

ghci> Red == Blue

False

ghci> Data.List.sort [Blue,Green,Blue,Red]  -- 大小和定义顺序一致

[Red,Green,Blue,Blue]

ghci> Red < Blue

True

-}

    

注意到Color order 接照我们定义构造器的顺序来定义的。

 

类似这样的data MyType = MyType (Int -> Bool) 不能自动继承,因为show 不知道怎样render 一个函数。

 

data CannotShow = CannotShow

                deriving (Show)

 

-- 不能编译

data CannotDeriveShow = CannotDeriveShow CannotShow

                      deriving (Show)

 

-- 正确

data OK = OK

 

instance Show OK where

    show _ = "OK"

 

data ThisWorks = ThisWorks OK

               deriving (Show)


 

Typeclasses at Work: Making JSON Easier to Use

 

--import JSON

 

result :: JValue

 

result = JObject [

    ("query", JString "awkward squad haskell"),

    ("estimatedCount", JNumber 3920),

    ("moreResults", JBool True),

    ("results", JArray [

        JObject [

        ("title", JString "Simon Peyton Jones: papers"),

        ("snippet", JString "Tackling the awkward ..."),

        ("url", JString "http://.../marktoberdorf/")

        ]])

    ]

 

type JSONError = String

class JSON a where

    toJValue :: a -> JValue

    fromJValue :: JValue -> Either JSONError a  -- Either 类似于Mabe我们用它表示这里的操作可能会失败。

 

instance JSON JValue where

    toJValue = id

    fromJValue = Right

 

More Helpful Errors

 

fromJValue 函数使用了Either 类型,Mabe 一样,Either这个类型也是也是预定义了的。我们用它表示那里的操作可能会失败。

 

Either 的定义

{-

data Either a b = Left a

                | Right b

                deriving (Eq, Ord, Read, Show)

-}

 

 

Either 的结构类似于Nothing ,但是Either 有一个“something bad happened”的Left 构造器。

 

instance JSON Bool where

    toJValue = JBool

    fromJValue (JBool b) = Right b

    fromJValue _ = Left "not a JSON boolean"  -- 有不好的事情发生了!

 

Making an Instance with a Type Synonym

 

Haskell 98 标准不允许写这样的代码,虽然看起来很perfectly

 

instance JSON String where

    toJValue = JString

    fromJValue (JString s) = Right s

    fromJValue _ = Left "not a JSON string"

 

 

使用这个可以使得上面的代码有效:

 

{-# LANGUAGE TypeSynonymInstances #-}  -- 把这个放到源码的最顶端(不是top 是不行的!)


 

Living in an Open World

 

-- JSONClass.hs

{-# LANGUAGE TypeSynonymInstances #-}

 

module JSONClass () where

 

import JSON

 

type JSONError = String

 

class JSON a where

    toJValue :: a -> JValue

    fromJValue :: JValue -> Either JSONError a

 

instance JSON JValue where

    toJValue = id

    fromJValue = Right

 

instance JSON Bool where

    toJValue = JBool

    fromJValue (JBool b) = Right b

    fromJValue _ = Left "not a JSON boolean"

 

instance JSON String where

    toJValue = JString

    fromJValue (JString s) = Right s

    fromJValue _ = Left "not a JSON string"

 

doubleToJValue :: (Double -> a) -> JValue -> Either JSONError a

doubleToJValue f (JNumber v) = Right (f v)

doubleToJValue _ _ = Left "not a JSON number"

 

instance JSON Int where

    toJValue = JNumber . realToFrac

    fromJValue = doubleToJValue round

 

instance JSON Integer where

    toJValue = JNumber . realToFrac

    fromJValue = doubleToJValue round

 

instance JSON Double where

    toJValue = JNumber

    fromJValue = doubleToJValue id

 

--------------------------------------------------------------

-- BrokenClass.hs

{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

 

module BrokenClass () where

 

import JSON

 

type JSONError = String

 

class JSON a where

    toJValue :: a -> JValue

    fromJValue :: JValue -> Either JSONError a

 

instance (JSON a) => JSON [a] where

    toJValue = undefined

    fromJValue = undefined

 

instance (JSON a) => JSON [(String, a)] where

    toJValue = undefined

    fromJValue = undefined

 

aa = toJValue [("foo","bar")]  -- 出错!解释见后面。-- Error:“Overlapping instances for JSON [([Char], [Char])]

 

When Do Overlapping Instances Cause Problems?

 

toJValue [("foo","bar")]  -- Error:“Overlapping instances for JSON [([Char], [Char])]

 

要了解Overlapping Instances 错误是怎么回事看下面的代码:

 

-- 要正常编译加这个:{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

class Borked a where

    bork :: a -> String

 

instance Borked Int where

    bork = show

 

instance Borked (Int, Int) where

    bork (a, b) = bork a ++ ", " ++ bork b

 

instance (Borked a, Borked b) => Borked (a, b) where

    bork (a, b) = ">>" ++ bork a ++ " " ++ bork b ++ "<<"

 

我们有两个pairs 实例:一个是Int pairs,另一个是任意Borked pairs(不知道应该匹配哪一个?)

 

Relaxing Some Restrictions on Typeclasses

 

TypeSynonymInstances 扩展使得我们可以使用[a] 这种泛类型的特化版本[Char]

 

OverlappingInstances 扩展使得当发生多匹配时使得编译器选择最特殊的那一个。

 

通常联合使用TypeSynonymInstancesOverlappingInstances

 

{-

{-# LANGUAGE TypeSynonymInstances, OverlappingInstances #-}

import Data.List

class Foo a where

    foo :: a -> String

 

instance Foo a => Foo [a] where

    foo = concat . intersperse ", " . map foo

 

instance Foo Char where

    foo c = [c]

 

instance Foo String where

    foo = id

-}


 

How Does Show Work for Strings?

 

 

How to Give a Type a New Identity

 

除了data 关键字,Haskell 还提供了一个newtype 关键字用来定义新类型

 

data DataInt = D Int

             deriving (Eq, Ord, Show)

 

newtype NewtypeInt = N Int

                   deriving (Eq, Ord, Show)

 

newtype 声明的目的是重命名一个已存在的类型,给它一个不同的标识。注意到newtype data 声明是很像的。

 

使用newtype 声明的是一种真正的新类型,而用type 声明的只是一种昵称

 

newtype UniqueID = UniqueID Int

                 deriving (Eq)

 

UniqueID Int 是两种不同的类型,作为UniqueID 的用户我们不知道它是用Int 实现的。

 

{-

ghci> N 1 < N 2

True

-}

 

因为没有暴露Int Num Integral 实例,所以NewtypeInt 的值不是数字:

{-

ghci> N 313 + N 37  -- 出错

-}


 

Differences Between Data and Newtype Declarations

 

newtype 的使用比Date 有更多的限制。

 

newtype 只能有一个值构造器,构造器的参数也只能有一个。

 

{-

data TwoFields = TwoFields Int Int

 

-- ok: exactly one field

newtype Okay = ExactlyOne Int

 

-- ok: type parameters are no problem

newtype Param a b = Param (Either a b)

 

-- ok: record syntax is fine

newtype Record = Record {

     getInt :: Int

    }

 

-- bad: no fields

newtype TooFew = TooFew

 

-- bad: more than one field

newtype TooManyFields = Fields Int Int

 

-- bad: more than one constructor

newtype TooManyCtors = Bad Int

                     | Worse Int

-}

 

data 创建类型在运行时有一个bookkeeping 开销,而newtype 没有。

 

下面的代码不会crash

 

{-

ghci> case undefined of N _ -> 1

1

-}

 

因为在运行时没有构造器要present 。匹配的时侯N _ 简单的等效于wild card _ ,因为wild card 总是匹配的,所以就不需要去evaluated 那个undefined


 

JSON Typeclasses Without Overlapping Instances

 

-- JSONClass

{-# LANGUAGE TypeSynonymInstances #-}

 

module JSONClass ( JAry(fromJAry), jary ) where

 

--import JSON

 

import Control.Arrow (second)

 

data JValue = JString String

            | JNumber Double

            | JBool Bool

            | JNull

            | JObject (JObj JValue) -- was [(String, JValue)]

            | JArray (JAry JValue) -- was [JValue]

            deriving (Eq, Ord, Show)

 

 

type JSONError = String

 

class JSON a where

    toJValue :: a -> JValue

    fromJValue :: JValue -> Either JSONError a

 

instance JSON JValue where

    toJValue = id

    fromJValue = Right

 

instance JSON Bool where

    toJValue = JBool

    fromJValue (JBool b) = Right b

    fromJValue _ = Left "not a JSON boolean"

 

instance JSON String where

    toJValue = JString

    fromJValue (JString s) = Right s

    fromJValue _ = Left "not a JSON string"

 

doubleToJValue :: (Double -> a) -> JValue -> Either JSONError a

doubleToJValue f (JNumber v) = Right (f v)

doubleToJValue _ _ = Left "not a JSON number"

 

instance JSON Int where

    toJValue = JNumber . realToFrac

    fromJValue = doubleToJValue round

 

instance JSON Integer where

    toJValue = JNumber . realToFrac

    fromJValue = doubleToJValue round

 

instance JSON Double where

    toJValue = JNumber

    fromJValue = doubleToJValue id

 

 

newtype JAry a = JAry {

    fromJAry :: [a]

   } deriving (Eq, Ord, Show)

 

 

-- 通常导出一个newtype 时我们不导出它的构造器,而是提供一个函数来构造

jary :: [a] -> JAry a

jary = JAry

 

newtype JObj a = JObj {

    fromJObj :: [(String, a)]

   } deriving (Eq, Ord, Show)

 

jaryFromJValue :: (JSON a) => JValue -> Either JSONError (JAry a)

jaryToJValue :: (JSON a) => JAry a -> JValue

 

instance (JSON a) => JSON (JAry a) where

    toJValue = jaryToJValue

    fromJValue = jaryFromJValue

 

 

listToJValues :: (JSON a) => [a] -> [JValue]

listToJValues = map toJValue

 

 

jvaluesToJAry :: [JValue] -> JAry JValue

jvaluesToJAry = JAry

 

jaryOfJValuesToJValue :: JAry JValue -> JValue

jaryOfJValuesToJValue = JArray

 

jaryToJValue = JArray . JAry . map toJValue . fromJAry

 

jaryFromJValue (JArray (JAry a)) =

    whenRight JAry (mapEithers fromJValue a)

jaryFromJValue _ = Left "not a JSON array"

 

whenRight :: (b -> c) -> Either a b -> Either a c

whenRight _ (Left err) = Left err

whenRight f (Right a) = Right (f a)

 

mapEithers :: (a -> Either b c) -> [a] -> Either b [c]

mapEithers f (x:xs) = case mapEithers f xs of

                          Left err -> Left err

                          Right ys -> case f x of

                                         Left err -> Left err

                                         Right y -> Right (y:ys)

mapEithers _ _ = Right []

 

 

instance (JSON a) => JSON (JObj a) where

    toJValue = JObject . JObj . map (second toJValue) . fromJObj

    fromJValue (JObject (JObj o)) = whenRight JObj (mapEithers unwrap o)

        where unwrap (k,v) = whenRight ((,) k) (fromJValue v)

    fromJValue _ = Left "not a JSON object"


 

The Dreaded Monomorphism Restriction

 

myShow = show  -- 出错?

 

-- ok

myShow2 value = show value

myShow3 :: (Show a) => a -> String

myShow3 = show

 

评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值