第五章：編寫 JSON 庫

第五章：編寫 JSON 庫

JSON 簡介

在這一章，我們將開發(fā)一個小而完整的 Haskell 庫，這個庫用于處理和序列化 JSON 數據。

JSON （JavaScript 對象符號）是一種小型、表示簡單、便于存儲和發(fā)送的語言。它通常用于從 web 服務向基于瀏覽器的 JavaScript 程序傳送數據。JSON 的格式由 www.json.org 描述，而細節(jié)由 RFC 4627 [http://www.ietf.org/rfc/rfc4627.txt] 補充。

JSON 支持四種基本類型值：字符串、數字、布爾值和一個特殊值， null 。

"a string"

12345

true

null

JSON 還提供了兩種復合類型：數組是值的有序序列，而對象則是“名字/值”對的無序收集器（unordered collection of name/value pairs）。其中對象的名字必須是字符串，而對象和數組的值則可以是任何 JSON 類型。

[-3.14, true, null, "a string"]

{"numbers": [1,2,3,4,5], "useful": false}

在 Haskell 中表示 JSON 數據

要在 Haskell 中處理 JSON 數據，可以用一個代數數據類型來表示 JSON 的各個數據類型：

-- file: ch05/SimpleJSON.hs
data JValue = JString String
            | JNumber Double
            | JBool Bool
            | JNull
            | JObject [(String, JValue)]
            | JArray [JValue]
              deriving (Eq, Ord, Show)

[譯注：這里的 JObject[(String,JValue)] 不能改為 JObject[(JString,JValue)] ，因為值構造器里面聲明的是類構造器，不能是值構造器。

另外，嚴格來說， JObject 并不是完全無序的，因為它的定義使用了列表來包圍，在書本的后面會介紹 Map 類型，它可以創(chuàng)建一個無序的鍵-值對結構。]

對于每個 JSON 類型，代碼都定義了一個單獨的值構造器。部分構造器帶有參數，比如說，如果你要創(chuàng)建一個 JSON 字符串，那么就要給 JString 值構造器傳入一個 String 類型值作為參數。

將這些定義載入到 ghci 試試看：

Prelude> :load SimpleJSON
[1 of 1] Compiling Main             ( SimpleJSON.hs, interpreted )
Ok, modules loaded: Main.

*Main> JString "the quick brown fox"
JString "the quick brown fox"

*Main> JNumber 3.14
JNumber 3.14

*Main> JBool True
JBool True

*Main> JNull
JNull

*Main> JObject [("language", JString "Haskell"), ("complier", JString "GHC")]
JObject [("language",JString "Haskell"),("complier",JString "GHC")]

*Main> JArray [JString "Haskell", JString "Clojure", JString "Python"]
JArray [JString "Haskell",JString "Clojure",JString "Python"]

前面代碼中的構造器將一個 Haskell 值轉換為一個 JValue 。反過來，同樣可以通過模式匹配，從 JValue 中取出 Haskell 值。

以下函數試圖從一個 JString 值中取出一個 Haskell 字符串：如果 JValue 真的包含一個字符串，那么程序返回一個用 Just 構造器包裹的字符串；否則，它返回一個 Nothing 。

-- file: ch05/SimpleJSON.hs
getString :: JValue -> Maybe String
getString (JString s) = Just s
getString _           = Nothing

保存修改過的源碼文件，然后使用 :reload 命令重新載入 SimpleJSON.hs 文件（:reload 會自動記憶最近一次載入的文件）：

*Main> :reload
[1 of 1] Compiling Main             ( SimpleJSON.hs, interpreted )
Ok, modules loaded: Main.

*Main> getString (JString "hello")
Just "hello"

*Main> getString (JNumber 3)
Nothing

再加上一些其他函數，初步完成一些基本功能：

-- file: ch05/SimpleJSON.hs
getInt (JNumber n) = Just (truncate n)
getInt _           = Nothing

getBool (JBool b) = Just b
getBool _         = Nothing

getObject (JObject o) = Just o
getObject _           = Nothing

getArray (JArray a) = Just a
getArray _          = Nothing

isNull v            = v == JNull

truncate 函數返回浮點數或者有理數的整數部分：

Prelude> truncate 5.8
5

Prelude> :module +Data.Ratio

Prelude Data.Ratio> truncate (22 % 7)
3

Haskell 模塊 一個 Haskell 文件可以包含一個模塊定義，模塊可以決定模塊中的哪些名字可以被外部訪問。 模塊的定義必須放在其它定義之前：

-- file: ch05/SimpleJSON.hs
module SimpleJSON
    (
        JValue(..)
    ,   getString
    ,   getInt
    ,   getDouble
    ,   getBool
    ,   getObject
    ,   getArray
    ,   isNull
    ) where

單詞 module 是保留字，跟在它之后的是模塊的名字：模塊名字必須以大寫字母開頭，并且它必須和包含這個模塊的文件的基礎名（不包含后綴的文件名）一致。比如上面定義的模塊就以 SimpleJSON 命名，因為包含它的文件名為 SimpleJSON.hs 。

在模塊名之后，用括號包圍的是導出列表（list of exports）。 where 關鍵字之后的內容為模塊的體。

導出列表決定模塊中的哪些名字對于外部模塊是可見的，使得私有代碼可以隱藏在模塊的內部。跟在 JValue 之后的 (..) 符號表示導出 JValue 類型以及它的所有值構造器。

事實上，模塊甚至可以只導出類型的名字（類構造器），而不導出這個類型的值構造器。這種能力非常重要：它允許模塊對用戶隱藏類型的細節(jié)，將一個類型變得抽象。如果用戶看不見類型的值構造器，他就沒辦法對類型的值進行模式匹配，也不能使用值構造器顯式創(chuàng)建這種類型的值[譯注：只能通過相應的 API 來創(chuàng)建這種類型的值]。本章稍后會說明，在什么情況下，我們需要將一個類型變得抽象。

如果省略掉模塊定義中的導出部分，那么所有名字都會被導出：

module ExportEverything where

如果不想導出模塊中的任何名字（通常不會這么用），那么可以將導出列表留空，僅保留一對括號：

module ExportNothing () where

編譯 Haskell 代碼

除了 ghci 之外， GHC 還包括一個生成本地碼（native code）的編譯器： ghc 。如果你熟悉 gcc 或者 cl （微軟 Visual Studio 使用的 C++ 編譯器組件）之類的編譯器，那么你對 ghc 應該不會感到陌生。

編譯一個 Haskell 源碼文件可以通過 ghc 命令來完成：

$ ghc -c SimpleJSON.hs

$ ls
SimpleJSON.hi  SimpleJSON.hs  SimpleJSON.o

-c 表示讓 ghc 只生成目標代碼。如果省略 -c 選項，那么 ghc 就會試圖生成一個完整的可執(zhí)行文件，這會失敗，因為目前的 SimpleJSON.hs 還沒有定義 main 函數，而 GHC 在執(zhí)行一個獨立程序時會調用這個 main 函數。

在編譯完成之后，會生成兩個新文件。其中 SimpleJSON.hi 是接口文件（interface file）， ghc 以機器可讀的格式，將模塊中導出名字的信息保存在這個文件。而 SimpleJSON.o 則是目標文件（object file），它包含了已生成的機器碼。

載入模塊和生成可執(zhí)行文件

既然已經成功編譯了 SimpleJSON 庫，是時候寫個小程序來執(zhí)行它了。打開編輯器，將以下內容保存為 Main.hs ：

-- file: ch05/Main.hs

module Main (main) where

import SimpleJSON

main = print (JObject [("foo", JNumber 1), ("bar", JBool False)])

[譯注：原文說，可以不導出 main 函數，但是實際中測試這種做法并不能通過編譯。]

放在模塊定義之后的 import 表示載入所有 SimpleJSON 模塊導出的名字，使得它們在 Main 模塊中可用。

所有 import 指令（directive）都必須出現在模塊的開頭，并且位于其他模塊代碼之前。不可以隨意擺放 import 。

Main.hs 的名字和 main 函數的命名是有特別含義的，要創(chuàng)建一個可執(zhí)行文件， ghc 需要一個命名為 Main 的模塊，并且這個模塊里面還要有一個 main 函數，而 main 函數在程序執(zhí)行時會被調用。

ghc -o simple Main.hs

這次編譯沒有使用 -c 選項，因此 ghc 會嘗試生成一個可執(zhí)行程序，這個過程被稱為鏈接（linking）。ghc 可以在一條命令中同時完成編譯和鏈接的任務。

-o 選項用于指定可執(zhí)行程序的名字。在 Windows 平臺下，它會生成一個 .exe 后綴的文件，而 UNIX 平臺的文件則沒有后綴。

ghc 會自動找到所需的文件，進行編譯和鏈接，然后產生可執(zhí)行文件，我們唯一要做的就是提供 Main.hs 文件。

[譯注：在原文中說到，編譯時必須手動列出所有相關文件，但是在新版 GHC 中，編譯時提供 Main.hs 就可以了，編譯器會自動找到、編譯和鏈接相關代碼。因此，本段內容做了相應的修改。]

一旦編譯完成，就可以運行編譯所得的可執(zhí)行文件了：

$ ./simple
JObject [("foo",JNumber 1.0),("bar",JBool False)]

打印 JSON 數據

SimpleJSON 模塊已經有了 JSON 類型的表示了，那么下一步要做的就是將 Haskell 值翻譯（render）成 JSON 數據。

有好幾種方法可以將 Haskell 值翻譯成 JSON 數據，最直接的一種是編寫翻譯函數，以 JSON 格式來打印 Haskell 值。稍后會介紹完成這個任務的其他更有趣方法。

module PutJSON where

import Data.List (intercalate)
import SimpleJSON

renderJValue :: JValue -> String

renderJValue (JString s)   = show s
renderJValue (JNumber n)   = show n
renderJValue (JBool True)  = "true"
renderJValue (JBool False) = "false"
renderJValue JNull         = "null"

renderJValue (JObject o) = "{" ++ pairs o ++ "}"
  where pairs [] = ""
    pairs ps = intercalate ", " (map renderPair ps)
    renderPair (k,v)   = show k ++ ": " ++ renderJValue v

renderJValue (JArray a) = "[" ++ values a ++ "]"
  where values [] = ""
    values vs = intercalate ", " (map renderJValue vs)

分割純代碼和帶有 IO 的代碼是一種良好的 Haskell 風格。這里我們用 putJValue 來進行打印操作，這樣就不會影響 renderJValue 的純潔性：

putJValue :: JValue -> IO ()
putJValue v = putStrLn (renderJValue v)

現在打印 JSON 值變得容易得多了：

Prelude SimpleJSON> :load PutJSON
[2 of 2] Compiling PutJSON          ( PutJSON.hs, interpreted )
Ok, modules loaded: PutJSON, SimpleJSON.

*PutJSON> putJValue (JString "a")
"a"

*PutJSON> putJValue (JBool True)
true

除了風格上的考慮之外，將翻譯代碼和實際打印代碼分開，也有助于提升靈活性。比如說，如果想在數據寫出之前進行壓縮，那么只需要修改 putJValue 就可以了，不必改動整個 renderJValue 函數。

將純代碼和不純代碼分離的理念非常強大，并且在 Haskell 代碼中無處不在?，F有的一些 Haskell 壓縮模塊，它們都擁有簡單的接口：壓縮函數接受一個未壓縮的字符串，并返回一個壓縮后的字符串。通過組合使用不同的函數，可以在打印 JSON 值之前，對數據進行各種不同的處理。

類型推導是一把雙刃劍

Haskell 編譯器的類型推導能力非常強大也非常有價值。在剛開始的時候，我們通常會傾向于盡可能地省略所有類型簽名，讓類型推導去決定所有函數的類型定義。

但是，這種做法是有缺陷的，它通常是 Haskell 新手引發(fā)類型錯誤的主要來源。

如果我們省略顯式的類型信息時，那么編譯器就必須猜測我們的意圖：它會推導出合乎邏輯且相容的（consistent）類型，但是，這些類型可能并不是我們想要的。一旦程序員和編譯器之間的想法產生了分歧，那么尋找 bug 的工作就會變得更困難。

作為例子，假設有一個函數，它預計會返回 String 類型的值，但是沒有顯式地為它編寫類型簽名：

-- file: ch05/Trouble.hs

import Data.Char (toUpper)

upcaseFirst (c:cs) = toUpper c  -- 這里忘記了 ":cs"

這個函數試圖將輸入單詞的第一個字母設置為大寫，但是它在設置之后，忘記了重新拼接字符串的后續(xù)部分 xs 。在我們的預想中，這個函數的類型應該是 String->String ，但編譯器推導出的類型卻是 String->Char 。

現在，有另一個函數調用這個 upcaseFirst 函數：

-- file: ch05/Trouble.hs

camelCase :: String -> String
camelCase xs = concat (map upcaseFirst (words xs))

這段代碼在載入 ghci 時會發(fā)生錯誤：

Prelude> :load Trouble.hs
[1 of 1] Compiling Main             ( Trouble.hs, interpreted )

Trouble.hs:8:28:
    Couldn't match expected type `[Char]' with actual type `Char'
    Expected type: [Char] -> [Char]
        Actual type: [Char] -> Char
    In the first argument of `map', namely `upcaseFirst'
    In the first argument of `concat', namely            `(map upcaseFirst (words xs))'
Failed, modules loaded: none.

請注意，如果不是 upcaseFirst 被其他函數所調用的話，它的錯誤可能并不會被發(fā)現！相反，如果我們之前為 upcaseFirst 編寫了類型簽名的話，那么 upcaseFirst 的類型錯誤就會立即被捕捉到，并且可以即刻定位出錯誤發(fā)生的位置。 為函數編寫類型簽名，既可以移除我們實際想要的類型和編譯器推導出的類型之間的分歧，也可以作為函數的一種文檔，幫助閱讀和理解函數的行為。 這并不是說要巨細無遺地為所有函數都編寫類型簽名。不過，為所有頂層（top-level）函數添加類型簽名通常是一種不錯的做法。在剛開始的時候最好盡可能地為函數添加類型簽名，然后隨著對類型系統了解的加深，逐步放松要求。
更通用的轉換方式 在前面構造 SimpleJSON 庫時，我們的目標主要是按照 JSON 的格式，將 Haskell 數據轉換為 JSON 值。而這些轉換所得值的輸出可能并不是那么適合人去閱讀。有一些被稱為美觀打印器（pretty printer）的庫，它們的輸出既適合機器讀入，也適合人類閱讀。我們這就來編寫一個美觀打印器，學習庫設計和函數式編程的相關技術。 這個美觀打印器庫命名為 Prettify ，它被包含在 Prettify.hs 文件里。為了讓 Prettify 適用于實際需求，我們先編寫一個新的 JSON 轉換器，它使用 Prettify 提供的 API 。等完成這個 JSON 轉換器之后，再轉過頭來補充 Prettify 模塊的細節(jié)。 和前面的 SimpleJSON 模塊不同，Prettify 模塊將數據轉換為一種稱為 Doc 類型的抽象數據，而不是字符串：抽象類型允許我們隨意選擇不同的實現，最大化靈活性和效率，而且在更改實現時，不會影響到用戶。 新的 JSON 轉換模塊被命名為 PrettyJSON.hs ，轉換的工作依然由 renderJValue 函數進行，它的定義和之前一樣簡單直觀：

-- file: ch05/PrettyJSON.hs
renderJValue :: JValue -> Doc
renderJValue (JBool True)  = text "true"
renderJValue (JBool False) = text "false"
renderJValue JNull         = text "null"
renderJValue (JNumber num) = double num
renderJValue (JString str) = string str

其中 text 、 double 和 string 都由 Prettify 模塊提供。

Haskell 開發(fā)訣竅

在剛開始進行 Haskell 開發(fā)的時候，通常需要面對大量嶄新、不熟悉的概念，要一次性完成程序的編寫，并順利通過編譯器檢查，難度非常的高。

在每次完成一個功能點時，花幾分鐘停下來，對程序進行編譯，是非常有益的：因為 Haskell 是強類型語言，如果程序能成功通過編譯，那么說明程序和我們預想中的目標相去不遠。

編寫函數和類型的占位符（placeholder）版本，對于快速原型開發(fā)非常有效。舉個例子，前文斷言， string 、 text 和 double 函數都由 Prettify 模塊提供，如果 Prettify 模塊里不定義這些函數，或者不定義 Doc 類型，那么對程序的編譯就會失敗，我們的“早編譯，常編譯”戰(zhàn)術就沒有辦法施展。通過編寫占位符代碼，可以避免這些問題：

-- file: ch05/PrettyStub.hs
import SimpleJSON

data Doc = ToBeDefined
         deriving (Show)

 string :: String -> Doc
 string str = undefined

 text :: String -> Doc
 text str = undefined

 double :: Double -> Doc
 double num = undefined

特殊值 undefined 的類型為 a ，因此它可以讓代碼順利通過類型檢查。因為它只是一個占位符，沒有什么實際作用，所以對它進行求值只會產生錯誤：

*Main> :type undefined
undefined :: a

*Main> undefined
*** Exception: Prelude.undefined

*Main> :load PrettyStub.hs
[2 of 2] Compiling Main             ( PrettyStub.hs, interpreted )
Ok, modules loaded: Main, SimpleJSON.

*Main> :type double
double :: Double -> Doc

*Main> double 3.14
*** Exception: Prelude.undefined

盡管程序里還沒有任何實際可執(zhí)行的代碼，但是編譯器的類型檢查器可以保證程序中類型的正確性，這為接下來的進一步開發(fā)奠定了良好基礎。

[譯注：原文中 PrettyStub.hs 和 Prettify.hs 混合使用，給讀者閱讀帶來了很大麻煩。為了避免混淆，下文統一在 Prettify.hs中書寫代碼，并列出編譯通過所需要的占位符代碼。隨著文章進行，讀者只要不斷將占位符版本替換為可用版本即可。]

美觀打印字符串

當需要美觀地打印字符串時，我們需要遵守 JSON 的轉義規(guī)則。字符串，顧名思義，僅僅是一串被包含在引號中的字符而已。

-- file: ch05/Prettify.hs
string :: String -> Doc
string = enclose '"' '"' . hcat . map oneChar

enclose :: Char -> Char -> Doc -> Doc
enclose left right x = undefined

hcat :: [Doc] -> Doc
hcat xs = undefined

oneChar :: Char -> Doc
oneChar c = undefined

enclose 函數把一個 Doc 值用起始字符和終止字符包起來。(<>) 函數將兩個 Doc 值拼接起來。也就是說，它是 Doc 中的 ++ 函數。

-- file: ch05/Prettify.hs
enclose :: Char -> Char -> Doc -> Doc
enclose left right x = char left <> x <> char right

(<>) :: Doc -> Doc -> Doc
a <> b = undefined

char :: Char -> Doc
char c = undefined

hcat 函數將多個 Doc 值拼接成一個，類似列表中的 concat 函數。

string 函數將 oneChar 函數應用于字符串的每一個字符，然后把拼接起來的結果放入引號中。 oneChar 函數將一個單獨的字符進行轉義（escape）或轉換（render）。

-- file: ch05/Prettify.hs
oneChar :: Char -> Doc
oneChar c = case lookup c simpleEscapes of
              Just r -> text r
              Nothing | mustEscape c -> hexEscape c
                      | otherwise    -> char c
    where mustEscape c = c < ' ' || c == '\x7f' || c > '\xff'

simpleEscapes :: [(Char, String)]
simpleEscapes = zipWith ch "\b\n\f\r\t\\\"/" "bnfrt\\\"/"
    where ch a b = (a, ['\\',b])

hexEscape :: Char -> Doc
hexEscape c = undefined

simpleEscapes 是一個序對組成的列表。我們把由序對組成的列表稱為關聯列表（association list），或簡稱為alist。我們的 alist 將字符和其對應的轉義形式關聯起來。

ghci> :l Prettify.hs
ghci> take 4 simpleEscapes
[('\b',"\\b"),('\n',"\\n"),('\f',"\\f"),('\r',"\\r")]

case 表達式試圖確定一個字符是否存在于 alist 當中。如果存在，我們就返回它對應的轉義形式，否則我們就要用更復雜的方法來轉義它。當兩種轉義都不需要時我們返回字符本身。保守地說，我們返回的非轉義字符只包含可打印的 ASCII 字符。

上文提到的復雜的轉義是指將一個 Unicode 字符轉為一個 “\u” 加上四個表示它編碼16進制數字。

[譯注：smallHex 函數為 hexEscape 函數的一部分，只處理較為簡單的一種情況。]

-- file: ch05/Prettify.hs
import Numeric (showHex)

smallHex :: Int -> Doc
smallHex x  = text "\\u"
           <> text (replicate (4 - length h) '0')
           <> text h
    where h = showHex x ""

showHex 函數來自于 Numeric 庫（需要在 Prettify.hs 開頭載入)，它返回一個數字的16進制表示。

