漢数字変換

	import Graphics.UI.Gtk
	import Control.Monad
	k = reverse "極哉正澗溝穣杼垓京兆億万"
	c = repeat ','
	kmg = reverse "YZEPTGMK"
	rn = return . reverse
	restore = map reverse
	disp b x = do
	if head x == '-'
	then putChar '-' >> disp' b (tail x)
	else disp' b x
	disp' b x =
	case b of
	"k" -> grp4 x >>= dispk
	"c" -> grp3 x >>= dispc
	"kmg" -> grp3 x >>= dispg
	_ -> return ()
	u xs x = reverse $ take (length xs -1) x
	dispc xs = disp4 xs $ u xs c
	dispk xs | length xs >= 14 =putStr "無量大数"
	| otherwise = disp3 xs $ u xs k
	dispg xs | length xs >= 10 =putStr "BIGNUM"
	| otherwise = disp4 xs $ u xs kmg
	disp4 (x:xs) [] = putStr x
	disp4 (x:xs) (y:ys) = do
	putStr x
	putChar y
	disp4 xs ys
	disp3 (x:xs) [] = disp2 x
	disp3 (("0000"):xs) (y:ys) = do{putStr "" ;disp3 xs ys;}
	disp3 (x:xs) (y:ys) = do
	disp2 x
	putChar y
	disp3 xs ys
	disp2 "0000" = putStr ""
	disp2 (x:xs) |x /= '0' = putStr (x:xs)
	|otherwise = disp2 xs
	grp4 xs = return $ restore $ grp 4 xs []
	grp3 xs = return $ restore $ grp 3 xs []
	grp n [] ys = ys
	grp n xs ys = grp n (drop n xs) (take n xs : ys)
	toInt :: String -> Integer
	toInt = read
	titles = ["Chinese numerals","giga,mega,kilo","xxx,xxx,xxx"]
	main = do
	c <- getContents
	let i = toInt c
	initGUI
	w <- windowNew
	vBox <- vBoxNew False 0
	containerAdd w vBox
	set w[windowTitle := "漢数字変換",
	windowWindowPosition := WinPosCenter,
	windowDefaultWidth := 500, windowDefaultHeight := 50]
	e <- entryNew
	set e [entryText := (show i)]
	e `on` entryActivate $ do
	f0 e
	f1 e
	f2 e
	bs <- mapM buttonNewWithLabel titles
	containerAdd vBox e
	mapM_ (containerAdd vBox) bs
	zipWithM (\b f -> (b `on` buttonActivated) (f e)) bs [f0,f1,f2]
	widgetShowAll w
	w `on` unrealize $ mainQuit
	mainGUI
	f0 e = f' "k" e
	f1 e = f' "kmg" e
	f2 e = f' "c" e
	f' t e = get e entryText >>= rn >>= disp t >> putChar '\n'

view raw kNum.hs hosted with ❤ by GitHub

整数限定です。

$ echo "123456789" | runghc kNum.hs