第二十章：使用 Haskell 進(jìn)行系統(tǒng)編程

第二十章：使用 Haskell 進(jìn)行系統(tǒng)編程

目前為止，我們討論的大多數(shù)是高階概念。 Haskell 也可以用于底層系統(tǒng)編程。完全可以使用 Haskell 編寫使用操作系統(tǒng)底層接口的程序。

本章中，我們將嘗試一些很有野心的東西：編寫一種類似 Perl 實(shí)際上是合法的 Haskell 的“語言”，完全使用 Haskell 實(shí)現(xiàn)，用于簡化編寫 shell 腳本。我們將實(shí)現(xiàn)管道，簡單命令調(diào)用，和一些簡單的工具用于執(zhí)行由 grep 和 sed 處理的任務(wù)。

有些模塊是依賴操作系統(tǒng)的。本章中，我們將盡可能使用不依賴特殊操作系統(tǒng)的通用模塊。不過，本章將有很多內(nèi)容著眼于 POSIX 環(huán)境。 POSIX 是一種類 Unix 標(biāo)準(zhǔn)， 如 Linux ，F(xiàn)reeBSD ，MacOS X ，或 Solaris 。Windows 默認(rèn)情況下不支持 POSIX ，但是 Cygwin 環(huán)境為 Windows 提供了 POSIX 兼容層。

調(diào)用外部程序

Haskell 可以調(diào)用外部命令。為了這么做，我們建議使用 System.Cmd 模塊中的 rawSystem 。其用特定的參數(shù)調(diào)用特定的程序，并將返回程序的退出狀態(tài)碼。你可以在 ghci 中練習(xí)一下。

ghci> :module System.Cmd
ghci> rawSystem "ls" ["-l", "/usr"]
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Loading package filepath-1.1.0.0 ... linking ... done.
Loading package directory-1.0.0.0 ... linking ... done.
Loading package unix-2.3.0.0 ... linking ... done.
Loading package process-1.0.0.0 ... linking ... done.
total 124
drwxr-xr-x   2 root root  49152 2008-08-18 11:04 bin
drwxr-xr-x   2 root root   4096 2008-03-09 05:53 games
drwxr-sr-x  10 jimb guile  4096 2006-02-04 09:13 guile
drwxr-xr-x  47 root root   8192 2008-08-08 08:18 include
drwxr-xr-x 107 root root  32768 2008-08-18 11:04 lib
lrwxrwxrwx   1 root root      3 2007-09-24 16:55 lib64 -> lib
drwxrwsr-x  17 root staff  4096 2008-06-24 17:35 local
drwxr-xr-x   2 root root   8192 2008-08-18 11:03 sbin
drwxr-xr-x 181 root root   8192 2008-08-12 10:11 share
drwxrwsr-x   2 root src    4096 2007-04-10 16:28 src
drwxr-xr-x   3 root root   4096 2008-07-04 19:03 X11R6
ExitSuccess

此處，我們相當(dāng)于執(zhí)行了 shell 命令 ls-l/usr 。 rawSystem 并不從字符串解析輸入?yún)?shù)或是擴(kuò)展通配符 [43] 。取而代之，其接受一個(gè)包含所有參數(shù)的列表。如果不想提供參數(shù)，可以像這樣簡單地輸入一個(gè)空列表。

ghci> rawSystem "ls" []
calendartime.ghci  modtime.ghci    rp.ghci    RunProcessSimple.hs
cmd.ghci       posixtime.hs    rps.ghci   timediff.ghci
dir.ghci       rawSystem.ghci  RunProcess.hs  time.ghci
ExitSuccess

目錄和文件信息

System.Directory 模塊包含了相當(dāng)多可以從文件系統(tǒng)獲取信息的函數(shù)。你可以獲取某目錄包含的文件列表，重命名或刪除文件，復(fù)制文件，改變當(dāng)前工作路徑，或者建立新目錄。 System.Directory 是可移植的，在可以跑 GHC 的平臺(tái)都可以使用。

System.Directory 的庫文檔 [http://hackage.haskell.org/package/directory-1.0.0.0/docs/System-Directory.html] 中含有一份詳盡的函數(shù)列表。讓我們通過 ghci 來對(duì)其中一些進(jìn)行演示。這些函數(shù)大多數(shù)簡單的等價(jià)于其對(duì)應(yīng)的 C 語言庫函數(shù)或 shell 命令。

ghci> :module System.Directory
ghci> setCurrentDirectory "/etc"
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Loading package filepath-1.1.0.0 ... linking ... done.
Loading package directory-1.0.0.0 ... linking ... done.
ghci> getCurrentDirectory
"/etc"
ghci> setCurrentDirectory ".."
ghci> getCurrentDirectory
"/"

此處我們看到了改變工作目錄和獲取當(dāng)前工作目錄的命令。它們類似 POSIX shell 中的 cd 和 pwd 命令。

ghci> getDirectoryContents "/"
[".","..","lost+found","boot","etc","media","initrd.img","var","usr","bin","dev","home","lib","mnt","proc","root","sbin","tmp","sys","lib64","srv","opt","initrd","vmlinuz",".rnd","www","ultra60","emul",".fonts.cache-1","selinux","razor-agent.log",".svn","initrd.img.old","vmlinuz.old","ugid-survey.bulkdata","ugid-survey.brief"]

getDirectoryContents 返回一個(gè)列表，包含給定目錄的所有內(nèi)容。注意，在 POSIX 系統(tǒng)中，這個(gè)列表通常包含特殊值 ”.” 和 ”..” 。通常在處理目錄內(nèi)容時(shí)，你可能會(huì)希望將他們過濾出去，像這樣：

ghci> getDirectoryContents "/" >>= return . filter (`notElem` [".", ".."])
["lost+found","boot","etc","media","initrd.img","var","usr","bin","dev","home","lib","mnt","proc","root","sbin","tmp","sys","lib64","srv","opt","initrd","vmlinuz",".rnd","www","ultra60","emul",".fonts.cache-1","selinux","razor-agent.log",".svn","initrd.img.old","vmlinuz.old","ugid-survey.bulkdata","ugid-survey.brief"]

Tip

更細(xì)致的討論如何過濾 getDirectoryContents 函數(shù)的結(jié)果，請(qǐng)參考 第八章：高效文件處理、正則表達(dá)式、文件名匹配

filter(notElem[".",".."]) 這段代碼是否有點(diǎn)莫名其妙？也可以寫作 filter(c->not$elemc[".",".."]) 。反引號(hào)讓我們更有效的將第二個(gè)參數(shù)傳給 notElem ；在 “中序函數(shù)” 一節(jié)中有關(guān)于反引號(hào)更詳細(xì)的信息。

也可以向系統(tǒng)查詢某些路徑的位置。這將向底層操作系統(tǒng)發(fā)起查詢相關(guān)信息。

ghci> getHomeDirectory
"/home/bos"
ghci> getAppUserDataDirectory "myApp"
"/home/bos/.myApp"
ghci> getUserDocumentsDirectory
"/home/bos"

終止程序

開發(fā)者經(jīng)常編寫?yīng)毩⒌某绦蛞酝瓿商囟ㄈ蝿?wù)。這些獨(dú)立的部分可能會(huì)被組合起來完成更大的任務(wù)。一段 shell 腳本或者其他程序?qū)?huì)執(zhí)行它們。發(fā)起調(diào)用的腳本需要獲知被調(diào)用程序是否執(zhí)行成功。 Haskell 自動(dòng)為異常退出的程序分配一個(gè) “不成功” 的狀態(tài)碼。