ghci> showHex 114111 ""
"1bdbf"

replicate 函數由 Prelude 提供，它創(chuàng)建一個長度確定的重復列表。

ghci> replicate 5 "foo"
["foo","foo","foo","foo","foo"]

有一點需要注意： smallHex 提供的4位數字編碼僅能夠表示 0xffff 范圍之內的 Unicode 字符。而合法的 Unicode 字符范圍可達 0x10ffff 。為了使用 JSON 字符串表示這部分字符，我們需要遵循一些復雜的規(guī)則將它們一分為二。這使得我們有機會對 Haskell 數字進行一些位操作(bit-level manipulation)。

-- file: ch05/Prettify.hs
import Data.Bits (shiftR, (.&.))

astral :: Int -> Doc
astral n = smallHex (a + 0xd800) <> smallHex (b + 0xdc00)
    where a = (n `shiftR` 10) .&. 0x3ff
          b = n .&. 0x3ff

shiftR 函數來自 Data.Bits 模塊，它把一個數字右移一位。同樣來自于 Data.Bits 模塊的 (.&.) 函數將兩個數字進行按位與操作。

ghci> 0x10000 `shiftR` 4   :: Int
4096
ghci> 7 .&. 2   :: Int
2

有了 smallHex 和 astral ，我們可以如下定義 hexEscape ：

