第二十三章：用 gtk2hs 進(jìn)行圖形界面編程

安裝 gtk2hs?

在我們研究如何使用 gtk2hs 工作前，需要先安裝它。在大多數(shù) Linux，BSD，或者其它 POSIX 平臺(tái)，有已經(jīng)打包好的 gtk2hs 安裝包。你一般需要安裝 GTK+ 開(kāi)發(fā)環(huán)境，Glade，和 gtk2hs。安裝的細(xì)節(jié)不同版本各有不同。

使用 Windows 和 Mac 的開(kāi)發(fā)者應(yīng)該查閱 gtk2hs 下載站 。從下載 gtk2hs 開(kāi)始，然后你需要 Glade version 3 的版本。Mac 開(kāi)發(fā)者可以從 macports 找到，Windows 開(kāi)發(fā)者應(yīng)該查閱 sourceforge 。

概覽 GTK+ 開(kāi)發(fā)棧?

在深入代碼前，讓我們暫停一會(huì)考慮一下我們將要使用的系統(tǒng)的架構(gòu)。首先，我們使用的 GTK+ 是一個(gè)跨平臺(tái)的，用 C 語(yǔ)言來(lái)實(shí)現(xiàn)的 GUI 工具集?？梢耘茉?Windows，Mac，Linux，BSD 等等操作系統(tǒng)上。Gnome 桌面環(huán)境的下層就是用了它。

然后，我們使用的 Glade 是一個(gè)用戶(hù)界面設(shè)計(jì)工具，可以讓你用圖形化的方式來(lái)設(shè)計(jì)你應(yīng)用的窗口和對(duì)話(huà)框等。Glade 把你的設(shè)計(jì)保存在 XML 文件中，你的應(yīng)用程序會(huì)在運(yùn)行時(shí)加載這些 XML 文件。

最后使用的是 gtk2hs。這是一個(gè) GTK+，Glade 以及一些依賴(lài)庫(kù)的 Haskell 綁定。它只是很多編程語(yǔ)言對(duì) GTK+ 綁定的一種。

使用 Glade 進(jìn)行用戶(hù)界面設(shè)計(jì)?

在這一小節(jié)中，我們將為 第22章中開(kāi)發(fā)的播客下載器 開(kāi)發(fā)一個(gè)圖形界面版本。我們的第一項(xiàng)任務(wù)就是在 Glade 中設(shè)計(jì)圖形界面。當(dāng)我們完成設(shè)計(jì)時(shí)，我們將編寫(xiě) Haskell 代碼集成進(jìn)應(yīng)用中。

因?yàn)檫@是一本 Haskell 書(shū)，而不是一本圖形界面設(shè)計(jì)書(shū)，所以我們快速帶過(guò)前面的步驟。需要更多關(guān)于使用 Glade 設(shè)計(jì)圖形界面的信息，你可以參考下面的資源：

• Glade 主頁(yè) ，包含了 Glade 的文檔。
• GTK+ 的主頁(yè) 包含了不同窗口小部件的信息。參考文檔章節(jié)，然后進(jìn)入穩(wěn)定版 GTK 文檔的區(qū)域。
• gtk2hs 主頁(yè) 也有很有用的文檔，包含了 gtk2hs 的 API 參考和一個(gè) glade 的教程。

Glade 基本概念?

Glade 是一個(gè)圖形界面設(shè)計(jì)工具。讓我們用圖形界面的方式來(lái)設(shè)計(jì)圖形界面。我們可以使用一堆 GTK+ 的函數(shù)來(lái)創(chuàng)建窗口組件，但更簡(jiǎn)單的方式是使用 Glade。

我們要使用 GTK+ 來(lái)開(kāi)發(fā)的基礎(chǔ)的東西叫窗口小部件。一個(gè)窗口小部件代表了 GUI 的一部分，可能這個(gè)小部件還包含了別的小部件。比如一些小部件包含了一個(gè)窗口，對(duì)話(huà)框，按鈕，以及帶文字的按鈕。

