content: import Text.Printf (printf)
  import Data.Maybe (mapMaybe)
  import Numeric (showIntAtBase)
  
  kaprekars :: Integer -> Integer -> [(Integer, Integer, Integer)]
  kaprekars base top = (1, 0, 1) : mapMaybe kap (filter res [2 .. top])
    where
      res x = x * (x - 1) `mod` (base - 1) == 0
      kap n =
        getSplit $
        takeWhile (<= nn) $ dropWhile (< n) $ iterate (* toInteger base) 1
        where
          nn = n * n
          getSplit [] = Nothing
          getSplit (p:ps)
            | p == n = Nothing
            | q + r == n = Just (n, q, r)
            | r > n = Nothing
            | otherwise = getSplit ps
            where
              (q, r) = nn `divMod` p
  
  heading :: Int -> String
  heading = printf (h ++ d)
    where
      h = " #    Value (base 10)         Sum (base %d)             Square\n"
      d = " -    ---------------         -------------             ------"
  
  printKap :: Integer -> (Int, (Integer, Integer, Integer)) -> String
  printKap b (i, (n, l, r)) =
    printf "%2d %13s %26s %16s" i (show n) ss (base b (n * n))
    where
      ss = base b n ++ " = " ++ base b l ++ " + " ++ base b r
      base b n = showIntAtBase b (("0123456789" ++ ['a' .. 'z']) !!) n ""
  
  main :: IO ()
  main = do
    putStrLn $ heading 10
    mapM_ (putStrLn . printKap 10) $ zip [1 ..] (kaprekars 10 1000000)
    putStrLn ""
    putStrLn $ heading 17
    mapM_ (putStrLn . printKap 17) $ zip [1 ..] (kaprekars 17 1000000)
  