-- file: ch05/Prettify.hs
import Data.Char (ord)

hexEscape :: Char -> Doc
hexEscape c | d < 0x10000 = smallHex d
            | otherwise   = astral (d - 0x10000)
    where d = ord c

數組和對象

跟字符串比起來，美觀打印數組和對象就簡單多了。我們已經知道它們兩個看起來很像：以起始字符開頭，中間是用逗號隔開的一系列值，以終止字符結束。我們寫個函數來體現它們的共同特點：

-- file: ch05/PrettyJSON.hs
series :: Char -> Char -> (a -> Doc) -> [a] -> Doc
series open close f = enclose open close
                    . fsep . punctuate (char ',') . map f

首先我們來解釋這個函數的類型。它的參數是一個起始字符和一個終止字符 ，然后是一個知道怎樣打印未知類型 a 的函數，接著是一個包含 a 類型數據的列表，最后返回一個 Doc 類型的值。

盡管函數的類型簽名有4個參數，我們在函數定義中只列出了3個。這跟我們把 myLengthxs=lengthxs 簡化成 myLength=length 是一個道理。

我們已經有了把 Doc 包在起始字符和終止字符之間的 enclose 函數。fsep 會在 Prettify 模塊中定義。它將多個 Doc 值拼接成一個，并且在需要的時候換行。