我們?cè)?Glade 中初始化小部件樹(shù)，最高級(jí)的窗口在樹(shù)的根部。你可以把 Glade 和小部件想象成 HTML：你可以像 table 布局一樣排列組件，然后設(shè)置 padding 規(guī)則，然后組織完整的繼承邏輯。

Glade 把組件描述保存在 XML 文件中。我們的程序在運(yùn)行時(shí)加載這些文件。我們通過(guò)指定名字從 Glade 運(yùn)行時(shí)庫(kù)中加載對(duì)應(yīng)的組件。

下面是一個(gè)使用 Glade 設(shè)計(jì)我們應(yīng)用主界面的截圖：

在本書(shū)的附加下載材料中，你可以找到完整的 Glade XML 文件(podresources.glade)，然后你可以加載它或者按你希望的修改它。

基于事件編程?

GTK+ 就像其它的 GUI 工具集一樣，是事件驅(qū)動(dòng)的工具集。這就意味著，我們不是要顯示一個(gè)對(duì)話(huà)框，然后等待用戶(hù)點(diǎn)擊按鈕，相反的，我們是要告訴 gtk2hs 當(dāng)點(diǎn)擊某個(gè)按鈕時(shí)要調(diào)用什么函數(shù)，而不是坐在那兒等待點(diǎn)擊對(duì)話(huà)框。

這跟傳統(tǒng)的控制臺(tái)編程是不同的模式。一個(gè) GUI 程序應(yīng)該有多個(gè)窗口打開(kāi)，但坐在那兒編寫(xiě)代碼來(lái)組合輸入特性組合的打開(kāi)窗口是一個(gè)復(fù)雜的命題。

事件驅(qū)動(dòng)編程很好的補(bǔ)充了 Haskell。就像我們?cè)跁?shū)中一遍又一遍的討論，函數(shù)是語(yǔ)言通過(guò)傳遞函數(shù)來(lái)繁榮昌盛。所以當(dāng)某些事件發(fā)生時(shí)，我們將調(diào)用傳給 gtk2hs 的函數(shù)。這種做法被稱(chēng)為回調(diào)函數(shù)。

GTK+ 程序的核心是主循環(huán)(main loop)。這部分程序等待用戶(hù)或者程序命令運(yùn)行，然后執(zhí)行它們。GTK+ 的主循環(huán)由 GTK+ 來(lái)掌控。對(duì)于我們來(lái)說(shuō)，它看起來(lái)就像一個(gè) I/O 操作，我們執(zhí)行命令，然后知道主循環(huán)執(zhí)行到我們的命令才返回結(jié)果(即不立即返回)。

因?yàn)橹餮h(huán)負(fù)責(zé)響應(yīng)一切的點(diǎn)擊鼠標(biāo)重繪窗口事件，所以它必須始終是可用狀態(tài)的。我們不能執(zhí)行一個(gè)很耗時(shí)的任務(wù) – 比如在主循環(huán)中下載一個(gè)播客節(jié)目。這會(huì)使得 GUI 出于無(wú)法響應(yīng)的狀態(tài)，所有的動(dòng)作比如點(diǎn)擊取消按鈕將不會(huì)被及時(shí)的執(zhí)行。

所以，我們將使用多線程來(lái)處理這些耗時(shí)任務(wù)。更多關(guān)于多線程的信息請(qǐng)查看[本書(shū)第24章]()。現(xiàn)在，你只需要知道我們將使用 forkIO 來(lái)創(chuàng)建新的線程來(lái)處理像下載播客的節(jié)目單和節(jié)目。對(duì)于很快的任務(wù)，像是添加一個(gè)播客到數(shù)據(jù)庫(kù)里，就不用新開(kāi)一個(gè)線程來(lái)處理了，因?yàn)樗斓接脩?hù)無(wú)法感知。

初始化 GUI?