不過，你需要對(duì)狀態(tài)碼進(jìn)行更細(xì)粒度的控制?？赡苣阈枰獙?duì)不同類型的錯(cuò)誤返回不同的代碼。 System.Exit 模塊提供一個(gè)途徑可以在程序退出時(shí)返回特定的狀態(tài)碼。通過調(diào)用 exitWithExitSuccess 表示程序執(zhí)行成功（POSIX 系統(tǒng)中的 0）?；蛘呖梢哉{(diào)用 exitWith(ExitFailure5) ，表示將在程序退出時(shí)向系統(tǒng)返回 5 作為狀態(tài)碼。

日期和時(shí)間

從文件時(shí)間戳到商業(yè)事務(wù)的很多事情都涉及到日期和時(shí)間。 除了從系統(tǒng)獲取日期時(shí)間信息之外，Haskell 提供了很多關(guān)于時(shí)間日期的操作方法。

ClockTime 和 CalendarTime

在 Haskell 中，日期和時(shí)間主要由 System.Time 模塊處理。它定義了兩個(gè)類型： ClockTime 和 CalendarTime 。

ClockTime 是傳統(tǒng) POSIX 中時(shí)間戳的 Haskell 版本。 ClockTime 表示一個(gè)相對(duì)于 UTC 1970 年 1 月 1 日 零點(diǎn)的時(shí)間。負(fù)值的 ClockTime 表示在其之前的秒數(shù)，正值表示在其之后的秒數(shù)。

ClockTime 便于計(jì)算。因?yàn)樗裱瓍f(xié)調(diào)世界時(shí)（Coordinated Universal Time，UTC），其不必調(diào)整本地時(shí)區(qū)、夏令時(shí)或其他時(shí)間處理中的特例。每天是精確的 (60 60 24) 或 86,400 秒 [44]，這易于計(jì)算時(shí)間間隔。舉個(gè)例子，你可以簡單的記錄某個(gè)程序開始執(zhí)行的時(shí)間和其結(jié)束的時(shí)間，相減即可確定程序的執(zhí)行時(shí)間。如果需要的話，還可以除以 3600，這樣就可以按小時(shí)顯示。

使用 ClockTime 的典型場景：

• 經(jīng)過了多長時(shí)間？
• 相對(duì)此刻 14 天前是什么時(shí)間？
• 文件的最后修改時(shí)間是何時(shí)？
• 當(dāng)下的精確時(shí)間是何時(shí)？

ClockTime 善于處理這些問題，因?yàn)樗鼈兪褂脽o法混淆的精確時(shí)間。但是， ClockTime 不善于處理下列問題：

• 今天是周一嗎？
• 明年 5 月 1 日是周幾？
• 在我的時(shí)區(qū)當(dāng)前是什么時(shí)間，考慮夏令時(shí)。

CalendarTime 按人類的方式存儲(chǔ)時(shí)間：年，月，日，小時(shí)，分，秒，時(shí)區(qū)，夏令時(shí)信息。很容易的轉(zhuǎn)換為便于顯示的字符串，或者以上問題的答案。

你可以任意轉(zhuǎn)換 ClockTime 和 CalendarTime 。Haskell 將 ClockTime 可以按本地時(shí)區(qū)轉(zhuǎn)換為 CalendarTime ，或者按 CalendarTime 格式表示的 UTC 時(shí)間。

使用 ClockTime

ClockTime 在 System.Time 中這樣定義：

data ClockTime = TOD Integer Integer

第一個(gè) Integer 表示從 Unix 紀(jì)元開始經(jīng)過的秒數(shù)。第二個(gè) Integer 表示附加的皮秒數(shù)。因?yàn)?Haskell 中的 ClockTime 使用無邊界的 Integer 類型，所以其能夠表示的數(shù)據(jù)范圍僅受計(jì)算資源限制。

讓我們看看使用 ClockTime 的一些方法。首先是按系統(tǒng)時(shí)鐘獲取當(dāng)前時(shí)間的 getClockTime 函數(shù)。

ghci> :module System.Time
ghci> getClockTime
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Mon Aug 18 12:10:38 CDT 2008

如果一秒鐘再次運(yùn)行 getClockTime ，它將返回一個(gè)更新后的時(shí)間。這條命令會(huì)輸出一個(gè)便于觀察的字符串，補(bǔ)全了周相關(guān)的信息。這是由于 ClockTime 的 Show 實(shí)例。讓我們從更底層看一下 ClockTime ：

ghci> TOD 1000 0
Wed Dec 31 18:16:40 CST 1969
ghci> getClockTime >>= (\(TOD sec _) -> return sec)
1219079438

這里我們先構(gòu)建一個(gè) ClockTime ，表示 UTC 時(shí)間 1970 年 1 月 1 日午夜后 1000 秒這個(gè)時(shí)間點(diǎn)。在你的時(shí)區(qū)這個(gè)時(shí)間相當(dāng)于 1969 年 12 月 31 日晚。

第二個(gè)例子演示如何從 getClockTime 返值中將秒數(shù)取出來。我們可以像這樣操作它：

ghci> getClockTime >>= (\(TOD sec _) -> return (TOD (sec + 86400) 0))
Tue Aug 19 12:10:38 CDT 2008

