Real World Haskell 第五章 编写库：操作JSON数据

JSON速成

这一章我们将开发一个小的但是完整的Haskell库。我们的库将操作和串行化数据到流行的JSON格式。

JSON（JavaScript Object Notation）语言是存储和传输结构化数据的一种小而简单的表示方式，用在诸如网络连接上传输数据。最常见的用法是从一个web服务传输数据给浏览器端的JavaScript程序。JSON格式在www.json.org有描述，更详细的细节参见 RFC 4627.1标准。

JSON支持四种基本类型的值：字符串，数字，布尔值，以及一个特殊的null值。


"a string" 12345 true
      null


语言提供了两种组合类型：一个数组是值的有序序列，对象是一组无序的名称/值对的集合。对象中的名称总是字符串；对象或数组中的值可以是任意类型。

[-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)

对每一个JSON类型，提供一个独特的值构造子。有些构造子有参数：如果想创建一个JSON字符串，必须提供一个String值的参数给JString构造子。

要开始试验这些代码，在编辑器中把代码保存成 SimpleJSON.hs 文件，切换到ghci窗口中，载入这个文件。

ghci> :load SimpleJSON
[1 of 1] Compiling SimpleJSON       ( SimpleJSON.hs, interpreted )
Ok, modules loaded: SimpleJSON.
ghci> JString "foo"
JString "foo"
ghci> JNumber 2.7
JNumber 2.7
ghci> :type JBool True
JBool True :: JValue

可以看到如何用构造子把普通Haskell的值转成一个JValue。要反向转换，使用模式匹配。可以向SimpleJSON.hs中加入下面的函数，来从 JSON值中抽取出字符串。如果JSON值确实包含一个字符串，这个函数将这个字符串用Just构造子包装起来，否则返回Nothing。

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

保存修改过的源文件，在ghci中重新载入就可以尝试新的定义了。（:reload 命令知道上次载入的源文件的名字，因此我们不需要明确的告诉它）。

ghci> :reload
Ok, modules loaded: SimpleJSON.
ghci> getString (JString "hello")
Just "hello"
ghci> getString (JNumber 3)
Nothing

其他一些访问函数，现在得到了一个能拿来用的代码体。

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

getDouble (JNumber n) = Just n
getDouble _           = 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函数把浮点数或者有理数转换成一个整数，它将丢弃掉小数点后面的数字。

ghci> truncate 5.8
5
ghci> :module +Data.Ratio
ghci> truncate (22 % 7)
3

解剖一个Haskell模块

一个Haskell源文件包含一个单独模块的定义。一个模块可以让我们确定模块内哪些名字可以被其他模块访问。

源文件的开始是模块定义。这些定义必须放在源文件中其他定义之前。

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

module一词是保留的。后面跟模块的名字，模块名必须大写字母开头。源文件的基本名（后缀前的部分）必须与它里面包含的模块的名字相同。这就是为什么SimpleJSON.hs 文件中的模块名叫 SimpleJSON。

模块名后是用括号括起来的导出列表。关键字where表示后面跟的是模块体。

导出列表指出模块中的哪些名字对其他模块可见。这可以把私有代码对外部世界隐藏起来。JValue后面的特殊记号 (..)表示导出类型和它的全部构造子。

可能看上去有些奇怪：可以导出类型名（类型构造子），但不导出它的值构造子。能这样做是重要的：可以把类型的细节对它的用户隐藏起来，使得类型抽象。如果无法看到类型的值构造子，就不能对这种类型的值进行模式匹配，也不能构造这种类型的新的值。本章后面会讨论一些想要把类型变成抽象的情况。

如果在类型定义中忽略导出列表（还有它的括号），会导出模块中的所有名字。

-- file: ch05/Exporting.hs
module ExportEverything where

如果根本不导出任何名字（很少有用），可以用一对括号写一个空的导出列表。


-- file: ch05/Exporting.hs
module ExportNothing () where

编译Haskell源代码

GHC的发布中除了ghci解释器外，还包含一个编译器 ghc，可以生产本地代码。如果你已经会使用像gcc或cl（微软Visual Studio的C++编译器组件）这样的命令行编译器，可以立刻适应ghc。