-- file: ch05/Prettify.hs
fsep :: [Doc] -> Doc
fsep xs = undefined

punctuate 函數也會在 Prettify 中定義。

-- file: ch05/Prettify.hs
punctuate :: Doc -> [Doc] -> [Doc]
punctuate p []     = []
punctuate p [d]    = [d]
punctuate p (d:ds) = (d <> p) : punctuate p ds

有了 series，美觀打印數組就非常直觀了。我們在 renderJValue 的定義的最后加上下面一行。

-- file: ch05/PrettyJSON.hs
renderJValue (JArray ary) = series '[' ']' renderJValue ary

美觀打印對象稍微麻煩一點：對于每個元素，我們還要額外處理名字和值。

-- file: ch05/PrettyJSON.hs
renderJValue (JObject obj) = series '{' '}' field obj
    where field (name,val) = string name
                          <> text ": "
                          <> renderJValue val

書寫模塊頭

PrettyJSON.hs 文件寫得差不多了，我們現在回到文件頂部書寫模塊聲明。

-- file: ch05/PrettyJSON.hs
module PrettyJSON
    (
      renderJValue
    ) where

import SimpleJSON (JValue(..))
import Prettify (Doc, (<>), char, double, fsep, hcat, punctuate, text, compact, pretty)

[譯注：compact 和 pretty 函數會在稍后介紹。]