第一步我們先來(lái)初始化我們的 GUI 項(xiàng)目。我們將創(chuàng)建一個(gè)小文件 PodLocalMain.hs 然后加載 PodMain 然后把它的路徑傳到 podresources.glade，這個(gè)被 Glade 保存的 XML 文件提供了我們的 GUI 組件的信息，這么做的原因我們將在 [使用 Cabal]() 這一章中解釋。

-- file: ch23/PodLocalMain.hs
module Main where
import qualified PodMainGUI
main = PodMainGUI.main "podresources.glade"

現(xiàn)在讓我們來(lái)考慮一下 PodMainGUI.hs 該怎么寫(xiě)。這個(gè)文件是我們?cè)?第 22 章 的例子基礎(chǔ)上唯一要修改的文件，我們修改它以便于讓它可以作為 GUI 工作。我們先把 PodMainGUI.hs 重命名為 PodMain.hs 使它更加清晰。

-- file: ch23/PodMainGUI.hs
module PodMainGUI where

import PodDownload
import PodDB
import PodTypes
import System.Environment
import Database.HDBC
import Network.Socket(withSocketsDo)

-- GUI libraries

import Graphics.UI.Gtk hiding (disconnect)
import Graphics.UI.Gtk.Glade

-- Threading

import Control.Concurrent

PodMainGUI.hs 的第一部分跟非GUI版本基本相同。我們引入三個(gè)附加的組件，首先，我們引入 Graphics.UI.Gtk，它提供了我們需要使用的大部分 GTK+ 函數(shù)。這個(gè)模塊和叫 Database.HDBC 的模塊都提供了一個(gè)函數(shù)叫 disconnect。我們將使用 HDBC 版本提供的，而不是 GTK+ 版本的，所以我們不從 Graphics.UI.Gtk 導(dǎo)入這個(gè)函數(shù)。Graphics.UI.Gtk.Glade 包含了需要加載的函數(shù)且可以跟我們的 Glade 文件協(xié)同工作。

然后我們引入 Control.Concurrent，它提供了多線程編程的基礎(chǔ)。我們從這里開(kāi)始將使用少量的函數(shù)來(lái)描述上面提到的功能。接下來(lái)，讓我們定義一個(gè)類(lèi)型來(lái)存儲(chǔ)我們的 GUI 信息。

-- file: ch23/PodMainGUI.hs
-- | Our main GUI type
data GUI = GUI {
      mainWin :: Window,
      mwAddBt :: Button,
      mwUpdateBt :: Button,
      mwDownloadBt :: Button,
      mwFetchBt :: Button,
      mwExitBt :: Button,
      statusWin :: Dialog,
      swOKBt :: Button,
      swCancelBt :: Button,
      swLabel :: Label,
      addWin :: Dialog,
      awOKBt :: Button,
      awCancelBt :: Button,
      awEntry :: Entry}

我們的新 GUI 類(lèi)型存儲(chǔ)所有我們?cè)诔绦蛑行枰P(guān)心的組件。即使是規(guī)模較大的程序，通常也不會(huì)用到這么單一而龐大的類(lèi)型。但是對(duì)于這個(gè)小示例來(lái)說(shuō)，單一類(lèi)型更容易在函數(shù)之間傳遞，并使得我們可以隨時(shí)拿到所需的信息，因此我們不妨在這里開(kāi)個(gè)特例。

這個(gè)類(lèi)型記錄中，我們有 Window(頂層窗口)， Dialog(對(duì)話(huà)框窗口)， Button(可被點(diǎn)擊的按鈕)， Label(文本)，以及 Entry(用戶(hù)輸入文本的地方)。讓我們馬上看一下 main 函數(shù)：

-- file: ch23/PodMainGUI.hs
main :: FilePath -> IO ()
main gladepath = withSocketsDo $ handleSqlError $
    do initGUI                  -- Initialize GTK+ engine

       -- Every so often, we try to run other threads.
       timeoutAddFull (yield >> return True)
                      priorityDefaultIdle 100

       -- Load the GUI from the Glade file
       gui <- loadGlade gladepath

       -- Connect to the database
       dbh <- connect "pod.db"

       -- Set up our events
       connectGui gui dbh

       -- Run the GTK+ main loop; exits after GUI is done
       mainGUI

       -- Disconnect from the database at the end
       disconnect dbh

