Real World Haskell - Chapter 6. Using Typeclasses

 

 

 

 

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 扩展使得当发生多匹配时使得编译器选择最特殊的那一个。

 

通常联合使用TypeSynonymInstances，OverlappingInstances

 

{-

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