我們只從這個模塊導出了一個函數，renderJValue，也就是我們的 JSON 轉換函數。其它的函數只是為了支持 renderJValue，因此沒必要對其它模塊可見。

關于載入部分，Numeric 和 Data.Bits 模塊是 GHC 內置的。我們已經寫好了 SimpleJSON 模塊，Prettify 模塊的框架也搭好了。可以看出載入標準模塊和我們自己寫的模塊沒什么區(qū)別。[譯注：原文在 PrettyJSON.hs 頭部載入了 Numeric 和 Data.Bits 模塊。但事實上并無必要，因此在譯文中刪除。此處作者的說明部分未作改動。]

在每個 import 命令中，我們都列出了想要引入我們的模塊的命名空間的名字。這并非強制：如果省略這些名字，我們就可以使用一個模塊導出的所有名字。然而，通常來講顯式地載入更好。

• 一個顯式列表清楚地表明了我們從哪里載入了哪個名字。如果讀者碰到了不熟悉的函數，這便于他們查看文檔。
• 有時候庫的維護者會刪除或者重命名函數。一個函數很可能在我們寫完模塊很久之后才從第三方庫中消失并導致編譯錯誤。顯式列表提醒我們消失的名字是從哪兒載入的，有助于我們更快找到問題。
• 另外一種情況是庫的維護者在模塊中加入的函數與我們代碼中現有的函數名字一樣。如果不用顯式列表，這個函數就會在我們的模塊中出現兩次。當我們用這個函數的時候，GHC 就會報告歧義錯誤。

通常情況下使用顯式列表更好，但這并不是硬性規(guī)定。有的時候，我們需要一個模塊中的很多名字，一一列舉會非常麻煩。有的時候，有些模塊已經被廣泛使用，有經驗的 Hashell 程序員會知道哪個名字來自那些模塊。

完成美觀打印庫

在 Prettify 模塊中，我們用代數數據類型來表示 Doc 類型。

-- file: ch05/Prettify.hs
data Doc = Empty
         | Char Char
         | Text String
         | Line
         | Concat Doc Doc
         | Union Doc Doc
           deriving (Show,Eq)

可以看出 Doc 類型其實是一棵樹。Concat 和 Union 構造器以兩個 Doc 值構造一個內部節(jié)點，Empty 和其它簡單的構造器構造葉子。

在模塊頭中，我們導出了這個類型的名字，但是不包含任何它的構造器：這樣可以保證使用這個類型的模塊無法創(chuàng)建 Doc 值和對其進行模式匹配。

如果想創(chuàng)建 Doc，Prettify 模塊的用戶可以調用我們提供的函數。下面是一些簡單的構造函數。

-- file: ch05/Prettify.hs
empty :: Doc
empty = Empty

char :: Char -> Doc
char c = Char c

text :: String -> Doc
text "" = Empty
text s  = Text s

double :: Double -> Doc
double d = text (show d)

Line 構造器表示一個換行。line 函數創(chuàng)建一個硬換行，它總是出現在美觀打印器的輸出中。有時候我們想要一個軟換行，只有在行太寬，一個窗口或一頁放不下的時候才用。稍后我們就會介紹這個softline 函數。

-- file: ch05/Prettify.hs
line :: Doc
line = Line