這將顯精確示你的時(shí)區(qū) 24 小時(shí)后的時(shí)間，因?yàn)?24 小時(shí)等于 86,400 秒。

使用 CalendarTime

正如其名字暗示的， CalendarTime 按日歷上的方式表示時(shí)間。它包括年、月、日等信息。 CalendarTime 和其相關(guān)類型定義如下：

data CalendarTime = CalendarTime
   {ctYear :: Int,         -- Year (post-Gregorian)
    ctMonth :: Month,
    ctDay :: Int,          -- Day of the month (1 to 31)
    ctHour :: Int,         -- Hour of the day (0 to 23)
    ctMin :: Int,          -- Minutes (0 to 59)
    ctSec :: Int,          -- Seconds (0 to 61, allowing for leap seconds)
    ctPicosec :: Integer,  -- Picoseconds
    ctWDay :: Day,         -- Day of the week
    ctYDay :: Int,         -- Day of the year (0 to 364 or 365)
    ctTZName :: String,    -- Name of timezone
    ctTZ :: Int,           -- Variation from UTC in seconds
    ctIsDST :: Bool        -- True if Daylight Saving Time in effect
   }

data Month = January | February | March | April | May | June
             | July | August | September | October | November | December

data Day = Sunday | Monday | Tuesday | Wednesday
           | Thursday | Friday | Saturday

關(guān)于以上結(jié)構(gòu)有些事情需要強(qiáng)調(diào)：

• ctWDay, ctYDay, ctTZName 是被創(chuàng)建 CalendarTime 的庫函數(shù)生成的，但是并不參與計(jì)算。如果你手工創(chuàng)建一個(gè) CalendarTime ，不必向其中填寫準(zhǔn)確的值，除非你的計(jì)算依賴于它們。
• 這三個(gè)類型都是 Eq, Ord, Read, Show 類型類的成員。另外， Month 和 Day 都被聲明為 Enum 和 Bounded 類型類的成員。更多的信息請(qǐng)參考 “重要的類型類” 這一章節(jié)。

有幾種不同的途徑可以生成 CalendarTime ?？梢韵襁@樣將 ClockTime 轉(zhuǎn)換為 CalendarTime ：

ghci> :module System.Time
ghci> now <- getClockTime
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Mon Aug 18 12:10:35 CDT 2008
ghci> nowCal <- toCalendarTime now
CalendarTime {ctYear = 2008, ctMonth = August, ctDay = 18, ctHour = 12, ctMin = 10, ctSec = 35, ctPicosec = 804267000000, ctWDay = Monday, ctYDay = 230, ctTZName = "CDT", ctTZ = -18000, ctIsDST = True}
ghci> let nowUTC = toUTCTime now
ghci> nowCal
CalendarTime {ctYear = 2008, ctMonth = August, ctDay = 18, ctHour = 12, ctMin = 10, ctSec = 35, ctPicosec = 804267000000, ctWDay = Monday, ctYDay = 230, ctTZName = "CDT", ctTZ = -18000, ctIsDST = True}
ghci> nowUTC
CalendarTime {ctYear = 2008, ctMonth = August, ctDay = 18, ctHour = 17, ctMin = 10, ctSec = 35, ctPicosec = 804267000000, ctWDay = Monday, ctYDay = 230, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}

用 getClockTime 從系統(tǒng)獲得當(dāng)前的 ClockTime 。接下來， toCalendarTime 按本地時(shí)間區(qū)將 ClockTime 轉(zhuǎn)換為 CalendarTime 。 toUTCtime 執(zhí)行類似的轉(zhuǎn)換，但其結(jié)果將以 UTC 時(shí)區(qū)表示。

注意， toCalendarTime 是一個(gè) IO 函數(shù)，但是 toUTCTime 不是。原因是 toCalendarTime 依賴本地時(shí)區(qū)返回不同的結(jié)果，但是針對(duì)相同的 ClockTime ， toUTCTime 將始終返回相同的結(jié)果。

很容易改變一個(gè) CalendarTime 的值

ghci> nowCal {ctYear = 1960}
CalendarTime {ctYear = 1960, ctMonth = August, ctDay = 18, ctHour = 12, ctMin = 10, ctSec = 35, ctPicosec = 804267000000, ctWDay = Monday, ctYDay = 230, ctTZName = "CDT", ctTZ = -18000, ctIsDST = True}
ghci> (\(TOD sec _) -> sec) (toClockTime nowCal)
1219079435
ghci> (\(TOD sec _) -> sec) (toClockTime (nowCal {ctYear = 1960}))
-295685365

此處，先將之前的 CalendarTime 年份修改為 1960 。然后用 toClockTime 將其初始值轉(zhuǎn)換為一個(gè) ClockTime ，接著轉(zhuǎn)換新值，以便觀察其差別。注意新值在轉(zhuǎn)換為 ClockTime 后顯示了一個(gè)負(fù)的秒數(shù)。這是意料中的， ClockTime 表示的是 UTC 時(shí)間 1970 年 1 月 1 日午夜之后的秒數(shù)。

也可以像這樣手工創(chuàng)建 CalendarTime ：

ghci> let newCT = CalendarTime 2010 January 15 12 30 0 0 Sunday 0 "UTC" 0 False
ghci> newCT
CalendarTime {ctYear = 2010, ctMonth = January, ctDay = 15, ctHour = 12, ctMin = 30, ctSec = 0, ctPicosec = 0, ctWDay = Sunday, ctYDay = 0, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}
ghci> (\(TOD sec _) -> sec) (toClockTime newCT)
1263558600

注意，盡管 2010 年 1 月 15 日并不是一個(gè)周日 – 并且也不是一年中的第 0 天 – 系統(tǒng)可以很好的處理這些情況。實(shí)際上，如果將其轉(zhuǎn)換為 ClockTime 后再轉(zhuǎn)回 CalendarTime ，你將發(fā)現(xiàn)這些域已經(jīng)被正確的處理了。

ghci> toUTCTime . toClockTime $ newCT
CalendarTime {ctYear = 2010, ctMonth = January, ctDay = 15, ctHour = 12, ctMin = 30, ctSec = 0, ctPicosec = 0, ctWDay = Friday, ctYDay = 14, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}

ClockTime 的 TimeDiff

以對(duì)人類友好的方式難于處理 ClockTime 值之間的差異， System.Time 模塊包括了一個(gè) TimeDiff 類型。 TimeDiff 用于方便的處理這些差異。其定義如下：

