Decomposing rationals as prefix + repeating

Decimals.hs

import qualified Data.Map as M
import Data.Maybe
import Data.Ratio
import Data.List
import Data.Char
import Control.Arrow

import Test.QuickCheck

f n (d,r) = ((10*r) `divMod` n)

-- Given a list and a way to extract a tag for each element, find the
-- indices of the list giving the first and second occurrence of the
-- first element to repeat, or Nothing if there are no repeats.
findRep :: Ord b => (a -> b) -> [a] -> Maybe (Int,Int)
findRep = findRep' M.empty 0

findRep' :: Ord b => M.Map b Int -> Int -> (a -> b) -> [a] -> Maybe (Int,Int)
findRep' _ _ _ [] = Nothing
findRep' prevs ix tag (x:xs) | t `M.member` prevs = Just (prevs M.! t, ix)
                             | otherwise          = findRep' (M.insert t ix prevs) (ix+1) tag xs
  where t = tag x

slice :: (Int,Int) -> [a] -> [a]
slice (s,f) = drop s . take f

type Decimal = ([Integer],[Integer])

toDecimal :: Integer -> Integer -> Decimal
toDecimal n d = (prefix,rep)
  where res       = tail $ iterate (f d) (0,n)
  	digits    = map fst res
        Just lims = findRep id res
        rep       = slice lims digits
        prefix    = take (fst lims) digits

fromDigits :: [Integer] -> Integer
fromDigits = foldl' (\d r -> 10*d + r) 0

fromDecimal :: Decimal -> Rational
fromDecimal (prefix, rep) = (fromDigits rep % (10^(length rep) - 1) + fromDigits prefix % 1) / (10^(length prefix))

showDecimal :: Decimal -> String
showDecimal (pre,[0]) = "." ++ concatMap show pre
showDecimal (pre,rep) = "." ++ concatMap show pre ++ "[" ++ concatMap show rep ++ "]"

showDecEq :: Decimal -> String
showDecEq d = showRat (fromDecimal d) ++ " = " ++ showDecimal d

showRat :: Rational -> String
showRat r | denominator r == 1 = show $ numerator r
          | otherwise          = show (numerator r) ++ "/" ++ show (denominator r)

prop_to_from_decimal :: Integer -> Integer -> Property
prop_to_from_decimal p q = (q > 0) ==> fromDecimal (toDecimal p q) == p%q

rotate :: [a] -> [a]
rotate (x:xs) = xs ++ [x]

rotateD :: Decimal -> Decimal
rotateD (pre,rep) = (pre, rotate rep)

rotations :: Decimal -> [Decimal]
rotations xs = take (length (snd xs)) (iterate rotateD xs)

displayRotations :: Integer -> Integer -> String
displayRotations p q = unlines . map showDecEq . rotations $ toDecimal p q

printRotations :: Integer -> Integer -> IO ()
printRotations p q = putStr $ displayRotations p q

spectrum :: Integer -> [(Int, Int)]
spectrum n = map (length . snd . flip toDecimal n) >>> sort >>> group >>> map (length &&& head) $ [1..n-1]