下面是 (<>) 函數的實現。

-- file: ch05/Prettify.hs
(<>) :: Doc -> Doc -> Doc
Empty <> y = y
x <> Empty = x
x <> y = x `Concat` y

我們使用 Empty 進行模式匹配。將一個 Empty 拼接在一個 Doc 值的左側或右側都不會有效果。這樣可以幫助我們的樹減少一些無意義信息。

ghci> text "foo" <> text "bar"
Concat (Text "foo") (Text "bar")
ghci> text "foo" <> empty
Text "foo"
ghci> empty <> text "bar"
Text "bar"

Note

A mathematical moment(to be added)

我們的 hcat 和 fsep 函數將 Doc 列表拼接成一個 Doc 值。在之前的一道題目里（fix link），我們提到了可以用 foldr 來定義列表拼接。[譯注：這個例子只是為了回顧，本章代碼并沒有用到。]

concat :: [[a]] -> [a]
concat = foldr (++) []

因為 (<>) 類比于 (++)，empty 類比于 []，我們可以用同樣的方法來定義 hcat 和 fsep 函數。

-- file: ch05/Prettify.hs
hcat :: [Doc] -> Doc
hcat = fold (<>)

fold :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold f = foldr f empty

fsep 的定義依賴于其它幾個函數。

-- file: ch05/Prettify.hs
fsep :: [Doc] -> Doc
fsep = fold (</>)

(</>) :: Doc -> Doc -> Doc
x </> y = x <> softline <> y

softline :: Doc
softline = group line

group :: Doc -> Doc
group x = undefined

稍微來解釋一下。如果當前行變得太長，softline 函數就插入一個新行，否則就插入一個空格。Doc 并沒有包含“怎樣才算太長”的信息，這該怎么實現呢？答案是每次碰到這種情況，我們使用 Union 構造器來用兩種不同的方式保存文檔。

-- file: ch05/Prettify.hs
group :: Doc -> Doc
group x = flatten x `Union` x

flatten :: Doc -> Doc
flatten = undefined

flatten 函數將 Line 替換為一個空格，把兩行變成一行。

-- file: ch05/Prettify.hs
flatten :: Doc -> Doc
flatten (x `Concat` y) = flatten x `Concat` flatten y
flatten Line           = Char ' '
flatten (x `Union` _)  = flatten x
flatten other          = other

我們只在 Union 左側的元素上調用 flatten： Union 左側元素的長度總是大于等于右側元素的長度。下面的轉換函數會用到這一性質。

緊湊轉換

我們經常希望一段數據占用的字符數越少越好。例如，如果我們想通過網絡傳輸 JSON 數據，就沒必要把它弄得很漂亮：另外一端的軟件并不關心它漂不漂亮，而使布局變漂亮的空格會增加額外開銷。

在這種情況下，我們提供一個最基本的緊湊轉換函數。

-- file: ch05/Prettify.hs
compact :: Doc -> String
compact x = transform [x]
    where transform [] = ""
          transform (d:ds) =
                case d of
                    Empty        -> transform ds
                    Char c       -> c : transform ds
                    Text s       -> s ++ transform ds
                    Line         -> '\n' : transform ds
                    a `Concat` b -> transform (a:b:ds)
                    _ `Union` b  -> transform (b:ds)

compact 函數把它的參數放進一個列表里，然后再對它應用 transform 輔助函數。transform 函數把參數當做棧來處理，列表的第一個元素即為棧頂。

transform 函數的 (d:ds) 模式將棧分為頭 d 和剩余部分 ds。在 case 表達式里，前幾個分支在 ds 上遞歸，每次處理一個棧頂的元素。最后兩個分支在 ds 前面加了東西：Concat 分支把兩個元素都加到棧里，Union 分支忽略左側元素（我們對它調用了 flatten ），只把右側元素加進棧里。

現在我們終于可以在 ghci 里試試 compact 函數了。[譯注：這里要對 PrettyJSON.hs 里 importPrettify 部分作一下修改才能使 PrettyJSON.hs 編譯。包括去掉還未實現的 pretty 函數，增加缺少的 string, series 函數等。一個可以編譯的版本如下。]

-- file: ch05/PrettyJSON.hs
import Prettify (Doc, (<>), string, series, char, double, fsep, hcat, punctuate, text, compact)

ghci> let value = renderJValue (JObject [("f", JNumber 1), ("q", JBool True)])
ghci> :type value
value :: Doc
ghci> putStrLn (compact value)
{"f": 1.0,
"q": true
}

為了更好地理解代碼，我們來分析一個更簡單的例子。

ghci> char 'f' <> text "oo"
Concat (Char 'f') (Text "oo")
ghci> compact (char 'f' <> text "oo")
"foo"

當我們調用 compact 時，它把參數轉成一個列表并應用 transform。

• transform 函數的參數是一個單元素列表，匹配 (d:ds) 模式。因此 d 是 Concat(Char'f')(Text"oo")，ds 是個空列表，[]。

因為 d 的構造器是 Concat，case 表達式匹配到了 Concat 分支。我們把 Char'f' 和 Text"oo" 放進棧里，并遞歸調用 transform。

• 這次 transform 的參數是一個二元素列表，匹配 (d:ds) 模式。變量 d 被綁定到 Char'f'，ds 被綁定到 [Text"oo"]。case 表達式匹配到 Char 分支。因此我們用 (:) 構造一個列表，它的頭是 'f'，剩余部分是對 transform 進行遞歸調用的結果。
• 這次遞歸調用的參數是一個單元素列表，變量 d 被綁定到 Text"oo"，ds 被綁定到 []。case 表達式匹配到 Text 分支。我們用 (++) 拼接 "oo" 和下次遞歸調用的結果。