注意這里的 main 函數(shù)的類(lèi)型與通常的優(yōu)點(diǎn)區(qū)別，因?yàn)樗?strong>PodLocalMain.hs中的 main 調(diào)用。我們一開(kāi)始調(diào)用了 initGUI 來(lái)初始化 GTK+ 系統(tǒng)。接下來(lái)我們調(diào)用了 timeoutAddFull。這個(gè)調(diào)用只有在進(jìn)行多線程 GTK+ 編程才需要。它告訴 GTK+ 的主循環(huán)時(shí)不時(shí)地給其它線程機(jī)會(huì)去執(zhí)行。

之后，我們調(diào)用 loadGlade 函數(shù)(見(jiàn)下面的代碼)來(lái)加載我們的 Glade XML 文件。接著，我們連接數(shù)據(jù)庫(kù)并調(diào)用 connectGui 函數(shù)來(lái)設(shè)置我們的回調(diào)函數(shù)。然后，我們啟動(dòng) GTK+ 主循環(huán)。我們期望它在 mainGUI 返回之前可能執(zhí)行數(shù)分鐘，數(shù)小時(shí)，甚至是數(shù)天。當(dāng) mainGUI 返回時(shí)，它表示用戶(hù)已經(jīng)關(guān)閉了主窗口或者是點(diǎn)擊了退出按鈕。這時(shí)，我們關(guān)閉數(shù)據(jù)庫(kù)連接并且結(jié)束程序。現(xiàn)在，來(lái)看看 loadGlade 函數(shù)：

-- file: ch23/PodMainGUI.hs
loadGlade gladepath =
    do -- Load XML from glade path.
       -- Note: crashes with a runtime error on console if fails!
       Just xml <- xmlNew gladepath

       -- Load main window
       mw <- xmlGetWidget xml castToWindow "mainWindow"

       -- Load all buttons

       [mwAdd, mwUpdate, mwDownload, mwFetch, mwExit, swOK, swCancel,
        auOK, auCancel] <-
           mapM (xmlGetWidget xml castToButton)
           ["addButton", "updateButton", "downloadButton",
            "fetchButton", "exitButton", "okButton", "cancelButton",
            "auOK", "auCancel"]

       sw <- xmlGetWidget xml castToDialog "statusDialog"
       swl <- xmlGetWidget xml castToLabel "statusLabel"

       au <- xmlGetWidget xml castToDialog "addDialog"
       aue <- xmlGetWidget xml castToEntry "auEntry"

       return $ GUI mw mwAdd mwUpdate mwDownload mwFetch mwExit
              sw swOK swCancel swl au auOK auCancel aue

這個(gè)函數(shù)從調(diào)用 xmlNew 開(kāi)始來(lái)加載 Glade XML 文件。當(dāng)發(fā)生錯(cuò)誤時(shí)它返回 Nothing。當(dāng)執(zhí)行成功時(shí)我們用模式匹配來(lái)獲取結(jié)果值。如果失敗，那么命令行將會(huì)有異常被輸出；這是這一章結(jié)束的練習(xí)題之一。

現(xiàn)在 Glade XML 文件已經(jīng)被加載了，你將看到一大堆 xmlGetWidget 的函數(shù)調(diào)用。這個(gè) Glade 函數(shù)被用來(lái)加載一個(gè)組件的 XML 定義，同時(shí)返回一個(gè) GTK+ 組件類(lèi)型給對(duì)應(yīng)的組件。我們將傳給這個(gè)函數(shù)一個(gè)值來(lái)指出我們期望的 GTK+ 類(lèi)型 – 當(dāng)類(lèi)型不匹配的時(shí)候會(huì)得到一個(gè)運(yùn)行時(shí)錯(cuò)誤。