要编译一个文件，先打开一个终端或者命令行窗口，调用ghc和源文件的文件名来编译。

ghc -c SimpleJSON.hs

选项-c告诉ghc只生成目标代码。如果忽略了-c 选项，编译器会尝试生成一个完整的可执行程序。那会失败，因为我们还没有写main函数，独立程序开始执行时，GHC会调用这个函数。
 
ghc完成后，如果列出目录的内容，可以看到包含了两个新文件： SimpleJSON.hi 和 SimpleJSON.o。前面一个是接口文件，ghc在里面用机器可读的格式保存模块导出名字的信息。后裔个是目标文件，保存生成的机器代码。

生成Haskell程序，导入模块

现在已经成功的编译了这个小的库，我们来写个使用它的小程序。在文本编辑器中创建下面内容，保存成 Main.hs。


-- file: ch05/Main.hs
module Main () where

import SimpleJSON

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

注意模块声明后面的import指令。这表示我们想要SimpleJSON模块中导出的所有名字，并让它们在我们的模块中可见。import指令必须成组的在模块的开头出现。它们必须在模块定义后，并在其他代码之前。不能把它们分散在源文件中间。


源文件和函数的命名是经过深思熟虑的。要创建一个可执行程序，ghc需要一个名为 Main 的模块，其中包含一个名为 main 的函数。在执行创建的可执行程序时会调用main函数。

ghc -o simple Main.hs SimpleJSON.o

这一次调用ghc的时候，我们去掉 -c 选项，这样它会尝试创建可执行程序。生成可执行程序的过程称为连接。我们的命令行显示，ghc可以完美的在单独一个调用中完成编译源文件和连接可执行程序。

传给ghc一个新的选项 -o ，它带一个参数：ghc要生成的可执行程序的名字。这里，我们决定把这个程序命名为 simple。在Windows上，程序会带 .exe  的后缀，但在Unix类系统上没有这个后缀。

最后，给出新的源文件的名字 Main.hs 和已经编译的目标文件 SimpleJSON.o。我们必须明确的列出包含最终可执行程序所需代码的所有文件。如果忘记了一个源文件或者目标文件，ghc会给出未定义符号的错误，这表示有些需要的定义没有在我们个的文件中提供出来。

编译时，可以给ghc任意的源文件和目标文件的混合。如果ghc注意到一个源文件已经被编译成了目标文件，那这个源文件只有被修改后才会再次编译。

ghc完成了程序的编译和连接后，我们就可以在命令行里运行它。

打印JSON数据

现在已经有了JSON类型的Haskell表示，我们希望能够把Haskell的值变成JSON数据并翻译成JSON的输出格式。

有几种方法来做。最直接的方法应该是写一个渲染函数来输出JSON格式的值。做完后，我们会看一些各功能有趣的方法。

-- file: ch05/PutJSON.hs
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)

好的Haskell代码风格要把纯的代码与执行I/O操作的代码区分开。我们的renderJValue函数与外部世界没有交互，但我们依然需要能打印 JValue。

-- file: ch05/PutJSON.hs
putJValue :: JValue -> IO ()
putJValue v = putStrLn (renderJValue v)

Printing a JSON value is now easy. 1 comment

为什么要把渲染代码与实际打印的代码分开呢？这可以给我们灵活性。例如，我们想在输出前压缩数据，那么如果渲染和打印混在一起的话，就很难调整代码适应这种情况了。

把纯代码与非纯代码分开的主意是强大的，并且在Haskell的代码中无处不在。有一些Haskell的压缩库存在，它们都具有类似的接口：一个压缩函数，它接受未压缩字符串并返回压缩后的字符串。可以通过函数组合来把JSON数据渲染成字符串，然后再压缩成另一个字符串，将如何实际显式或转换数据的决定推后。

类型推断是双刃剑

Haskell编译器推断类型的能力很强大很有价值。起初你可能要面对很大的诱惑：利用推断的优点去尽可能去除类型声明，让编译器去解决其他事！

对明确类型信息的吝啬有个不利的一面，尤其会对新的Haskell程序员造成影响。作为新的Haskell程序员，很可能因为类型错误造成代码无法编译。

