フォームを閉じるとき終了確認をする（wxHaskell）

フォームを閉じるときにダイアログで終了の確認をします。

--  ghc --make Main.hs -o confirm.exe
module Main where

-- ライブラリを学習するためになるべく丁寧に依存先を書きました。
import Graphics.UI.WX            (start)
import Graphics.UI.WX.Events     (on, command, closing)
import Graphics.UI.WX.Types      (fontFixed, _fontSize, _fontFace,sz)
import Graphics.UI.WX.Attributes (Prop(..), get, set)
import Graphics.UI.WX.Classes    (Textual, appendText, visible, clientSize, enabled, font, fontFace,selection, text,
                                  close, closeable,minimizeable )
import Graphics.UI.WX.Layout     (container, widget, minsize, layout, row, hfill, column, floatRight,
                                  Widget, Layout, margin)
import Graphics.UI.WX.Controls   (Wrap(..), staticText, textCtrl, button, wrap, panel)
import Graphics.UI.WX.Frame      (frame)
import Graphics.UI.WX.Dialogs    (confirmDialog)
import Graphics.UI.WXCore.Frame  (frameCenter)
import Graphics.UI.WXCore.WxcClassTypes (Window)
import Graphics.UI.WXCore.WxcClassesMZ (wxcAppExit)
import Control.Monad             (when)
import Graphics.UI.WXCore        (textCtrlClear)
import Data.DateTime             (fromClockTime)
import System.Time               (getClockTime)

-- 本体は前回と同じ時刻を表示するプログラムです。
main :: IO ()
main = start gui

gui :: IO ()
gui = do 
    -- 最初、visible を Falseにしてセンタリングしてから True にすると
    -- 無駄な描写が表示されないですっきりします。
    form    <- frame [text := "Message test", visible := False]
    p       <- panel form []
    textlog <- textCtrl p [enabled := True, wrap := WrapNone, font := fontFixed{ _fontSize=11,_fontFace = "Monospace"} ] 
    ok   <- button p [text := "実行",   on command := doCommand textlog]
    clr  <- button p [text := "クリア", on command := textCtrlClear textlog, clientSize := sz 50 24]
    quit <- button p [text := "終了" , on command := close form,clientSize := sz 50 24]
    set ok   [clientSize := sz 50 24 ]
    set form [layout :=
                container p $
                  column 0
                    [floatRight 
                       (margin 10 $ row 5 [widget ok, widget clr, widget quit])
                 , hfill $ minsize (sz 350 250) $ widget textlog ]
             , clientSize := sz 350 300]
    frameCenter form
    -- closing イベントのときの動作を登録。
    -- フォームを可視化します。
    set form [on closing := confirmExit form, visible := True]
    return ()

-- 確認ダイアログ。
confirmExit :: Window a -> IO ()
confirmExit form = do
    yes <- confirmDialog form "終了確認" "終了しますか？" True
    -- when は yes が True のとき次の wxcAppExit を評価し、
    -- それ以外は何もしないという不思議なモナド。
    -- 反対の unless というものもある。
    when yes wxcAppExit
    return ()

doCommand :: (Textual w) => w -> IO ()
doCommand log = do 
    writeDate log 10
    writeText log "done.\n"

writeDate :: (Num t,Textual w) => w -> t -> IO ()
writeDate log 0 = return ()
writeDate log n = do
    ctime <- getClockTime
    writeText log $ show (fromClockTime ctime) ++ "\n"
    writeDate log (n-1)

writeText :: (Textual w) => w -> String -> IO ()
writeText log str = do
    appendText log str

elbrujohalcon / wxhnotepadを参考にしました。

-- unless は Bool と Monad を引数にして Monad を返す。
> :t unless
unless :: (Monad m) => Bool -> m () -> m ()

> let t = unless True  $ print 1
> let f = unless False $ print 1
-- t も f も IO ()
> :t t        --=> t :: IO ()
> :t f        --=> f :: IO ()
-- t は何もしないアクションで f は 1 を表示するアクション
> t
> f
1

追記：when yes wxcAppExit は以下と同等と気が付いてやってみたらOKでした･･･Orz

if  yes then wxcAppExit else return ()