我們開(kāi)始在主窗口創(chuàng)建一個(gè)組件。它在 XML 里被定義為 mainWindow 并被加載，然后存到 mw 這個(gè)變量里。接著我們通過(guò)模式匹配和 mapM 來(lái)加載所有的按鈕。然后，我們有了兩個(gè)對(duì)話(huà)框，一個(gè)標(biāo)簽，和一個(gè)被加載的實(shí)體。最后，我們使用所有的這些來(lái)建立 GUI 類(lèi)型并且返回。接下來(lái)，我們?cè)O(shè)置回調(diào)函數(shù)作為事件控制器：

-- file: ch23/PodMainGUI.hs
connectGui gui dbh =
    do -- When the close button is clicked, terminate GUI loop
       -- by calling GTK mainQuit function
       onDestroy (mainWin gui) mainQuit

       -- Main window buttons
       onClicked (mwAddBt gui) (guiAdd gui dbh)
       onClicked (mwUpdateBt gui) (guiUpdate gui dbh)
       onClicked (mwDownloadBt gui) (guiDownload gui dbh)
       onClicked (mwFetchBt gui) (guiFetch gui dbh)
       onClicked (mwExitBt gui) mainQuit

       -- We leave the status window buttons for later

我們通過(guò)調(diào)用 onDestroy 來(lái)開(kāi)始調(diào)用 connectGui 函數(shù)。這意味著當(dāng)某個(gè)人點(diǎn)擊了操作系統(tǒng)的關(guān)閉按鈕(在 Windows 或者 Linux 上 是標(biāo)題欄上面的 X 標(biāo)志，在 Mac OS X 上 是紅色的圓點(diǎn))，我們?cè)谥鞔翱谡{(diào)用 mainQuit 函數(shù)。mainQuit 關(guān)閉所有的 GUI 窗口然后結(jié)束 GTK+ 主循環(huán)。

接下來(lái)，我們調(diào)用 onClicked 對(duì)五個(gè)不同按鈕的點(diǎn)擊來(lái)注冊(cè)事件控制器。對(duì)于每個(gè)按鈕，當(dāng)用戶(hù)通過(guò)鍵盤(pán)選擇按鈕時(shí)控制器同樣會(huì)被觸發(fā)。點(diǎn)擊這些按鈕將會(huì)調(diào)用比如 guiAdd 這樣的函數(shù)，傳遞 GUI 記錄以及一個(gè)對(duì)數(shù)據(jù)庫(kù)的調(diào)用。

現(xiàn)在，我們完整地定義了我們 GUI 播客的主窗口。它看起來(lái)像下面的截圖。

增加播客窗口?

現(xiàn)在，我們已經(jīng)完整介紹了主窗口，讓我們來(lái)介紹別的需要呈現(xiàn)的窗口，從增加播客窗口開(kāi)始。當(dāng)用戶(hù)點(diǎn)擊增加一個(gè)播客的時(shí)候，我們需要彈出一個(gè)對(duì)話(huà)框來(lái)提示輸入播客的 URL。我們已經(jīng)在 Glade 中定義了這個(gè)對(duì)話(huà)框，所以接下來(lái)需要做的就是設(shè)置它：

-- file: ch23/PodMainGUI.hs
guiAdd gui dbh =
    do -- Initialize the add URL window
       entrySetText (awEntry gui) ""
       onClicked (awCancelBt gui) (widgetHide (addWin gui))
       onClicked (awOKBt gui) procOK

       -- Show the add URL window
       windowPresent (addWin gui)
       where procOK =
           do url <- entryGetText (awEntry gui)
               widgetHide (addWin gui) -- Remove the dialog
               add dbh url             -- Add to the DB

我們通過(guò)調(diào)用 entrySetText 來(lái)設(shè)置輸入框(用戶(hù)填寫(xiě)播客 URL 的地方)的內(nèi)容，讓我們先設(shè)置為一個(gè)空字符串。這是因?yàn)檫@個(gè)組件在我們程序的生命周期中會(huì)被復(fù)用，所以我們不希望用戶(hù)最后添加的 URL 被留在輸入框中。接下來(lái)，我們?cè)O(shè)置對(duì)話(huà)框中兩個(gè)按鈕的事件。如果用戶(hù)點(diǎn)擊取消按鈕，我們就調(diào)用 widgetHide 函數(shù)來(lái)從屏幕上移除這個(gè)對(duì)話(huà)框。如果用戶(hù)點(diǎn)擊了 OK按鈕，我們調(diào)用 procOK。

