DouKaku?

import System.IO.UTF8 as U

nsplit :: Int -> String -> [String]
nsplit _ [] = []
nsplit n ss | n == 0    = [ss]
            | otherwise = let (x,xs) = splitAt n ss in x:nsplit n xs

rnsplit :: Int -> String -> [String]
rnsplit n = reverse . map reverse . nsplit n . reverse

suppress n c s = reverse $ take n $ reverse s ++ repeat c

kansuuji = ["零","一","二","三","四","五","六","七","八","九"]
keta1 = reverse ["","十","百","千"]
keta2 n = reverse $ take n ["", "萬","億","兆","京"]

addK1 :: String -> String -> String
addK1 "一" "十"  = "十"
addK1 "一" "百"  = "百"
addK1 "一" "千"  = "千"
addK1 "零" _  = ""
addK1 x y     = x ++ y

f :: Integer -> IO ()
f = U.putStrLn . concatMap (++" ") . k2 . k1 . rnsplit 4 . reads . show
  where reads = concatMap ((!!) kansuuji . read) . ss
        fmt   = map (suppress 4 '零')
        k1    = map (concat . zipWith (flip addK1) keta1 . ss) . fmt
        k2 xs = zipWith addK1 xs (keta2 (length xs))
        ss    = map (flip (:) [])