• 最后一次調用，transform 的參數是一個空列表，因此返回一個空字符串。

• 結果是 "oo"++""。

• 結果是 'f':"oo"++""。

真正的美觀打印

我們的 compact 方便了機器之間的交流，人閱讀起來卻非常困難。我們寫一個 pretty 函數來產生可讀性較強的輸出。跟 compact 相比，``pretty``多了一個參數：每行的最大寬度(有幾列)。(假設我們使用等寬字體。)

-- file: ch05/Prettify.hs
pretty :: Int -> Doc -> String
pretty = undefined

更準確地說，這個 Int 參數控制了 pretty 遇到 softline 時的行為。只有碰到 softline 時，pretty 才能選擇繼續(xù)當前行還是新開一行。別的地方，我們必須嚴格遵守已有的打印規(guī)則。

下面是這個函數的核心部分。

-- file: ch05/Prettify.hs
pretty :: Int -> Doc -> String
pretty width x = best 0 [x]
    where best col (d:ds) =
        case d of
            Empty        -> best col ds
            Char c       -> c :  best (col + 1) ds
            Text s       -> s ++ best (col + length s) ds
            Line         -> '\n' : best 0 ds
            a `Concat` b -> best col (a:b:ds)
            a `Union` b  -> nicest col (best col (a:ds))
                                       (best col (b:ds))
      best _ _ = ""

      nicest col a b | (width - least) `fits` a = a
                     | otherwise                = b
                     where least = min width col

fits :: Int -> String -> Bool
fits = undefined

輔助函數 best 接受兩個參數：當前行已經走過的列數和剩余需要處理的 Doc 列表。一般情況下，best 會簡單地消耗輸入更新 col。即使 Concat 這種情況也顯而易見：我們把拼接好的兩個元素放進棧里，保持 col 不變。

有趣的是涉及到 Union 構造器的情況?；叵胍幌?，我們將 flatten 應用到了左側元素，右側不變。并且，flatten 把換行替換成了空格。因此，我們的任務是看看兩種布局中，哪一種（如果有的話）能滿足我們的 width 限制。

我們還需要一個小的輔助函數來確定某一行已經被轉換的 Doc 值是否能放進給定的寬度中。

-- file: ch05/Prettify.hs
fits :: Int -> String -> Bool
w `fits` _ | w < 0 = False
w `fits` ""        = True
w `fits` ('\n':_)  = True
w `fits` (c:cs)    = (w - 1) `fits` cs

理解美觀打印器

為了理解這段代碼是如何工作的，我們首先來考慮一個簡單的 Doc 值。[譯注：PrettyJSON.hs 并未載入 empty 和 >。需要讀者自行載入。]

ghci> empty </> char 'a'
Concat (Union (Char ' ') Line) (Char 'a')

我們會將 pretty2 應用到這個值上。第一次應用 best 時，col 的值是0。它匹配到了 Concat 分支，于是把 Union(Char'')Line 和 Char'a' 放進棧里，繼續(xù)遞歸。在遞歸調用時，它匹配到了 Union 分支。

這個時候，我們忽略 Haskell 通常的求值順序。這使得在不影響結果的情況下，我們的解釋最容易被理解?，F在我們有兩個子表達式：best0[Char'',Char'a'] 和 best0[Line,Char'a']。第一個被求值成 "a"，第二個被求值成 "\na"。我們把這些值替換進函數得到 nicest0"a""\na"。

為了弄清 nicest 的結果是什么，我們再做點替換。width 和 col 的值分別是0和2，所以 least 是0，width-least 是2。我們在 ghci 里試試 2fits"a" 的結果是什么。

ghci> 2 `fits` " a"
True

由于求值結果為 True，nicest 的結果是 "a"。

如果我們將 pretty 函數應用到之前的 JSON 上，我們可以看到隨著我們給它的寬度不同，它產生了不同的結果。

ghci> putStrLn (pretty 10 value)
{"f": 1.0,
"q": true
}
ghci> putStrLn (pretty 20 value)
{"f": 1.0, "q": true
}
ghci> putStrLn (pretty 30 value)
{"f": 1.0, "q": true }

練習

我們現有的美觀打印器已經可以滿足一定的空間限制要求，我們還可以對它做更多改進。

1. 用下面的類型簽名寫一個函數 fill。

-- file: ch05/Prettify.hs
fill :: Int -> Doc -> Doc

它應該給文檔添加空格直到指定寬度。如果寬度已經超過指定值，則不加。

1. 我們的美觀打印器并未考慮嵌套（nesting）這種情況。當左括號（無論是小括號，中括號，還是大括號）出現時，之后的行應該縮進，直到對應的右括號出現為止。

實現這個功能，縮進量應該可控。

-- file: ch05/Prettify.hs
nest :: Int -> Doc -> Doc

創(chuàng)建包

Cabal 是 Haskell 社區(qū)用來構建，安裝和發(fā)布軟件的一套標準工具。Cabal 將軟件組織為包（package）。一個包有且只能有一個庫，但可以有多個可執(zhí)行程序。

為包添加描述

Cabal 要求你給每個包添加描述。這些描述放在一個以 .cabal 結尾的文件當中。這個文件需要放在你項目的頂層目錄里。它的格式很簡單，下面我們就來介紹它。

每個 Cabal 包都需要有個名字。通常來說，包的名字和 .cabal 文件的名字相同。如果我們的包叫做 mypretty ，那我們的文件就是 mypretty.cabal 。通常，包含 .cabal文件的目錄名字和包名字相同，如 mypretty 。

放在包描述開頭的是一些全局屬性，它們適用于包里所有的庫和可執(zhí)行程序。

Name:          mypretty
Version:       0.1

-- This is a comment.  It stretches to the end of the line.