data TimeDiff = TimeDiff
   {tdYear :: Int,
    tdMonth :: Int,
    tdDay :: Int,
    tdHour :: Int,
    tdMin :: Int,
    tdSec :: Int,
    tdPicosec :: Integer}

diffClockTimes 和 addToClockTime 兩個(gè)函數(shù)接收一個(gè) ClockTime 和一個(gè) TimeDiff 并在內(nèi)部將 ClockTime 轉(zhuǎn)換為一個(gè) UTC 時(shí)區(qū)的 CalendarTime ，在其上執(zhí)行 TimeDiff ，最后將結(jié)果轉(zhuǎn)換回一個(gè) ClockTime 。

看看它怎樣工作：

ghci> :module System.Time
ghci> let feb5 = toClockTime $ CalendarTime 2008 February 5 0 0 0 0 Sunday 0 "UTC" 0 False
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
ghci> feb5
Mon Feb  4 18:00:00 CST 2008
ghci> addToClockTime (TimeDiff 0 1 0 0 0 0 0) feb5
Tue Mar  4 18:00:00 CST 2008
ghci> toUTCTime $ addToClockTime (TimeDiff 0 1 0 0 0 0 0) feb5
CalendarTime {ctYear = 2008, ctMonth = March, ctDay = 5, ctHour = 0, ctMin = 0, ctSec = 0, ctPicosec = 0, ctWDay = Wednesday, ctYDay = 64, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}
ghci> let jan30 = toClockTime $ CalendarTime 2009 January 30 0 0 0 0 Sunday 0 "UTC" 0 False
ghci> jan30
Thu Jan 29 18:00:00 CST 2009
ghci> addToClockTime (TimeDiff 0 1 0 0 0 0 0) jan30
Sun Mar  1 18:00:00 CST 2009
ghci> toUTCTime $ addToClockTime (TimeDiff 0 1 0 0 0 0 0) jan30
CalendarTime {ctYear = 2009, ctMonth = March, ctDay = 2, ctHour = 0, ctMin = 0, ctSec = 0, ctPicosec = 0, ctWDay = Monday, ctYDay = 60, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}
ghci> diffClockTimes jan30 feb5
TimeDiff {tdYear = 0, tdMonth = 0, tdDay = 0, tdHour = 0, tdMin = 0, tdSec = 31104000, tdPicosec = 0}
ghci> normalizeTimeDiff $ diffClockTimes jan30 feb5
TimeDiff {tdYear = 0, tdMonth = 12, tdDay = 0, tdHour = 0, tdMin = 0, tdSec = 0, tdPicosec = 0}

首先我們生成一個(gè) ClockTime 表示 UTC 時(shí)間 2008 年 2 月 5 日。注意，若你的時(shí)區(qū)不是 UTC，按你本地時(shí)區(qū)的格式，當(dāng)其被顯示的時(shí)候可能是 2 月 4 日晚。

其次，我們用 addToClockTime 在其上加一個(gè)月。2008 是閏年，但系統(tǒng)可以正確的處理，然后我們得到了一個(gè)月后的相同日期。使用 toUTCTime ，我們可以看到以 UTC 時(shí)間表示的結(jié)果。

第二個(gè)實(shí)驗(yàn)，設(shè)定一個(gè)表示 UTC 時(shí)間 2009 年 1 月 30 日午夜的時(shí)間。2009 年不是閏年，所以我們可能很好奇其加上一個(gè)月是什么結(jié)果。因?yàn)?2009 年沒有 2 月 29 日和 2 月 30 日，所以我們得到了 3 月 2 日。

最后，我們可以看到 diffClockTimes 怎樣通過兩個(gè) ClockTime 值得到一個(gè) TimeDiff ， 盡管其只包含秒和皮秒。 normalizeTimeDiff 函數(shù)接受一個(gè) TimeDiff 將其重新按照人類的習(xí)慣格式化。

文件修改日期

很多程序需要找出某些文件的最后修改日期。 ls 和圖形化的文件管理器是典型的需要顯示文件最后變更時(shí)間的程序。 System.Directory 模塊包含一個(gè)跨平臺(tái)的 getModificationTime 函數(shù)。其接受一個(gè)文件名，返回一個(gè)表示文件最后變更日期的 ClockTime 。例如：

ghci> :module System.Directory
ghci> getModificationTime "/etc/passwd"
Loading package old-locale-1.0.0.0 ... linking ... done.
Loading package old-time-1.0.0.0 ... linking ... done.
Loading package filepath-1.1.0.0 ... linking ... done.
Loading package directory-1.0.0.0 ... linking ... done.
Fri Aug 15 08:29:48 CDT 2008

POSIX 平臺(tái)不僅維護(hù)變更時(shí)間 (被稱為 mtime)， 還有最后讀或?qū)懺L問時(shí)間 (atime)以及最后狀態(tài)變更時(shí)間 (ctime)。這是 POSIX 平臺(tái)獨(dú)有的，所以跨平臺(tái)的 System.Directory 模塊無法訪問它。取而代之，需要使用 System.Posix.Files 模塊中的函數(shù)。下面有一個(gè)例子：

-- file: ch20/posixtime.hs
-- posixtime.hs

import System.Posix.Files
import System.Time
import System.Posix.Types

-- | Given a path, returns (atime, mtime, ctime)
getTimes :: FilePath -> IO (ClockTime, ClockTime, ClockTime)
getTimes fp =
    do stat <- getFileStatus fp
       return (toct (accessTime stat),
               toct (modificationTime stat),
               toct (statusChangeTime stat))

-- | Convert an EpochTime to a ClockTime
toct :: EpochTime -> ClockTime
toct et =
    TOD (truncate (toRational et)) 0

注意對(duì) getFileStatus 的調(diào)用。 這個(gè)調(diào)用直接映射到 C 語言的 stat() 函數(shù)。其返回一個(gè)包含了大量不同種類信息的值，包括文件類型、權(quán)限、屬主、組、和我們感性去的三種時(shí)間值。 System.Posix.Files 提供了 accessTime 等多個(gè)函數(shù)，可以將我們感興趣的時(shí)間從 getFileStatus 返回的 FileStatus 類型中提取出來。

accessTime 等函數(shù)返回一個(gè)POSIX 平臺(tái)特有的類型，稱為 EpochTime ， 可以通過 toct 函數(shù)轉(zhuǎn)換 ClockTime 。 System.Posix.Files 模塊同樣提供了 setFileTimes 函數(shù)，以設(shè)置文件的 atime 和 mtime 。 [45]

