型の練習

ネタが無いのでnewtypeの練習で書いたコードを晒します。

module Main where

--単価
newtype Price = Price Int deriving (Eq,Show,Read)
instance Num Price where
  _ + _ = error "You can`t calculate Price + Price"
  _ - _ = error "You can`t calculate Price - Price"
  _ * _ = error "You can`t calculate Price * Price"
  abs (Price x) = Price $ abs x
  signum (Price x) = Price $ signum x
  fromInteger x = Price $ fromInteger x

--数量
newtype Quantity = Quantity Int deriving (Eq,Show,Read)
instance Num Quantity where
  (Quantity x) + (Quantity y) = Quantity (x+y)
  (Quantity x) - (Quantity y) = Quantity (x-y)
  _ * _ = error "You can`t calculate Quantity * Quantity"
  abs (Quantity x) = Quantity $ abs x
  signum (Quantity x) = Quantity $ signum x
  fromInteger x = Quantity $ fromInteger x

--合計金額
newtype Amount = Amount Int deriving (Eq,Show,Read)

(@*) :: Price -> Quantity -> Amount
(Price p) @* (Quantity q) = Amount $ p*q

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

dars :: Int -> Quantity
dars x = Quantity $ x * 12

greap :: Price
greap = 120

apple :: Price
apple = 100

-----------------------------------------------
--実行

main :: IO ()
main = do
  putStrLn $ "apple * 3 = " ++ (show $ greap @* 3)
  putStrLn $ "greap 2 dars = " ++ (show $ apple @* (dars 2))

実行結果

$ runghc Main.hs
apple * 3 = Amount 360
greap 2 dars = Amount 2400

単価も数量も数値として扱えますが、単価同士の演算や、数量×数量のような、明らかにおかしな計算はerrorになるようする事で、「りんごの単価×ぶどうの単価」のようなあり得ない計算が行われるのを回避できます。

*Main> 30 + (dars 5)
Quantity 90
*Main> greap*apple
Price *** Exception: You can`t calculate Price * Price
*Main> 5 * (dars 2)
Quantity *** Exception: You can`t calculate Quantity * Quantity

この当たり、Haskellの型定義の強い所ではあるのですが、欲を言うと実行時でなく、コンパイル時にエラーにしたいですね。そうするとNumクラスではやっぱりダメでしょうね。