DouKaku?

import List (unfoldr,findIndex)
import Monad (msum)

{-
余り列からμ（循環部より前の長さ）とλ（循環部の長さ）を求める

(A) xs を１個、２個、４個、８個・・・からなる区間に分ける。
  例えば xs = [1..] だったら [[1],[2,3],[4,5,6,7],..] に分けるように。
  （本当はさらにもうちょっと加工している）
(B) 各区間で先頭の値と同じものが区間中にあるか検索する
(C) 最初に見つかった検索成功情報を取ってくる。
  成功情報は Just i の形で i は λ-1 に等しい。
(D) インデックスを Just の中から取り出し１加える。
(E) λステップ進んだ位置とスタート位置から同時に進む（カウンタ付き）。
(F) 循環して出会うまで待つ。
-}

muLam xs = (mu, if (d==0) then 0 else lam) where
  ys = unfoldr f (1,xs)                                         -- (A)
  f (m,zs) = Just (splitAt 1 zs1, (2*m,zs2)) where
    (zs1,zs2) = splitAt m zs
  lam = maybe 0 (+1)                                            -- (D)
    $ msum                                                      -- (C)
    $ zipWith (\([a],as) ([b],_) -> findIndex (==a) (as++[b]))  -- (B)
        ys (tail ys)
  (_,d,mu) = head $ dropWhile (\(a,b,_) -> a/=b)                -- (F)
    $ zip3 xs (drop lam xs) [0..]                               -- (E)

toDecimal m n = show q0 ++ "." ++ (qs1 >>= show) ++ cyc  where
  (q0,m') = divMod m n
  (_:qs,rs) = unzip $ iterate ((`divMod` n).(10*).snd) (0,m')
  (mu,lam) = muLam rs
  (qs1,qs2) = splitAt mu qs
  cyc | lam == 0  = ""
      | otherwise = "{" ++ (take lam qs2 >>= show) ++ "}"