当忽略掉明确的类型信息后，我们强迫编译器去想明白我们的意图。它推断类型符合逻辑并始终如一的，但也许根本不是我们想要的。如果我们与编译器无意中意见不一致的话，将会让我们花更长时间来找出源代码中的问题。

假设我们写了一个函数并认为它会返回String，但是没有给它写类型签名。

-- file: ch05/Trouble.hs
upcaseFirst (c:cs) = toUpper c -- forgot ":cs" here

这里我们想要把一个单词的首字母大写，但是忘记了把单词剩下的部分加到结果上了。我们认为函数的类型是 String -> String，但是编译器会把它的类型正确的推断为 String -> Char。让我们要在某处使用这个函数。

-- file: ch05/Trouble.hs
camelCase :: String -> String
camelCase xs = concat (map upcaseFirst (words xs))

当尝试编译这段代码并载入ghci时，将不会得到明白的错误信息。

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

Trouble.hs:9:27:
    Couldn't match expected type `[Char]' against inferred type `Char'
      Expected type: [Char] -> [Char]
      Inferred 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 函数的地方。如果我们误认为upcaseFirst的定义和类型是正确的话，将会在错误的位置花费很多时间，直到忽然开窍。

每当写了一个类型签名，就从类型推断引擎上减少了一些自由度。这减少了我们与编译器对代码理解产生分歧的可能性。在我们阅读自己代码的时候，类型声明也起到注解的作用，让我们更容易理解一段代码应有的行为。

这并不是说我们需要给代码的每个细小的部分都加上类型声明。而是说给代码的每个顶级定义都加上签名是好的风格。最好着开始的时候尽量用明确的类型签名，随着对类型检查理解的更加精确之后慢慢放松限制。

[Tip]    显式类型，undefined值和error


undefined

特殊值undefined 用在任何地方使用都可以通过类型检查，表达式 error "argh!"也是如此。在使用它们时写类型签名更加重要。假设我们用 undefined 或者 error "write me" 作为一个顶层函数定义函数体的占位符。如果忽略了类型签名，就可能使用一些错误类型的值，而正确类型的版本却会被编译器拒绝。这可能轻易的误导我们。

渲染更通用的观点

我们的JSON渲染代码专门为我们的data类型和JSON格式化转换特别定制的。它产生的输出可能不适合人类阅读。现在我们来把渲染作为更通用的任务：如何构造一个在多种情况下渲染数据的库？

我们要生成的输出既要适合人读（方便调试），也要适合机器处理。进行这种工作的库称为美化打印（pretty printer）。已经有一些Haskell的美化打印库。我们创建一个自己的库不是为了取代它们，而是为了获得有用的库设计经验与函数式编程技术。

我们的美化打印模块称为 Prettify，我们的代码放在 Prettify.hs 文件中。

[Note]命名

我们的Prettify模块中，名字将基于一些基础Haskell美化打印库使用的名字。这可以和已经存在的成熟库有一定程度的兼容性。

要确定Prettify 满足实际需要，我们用这个Prettify API写个新的JSON渲染器。做完后我们再回过头来填充Prettify模块的细节。

我们的Prettify模块将使用称为Doc抽象类型，而不是直接渲染成字符串。把我们的通用渲染库基于一个抽象的类型，我们可以选择灵活高效的实现。如果我们决定改变底层的代码，用户可以不必知道。

我们把新的 JSON渲染模块称为  PrettyJSON.hs，渲染函数依然叫 renderJValue 。渲染基本的 JSON值是简单直接的。

-- 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代码

Developing Haskell code without going nuts

早前当我们开始学习Haskell开发时，同时有很多新的不熟悉的概念要理解，因此要一次把全部代码编译是很有挑战性的。

在写了一大段代码后，停下来尝试编译刚刚写的是很有帮助的。因为Haskell是强类型的，如果编译顺利，我们就可以很有信心的说我们没有偏差太远。

一个快速开发程序骨架的有用方法是使用占位符（或stub）来写类型和函数。例如上面提到过 string，text和double函数将在Prettify模块中提供。如果我们没有提供这些函数和Doc类型的定义，对JSON渲染器“尽早编译，经常编译”的尝试就会失败，因为编译器不认识这些函数。要避免这些问题，我们写一些不做任何事，只是占位符的代码。

-- 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，因此不管它用在什么地方总能通过类型检查。如果我们尝试对其求值，会导致程序崩溃。

ghci> :type undefined
undefined :: a
ghci> undefined
*** Exception: Prelude.undefined
ghci> :type double
double :: Double -> Doc
ghci> double 3.14
*** Exception: Prelude.undefined

虽然我们还不能运行这个桩程序，但是编译器的类型检查器可以确保程序是类型正确的。

字符串整齐打印

当我们要整齐打印一个字符串的值时，我们需要遵守JSON的一些转义规则。在最高一级，一个字符串是引号包起来的一列字符。

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

[Note]    Point-free 风格

这种只用其他函数的组合来写函数定义的风格称为 point-free 风格。这里的"point"与函数组合符 "." 没有关系。这里术语point大体上与值同义（在Haskell里），因此在point-free表达式中没有它要操作的值。

与上面的point-free风格的string定义相对比，这个“有值”的版本使用一个变量来引用它操作的值。

-- file: ch05/PrettyJSON.hs
pointyString :: String -> Doc
pointyString s = enclose '"' '"' (hcat (map oneChar s))

enclose 函数简单的把Doc值用开闭引号字符包装起来。

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

在我们的整齐打印库中提供了 (<>)函数。它把两个Doc值拼接在一起，因此它是Doc上 (++)的等价物。

-- file: ch05/PrettyStub.hs
(<>) :: Doc -> Doc -> Doc
a <> b = undefined

char :: Char -> Doc
char c = undefined

我们的整齐打印库也提供了 hcat，它把多个Doc值连接成一个：它是对列表的concat的模拟。

-- file: ch05/PrettyStub.hs
hcat :: [Doc] -> Doc
hcat xs = undefined

我们的string函数对字符串中每一个字符应用 oneChar函数，然后把他们连接起来，并把结果用引号括起来。oneChar函数对单个字符进行转义或渲染。

-- file: ch05/PrettyJSON.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])

simpleEscapes 值是数对的列表。我们把数对的列表称为关联表，或简称为 alist。我们的关联表中的每一个元素将一个字符和它对应的转义表示关联在一起。

ghci> take 4 simpleEscapes
[('\b',"\\b"),('\n',"\\n"),('\f',"\\f"),('\r',"\\r")]

case 表达式尝试把字符在关联表中检查是否有匹配。如果匹配上了，就给出转义字符，否则我们就需要用更复杂的方式来转义这个字符了。假如这样的话，我们进行这个转义。只有当两种转义都不需要时，我们直接给出无格式的字符。按照传统我们给出的非转义字符是可打印的 ASCII 字符。

更复杂的转义涉及到把字符变成 "\u"跟4个十六进制数字表示的Unicode字符表示。

-- file: ch05/PrettyJSON.hs
smallHex :: Int -> Doc
smallHex x  = text "\\u"
           <> text (replicate (4 - length h) '0')
           <> text h
    where h = showHex x ""

showHex 函数来自Numeric库（需要在 Prettify.hs 的开头import它），它返回一个数字的十六进制表示。

ghci> showHex 114111 ""
"1bdbf"

replicate函数在Prelude中提供，它用其参数构造一个固定常数的重复列表。

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

有一个障碍：smallHex提供的4位编码只能表示到 0xffff的Unicode字符。有效的Unicode字符可以达到 0x10ffff的范围。在JSON字符串中要正确的表示高于 0xffff 的字符，需要按照一些复杂的规则来把它分割成两个。这让我们有机会对Haskell的数字进行一些位操作。

-- file: ch05/PrettyJSON.hs
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/PrettyJSON.hs
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 item = enclose open close
                       . fsep . punctuate (char ',') . map item

我们从函数类型的解释开始。它取一个开始和一个结束字符，然后是一个知道如何整齐打印未知类型a值的函数，后面跟a类型值的列表，它返回一个Doc类型的值。


注意虽然我们的类型签名有四个参数，我们只在函数的定义中列出了三个。我们只是像把 myLength xs = length xs 写成 myLength = length一样，来简化我们的定义。

我们已经写了 enclose，它把Doc值用开始和结束字符包装起来。 Prettify 模块中的fsep 函数把Doc值的列表组合成一个，如果输出不能放入一行可能会环绕多行。

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

参照给出的例子，我们现在可以在 Prettify.hs 中定义自己的占位程序。我们不显式的定义更多的占位程序了。

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

对数组进行整齐打印直接用这一系列定义表示。把这个等式加到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 Numeric (showHex)
import Data.Char (ord)
import Data.Bits (shiftR, (.&.))

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

我们从这个模块中只导出一个名字：JSON的渲染函数 renderJValue 。这个模块中存在的其他定义只是为了辅助renderJValue函数，因此没有理由使它们在其他模块中可见。

关于import语句，Numeric和Data.Bits模块在GHC中分发。我们已经写了 SimpleJSON模块了，Prettify模块也加上了定义的骨架。注意在导入标准模块和哦我们自己定义的模块时没有什么不同。

在每一个import 指令中，我们明确的列出了要引入本模块名字空间的名字。这并不是必须的：如果我们去掉名字列表，这个模块所有导出的名字便都可用。不过明确列出名字列表通常是一个好主意。

    * 明确的列表可以更清楚的指出导入的名字来自哪里。如果读着遇到不熟悉的函数，他可以更容易的找到对应文档。


    * 有时候程序库的维护人员要去除或者重命名一个函数。如果我们使用的一个函数在第三方模块中消失了，那么在我们写了这个模块很久后，有可能发生任何编译错误。明确的导入列表可以帮助我们自己记住丢失的名字是从哪里导入的，这有助于快速的定位错误。



 它也可能会发生，有人将一个名称为模块，是相同的名称已经在我们自己的代码。如果我们不使用一个明确的进口清单，我们将最终具有相同名称的模块两次。如果我们使用这个名字， GHC会报告错误由于含糊。一个明确的清单让我们避免意外进口意想不到的新名称。 1条评论



    * 也有可能某人要向模块中添加一个和我们代码中相同的名字。如果不用明确导入列表，就会在我们的模块中初恋两个相同的名字。如果使用了这个名字，GHC编译器就会因为歧义而报告错误。一个明确的列表可以避免偶然导入意想不到的新名称。


这种使用明确导入的方式通常是合理的准则，但并不是硬性规定。有时候要一个模块中太多的名字，如果都列出来会变得很混乱。在其他情况下，一个模块可能用的非常广泛，普通的Haskell程序员都应该知道这些名字来自哪个模块。

完善整齐打印库

在我们的 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值创建了内部节点，而Empty和其他的简单构造子创建了叶子节点。


在我们模块的开头，我们要导出类型的名字，但不导出它的任何构造子：这将防止使用Doc类型的模块创建Doc值或对其进行模式匹配。


相反，要创建一个Doc值，Prettify模块的用户要调用一个我们提供的函数。这里是简单构造子函数。在添加真正的定义时，我们必须把Prettify.hs 源文件中存在的占位程序更换掉。

-- 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函数创建一个硬换行，将在整齐打印输出时总是出现。有时我们需要一个软换行，只在一行太长不能在一个窗口或一页纸上容纳下时才换行。很快我们会介绍一个softline函数。


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

和基本构造子一样简单的是 (<>) 函数，他连接两个Doc值。

-- 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"

[Tip]    数学时刻


我们暂时转到数学的角度，我们可以说 Empty 是连接的单位元，因为如果连接Doc值和一个Empty什么都不会发生。相似的，0是数字相加的单位元，1是数字相乘的单位元。采用数学观点在后面将会很有用，本书很多地方都会看到。

hcat和fsep函数把一个Doc值的列表连接成一个。在“练习”一节我们提到可以用foldr来定义列表连接。

-- file: ch05/Concat.hs
concat :: [[a]] -> [a]
concat = foldr (++) []

因为(<>)与 (++)相似，empty与[] 相似，可以看到如何用fold来定义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



这些需要一点解释。softline函数在当前行太宽时插入一个换行，否则插入空格。如果Doc类型不包含任何渲染的信息，我们如何做到这一点？ 答案是每当遇到一个软换行，我们使用Union构造子维护文档的两个备选表示。

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

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 函数了。

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，Concat与case表达式中的模式匹配。在右侧，我们把 Char 'f' 和 Text "oo" 加到桟中，并递归调用 transform。

    * transform函数接收到一个两个元素的列表，再次与 (d:ds) 模式匹配。变量d绑定到 Char 'f'， ds 绑定到 [Text "oo"]。

    － case表达式在 Char 分支中匹配。在右侧，用 (:) 构造一个列表，其头部是 'f' ，主体是递归调用 transform 的结果。

          o 递归调用接收到一个单元素列表。变量d绑定到 Text "oo"， ds绑定到 []。
      case表达式在Text分支中匹配。在右侧，用 (++) 来连接 "oo" 和递归调用 transform 的结果。

                +
                      # 在最后一次调用，transform 得到空列表，返回一个空字符串。
                + 结果是 "oo" ++ ""。
          o 结果是 'f' : "oo" ++ ""。

真正的整齐打印

虽然compact函数在机器到机器的通信中很有用，但是它的结果并不总是人类可读的：在每行中信息很少。要输出更可读的输出，我们要写另一个函数 pretty。与compact相比，pretty取一个附加参数：一行的最大宽度，用列数表示。（我们假设字体是等宽的）


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

为了更加精确，这个Int参数控制pretty遇到softline时的行为。只有softline在pretty可以选择继续当前行还是开始一个新行。其他地方，我们必须严格按照使用整齐打印函数的人的指示来做。

这里是我们的实现的核心部分：

-- file: ch05/Prettify.hs
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

best辅助函数取两个参数：当前行已经输出的列数和要处理的剩余Doc值列表。

在简单的情况下，best消耗输入的同时直接更新col变量。即使Concat的情况也是很明显的：我们把两个连接的部分放入我们的桟/列表中，而不修改col。


涉及到Union构造子的情况比较有趣。记得我们对其左侧元素调用了 flatten，而对右侧什么也没做。此外，flatten把换行替换成空格。因此，我们要做的就是看哪一个布局（被flatten函数平整过的和原始的）可以符合当前的宽度限制。


要做到这一点，我们写一个小的帮助函数来确定渲染的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值：

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

在这个值上调用 pretty 2 。当第一次调用best， col 的值是0。它与 Concat 分支匹配，将 Union (char ' ') Line 和 Char 'a' 的值压入桟中，并递归调用自己。在递归调用中，匹配到 Union (Char ' ')。

此时我们将忽略Haskell通常的执行顺序。这可以让我们的解释更简单，而不会改变最终结果。我们现在有两个子表达式 best 0 [Char ' ', Char 'a'] 和 best 0 [Line, Char 'a']。第一个求值为 " a"，第二个为 "\na"。我们把他们替换到外部的表达式中，因此得到 nicest 0 " a" "\na"。

要算出nicest的值，要做一些简单的替换。width和col的值分别是 0 和 2， 因此least是0， width - least 是 2 。我们在ghci中快速的求出 2 `fits` " a"。

ghci> 2 `fits` " a"
True

因为这个表达式求值为 True，nicest的值是  " a"。

如果像之前那样对相同的JSON数据调用pretty函数，可以看到它根据给定的宽度产生了不同的输出结果。

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

它给一个Doc添加空格，使它达到给定的宽度。如果它已经比给定值更宽了，则不加空格。

2. 我们的整齐打印并没有考虑嵌套。每当开始一个括号、大括号、或者方括号时，下一行应该缩进与开括号对齐，直到遇到相应的关闭字符。

增加对嵌套的支持，缩进数量可控制。

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

创建一个包(package)

haskell社区已经创建了一个标准工具集，称为Cabal，它可以帮助构建，安装和分发软件。Cabal把软件组织成包。一个包包括一个库，还可能有一些可执行程序。

写一个包描述

要对包做任何事，Cabal都需要一个描述。它包含在一个文件扩展名为 .cabal的文本文件中。这个文件位于工程的最顶级目录。它具有简单的格式，下面将会讨论。

一个Cabal 包必须有一个名字。通常包的名字与 .cabal文件的名字相同。我们称我们的包为 mypretty，因此我们的描述文件是 mypretty.cabal。包含 .cabal文件的目录的名字经常和包同名。

包的描述以一系列全局属性开始，它对包中的每个库和可执行文件都适用。

Name:          mypretty
Version:       0.1

-- 这是注释。它延伸到行末

包的名字必须是独一无二的。如果你创建和安装的包的名字与系统中已经存在的包名字相同的话，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:    nobody@realworldhaskell.org

像Description 字段指出的那样，一个字段可以有多行，把它们缩进给出。

全局信息中还包含授权信息。大部分Haskell 包用BSD协议授权，Cabal 称为 BSD3。（显然你可以自由的选择你认为何时的授权。）可选的 License-File 可以让你指定一个包含包的授权条款的文件。

Cabal支持的特性在后序版本中随着事件进化，因此最好指出要与什么版本的Cabal兼容。我们描述的特性在1.2及更高版本Cabal支持。

Cabal-Version: >= 1.2

要描述包中单独一个库，我们写一个library节。这里缩进是重要的：一个节的内容必须被缩进对齐。

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

Exposed-Modules字段包含了包用户可以使用的模块列表。可选字段Other-Modules 包含了北部模块的列表。这些被库所需要的函数，但是用户不可见。

Build-Depends 字段包含了库构建时需要的包列表，用逗号分隔。对每一个包，可以指定它已知可工作的版本的范围。base 包包含很多Haskell核心模块，如Prelude，因此总是包含它。

[Tip]    确定构建的依赖关系

我们没必要去猜测或者做任何研究来确定要依赖哪个些包。如果我们试图构建包时不带 Build-Depends 字段的话，编译就会失败并给出有用的错误信息。这里是一个例子，我们把base 包的依赖注释掉。

$ 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包，尽管我们已经安装了base包了。强制我们明确每一个需要用到的包有一个现实的好处：一个名为 cabal-install 的命令行工具可以自动下载，构建和安装一个包及其依赖的所有其他包。

GHC的包管理器

GHC包含了一个简单的包管理器，它可以跟踪已经安装了哪些包，以及这些包的版本。一个名为ghc-pkg 的命令行工具可以操作这些包数据库。


我们称这些数据库(databases复数)是因为GHC区分系统级包和分用户单独的包。系统级包对每一个用户都可用，而分用户单独包只有当前用户可见。分用户数据库可以让我们不需要系统管理员权限就能安装包。

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 文件，我们就剩下三步了。

1. 要告诉 Cabal一个包如何构建以及安装到哪里，我们运行一个简单的命令。

$ runghc Setup configure

这会确保我们需要的包都可用，并把设置存储下来供后面其他的Cabal命令使用。

如果不给 configure 提供参数，Cabal 将把包安装到系统级包数据库中。要把它安装到我们自己的home目录和自己的个人包数据库中，必须提供些其他信息：

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

2. 构造包：

$ runghc Setup build

3. 如果构建成功，就可以安装这个包。我们不需要指出要安装到哪里-Cabal将使用configue阶段提供的设置。他将被安装到我们自己的目录中，并更新GHC的分用户包数据库。

$ runghc Setup install

实践忠告和延伸阅读

GHC已经捆绑了一个整齐打印库 Text.PrettyPrint.HughesPJ。它提供了和我们的例子相同的基本API，但是有更丰富更有用的整齐打印函数。我们推荐使用它而不是用我们自己写的这个。

John Hughes在 "The Design of a Pretty-Printing library"中介绍了HughesPJ的设计（http://citeseer.ist.psu.edu /hughes95design.html）。这个库后来被  Simon Peyton Jones 改进，因此得名。Hughes到论文有些长，但是它对如何设计一个Haskell库的讨论很值得一读。

在本章中，我们的整齐打印库基于 Philip Wadler在"A prettier printer"中描述的简化系统（http://citeseerx.ist.psu.edu/viewdoc /summary?doi=10.1.1.19.635）。他的库被 Daan Leijen扩展了；这个版本在hackage可以下载到： wl-pprint。如果你使用 cabal 的命令行，可以一步完成下载构建和安装： cabal install wl-pprint。

[10] 助记： -o 表示 "output" 或者  "object file"

[11] BSD3 中的 "3" 表示许可中的条款数量。有一个更老版本的BSD许可包含了4个条款。