延伸的例子: 管道

我們已經(jīng)了解了如何調(diào)用外部程序。有時(shí)候需要更多的控制。比如獲得程序的標(biāo)準(zhǔn)輸出、提供輸入，甚至將不同的外部程序串起來調(diào)用。管道有助于實(shí)現(xiàn)所有這些需求。管道經(jīng)常用在 shell 腳本中。 在 shell 中設(shè)置一個(gè)管道，會(huì)調(diào)用多個(gè)程序。第一個(gè)程序的輸入會(huì)做為第二個(gè)程序的輸入。其輸出又會(huì)作為第三個(gè)的輸入，以此類推。最后一個(gè)程序通常將輸出打印到終端，或者寫入文件。下面是一個(gè) POSIX shell 的例子，演示如何使用管道：

$ ls /etc | grep 'm.*ap' | tr a-z A-Z
IDMAPD.CONF
MAILCAP
MAILCAP.ORDER
MEDIAPRM
TERMCAP

這條命令運(yùn)行了三個(gè)程序，使用管道在它們之間傳輸數(shù)據(jù)。它以 ls/etc 開始，輸出是 /etc 目錄下全部文件和目錄的列表。 ls 的輸出被作為 grep 的輸入。我們想 grep 輸入一條正則使其只輸出以 ‘m' 開頭并且在某處包含 “ap” 的行。最后，其結(jié)果被傳入 tr 。我們給 tr 設(shè)置一個(gè)選項(xiàng)，使其將所有字符轉(zhuǎn)換為大寫。 tr 的輸出沒有特殊的去處，所以直接在屏幕顯示。

這種情況下，程序之間的管道線路由 shell 設(shè)置。我們可以使用 Haskell 中的 POSIX 工具實(shí)現(xiàn)同的事情。

在講解如何實(shí)現(xiàn)之前，要提醒你一下， System.Posix 模塊提供的是很低階的 Unix 系統(tǒng)接口。無論使用何種編程語言，這些接口都可以相互組合，組合的結(jié)果也可以相互組合。這些低階接口的完整性質(zhì)可以用一整本書來討論，這章中我們只會(huì)簡單介紹。

使用管道做重定向

POSIX 定義了一個(gè)函數(shù)用于創(chuàng)建管道。這個(gè)函數(shù)返回兩個(gè)文件描述符（FD），與 Haskell 中的句柄概念類似。一個(gè) FD 用于讀端，另一個(gè)用于寫端。任何從寫端寫入的東西，都可以從讀端讀取。這些數(shù)據(jù)就是“通過管道推送”的。在 Haskell 中，你可以通過 createPipe 使用這個(gè)接口。

在外部程序之間傳遞數(shù)據(jù)之前，要做的第一步是建立一個(gè)管道。同時(shí)還要將一個(gè)程序的輸出重定向到管道，并將管道做為另一個(gè)程序的輸入。 Haskell 的 dupTo 函數(shù)就是做這個(gè)的。其接收一個(gè) FD 并將其拷貝為另一個(gè) FD 號(hào)。 POSIX 的標(biāo)準(zhǔn)輸入、標(biāo)準(zhǔn)輸出和標(biāo)準(zhǔn)錯(cuò)誤的 FD 分別被預(yù)定義為 0, 1, 2 。將管道的某一端設(shè)置為這些 FD 號(hào)，我們就可以有效的重定向程序的輸入和輸出。

不過還有問題需要解決。我們不能簡單的只是在某個(gè)調(diào)用比如 rawSystem 之前使用 dupTo ，因?yàn)檫@回混淆我們的 Haskell 主程序的輸入和輸出。此外， rawSystem 會(huì)一直阻塞直到被調(diào)用的程序執(zhí)行完畢，這讓我們無法啟動(dòng)并行執(zhí)行的進(jìn)程。 為了解決這個(gè)問題，可以使用 forkProcess 。這是一個(gè)很特殊的函數(shù)。它實(shí)際上生成了一份當(dāng)前進(jìn)程的拷貝，并使這兩份進(jìn)程同時(shí)運(yùn)行。 Haskell 的 forkProcess 函數(shù)接收一個(gè)函數(shù)，使其在新進(jìn)程（稱為子進(jìn)程）中運(yùn)行。我們讓這個(gè)函數(shù)調(diào)用 dupTo 。之后，其調(diào)用 executeFile 調(diào)用真正希望執(zhí)行的命令。這同樣也是一個(gè)特殊的函數(shù)：如果一切順利，他將不會(huì)返回。這是因?yàn)?executeFile 使用一個(gè)不同的程序替換了當(dāng)前執(zhí)行的進(jìn)程。最后，初始的 Haskell 進(jìn)程調(diào)用 getProcessStatus 以等待子進(jìn)程結(jié)束，并獲得其狀態(tài)碼。

在 POSIX 系統(tǒng)中，無論何時(shí)你執(zhí)行一條命令，不關(guān)是在命令上上敲 ls 還是在 Haskell 中使用 rawSystem ，其內(nèi)部機(jī)理都是調(diào)用 forkProcess , executeFile , 和 getProcessStatusa (或是它們對(duì)應(yīng)的 C 函數(shù))。為了使用管道，我們復(fù)制了系統(tǒng)啟動(dòng)程序的進(jìn)程，并且加入了一些調(diào)用和重定向管道的步驟。

還有另外一些輔助步驟需要注意。當(dāng)調(diào)用 forkProcess 時(shí)，“幾乎”和程序有關(guān)的一切都被復(fù)制 [46] 。包括所有已經(jīng)打開的文件描述符（句柄）。程序通過檢查管道是否傳來文件結(jié)束符判斷數(shù)據(jù)接收是否結(jié)束。寫端進(jìn)程關(guān)閉管道時(shí)，讀端程序?qū)⑹盏轿募Y(jié)束符。然而，如果同一個(gè)寫端文件描述符在多個(gè)進(jìn)程中同時(shí)存在，則文件結(jié)束符要在所有進(jìn)程中都被關(guān)閉才會(huì)發(fā)送文件結(jié)束符。因此，我們必須在子進(jìn)程中追蹤打開了哪些文件描述符，以便關(guān)閉它們。同樣，也必須盡早在主進(jìn)程中關(guān)閉子進(jìn)程的寫管道。