procOK 先獲取輸入框中提供的 URL。接下來(lái)，它用 widgetHide 函數(shù)來(lái)隱藏輸入框，最后它調(diào)用 add 函數(shù)來(lái)往輸入庫(kù)里增加 URL。這個(gè) add 函數(shù)跟我們沒(méi)有 GUI 版本的程序中的一樣。

我們?cè)?guiAdd 里做的最后一件事是彈出窗口，這個(gè)通過(guò)調(diào)用 windowPresent 來(lái)做，這個(gè)函數(shù)功能正好跟 widgetHide 相反。

注意 guiAdd 函數(shù)會(huì)立即返回。它只是設(shè)置組件并且讓輸入框顯示出來(lái)；它不會(huì)阻塞自己等待輸入。下圖顯示了對(duì)話(huà)框看起來(lái)是什么樣的。

長(zhǎng)時(shí)間執(zhí)行的任務(wù)?

在主窗口的按鈕中，有三個(gè)點(diǎn)擊之后的任務(wù)是需要等一會(huì)才會(huì)完成的，這三個(gè)分別是 更新(update)，下載(download)，已經(jīng)獲取(fetch)。當(dāng)這些操作發(fā)生時(shí)，我們希望做兩件事：提供給用戶(hù)當(dāng)前操作的進(jìn)度，以及可以取消當(dāng)前正在執(zhí)行的操作的功能。

因?yàn)檫@些操作都非常類(lèi)似，所以可以提供一個(gè)通用的處理方式來(lái)處理這些交互。我們已經(jīng)在 Glade 文件中定義了一個(gè)狀態(tài)窗口組件，這個(gè)組件將會(huì)被這三個(gè)操作使用。在我們的 Haskell 代碼中，我們定義了一個(gè)通用的 statusWindow 函數(shù)來(lái)同時(shí)被這三個(gè)操作使用。

statusWindow 需要 4 個(gè)參數(shù)：GUI 信息，數(shù)據(jù)庫(kù)信息，表示該窗口標(biāo)題的字符串，一個(gè)執(zhí)行操作的函數(shù)。這個(gè)函數(shù)自己將會(huì)被當(dāng)做參數(shù)傳遞給匯報(bào)進(jìn)度的那個(gè)函數(shù)。下面是代碼：

-- file: ch23/PodMainGUI.hs
statusWindow :: IConnection conn =>
                GUI
             -> conn
             -> String
             -> ((String -> IO ()) -> IO ())
             -> IO ()
statusWindow gui dbh title func =
    do -- Clear the status text
       labelSetText (swLabel gui) ""

       -- Disable the OK button, enable Cancel button
       widgetSetSensitivity (swOKBt gui) False
       widgetSetSensitivity (swCancelBt gui) True

       -- Set the title
       windowSetTitle (statusWin gui) title

       -- Start the operation
       childThread <- forkIO childTasks

       -- Define what happens when clicking on Cancel
       onClicked (swCancelBt gui) (cancelChild childThread)

       -- Show the window
       windowPresent (statusWin gui)
    where childTasks =
              do updateLabel "Starting thread..."
                 func updateLabel
                 -- After the child task finishes, enable OK
                 -- and disable Cancel
                 enableOK

          enableOK =
      do widgetSetSensitivity (swCancelBt gui) False
         widgetSetSensitivity (swOKBt gui) True
         onClicked (swOKBt gui) (widgetHide (statusWin gui))
         return ()

  updateLabel text =
      labelSetText (swLabel gui) text
  cancelChild childThread =
      do killThread childThread
         yield
         updateLabel "Action has been cancelled."
         enableOK

