Gtk2Hsで10進16進変換ツールを作ってみました

簡単に10進数と16進数を変換するツールを作ってみました。
使い方を説明します。

• 数値を入力してエンターを押すと、10進数と16進数を変換します。なお16進数の場合は0xで始めてください。
• 背景色が、入力文字列が変換可能な場合はライトグリーン、不可能な場合はピンクになります。
• qまたはQを入力文字列に入れてエンターを押すと、アプリケーションが終了します。
• スペースを入力文字列に入れてエンターを押すと、入力文字列がクリアされます。

スクリーンショットを右上に載せました。上から16進の0x2904を入力した場合、それを変換した場合、入力ミスがあった場合です。
ソースコードはこちらです。
ファイル: hexdec.hs

import Control.Monad
import Data.Char
import Data.List
import Graphics.UI.Gtk

main :: IO ()
main = do 
  initGUI
  entry  <- entryNew
  entrySetActivatesDefault entry True
  onEditableChanged entry $ validateInput entry
  onEntryActivate entry $ entryActivate entry
  entryModifyBaseOKColor entry

  window <- windowNew
  set window [windowTitle := "HexDec", containerChild := entry]
  onDestroy window mainQuit
  widgetShowAll window
  mainGUI

entryModifyBaseOKColor :: EntryClass ec => ec -> IO ()
entryModifyBaseOKColor entry = 
  widgetModifyBase entry StateNormal $ Color 0xaaaa 0xffff 0xaaaa

entryModifyBaseNGColor :: EntryClass ec => ec -> IO ()
entryModifyBaseNGColor entry = 
  widgetModifyBase entry StateNormal $ Color 0xffff 0xaaaa 0xaaaa

validateInput :: EntryClass ec => ec -> IO ()
validateInput entry = do
  text <- entryGetText entry
  if isValidStirng text
    then entryModifyBaseOKColor entry
    else entryModifyBaseNGColor entry

entryActivate :: EntryClass ec => ec -> IO ()
entryActivate entry = do
  text <- entryGetText entry
  if isValidStirng text
    then convertHexAndDec entry text
    else processSpecialCommand entry text

convertHexAndDec :: EntryClass ec => ec -> String -> IO ()
convertHexAndDec entry text = do
  entrySetText entry $ 
    if isHexString text
      then show $ stringToInteger text
      else integerToHexString $ stringToInteger text

processSpecialCommand :: EntryClass ec => ec -> String -> IO ()
processSpecialCommand entry text
  | any (\c -> c == 'q') text = mainQuit
  | any (\c -> c == 'Q') text = mainQuit
  | any (\c -> c == ' ') text = entrySetText entry ""
  | otherwise = return ()

isValidStirng :: String -> Bool
isValidStirng s =
  if isHexString s
    then all isHexDigit $ tail $ tail s
    else all isDigit s

isHexString :: String -> Bool
isHexString s = "0x" `isPrefixOf` s

integerToHexString :: Integer -> String
integerToHexString n =
  "0x" ++ integerToHexString' "" n
  where
    integerToHexString' :: String -> Integer -> String
    integerToHexString' s n
      | n < 16 = indexToHexString (fromInteger n) ++ s
      | otherwise = integerToHexString'
                      (indexToHexString (fromInteger (n `mod` 16)) ++ s)
                      (n `div` 16)

    indexToHexString :: Int -> String
    indexToHexString i = ["0123456789abcdef" !! i]

stringToInteger :: String -> Integer
stringToInteger s = (read :: String -> Integer) s

ファイル: Makefile

TARGET = hexdec

HC          = ghc
HCFLAGS     = -W -fno-warn-unused-matches --make
HCFLAGS_REL = -optl-mwindows
UPX         = upx
UPXFLAGS    = --overlay=strip --strip-relocs=0
EXE         = .exe

all: $(TARGET)_d$(EXE)
release: clean $(TARGET)$(EXE)

$(TARGET)_d$(EXE): $(TARGET).hs
	$(HC) $(HCFLAGS) $< -o $@

$(TARGET)$(EXE): $(TARGET).hs
	$(HC) $(HCFLAGS) $(HCFLAGS_REL) $< -o $@
	$(UPX) $(UPXFLAGS) $@

clean:
	rm -f $(TARGET)_d$(EXE) $(TARGET)$(EXE) *.o *.hi