下面是一個(gè)用 Haskell 編寫的管道系統(tǒng)的初始實(shí)現(xiàn)：

-- file: ch20/RunProcessSimple.hs

{-# OPTIONS_GHC -XDatatypeContexts #-}
{-# OPTIONS_GHC -XTypeSynonymInstances #-}
{-# OPTIONS_GHC -XFlexibleInstances #-}

module RunProcessSimple where

--import System.Process
import Control.Concurrent
import Control.Concurrent.MVar
import System.IO
import System.Exit
import Text.Regex.Posix
import System.Posix.Process
import System.Posix.IO
import System.Posix.Types
import Control.Exception

{- | The type for running external commands.  The first part
of the tuple is the program name.  The list represents the
command-line parameters to pass to the command. -}
type SysCommand = (String, [String])

{- | The result of running any command -}
data CommandResult = CommandResult {
    cmdOutput :: IO String,              -- ^ IO action that yields the output
    getExitStatus :: IO ProcessStatus    -- ^ IO action that yields exit result
    }

{- | The type for handling global lists of FDs to always close in the clients
-}
type CloseFDs = MVar [Fd]

{- | Class representing anything that is a runnable command -}
class CommandLike a where
    {- | Given the command and a String representing input,
         invokes the command.  Returns a String
         representing the output of the command. -}
    invoke :: a -> CloseFDs -> String -> IO CommandResult

-- Support for running system commands
instance CommandLike SysCommand where
    invoke (cmd, args) closefds input =
        do -- Create two pipes: one to handle stdin and the other
           -- to handle stdout.  We do not redirect stderr in this program.
           (stdinread, stdinwrite) <- createPipe
           (stdoutread, stdoutwrite) <- createPipe

           -- We add the parent FDs to this list because we always need
           -- to close them in the clients.
           addCloseFDs closefds [stdinwrite, stdoutread]

           -- Now, grab the closed FDs list and fork the child.
           childPID <- withMVar closefds (\fds ->
                          forkProcess (child fds stdinread stdoutwrite))

           -- Now, on the parent, close the client-side FDs.
           closeFd stdinread
           closeFd stdoutwrite

           -- Write the input to the command.
           stdinhdl <- fdToHandle stdinwrite
           forkIO $ do hPutStr stdinhdl input
                       hClose stdinhdl

           -- Prepare to receive output from the command
           stdouthdl <- fdToHandle stdoutread

           -- Set up the function to call when ready to wait for the
           -- child to exit.
           let waitfunc =
                do status <- getProcessStatus True False childPID
                   case status of
                       Nothing -> fail $ "Error: Nothing from getProcessStatus"
                       Just ps -> do removeCloseFDs closefds
                                          [stdinwrite, stdoutread]
                                     return ps
           return $ CommandResult {cmdOutput = hGetContents stdouthdl,
                                   getExitStatus = waitfunc}

        -- Define what happens in the child process
        where child closefds stdinread stdoutwrite =
                do -- Copy our pipes over the regular stdin/stdout FDs
                   dupTo stdinread stdInput
                   dupTo stdoutwrite stdOutput

                   -- Now close the original pipe FDs
                   closeFd stdinread
                   closeFd stdoutwrite

                   -- Close all the open FDs we inherited from the parent
                   mapM_ (\fd -> catch (closeFd fd) (\(SomeException e) -> return ())) closefds

                   -- Start the program
                   executeFile cmd True args Nothing

-- Add FDs to the list of FDs that must be closed post-fork in a child
addCloseFDs :: CloseFDs -> [Fd] -> IO ()
addCloseFDs closefds newfds =
    modifyMVar_ closefds (\oldfds -> return $ oldfds ++ newfds)

-- Remove FDs from the list
removeCloseFDs :: CloseFDs -> [Fd] -> IO ()
removeCloseFDs closefds removethem =
    modifyMVar_ closefds (\fdlist -> return $ procfdlist fdlist removethem)

    where
    procfdlist fdlist [] = fdlist
    procfdlist fdlist (x:xs) = procfdlist (removefd fdlist x) xs

    -- We want to remove only the first occurance ot any given fd
    removefd [] _ = []
    removefd (x:xs) fd
        | fd == x = xs
        | otherwise = x : removefd xs fd

{- | Type representing a pipe.  A 'PipeCommand' consists of a source
and destination part, both of which must be instances of
'CommandLike'. -}
data (CommandLike src, CommandLike dest) =>
     PipeCommand src dest = PipeCommand src dest

{- | A convenient function for creating a 'PipeCommand'. -}
(-|-) :: (CommandLike a, CommandLike b) => a -> b -> PipeCommand a b
(-|-) = PipeCommand

{- | Make 'PipeCommand' runnable as a command -}
instance (CommandLike a, CommandLike b) =>
         CommandLike (PipeCommand a b) where
    invoke (PipeCommand src dest) closefds input =
        do res1 <- invoke src closefds input
           output1 <- cmdOutput res1
           res2 <- invoke dest closefds output1
           return $ CommandResult (cmdOutput res2) (getEC res1 res2)

{- | Given two 'CommandResult' items, evaluate the exit codes for
both and then return a "combined" exit code.  This will be ExitSuccess
if both exited successfully.  Otherwise, it will reflect the first
error encountered. -}
getEC :: CommandResult -> CommandResult -> IO ProcessStatus
getEC src dest =
    do sec <- getExitStatus src
       dec <- getExitStatus dest
       case sec of
            Exited ExitSuccess -> return dec
            x -> return x

{- | Execute a 'CommandLike'. -}
runIO :: CommandLike a => a -> IO ()
runIO cmd =
    do -- Initialize our closefds list
       closefds <- newMVar []

       -- Invoke the command
       res <- invoke cmd closefds []

       -- Process its output
       output <- cmdOutput res
       putStr output

       -- Wait for termination and get exit status
       ec <- getExitStatus res
       case ec of
            Exited ExitSuccess -> return ()
            x -> fail $ "Exited: " ++ show x

在研究這個(gè)函數(shù)的運(yùn)作原理之前，讓我們先來在 ghci 里面嘗試運(yùn)行它一下：

ghci> runIO $ ("pwd", []::[String])
/Users/Blade/sandbox

ghci> runIO $ ("ls", ["/usr"])
NX
X11
X11R6
bin
include
lib
libexec
local
sbin
share
standalone

ghci> runIO $ ("ls", ["/usr"]) -|- ("grep", ["^l"])
lib
libexec
local

ghci> runIO $ ("ls", ["/etc"]) -|- ("grep", ["m.*ap"]) -|- ("tr", ["a-z", "A-Z"])
COM.APPLE.SCREENSHARING.AGENT.LAUNCHD

我們從一個(gè)簡單的命令 pwd 開始，它會(huì)打印當(dāng)前工作目錄。我們將 [] 做為參數(shù)列表，因?yàn)?pwd 不需要任何參數(shù)。由于使用了類型類， Haskell 無法自動(dòng)推導(dǎo)出 [] 的類型，所以我們說明其類型為字符串組成的列表。

下面是一個(gè)更復(fù)雜些的例子。我們執(zhí)行了 ls ，將其輸出傳入 grep 。最后我們通過管道，調(diào)用了一個(gè)與本節(jié)開始處 shell 內(nèi)置管道的例子中相同的命令。不像 shell 中那樣舒服，但是相對(duì)于 shell 我們的程序始終相對(duì)簡單。

讓我們讀一下程序。起始處的 OPTIONS_GHC 語句，作用與 ghc 或 ghci 開始時(shí)傳入 -fglasgow-exts 參數(shù)相同。我們使用了一個(gè) GHC 擴(kuò)展，以允許使用 (String,[String]) 類型作為一個(gè)類型類的實(shí)例 [47] 。將此類聲明加入源碼文件，就不用在每次調(diào)用這個(gè)模塊的時(shí)候都要記得手工打開編譯器開關(guān)。

在載入了所需模塊之后，定義了一些類型。首先，定義 typeSysCommand=(String,[String]) 作為一個(gè)別名。這是系統(tǒng)將接收并執(zhí)行的命令的類型。例子中的每條領(lǐng)命都要用到這個(gè)類型的數(shù)據(jù)。 CommandResult 命令用于表示給定命令的執(zhí)行結(jié)果， CloseFDs 用于表示必須在新的子進(jìn)程中關(guān)閉的文件描述符列表。

接著，定義一個(gè)類稱為 CommandLike 。這個(gè)類用來跑 “東西” ，這個(gè)“東西” 可以是獨(dú)立的程序，可以是兩個(gè)程序之間的管道，未來也可以跑純 Haskell 函數(shù)。任何一個(gè)類型想為這個(gè)類的成員，只需實(shí)現(xiàn)一個(gè)函數(shù) – invoke 。這將允許以 runIO 啟動(dòng)一個(gè)獨(dú)立命令或者一個(gè)管道。這在定義管道時(shí)也很有用，因?yàn)槲覀兛梢該碛心硞€(gè)管道的讀寫兩端的完整調(diào)用棧。

我們的管道基礎(chǔ)設(shè)施將使用字符串在進(jìn)程間傳遞數(shù)據(jù)。我們將通過 hGetContents 獲得 Haskell 在延遲讀取方面的優(yōu)勢(shì)，并使用 forkIO 在后臺(tái)寫入。這種設(shè)計(jì)工作得不錯(cuò)，盡管傳輸速度不像將兩個(gè)進(jìn)程的管道讀寫端直接連接起來那樣快 [48] 。但這讓實(shí)現(xiàn)很簡單。我們僅需要小心，不要做任何會(huì)讓整個(gè)字符串被緩沖的操作，把接下來的工作完全交給 Haskell 的延遲特性。

接下來，為 SysCommand 定義一個(gè) CommandLike 實(shí)例。我們創(chuàng)建兩個(gè)管道：一個(gè)用來作為新進(jìn)程的標(biāo)準(zhǔn)輸入，另一個(gè)用于其標(biāo)準(zhǔn)輸出。將產(chǎn)生兩個(gè)讀端兩個(gè)寫端，四個(gè)文件描述符。我們將要在子進(jìn)程中關(guān)閉的文件描述符加入列表。這包括子進(jìn)程標(biāo)準(zhǔn)輸入的寫端，和子進(jìn)程標(biāo)準(zhǔn)輸出的讀端。接著，我們 fork 出子進(jìn)程。然后可以在父進(jìn)程中關(guān)閉相關(guān)的子進(jìn)程文件描述符。 fork 之前不能這樣做，因?yàn)槟菚r(shí)子進(jìn)程還不可用。獲取 stdinwrite 的句柄，并通過 forkIO 啟動(dòng)一個(gè)現(xiàn)成向其寫入數(shù)據(jù)。接著定義 waitfunc , 其中定義了調(diào)用這在準(zhǔn)備好等待子進(jìn)程結(jié)束時(shí)要執(zhí)行的動(dòng)作。同時(shí)，子進(jìn)程使用 dupTo ，關(guān)閉其不需要的文件描述符。并執(zhí)行命令。