包的名字必須獨一無二。如果你創(chuàng)建安裝的包和你系統里已經存在的某個包名字相同，GHC 會搞不清楚用哪個。

全局屬性中的很多信息都是給人而不是 Cabal 自己來讀的。

Synopsis:      My pretty printing library, with JSON support
Description:
    A simple pretty printing library that illustrates how to
    develop a Haskell library.
Author:        Real World Haskell
Maintainer:    somebody@realworldhaskell.org

如 Description 所示，一個字段可以有多行，只要縮進即可。

許可協議也被放在全局屬性中。大部分 Haskell 包使用 BSD 協議，Cabal 稱之為 BSD3。（當然，你可以隨意選擇合適的協議。）我們可以在 License-File 這個非強制字段中加入許可協議文件，這個文件包含了我們的包所使用的協議的全部協議條款。

Cabal 所支持的功能會不斷變化，因此，指定我們期望兼容的 Cabal 版本是非常明智的。我們增加的功能可以被 Cabal 1.2及以上的版本支持。

Cabal-Version: >= 1.2

我們使用 library 區(qū)域來描述包中單獨的庫?？s進的使用非常重要：處于一個區(qū)域中的內容必須縮進。

library
    Exposed-Modules: Prettify
                     PrettyJSON
                     SimpleJSON
    Build-Depends:   base >= 2.0

Exposed-Modules 列出了本包中用戶可用的模塊?？蛇x字段字段 Other-Modules 列出了內部模塊。這些內部模塊用來支持這個庫的功能，然而對用戶不可見。

Build-Depends 包含了構建我們庫所需要的包，它們之間用逗號分開。對于每一個包，我們可以選擇性地說明這個庫可以與之工作的版本號范圍。base 包包含了很多 Haskell 的核心模塊，如Prelude，因此實際上它總是被需要的。

Note

處理依賴關系

我們并不需要猜測或者調查我們依賴于哪些包。如果我們在構建包的時候沒有包含 Build-Depends 字段，編譯會失敗，并返回一條有用的錯誤信息。我們可以試試把 base 注釋掉會發(fā)生什么。

$ runghc Setup build
Preprocessing library mypretty-0.1...
Building mypretty-0.1...

PrettyJSON.hs:8:7:
    Could not find module `Data.Bits':
        it is a member of package base, which is hidden

錯誤信息清楚地表明我們需要增加 base 包，盡管它已經被安裝了。強制我們顯式地列出所有包有一個實際好處：cabal-install 這個命令行工具會自動下載，構建并安裝一個包和所有它依賴的包。 [譯注，在運行 runghc Setup build 之前，Cabal 會首先要求你運行 configure。具體方法見下文。]
GHC 的包管理器 GHC 內置了一個簡單的包管理器用來記錄安裝了哪些包以及它們的版本號。我們可以使用 ghc-pkg 命令來查看包數據庫。 我們說數據庫，是因為 GHC 區(qū)分所有用戶都能使用的系統包（system-wide packages）和只有當前用戶才能使用的用戶包（per-user packages）。 用戶數據庫（per-user database）使我們沒有管理員權限也可以安裝包。 ghc-pkg 命令為不同的任務提供了不同的子命令。大多數時間，我們只用到兩個。 ghc-pkg list 命令列出已安裝的包。當我們想要卸載一個包時，ghc-pkg unregister 告訴 GHC 我們不再用這個包了。 （我們需要手動刪除已安裝的文件。）
配置，構建和安裝 除了 .cabal 文件，每個包還必須包含一個 setup 文件。 這使得 Cabal 可以在需要的時候自定義構建過程。一個最簡單的配置文件如下所示。

-- file: ch05/Setup.hs
#!/usr/bin/env runhaskell
import Distribution.Simple
main = defaultMain

我們把這個文件保存為 Setup.hs。

有了 .cabal 和 Setup.hs 文件之后，我們只有三步之遙。

我們用一個簡單的命令告訴 Cabal 如何構建一個包以及往哪里安裝這個包。

[譯注：運行此命令時，Cabal 提示我沒有指定 build-type。于是我按照提示在 .cabal 文件里加了 build-type:Simple 字段。]

$ runghc Setup configure

這個命令保證了我們的包可用，并且保存設置讓后續(xù)的 Cabal 命令使用。

如果我們不給 configure 提供任何參數，Cabal 會把我們的包安裝在系統包數據庫里。如果想安裝在指定目錄下和用戶包數據庫內，我們需要提供更多的信息。

$ runghc Setup configure --prefix=$HOME --user

完成之后，我們來構建這個包。

$ runghc Setup build

成功之后，我們就可以安裝包了。我們不需要告訴 Cabal 裝在哪兒，它會使用我們在第一步里提供的信息。它會把包裝在我們指定的目錄下然后更新 GHC 的用戶包數據庫。

$ runghc Setup install

實用鏈接和擴展閱讀

GHC 內置了一個美觀打印庫，Text.PrettyPrint.HughesPJ。它提供的 API 和我們的例子相同并且有更豐富有用的美觀打印函數。與自己實現相比，我們更推薦使用它。

John Hughes 在 [Hughes95] 中介紹了 HughesPJ 美觀打印器的設計。這個庫后來被 Simon Peyton Jones 改進，也因此得名。Hughes 的論文很長，但他對怎樣設計 Haskell 庫的討論非常值得一讀。

本章介紹的美觀打印庫基于 Philip Wadler 在 [Wadler98] 中描述的一個更簡單的系統。Daan Leijen 擴展了這個庫，擴展之后的版本可以從 Hackage 里下載： wl-pprint。如果你用 cabal 命令行工具，一個命令即可完成下載，構建和安裝： cabal install wl-pprint。