Haskell Json数据处理

json的基本类型为——string, numbers, Booleans以及null，定义json类型如下

-- file: Json.hs

module Json where

data JValue = JString String

           |  JNumber Double

           |  JBool Bool

           |  JNull 

           |  JObject [(String, JValue)]

           |  JArray [JValue]

              deriving(Eq, Ord, Show)

打印Json类型数据

-- file: PutJson.hs

module PutJson where

import Data.List (intercalate)

import Json

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)

putJValue :: JValue –> IO()

putJValue v = putStrLn (renderJValue v)

最后编写调用文件

-- file: Main.hs

module Main where

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

在命令行中输入如下指令

ghc –o demo Json.hs PutJson.hs Main.hs

生成demo.exe，然后在命令行中输入demo，即可得到JValue的打印字符串。如果JValue的值结构非常复杂，则通过这种方法打印出来显得对人类不够友好。那么，如何友好的打印出来呢？

假设我们有一个模块Prettify，这个模块的API将JValue转换为Doc而不是上面的String，我们重写render函数如下，

-- file: 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

其中，Doc类型，text，double和string函数由我们的Prettify模块实现。

先给出string函数的定义

-- file: PrettyJson.hs

string :: String –> Doc

string = enclose '"' '"' . hcat . map oneChar

这个定义中使用了自由点风格（自由点风格），本来函数是从左向右运算的，使用自由点风格后，等价于

-- file: PrettyJson.hs

string :: String –> Doc

string s = enclose '"' '"' (hcat (map oneChar s))                                          （1）

可以看出，使用这种风格，省去参数s，并将小括号替换为点号。这个定义中，出现了各种函数，现在来依次分解。enclose函数是在一个Doc对象的前面和后面分别附加字符，其定义如下

-- file: PrettyJson.hs

enclose :: Char –> Char –> Doc –> Doc

enclose left right x = char left <> x <> char right

char是一个函数，用于将一个Char字符类型转换为Doc类型，目前我们还不知道其方法体，先用undefined表示其方法体，这样， 签名如下，

-- file: PrettyJson.hs

char :: Char –> Doc

char c = undefined

<>是一个中缀函数，写在两个运算分量中间时，看作一个运算符，其运算优先级比作为函数的char底，故enclose函数方法体可以这么看，char函数将Char字符类型参数left和right转换为两个Doc类型参数，然后与另一个Doc类型参数 x 用两个 <> 运算符连接，容易知道，<>连接两个Doc类型参数，得到另一个Doc类型结果，签名如下，其实，这个<>运算符类似于String类型的(++)运算符，即连接两个Doc参数，生成一个新的Doc类型结果。

-- file: PrettyJson.hs

(<>) :: Doc –> Doc –> Doc

a <> b = undefined

我们再看（1），现在可以知道string函数的作用就是对(hcat (map oneChar s)) 这个Doc类型值两边添加双引号 (")，于是我们接着看hcat函数，这个函数类似于list的连接函数concat （注意跟 <> 的区别），签名如下

-- file: PrettyJson.hs

hcat :: [Doc]-> Doc

hcat xs = undefined

接下来，由于map函数是对列表s的每个元素应用oneChar函数，故我们只要看一下oneChar函数是干什么用的就可以了。由于s是一个String类型，故oneChar函数是将一个Char类型转为一个Doc类型，给出函数的详细定义如下，

-- file: PrettyJson.hs

oneChar :: Char –> Doc

oneChar c = case lookup c simpleEscapes of 

              Just r –> text r

              Nothing | mustEscape –> hexEscape c

                      | otherwise  ->  char c

    where mustEscape c = c < ' ' || c == 'x7f' || c > 'xff'

simpleEscapes :: [(Char, String)]

simpleEscapes = zipWith ch "
f
	\"/" "bnfrt\"/"

    where ch a b = (a, ['\', b]

这段函数定义篇幅稍微有点大，我们一点一点来看，首先simpleEscapes是一个二元元组的列表，元组的第一项为一个简单转义字符（, , f, , , \, ", /)，第二项是将第一项表现出来，比如 '' ，表现为 "\b" ,可以写一个测试如下

Prelude> :load PrettyJson.hs

Prelude> take 8 simpleEscapes

[('',"\b"),('
',"\n"),('f',"\f"),('
',"\r"),('	',"\t"),('\',"\\"),('"',"\""),('/',"\/")]

lookup函数是检查字符c是否在simpleEscapes中某一元组的第一项，如果是，则返回这个转义字符的字符串表现形式，如果字符c不是简单的转义字符，则如果是其他需要转义的字符，对字符c应用hexEscape函数，否则，就是简单的字符，不需要转义，直接应用char函数将Char类型转为Doc类型。

还有一个函数hexEscape还未给出解析。我们直接给出定义如下

-- file: PrettyJson.hs

hexEscape :: Char –> Doc

hexEscape c | d < 0x10000 = smallHex d

            | otherwise   = astral (d – 0x10000)

    where d = ord c

根据字符c的ascii码值是否小于0x10000，对字符c的码值进行不同的处理。

-- file: PrettyJson.hs

smallHex :: Int –> Doc

smallHex x = text "\u"

          <> text (replicate (4 – length h) ‘0’)

          <> text h

    where h = showHex x ""

其中，showHex函数来自Numeric库，需要在文件的开头import这个库。showHex函数的功能是以16进制打印一个数。replicate函数是将一个指定类型a重复n次，生成一个a类型的列表

replicate :: Int –> a –> [a]

根据hexEscape的定义，字符c的ascii码值（16进制）的长度不超过4位（根据guard表达式为d< 0x10000得到），故4 – length h 的范围为[0, 4]，smallHex函数的作用是这样打印参数x，先打印"\u"， 然后x的16进制位数如果不足4位，补0使得满足4位，然后打印x的16进制值。

smallHex函数能打印的值最大不超过0xffff，而有效的unicode字符范围上限一直到0x10ffff，对 (0xffff, 0x10ffff) 的字符，应用 astral 函数，其定义给出如下

-- file: PrettyJson.hs

astral :: Int –> Doc

astral n = smallHex (a + 0xd800) <> smallHex (b + 0xdc00)

    where a = (n `shiftR` 10).&. 0x3ff

          b = n .&. 0x3ff

其中，shiftR是右移函数，(.&.)是按位与。我们看一下astral函数是如何处理参数n的，对于参数n，取其低10位作为b，取其第11位到第20位（次低10位）作为a，当然了，前面说到参数的范围为 (0xffff, 0x10ffff) ，值位数就是17位到20位，故 a 是高10位，b 是低10位。