import Data.List (unfoldr, mapAccumR)
import Data.Ratio ((%), denominator, numerator)
import Text.Printf (PrintfArg, printf)

-- The n'th order Farey sequence.
farey :: Integer -> [Rational]
farey n = 0 : unfoldr step (0, 1, 1, n)
  where
    step (a, b, c, d)
      | c > n = Nothing
      | otherwise =
        let k = (n + b) `quot` d
        in Just (c %d, (c, d, k * c - a, k * d - b))

-- A list of pairs, (n, fn n), where fn is a function applied to the n'th order
-- Farey sequence.  We assume the list of orders is increasing.  Only the
-- highest order Farey sequence is evaluated; the remainder are generated by
-- successively pruning this sequence.
fareys :: ([Rational] -> a) -> [Integer] -> [(Integer, a)]
fareys fn ns = snd $ mapAccumR prune (farey $ last ns) ns
  where
    prune rs n =
      let rs'' = filter ((<= n) . denominator) rs
      in (rs'', (n, fn rs''))

fprint
  :: (PrintfArg b)
  => String -> [(Integer, b)] -> IO ()
fprint fmt = mapM_ (uncurry $ printf fmt)

showFracs :: [Rational] -> String
showFracs =
  unwords .
  map (concat . (<*>) [show . numerator, const "/", show . denominator] . pure)

main :: IO ()
main = do
  putStrLn "Farey Sequences\n"
  fprint "%2d %s\n" $ fareys showFracs [1 .. 11]
  putStrLn "\nSequence Lengths\n"
  fprint "%4d %d\n" $ fareys length [100,200 .. 1000]