然后定義一些工具函數(shù)用來管理文件描述符。此后，定義一些工具用于建立管道。首先，定義一個(gè)新類型 PipeCommand ，其有源和目的兩個(gè)屬性。源和目的都必須是 CommandLike 的成員。為了方便，我們還定義了 -|- 操作符。然后使 PipeCommand 成為 CommandLike 的實(shí)例。它調(diào)用第一個(gè)命令并獲得輸出，將其傳入第二個(gè)命令。之后返回第二個(gè)命令的輸出，并調(diào)用 getExitStatus 函數(shù)等待命令執(zhí)行結(jié)束并檢查整組命令執(zhí)行之后的狀態(tài)碼。

最后以定義 runIO 結(jié)束。這個(gè)函數(shù)建立了需要在子進(jìn)程中關(guān)閉的 FDS 列表，執(zhí)行程序，顯示輸出，并檢查其退出狀態(tài)。

更好的管道

上個(gè)例子中解決了一個(gè)類似 shell 的管道系統(tǒng)的基本需求。但是為它加上下面這些特點(diǎn)之后就更好了：

• 支持更多的 shell 語法。
• 使管道同時(shí)支持外部程序和正規(guī) Haskell 函數(shù)，并使二者可以自由的混合使用。
• 以易于 Haskell 程序利用的方式返回標(biāo)準(zhǔn)輸出和退出狀態(tài)碼。

幸運(yùn)的是，支持這些功能的代碼片段已經(jīng)差不多就位了。只需要為 CommandLike 多加入幾個(gè)實(shí)例，以及一些類似 runIO 的函數(shù)。下面是修訂后實(shí)現(xiàn)了以上功能的例子代碼：

