newtype を作ってみる

やさしい Haskell 入門 (バージョン 98 )　6 再び、型について　6.1 Newtype 宣言　を参考に newtype を作ってみます。

newtype Age     = Age     Integer     deriving (Eq, Read, Show)

toAge :: Integer -> Age
toAge x | x < 0     = error "Can't create negative age!" 
        | otherwise = Age x

fromAge :: Age -> Integer
fromAge (Age i) = i

instance Num Age where
    fromInteger = toAge
    x + y       = toAge (fromAge x + fromAge y)
    x - y       = let r = fromAge x - fromAge y in
                    if r < 0 then error "Can't subtraction"
                             else toAge r
    
newtype Name    = Name    String  deriving (Eq, Read, Show)
newtype Address = Address String  deriving (Eq, Read, Show)
data    Sex     = Male | Female   deriving (Eq, Read, Show)

data Person = P { name :: Name, sex :: Sex , address :: Address , age :: Age} 
                deriving (Eq,Read,Show)

taro   = P { name =Name "taro", sex = Male , address = Address "Chiba", age =Age 20}
hanako = P (Name "hanako") Female (address taro) (Age 18)

ls :: [Person]
ls = [ hanako,taro]

newtype Employee     = Employee Person     deriving (Eq, Read, Show)

fromEmployee :: Employee -> Person
fromEmployee (Employee p) = p

• * , abs , signum のインスタンスがないので Warning が出ています。

[1 of 1] Compiling Main             ( type.hs, interpreted )

type.hs:10:9:
    Warning: No explicit method nor default method for `*'
    In the instance declaration for `Num Age'

type.hs:10:9:
    Warning: No explicit method nor default method for `abs'
    In the instance declaration for `Num Age'

type.hs:10:9:
    Warning: No explicit method nor default method for `signum'
    In the instance declaration for `Num Age'
Ok, modules loaded: Main.

足し算、引き算が可能、掛け算はNG。

ghci> Age 1 + Age 2
Age 3
ghci> Age 30 - Age 10
Age 20
ghci> Age 30 * 10
Age *** Exception: type.hs:10:9-15: No instance nor default method for class operation GHC.Num.*

ghci> map name ls
[Name "hanako",Name "taro"]
ghci> map sex ls
[Female,Male]
ghci> map (\x->(name x,age x))  ls
[(Name "hanako",Age 18),(Name "taro",Age 20)]

> let naoto = Employee $ P (Name "Naoto") Male (address taro) (Age 44)

> naoto
Employee (P {name = Name "Naoto", sex = Male, address = Address "Chiba", age = Age 44})

> name $ fromEmployee naoto
Name "Naoto"