content: 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]
  