這個(gè)函數(shù)一開(kāi)始清理了它上次運(yùn)行時(shí)的標(biāo)簽內(nèi)容。接下來(lái)，我們使 OK 按鈕不可被點(diǎn)擊(變灰色)，同時(shí)使取消按鈕可被點(diǎn)擊。當(dāng)操作在進(jìn)行中時(shí)，點(diǎn)擊 OK 按鈕不起任何作用，當(dāng)操作結(jié)束后，點(diǎn)擊取消按鈕不起任何作用。

接著，我們?cè)O(shè)置窗口的標(biāo)題。這個(gè)標(biāo)題會(huì)出現(xiàn)在系統(tǒng)顯示的窗口標(biāo)題欄中。最后，我們啟動(dòng)一個(gè)新的線程(通過(guò)調(diào)用 childTasks)，然后保存這個(gè)線程ID。然后，我們定義當(dāng)用戶(hù)點(diǎn)擊取消按鈕之后的行為 – 我們調(diào)用 cancelChild 傳入線程 ID。最后，我們調(diào)用 windowPresent 來(lái)顯示進(jìn)度窗口。

在子任務(wù)中，我們顯示一條信息來(lái)說(shuō)明我們正在啟動(dòng)線程。然后我們調(diào)用真正的工作函數(shù)，傳入 updateLabel 函數(shù)來(lái)顯示狀態(tài)信息。注意命令行版本的程序可以傳入 putStrLn 函數(shù)。

最后，當(dāng)工作函數(shù)退出后，我們調(diào)用 enableOK 函數(shù)。這個(gè)函數(shù)使取消按鈕變得不可被點(diǎn)擊，并且讓 OK 按鈕變得可點(diǎn)擊，順便定義在點(diǎn)擊 OK 按鈕時(shí)候的行為 – 讓進(jìn)度窗口消失。

updateLabel 簡(jiǎn)單地調(diào)用在標(biāo)簽組件上的 labelSetText 函數(shù)來(lái)更新標(biāo)簽顯示信息。最后，cancelChild 函數(shù)被調(diào)用來(lái)殺死執(zhí)行任務(wù)的線程，更新標(biāo)簽信息，并且使 OK 按鈕可被點(diǎn)擊。

現(xiàn)在我們需要的基礎(chǔ)功能都就位了。他們看起來(lái)像下面這樣：

-- file: ch23/PodMainGUI.hs
guiUpdate :: IConnection conn => GUI -> conn -> IO ()
guiUpdate gui dbh =
    statusWindow gui dbh "Pod: Update" (update dbh)

guiDownload gui dbh =
    statusWindow gui dbh "Pod: Download" (download dbh)

guiFetch gui dbh =
    statusWindow gui dbh "Pod: Fetch"
                     (\logf -> update dbh logf >> download dbh logf)

我們只給出了第一個(gè)函數(shù)的類(lèi)型，但是其實(shí)三個(gè)函數(shù)類(lèi)型都是相同的，Haskell 可以通過(guò)類(lèi)型推斷來(lái)推導(dǎo)出它們的類(lèi)型。注意我們實(shí)現(xiàn)的 guiFetch 函數(shù)，我們不用調(diào)用兩次 statusWindow 函數(shù)，相反，我們?cè)谒牟僮髦薪M合函數(shù)來(lái)實(shí)現(xiàn)。

最后一點(diǎn)構(gòu)成三個(gè)函數(shù)的部分是真正做想要的工作。add 函數(shù)是命令行版本直接拿過(guò)來(lái)的，沒(méi)有任何修改。update 和 download 函數(shù)僅僅修改了一小部分 – 通過(guò)一個(gè)記錄函數(shù)(logging function)來(lái)取代調(diào)用 putStrLn 函數(shù)來(lái)更新進(jìn)度狀態(tài)。