-- file: ch20/RunProcess.hs
{-# OPTIONS_GHC -XDatatypeContexts #-}
{-# OPTIONS_GHC -XTypeSynonymInstances #-}
{-# OPTIONS_GHC -XFlexibleInstances #-}

module RunProcess where

import System.Process
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception
import System.Posix.Directory
import System.Directory(setCurrentDirectory)
import System.IO
import System.Exit
import Text.Regex
import System.Posix.Process
import System.Posix.IO
import System.Posix.Types
import Data.List
import System.Posix.Env(getEnv)

{- | The type for running external commands.  The first part
of the tuple is the program name.  The list represents the
command-line parameters to pass to the command. -}
type SysCommand = (String, [String])

{- | The result of running any command -}
data CommandResult = CommandResult {
    cmdOutput :: IO String,              -- ^ IO action that yields the output
    getExitStatus :: IO ProcessStatus    -- ^ IO action that yields exit result
    }

{- | The type for handling global lists of FDs to always close in the clients
-}
type CloseFDs = MVar [Fd]

{- | Class representing anything that is a runnable command -}
class CommandLike a where
    {- | Given the command and a String representing input,
         invokes the command.  Returns a String
         representing the output of the command. -}
    invoke :: a -> CloseFDs -> String -> IO CommandResult

-- Support for running system commands
instance CommandLike SysCommand where
    invoke (cmd, args) closefds input =
        do -- Create two pipes: one to handle stdin and the other
           -- to handle stdout.  We do not redirect stderr in this program.
           (stdinread, stdinwrite) <- createPipe
           (stdoutread, stdoutwrite) <- createPipe

           -- We add the parent FDs to this list because we always need
           -- to close them in the clients.
           addCloseFDs closefds [stdinwrite, stdoutread]

           -- Now, grab the closed FDs list and fork the child.
           childPID <- withMVar closefds (\fds ->
                          forkProcess (child fds stdinread stdoutwrite))

           -- Now, on the parent, close the client-side FDs.
           closeFd stdinread
           closeFd stdoutwrite

           -- Write the input to the command.
           stdinhdl <- fdToHandle stdinwrite
           forkIO $ do hPutStr stdinhdl input
                       hClose stdinhdl

           -- Prepare to receive output from the command
           stdouthdl <- fdToHandle stdoutread

           -- Set up the function to call when ready to wait for the
           -- child to exit.
           let waitfunc =
                do status <- getProcessStatus True False childPID
                   case status of
                       Nothing -> fail $ "Error: Nothing from getProcessStatus"
                       Just ps -> do removeCloseFDs closefds
                                          [stdinwrite, stdoutread]
                                     return ps
           return $ CommandResult {cmdOutput = hGetContents stdouthdl,
                                   getExitStatus = waitfunc}

        -- Define what happens in the child process
        where child closefds stdinread stdoutwrite =
                do -- Copy our pipes over the regular stdin/stdout FDs
                   dupTo stdinread stdInput
                   dupTo stdoutwrite stdOutput

                   -- Now close the original pipe FDs
                   closeFd stdinread
                   closeFd stdoutwrite

                   -- Close all the open FDs we inherited from the parent
                   mapM_ (\fd -> catch (closeFd fd) (\(SomeException e) -> return ())) closefds

                   -- Start the program
                   executeFile cmd True args Nothing

{- | An instance of 'CommandLike' for an external command.  The String is
passed to a shell for evaluation and invocation. -}
instance CommandLike String where
    invoke cmd closefds input =
        do -- Use the shell given by the environment variable SHELL,
           -- if any.  Otherwise, use /bin/sh
           esh <- getEnv "SHELL"
           let sh = case esh of
                       Nothing -> "/bin/sh"
                       Just x -> x
           invoke (sh, ["-c", cmd]) closefds input

-- Add FDs to the list of FDs that must be closed post-fork in a child
addCloseFDs :: CloseFDs -> [Fd] -> IO ()
addCloseFDs closefds newfds =
    modifyMVar_ closefds (\oldfds -> return $ oldfds ++ newfds)

-- Remove FDs from the list
removeCloseFDs :: CloseFDs -> [Fd] -> IO ()
removeCloseFDs closefds removethem =
    modifyMVar_ closefds (\fdlist -> return $ procfdlist fdlist removethem)

    where
    procfdlist fdlist [] = fdlist
    procfdlist fdlist (x:xs) = procfdlist (removefd fdlist x) xs

    -- We want to remove only the first occurance ot any given fd
    removefd [] _ = []
    removefd (x:xs) fd
        | fd == x = xs
        | otherwise = x : removefd xs fd

-- Support for running Haskell commands
instance CommandLike (String -> IO String) where
    invoke func _ input =
       return $ CommandResult (func input) (return (Exited ExitSuccess))

-- Support pure Haskell functions by wrapping them in IO
instance CommandLike (String -> String) where
    invoke func = invoke iofunc
        where iofunc :: String -> IO String
              iofunc = return . func

-- It's also useful to operate on lines.  Define support for line-based
-- functions both within and without the IO monad.

instance CommandLike ([String] -> IO [String]) where
    invoke func _ input =
           return $ CommandResult linedfunc (return (Exited ExitSuccess))
       where linedfunc = func (lines input) >>= (return . unlines)

instance CommandLike ([String] -> [String]) where
    invoke func = invoke (unlines . func . lines)

{- | Type representing a pipe.  A 'PipeCommand' consists of a source
and destination part, both of which must be instances of
'CommandLike'. -}
data (CommandLike src, CommandLike dest) =>
     PipeCommand src dest = PipeCommand src dest

{- | A convenient function for creating a 'PipeCommand'. -}
(-|-) :: (CommandLike a, CommandLike b) => a -> b -> PipeCommand a b
(-|-) = PipeCommand

{- | Make 'PipeCommand' runnable as a command -}
instance (CommandLike a, CommandLike b) =>
         CommandLike (PipeCommand a b) where
    invoke (PipeCommand src dest) closefds input =
        do res1 <- invoke src closefds input
           output1 <- cmdOutput res1
           res2 <- invoke dest closefds output1
           return $ CommandResult (cmdOutput res2) (getEC res1 res2)

{- | Given two 'CommandResult' items, evaluate the exit codes for
both and then return a "combined" exit code.  This will be ExitSuccess
if both exited successfully.  Otherwise, it will reflect the first
error encountered. -}
getEC :: CommandResult -> CommandResult -> IO ProcessStatus
getEC src dest =
    do sec