Goodstein sequences, Haskell

Goodstein sequences

import System.IO

infixl 4 :+:
infixl 5 :*:
infixl 6 :^:

data H = H Integer | H :+: H | H :*: H | H :^: H deriving (Show, Eq, Ord)

fromH :: H -> Integer
fromH (a :^: b) = fromH a ^ fromH b
fromH (a :*: b) = fromH a * fromH b
fromH (a :+: b) = fromH a + fromH b
fromH (H a)     = a

toH :: Integer -> Integer -> H
toH val base = toH' val base 0
  where
    toH' :: Integer -> Integer -> Integer -> H
    toH' 0 _ _ = H 0
    toH' val base depth = toH' q base (depth + 1) :+: (H r :*: H base :^: toH depth base)
      where
        (q,r) = quotRem val base

replaceH :: Integer -> Integer -> H -> H
replaceH old new (H a) | a == old = H new | otherwise = H a
replaceH old new (a :^: b) = replaceH old new a :^: replaceH old new b
replaceH old new (a :*: b) = replaceH old new a :*: replaceH old new b
replaceH old new (a :+: b) = replaceH old new a :+: replaceH old new b

goodSteinH :: Integer -> [Integer]
goodSteinH n = takeWhile (>= 0) $ map (fromH . fst) $ iterate (\(x,i) -> (toH (fromH (replaceH (i - 1) i x) - 1) i, i + 1)) (toH n 2, 3)

main :: IO ()
main = do
  n <- read <$> getLine
  i <- read <$> getLine
  putStrLn "\nResults:"
  mapM_ (\(i,x) -> putStrLn (show i ++ ". " ++ show x)) $ zip [0..] $ take i $ goodSteinH n


run \| edit \| history \| help	0