-- file: ch23/PodMainGUI.hs
add dbh url =
    do addPodcast dbh pc
       commit dbh
    where pc = Podcast {castId = 0, castURL = url}

update :: IConnection conn => conn -> (String -> IO ()) -> IO ()
update dbh logf =
    do pclist <- getPodcasts dbh
       mapM_ procPodcast pclist
       logf "Update complete."
    where procPodcast pc =
              do logf $ "Updating from " ++ (castURL pc)
                 updatePodcastFromFeed dbh pc

download dbh logf =
    do pclist <- getPodcasts dbh
       mapM_ procPodcast pclist
       logf "Download complete."
    where procPodcast pc =
              do logf $ "Considering " ++ (castURL pc)
                 episodelist <- getPodcastEpisodes dbh pc
                 let dleps = filter (\ep -> epDone ep == False)
                             episodelist
                 mapM_ procEpisode dleps
          procEpisode ep =
              do logf $ "Downloading " ++ (epURL ep)
                 getEpisode dbh ep

下圖展示了更新操作執(zhí)行完成的結(jié)果是什么樣子的。

使用 Cabal?

我們通過(guò)一個(gè) Cabal 文件來(lái)構(gòu)建我們命令行版本的項(xiàng)目。我們需要做一些修改來(lái)讓它支持構(gòu)建我們 GUI 版本的項(xiàng)目。首先我們需要增加 gtk2hs 包的依賴(lài)。當(dāng)然還有 Glade XML 文件的問(wèn)題。

在前面，我們寫(xiě)了PodLocalMain.hs文件來(lái)假定配置文件叫 podresources.glade，然后把它存到當(dāng)前目錄下。但是對(duì)于真正的系統(tǒng)安裝來(lái)說(shuō)，我們不能做這個(gè)假設(shè)。而且，不同的操作系統(tǒng)會(huì)把文件放到不同的路徑下。

Cabal 提供了處理這個(gè)問(wèn)題的方法。它自動(dòng)生成一個(gè)模塊，這個(gè)模塊可以通過(guò)導(dǎo)出函數(shù)來(lái)查詢(xún)環(huán)境變量。我們必須在 Cabal 依賴(lài)文件里增加一行 Data-files。這個(gè)文件名稱(chēng)表示了所有需要一同安裝的數(shù)據(jù)文件。然后，Cabal 將會(huì)導(dǎo)出一個(gè) Paths_pod 模塊(pod 部分來(lái)自 Cabal文件中的 Name 行)，我們可以使用這個(gè)模塊來(lái)在運(yùn)行時(shí)查看文件路徑。下面是我們新的 Cabal 依賴(lài)文件：

-- ch24/pod.cabal
name: pod
Version: 1.0.0
Build-type: Simple
Build-Depends: HTTP, HaXml, network, HDBC, HDBC-sqlite3, base,
               gtk, glade
Data-files: podresources.glade

Executable: pod
Main-Is: PodCabalMain.hs
GHC-Options: -O2

當(dāng)然還有 PodCabalMain.hs：

-- file: ch23/PodCabalMain.hs
module Main where

import qualified PodMainGUI
import Paths_pod(getDataFileName)

main =
    do gladefn <- getDataFileName "podresources.glade"
       PodMainGUI.main gladefn

練習(xí)?

1. 如果調(diào)用 xmlNew 返回了 Nothging，顯示一個(gè)圖形話(huà)的出錯(cuò)信息。
2. 修改項(xiàng)目來(lái)實(shí)現(xiàn)在同一個(gè)代碼倉(cāng)庫(kù)既可以使用圖形界面的方式，又可以選擇命令行模式來(lái)運(yùn)行程序。提示：把通用代碼移出 PodMainGUI.hs，然后創(chuàng)建兩個(gè) main 模塊，一個(gè)為圖形界面服務(wù)，一個(gè)為命令行服務(wù)。
3. 為什么 guiFetch 函數(shù)組合工作函數(shù)而不是調(diào)用 statusWindow 兩次？