Haskellの型クラスを利用した有理数型

タイトル通りです。

data Ration = Integer :/ Integer | AddID 
instance Eq Ration where
         (x :/ y) == (x':/y') = let s1 = gcd x y
                                    s2 = gcd x' y'
                     in
                 (x `div` s1 == x' `div` s2)
                                           && (y `div` s1 == y' `div` s2)
instance Show Ration where
         show (x :/ y) = let s = gcd x y
                         in
                        show (x`div`s) ++ "/" ++ show (y`div`s)

rationToFloat :: Ration -> Float
rationToFloat (x :/ y) = fromIntegral x / fromIntegral y
mul (x :/ y) (x' :/ y') = reduct ((x * x'):/(y * y'))
reduct (x :/ y) = let g = gcd x y
                  in
                  (x `div` g) :/ (y`div`g)
di (x :/ y) (x' :/  y') = mul (x :/ y) (y' :/ x')
add x AddID = x
add AddID y = y
add (x :/ y) (x' :/ y') = let l = lcm y y'
                              m1 = l `div` y
                              m2 = l `div` y'
                          in reduct ((m1*x + m2*x') :/ l)
sub (x :/ y) (x' :/ y') = add (x :/ y) ((-x') :/ (y'))

有理型は和も積も単位元が複数存在するのが厄介です。
さらに0除算のことなどいろいろな例外があります。
今回のコードは急ごしらえでそのようなことは考えていません。
和の単位元だけ試験的に実装しています。(AddID)
今回はこれを応用して、ライプニッツ級数
\[\sum^{\infty}_{n=0}\frac{(-1)^n}{2n+1} = \frac{\pi}{4} \]
より円周率を求めてみます。
利用する関数、定義

let lip = [ ((-1)^n):/(2*n+1) | n<-[0,1..]]
partsum b 0 _ = b
partsum b n (x:xs) = partsum (add b x) (n-1) xs

実行例

*Main> ((4:/1) `mul` (partsum AddID 100 lip))
8252079759413970386664454687621174435983101115012912631997769614579677862845786070667088/2635106162757236442495826303084698495565581115509040892412867358728390766099042109898375
*Main> ((4:/1) `mul` (partsum AddID 200 lip))
731070388038968202720510198283781775454721070454247644121830326235077353957426480846277182638522756913731374269936715193263560910895530282361264868908266204946805311497184/233077884665326398150824103062920077329319208418023678398907683319848459110106903491713919541172119871364032797568478630600311502003066966840474629472267552661106168111125
*Main> ((4:/1) `mul` (partsum AddID 300 lip))
5225645700732578660757222494473018434678943097092985751800195180838596610013780584278253709093305256797047031098916493425558192295042537198564257121082268188433032685860147637228857628560723477301587102016574531025314432495082724959309868725561540131084688/1665141453284292119501128176265135852020805040785019269013402590677638665112799180271757599577286560166540552724725936015136272490152610881122344030143206974706298054993350415948784680656377567820299938133978899260687047126681401325662561292696661412536625
(実数値で上から)
3.131592903558553
3.136592684838817
3.1382593295155905

収束遅い...