Ch10 Code case study: parsing a binary data format.tex

\documentclass[./main.tex]{subfiles}

\begin{document}

本章我们将要探讨一个通用任务：解析一个二进制文件。使用该任务有两个目的，第一是借助解析来探讨程序的规划，重构，以及“模板化代码移除”。
我们将展示如何简化重复的代码，并为我们在第 14 章 Monads 中做准备。

我们将使用的文件格式源自 netpbm 套件，这是一个古老而可敬的用于处理位图图像的程序和文件格式集合。这些文件格式具有广泛的时候以及容易
解析的双重有点。更重要的是为了方便起见，netpbm 文件没有被压缩。

\subsection*{灰度文件}

netpbm 的灰度文件格式为 PGM（“portable grey map”）。它有两种格式构；“plain”（或“P2”）格式是由 ASCII 编码的，而更常用的“raw”
（“P5”）则是二进制格式。

两种格式的文件都有 header，即一个用于描述格式的“魔力”字符串。对于一个 plain 文件而言，字符串为\acode{P2}；raw 文件则是\acode{P5}。
紧随字符串后的则是一个空格然后再是三个数字：图片的宽度，长度，以及最大灰度。这些数字皆为 ASCII 小数，由空格分隔。

接下来的就是图片数据。raw 文件中是二进制的字符串，plain 文件中则是由单空格字符分隔的 ASCII 小数构成。

raw 文件可以包含一系列的图片，一张接着一张，每张由 header 开头；plain 文件仅包含一张图片。

\subsection*{解析一个原始 PGM 文件}

我们的第一个解析函数仅需考虑 raw PGM 文件，同时该解析函数是一个\textit{纯}函数。该函数并不对数据获取负责，仅仅用作于解析。这在
Haskell 中是一个常规操作。通过分离数据读取，我们获得了更加灵活的操作空间。

我们将使用\acode{ByteString}类型来存储 greymap 数据。由于 PGM 文件的头部是 ASCII 文本，而本体是二进制的，我们需要同时引用文本
以及二进制的\acode{ByteString}模块。

\begin{lstlisting}[language=Haskell]
  import qualified Data.ByteString.Lazy as L
  import qualified Data.ByteString.Lazy.Char8 as L8
  import Data.Char (isSpace)
\end{lstlisting}

我们将使用一个直接的数据类型来表示 PGM 图片。

\begin{lstlisting}[language=Haskell]
  data Greymap = Greymap
  { greyWidth :: Int,
    greyHeight :: Int,
    greyMax :: Int,
    greyData :: L.ByteString
  }
  deriving (Eq)
\end{lstlisting}

通常而言，Haskell 的\acode{Show}实例应该生成一个字符串作为展示，同时我们可以通过\acode{read}将其从字符串中转回。然而对于 bitmap
图像文件而言，这会潜在的生产出巨大的文本字符串，例如对一个图片执行\acode{show}。因此我们不会让编译器自动派生一个\acode{Show}实例：
我们编写自己的实现，并将其简化。

\begin{lstlisting}[language=Haskell]
  instance Show Greymap where
    show (Greymap w h m _) = "Greymap " ++ show w ++ "x" ++ show h ++ " " ++ show m
\end{lstlisting}

因为我们的\acode{Show}实例是特意避开了打印 bitmap 数据，因此我们无法编写一个\acode{Read}实例，毕竟我们不能通过\acode{show}的
结果来重新构建一个合法的\acode{Greymap}。

接下来是我们解析函数的类型：

\begin{lstlisting}[language=Haskell]
  parseP5 :: L.ByteString -> Maybe (Greymap, L.ByteString)
\end{lstlisting}

该函数接受一个\acode{ByteString}，如果解析成功则返回一个单独解析好的\acode{Greymap}，以及剩下还需要解析的字符串。

我们的解析函数需要需要花费一点时间。首先是确保输入的文件是 raw PGM；接着解析文件头剩下的数值；然后再是解析 bitmap 数据。下面是一个
浅显的表达方式：

\begin{lstlisting}[language=Haskell]
  matchHeader :: L.ByteString -> L.ByteString -> Maybe L.ByteString
  matchHeader = undefined

  getNat :: L.ByteString -> Maybe (Int, L.ByteString)
  getNat = undefined

  getBytes :: Int -> L.ByteString -> Maybe (L.ByteString, L.ByteString)
  getBytes = undefined

  -- parse function
  parseP5 :: L.ByteString -> Maybe (Greymap, L.ByteString)
  parseP5 s =
    case matchHeader (L8.pack "PS") s of
      Nothing -> Nothing
      Just s1 ->
        case getNat s1 of
          Nothing -> Nothing
          Just (width, s2) ->
            case getNat (L8.dropWhile isSpace s2) of
              Nothing -> Nothing
              Just (height, s3) ->
                case getNat (L8.dropWhile isSpace s3) of
                  Nothing -> Nothing
                  Just (maxGrey, s4)
                    | maxGrey > 255 -> Nothing
                    | otherwise ->
                        case getBytes 1 s4 of
                          Nothing -> Nothing
                          Just (_, s5) ->
                            case getBytes (width * height) s5 of
                              Nothing -> Nothing
                              Just (bitmap, s6) ->
                                Just (Greymap width height maxGrey bitmap, s6)
\end{lstlisting}

这非常字面化的代码将所有的解析放在了一个长的阶梯型的\acode{case}表达式上。每个函数在消费完其所需的字符串后，都会返回剩下的
\acode{ByteString}。接着解构每个结果，如果解析失败则返回\acode{Nothing}。下面是解析过程中所用到的函数：

\begin{lstlisting}[language=Haskell]
  matchHeader :: L.ByteString -> L.ByteString -> Maybe L.ByteString
  matchHeader prefix str
    | prefix `L8.isPrefixOf` str = Just (L8.dropWhile isSpace (L.drop (L.length prefix) str))
    | otherwise = Nothing

  getNat :: L.ByteString -> Maybe (Int, L.ByteString)
  getNat s = case L8.readInt s of
    Nothing -> Nothing
    Just (num, rest)
      | num <= 0 -> Nothing
      | otherwise -> Just (fromIntegral num, rest)

  getBytes :: Int -> L.ByteString -> Maybe (L.ByteString, L.ByteString)
  getBytes n str =
    let count = fromIntegral n
        both@(prefix, _) = L.splitAt count str
     in if L.length prefix < count
          then Nothing
          else Just both
\end{lstlisting}

\subsection*{移除样板代码}

虽然\acode{parseP5}函数能工作，其形态并不令人满意。我们不停地重复\acode{Maybe}值的构建与解构，且仅在匹配\acode{Just}时继续。
所有的这些相似的\acode{case}表达式就像是“模板代码”那样。

我们可以看到有两个模式。首先是很多应用的函数都有相同的类型，接受\acode{ByteString}作为其最后一个参数，并返回\acode{Maybe}。
其次\acode{parseP5}函数中的每一步“阶梯”都会解构一个\acode{Maybe}值，要么失败或是传递未解包的结果给一个函数。

我们可以轻易地用一个函数捕获第二个模式。

\begin{lstlisting}[language=Haskell]
  (>>?) :: Maybe a -> (a -> Maybe b) -> Maybe b
  Nothing >>? _ = Nothing
  Just v >>? f = f v
\end{lstlisting}

\acode{>>?}函数的作用非常简单：它接受一个值作为其右参，以及一个函数作为其左参。如果值非\acode{Nothing}，那么便将函数应用在
\acode{Just}值上。我们定义了作为一个操作符的函数，以此可以链接所有函数在一起。最后我们并未提供给\acode{(>>?)}一个优先级声明，
那么默认为\acode{infixl 9}（左结合，最强的操作符优先级）。换言之，\acode{a >>? b >>? c}将会从左至右进行计算，类似于
\acode{(a >>? b) >>? c}。

有了这个链接函数，我们可以再尝试一下编写我们的解析函数。

\begin{lstlisting}[language=Haskell]
  parseP5_take2 :: L.ByteString -> Maybe (Greymap, L.ByteString)
  parseP5_take2 s =
    matchHeader (L8.pack "P5") s
      >>? \s ->
        skipSpace ((), s)
          >>? (getNat . snd)
          >>? skipSpace
          >>? \(width, s) ->
            getNat s
              >>? skipSpace
              >>? \(height, s) ->
                getNat s
                  >>? \(maxGrey, s) ->
                    getBytes 1 s
                      >>? (getBytes (width * height) . snd)
                      >>? \(bitmap, s) -> Just (Greymap width height maxGrey bitmap, s)

  skipSpace :: (a, L.ByteString) -> Maybe (a, L.ByteString)
  skipSpace (a, s) = Just (a, L8.dropWhile isSpace s)
\end{lstlisting}

理解这个函数的关键在于链条的思考。每个\acode{(>>?)}的左侧总是一个\acode{Maybe}值；右侧则是一个返回\acode{Maybe}值的函数。
那么表达式的两侧类型都是\acode{Maybe}，即满足下一个\acode{(>>?)}表达式。

另一个增加可读性的工作就是添加了\acode{skipSpace}函数。

\subsection*{隐式状态}

我们的代码仍然在显式的传递一对一对的值，第一个元素作为解析过程中的结果，第二个元素则是当前剩余的\acode{ByteString}。当我们想要
扩展代码时，例如追踪消费了多少字节数量以便报告解析异常位置的时候，我们需要修改八个不同的地方，仅仅是为了传递一个三元组。

即使在少量代码的情况下，这样的需求都会使得代码难以修改。这个问题存在于使用模式匹配从每个元组中提取值时：我们默认了在代码中直接使用
元组。

让我们讲解一下新代码为何是不灵活的。首先修改解析器使用的状态类型。

\begin{lstlisting}[language=Haskell]
  data ParseState = ParseState
  { string :: L.ByteString,
    offset :: Int64
  }
  deriving (Show)
\end{lstlisting}

在我们新的代数数据类型中，我们同时拥有了追踪剩余字符串以及当前偏移量的能力。最重要的变化还是使用了 record 语义：现在可以\textit{避免}
对状态的模式匹配了，而是使用访问函数\acode{string}以及\acode{offset}。

我们给与需要解析的状态一个名称。当我们为某物命名时，它可以变得更有意义。例如，我们可以将解析视为一种函数：其消费一个解析状态，并同时
生产一个新的解析状态，以及一些额外的信息。我们可以直接将其视为一个 Haskell 类型。

\begin{lstlisting}[language=Haskell]
  simpleParse :: ParseState -> (a, ParseState)
  simpleParse = undefined
\end{lstlisting}

为了更好的帮助用户，我们可以在解析失败时报告异常信息。这仅仅需要我们解析器一点小小的改动。

\begin{lstlisting}[language=Haskell]
  betterParse :: ParseState -> Either String (a, ParseState)
  betterParse = undefined
\end{lstlisting}

之前显式的使用状态元组时，要扩展解析器的时候我们很快就发现问题了。为了避免重复，我们将使用\acode{newtype}声明来隐去解析类型的细节。

\begin{lstlisting}[language=Haskell]
  newtype Parse a = Parse
  { runParse :: ParseState -> Either String (a, ParseState)
  }
\end{lstlisting}

记住\acode{newtype}定义就是一个编译时的包装函数，因此它没有任何的运行时负荷。当我们使用该函数时，我们将应用\acode{runParser}
访问函数。

如果我们不从模块中导出\acode{Parse}值，我们可以确保他人不会意外的创建一个解析器，也避免了通过模式匹配来查看内部实现。

\subsubsection*{唯一性解析器}

让我们尝试定义一个简单的解析器，\textit{identity}解析器。它的功能便是将任何传递进其的参数转换为解析器的结果。这种情况下，它更像是
\acode{id}函数。

\begin{lstlisting}[language=Haskell]
  identity :: a -> Parse a
  identity a = Parse (\s -> Right (a, s))
\end{lstlisting}

该函数不会改变解析状态，并使用其参数作为解析的结果。我们将函数体包装成\acode{Parse}类型来满足类型检查器。那么我们该如何使用该包装后
的函数来进行解析呢？

首先我们通过\acode{runParse}函数去除\acode{Parse}的包装，以此获取其中的函数。接着构造一个\acode{ParseState}，并以此运行我们的
解析函数。最后则是将解析的结果从最终的\acode{ParseState}中分离。

\begin{lstlisting}[language=Haskell]
  parse :: Parse a -> L.ByteString -> Either String a
  parse parser initState =
    case runParse parser (ParseState initState 0) of
      Left err -> Left err
      Right (result, _) -> Right result
\end{lstlisting}

由于\acode{identity}解析器与\acode{parse}函数都不会测试状态，我们甚至不需要创建一个字符串输入来进行测试。

\begin{lstlisting}[language=Haskell]
  ghci> :l Parse.hs
  [1 of 1] Compiling Main             ( Parse.hs, interpreted )
  Ok, one module loaded.
  ghci> :t parse (identity 1) undefined
  parse (identity 1) undefined :: Num a => Either String a
  ghci> parse (identity 1) undefined
  Right 1
  ghci> parse (identity "foo") undefined
  Right "foo"
\end{lstlisting}

解析器甚至不会检查其不感兴趣的输入，之后我们将见识到其有用之处。

\subsubsection*{Record 语义，更新，以及模式匹配}

Record 语义不仅仅只有访问函数有用：我们用它来拷贝以及修改现有值的一部分。使用中，概念如下：

\begin{lstlisting}[language=Haskell]
  modifyOffset :: ParseState -> Int64 -> ParseState
  modifyOffset initState newOffset = initState {offset = newOffset}
\end{lstlisting}

这会创造一个新的与\acode{initState}一样的\acode{ParseState}值，不过其\acode{offset}字段被设置成了指定的\acode{newOffset}。

\begin{lstlisting}[language=Haskell]
  ghci> :l Parse.hs
  [1 of 1] Compiling Main             ( Parse.hs, interpreted )
  Ok, one module loaded.
  ghci> let before = ParseState (L8.pack "foo") 0
  ghci> let after = modifyOffset before 3
  ghci> before
  ParseState {string = "foo", offset = 0}
  ghci> after
  ParseState {string = "foo", offset = 3}
\end{lstlisting}

我们可以在花括号内部设置任意数量的字段，通过逗号进行分隔。

\subsubsection*{一个更有趣的解析器}

现在让我们聚焦到编写一个更有意义的解析器上。我们暂时没有太大的野心：我们需要的是解析一个单字节。

\begin{lstlisting}[language=Haskell]
  parseByte :: Parse Word8
  parseByte =
    getState ==> \initState ->
      case L.uncons (string initState) of
        Nothing ->
          bail "no more input"
        Just (byte, remainder) ->
          putState newState ==> \_ ->
            identity byte
          where
            newState = initState {string = remainder, offset = newOffset}
            newOffset = offset initState + 1
\end{lstlisting}

定义中出现了若干新函数。

\acode{L8.uncons}函数从一个\acode{ByteString}中接受首个元素。

\begin{lstlisting}[language=Haskell]
  ghci> L8.uncons (L8.pack "foo")
  Just ('f',"oo")
  ghci> L8.uncons L8.empty
  Nothing
\end{lstlisting}

\acode{getState}函数获取当前的解析状态，而\acode{putState}则是用于替换状态；\acode{bail}函数则是终结解析并报告异常；\acode{(==>)}
函数将解析器链接起来。我们将稍后对每个函数进行解析。

\begin{anote}
  Hanging lambdas

  \acode{parseByte}的定义拥有一个视觉上的风格是我们之前没有讨论过的。它包含的匿名函数为参数以及\acode{->}作为一行的结尾，而函数体起始于
  下一行。

  这种方式的匿名函数并没有一个官方的名称，所以让我们称其“hanging lambda”。它主要的作用是为函数体留下更多的空间，同样可以将函数及其后续部分的
  关系在视觉上进行区分。例如通常而言，首个函数的结果会被当做参数传递给下一个函数。
\end{anote}

\subsubsection*{获取与修改解析状态}

\acode{parseByte}函数并不将解析状态作为一个参数，而是调用\acode{getState}来获取一个状态的拷贝，\acode{putState}则是将当前状态替换。

\begin{lstlisting}[language=Haskell]
  getState :: Parse ParseState
  getState = Parse (\s -> Right (s, s))

  putState :: ParseState -> Parse ()
  putState s = Parse (\_ -> Right ((), s))
\end{lstlisting}

当读取这些函数，记住元组的左元素是\acode{Parse}的结果，而右元素则是当前解析状态。这使得接下来的函数变得更加方便使用。

\acode{getState}函数提取当前解析中的状态，使得调用者可以访问字符串。\acode{putState}函数替换当前解析中的状态。该状态通过\acode{==>}链在
下一个函数中可见。

这些函数让我们显式的移动状态在仅需要其所需的函数中。很多函数并不需要知道当前的状态，因此它们永远也不会调用\acode{getState}或者\acode{putState}。
这相较于之前手动使用元组的解析器，这让我们可以编写出更简洁的代码，

我们将解析状态的细节打包进\acode{ParseState}类型中，通过访问函数而不是模式匹配来进行工作。现在的解析状态是被隐式的传递，这为我们带来了极大的便利。
如果我们希望添加更多的信息在解析状态中，我们仅需要修改\acode{ParseState}的定义，以及任何需要这些新的信息的函数。相较于早期编写的解析器，所有的
状态都被模式匹配所暴露，现在的代码则更加模块化：所有被影响的代码为需要新信息的代码。

\subsubsection*{报告解析异常}

我们小心的定义\acode{Parse}类型来兼容所有可能的异常。\acode{==>}组合子检查一个解析异常，并在出现异常时停止。然而我们仍未介绍\acode{bail}函数，
其用于报告解析异常。

\begin{lstlisting}[language=Haskell]
  bail :: String -> Parse a
  bail err = Parse $ \s ->
    Left $
      "byte offset " ++ show (offset s) ++ ": " ++ err
\end{lstlisting}

在我们调用\acode{bail}之后，\acode{(==>)}将会成功的在\acode{Left}构造子上进行模式匹配包装错误信息，接着唤起链条中下一个解析函数。这将导致
错误信息通过链条反向传递至上一级调用者。

\subsubsection*{链起所有解析器}

\acode{(==>)}函数类似之前的\acode{(>>?)}函数：它用于“粘合”使得所有函数链接在一起。

\begin{lstlisting}[language=Haskell]
  (==>) :: Parse a -> (a -> Parse b) -> Parse b
  firstParser ==> secondParser = Parse chainedParser
    where
      chainedParser initState =
        case runParse firstParser initState of
          Left errMessage ->
            Left errMessage
          Right (firstResult, newState) ->
            runParse (secondParser firstResult) newState
\end{lstlisting}

\acode{(==>)}的函数体很有意思。回忆一下\acode{Parse}类型是一个被包装装的函数。因为\acode{(==>)}将两个\acode{Parse}值链接生产出第三个值，
它必须返回一个包装后的函数。

该函数不需要真正的“做”什么：它仅仅是创建一个\textit{闭包 closure}来记住\acode{firstParser}与\acode{secondParser}的值。

\begin{anote}
  闭包其实就是一个带有\textit{环境}的函数，其边界变量为其可见区域。闭包在 Haskell 中很常见。例如\acode{(+5)}就是一个闭包。该闭包的实现必须将
  值\acode{5}作为操作符\acode{(+)}的第二个参数，因此无论函数传递的值是什么，其返回将会加五。
\end{anote}

闭包不会被解包并执行，直到应用了\acode{parse}函数。此时它将被应用至一个\acode{ParseState}上，首先是应用\acode{firstParser}并检验其结果。
如果解析失败，闭包同样也会失败；否则它将传递解析的结果，以及新的\acode{ParseState}至\acode{secondParser}。

这真的是一个美妙的东西：我们高效的将\acode{ParseState}隐式的传递至\acode{Parse}链。（我们在稍后的章节中继续学习。）

\subsection*{函子简介}

我们现在已经很熟悉\acode{map}函数了，它将一个函数应用在一个列表中的每个元素上，返回很可能是另一种类型的列表。

\begin{lstlisting}[language=Haskell]
  ghci> map (+1) [1,2,3]
  [2,3,4]
  ghci> map show [1,2,3]
  ["1","2","3"]
  ghci> :t map show
  map show :: Show a => [a] -> [String]
\end{lstlisting}

\acode{map}-类似的行为在其它实例中也很有用。例如，假设有一个二元树。

\begin{lstlisting}[language=Haskell]
  data Tree a
  = Node (Tree a) (Tree a)
  | Leaf a
  deriving (Show)
\end{lstlisting}

如果我们想要将一个字符串树转换为一个包含了这些字符串长度的树，我们可以这样做：

\begin{lstlisting}[language=Haskell]
  treeLengths (Leaf s) = Leaf (length s)
  treeLengths (Node l r) = Node (treeLengths l) (treeLengths r)
\end{lstlisting}

现在可以将目光转向更为通用的函数：

\begin{lstlisting}[language=Haskell]
  treeMap :: (a -> b) -> Tree a -> Tree b
  treeMap f (Leaf a) = Leaf (f a)
  treeMap f (Node l r) = Node (treeMap f l) (treeMap f r)
\end{lstlisting}

正如我们希望的那样，\acode{treeLengths}与\acode{treeMap length}可以得到同样的结果。

\begin{lstlisting}[language=Haskell]
  ghci> :l TreeMap.hs
  [1 of 1] Compiling Main             ( TreeMap.hs, interpreted )
  Ok, one module loaded.
  ghci> let tree = Node (Leaf "foo") (Node (Leaf "x") (Leaf "quux"))
  ghci> treeLengths tree
  Node (Leaf 3) (Node (Leaf 1) (Leaf 4))
  ghci> treeMap length tree
  Node (Leaf 3) (Node (Leaf 1) (Leaf 4))
  ghci> treeMap (odd . length) tree
  Node (Leaf True) (Node (Leaf True) (Leaf False))
\end{lstlisting}

Haskell 提供了一个著名的 typeclass 来泛化\acode{treeMap}。该 typeclass 就是\acode{Functor}，其定义为一个函数，\acode{fmap}。

我们可以认为\acode{fmap}类似于之前小节中所提到的\textit{提升 lifting}函数。它接受类型为\acode{a -> b}的函数，将其提升至应用在容器上的
\acode{f a -> f b}函数，这里的\acode{f}即容器类型。

如果我们将\acode{f}替换为\acode{Tree}类型，那么\acode{fmap}的类型应与\acode{treeMap}一致，那么实际上我们可以用\acode{treeMap}作为
\acode{Tree}的\acode{fmap}实现。

\begin{lstlisting}[language=Haskell]
  instance Functor Tree where
  fmap = treeMap
\end{lstlisting}

\acode{Functor}的定义强制了一些明显的限制在\acode{fmap}上。例如我们仅能实现\acode{Functor}实例在只有一个类型参数的类型上。

例如我们不可以将\acode{fmap}实现在\acode{Either a b}或\acode{(a, b)}上，因为它们有两个类型参数。同样的，我们不能实现在\acode{Bool}
或\acode{Int}上，因为它们没有类型参数。

另外，我们不能在类型约束上添加任何约束。这是什么意思呢？为了更好的进行解释，首先看一下普通的\acode{data}定义以及其\acode{Functor}实例。

\begin{lstlisting}[language=Haskell]
  data Foo a = Foo a

  instance Functor Foo where
    fmap f (Foo a) = Foo (f a)
\end{lstlisting}

当我们定义一个新的类型，我们可以添加一个类型约束在\acode{data}关键字之后。

\begin{lstlisting}[language=Haskell]
  data Eq a => Bar a = Bar a

  instance Functor Bar where
    fmap f (Bar a) = Bar (f a)
\end{lstlisting}

报错如下：

\begin{lstlisting}
  • No instance for (Eq a) arising from a use of ‘Bar’
    Possible fix:
      add (Eq a) to the context of
        the type signature for:
          fmap :: forall a b. (a -> b) -> Bar a -> Bar b
  • In the pattern: Bar a
    In an equation for ‘fmap’: fmap f (Bar a) = Bar (f a)
    In the instance declaration for ‘Functor Bar’typecheck(-Wdeferred-type-errors)
\end{lstlisting}

\subsubsection*{类型定义上的约束并不好}

在一个类型定义上添加一个约束这种行为基本上永远不会是一个好主意。它造成的影响便是强迫用户在\textit{每个}函数上也都添加类型约束。假设我们需要一个
栈数据结构，使得我们可以查询其元素是否遵从某种排序。下面是该数据类型的定义：

\begin{lstlisting}[language=Haskell]
  data (Ord a) => OrdStack a
    = Bottom
    | Item a (OrdStack a)
    deriving (Show)
\end{lstlisting}

如果我们希望编写一个函数用于检查栈结构是否增加，我们显然需要一个\acode{Ord}约束来执行一对元素的比较。

\begin{lstlisting}[language=Haskell]
  isIncreasing :: (Ord a) => OrdStack a -> Bool
  isIncreasing (Item a rest@(Item b _))
    | a < b = isIncreasing rest
    | otherwise = False
  isIncreasing _ = True
\end{lstlisting}

然而因为我们在类型定义上加上了类型约束，该约束实际上影响了完全不需要的地方：我们需要添加\acode{Ord}约束至\acode{push}，其本身并不关心堆上的
顺序。

\begin{lstlisting}[language=Haskell]
  push :: (Ord a) => a -> OrdStack a -> OrdStack a
  push a s = Item a s
\end{lstlisting}

这个时候尝试移除上述函数的\acode{Ord}约束，\acode{push}则会在类型检查时失败。

这也是为什么较早之前我们尝试着为\acode{Bar}编写一个\acode{Functor}实例时失败了：它需要\acode{Eq}约束在\acode{fmap}上。

现在我们有了 Haskell 中在类型定义上添加类型约束是不好的认知，那么更合理的做法呢？答案就是简单的移除在类型定义上的类型约束，且放置在真正需要约束的
函数上。

\subsubsection*{fmap 的中缀使用}

很多时候我们会看到\acode{fmap}作为操作符一样调用：

\begin{lstlisting}[language=Haskell]
  ghci> (1+) `fmap` [1,2,3] ++ [4,5,6]
  [2,3,4,4,5,6]
\end{lstlisting}

如果希望作为操作符那样使用\acode{fmap}，那么\acode{Control.Applicative}模块中有一个操作符\acode{(<\$>)}，它是\acode{fmap}的别名。
名称中\acode{\$}展现了一种相似性，即将一个函数应用至其参数（通过\acode{(\$)}操作符）以及将一个函数提升至一个函子。

\subsubsection*{灵活的实例}

我们可能希望能为\acode{Either Int b}实现一个\acode{Functor}实例，因为它仅有一个类型参数。

\begin{lstlisting}[language=Haskell]
  instance Functor (Either Int) where
    fmap _ (Left n) = Left n
    fmap f (Right r) = Right (f r)
\end{lstlisting}

然而 Haskell 98 的类型系统不能保证，这样的一个实例约束的检查能终止。非终止的约束检查可能会让编译器陷入无限循环，因此禁用了这样形式的实例。

\begin{lstlisting}[language=Haskell]
  • Illegal instance declaration for ‘Functor (Either Int)’
    (All instance types must be of the form (T a1 ... an)
    where a1 ... an are *distinct type variables*,
    and each type variable appears at most once in the instance head.
    Use FlexibleInstances if you want to disable this.)
  • In the instance declaration for ‘Functor (Either Int)’typecheck
\end{lstlisting}

原书使用一下代码解决编译出错的问题：

\begin{lstlisting}[language=Haskell]
  {-# LANGUAGE FlexibleInstances #-}

  instance Functor (Either Int) where
    fmap _ (Left n) = Left n
    fmap f (Right r) = Right (f r)
\end{lstlisting}

然而实际上新的 Haskell 仍然不能通过编译，报错如下：

\begin{lstlisting}[language=Haskell]
  • Overlapping instances for Functor (Either Int)
      arising from a use of ‘GHC.Base.$dm<$’
    Matching instances:
      instance Functor (Either a) -- Defined in ‘Data.Either’
      instance Functor (Either Int)
        -- Defined at <...>/EitherIntFlexible.hs:7:10
  • In the expression: GHC.Base.$dm<$ @(Either Int)
    In an equation for ‘<$’: (<$) = GHC.Base.$dm<$ @(Either Int)
    In the instance declaration for ‘Functor (Either Int)’typecheck(-Wdeferred-type-errors)
\end{lstlisting}

实际上，Haskell 的标准库早已更新，详见上一本书的笔记《Learn Me a Haskell》中第八章的“函子 typeclass”部分。Haskell 的标准实现如下：

\begin{lstlisting}[language=Haskell]
  instance Functor (Either a) where
    fmap f (Right x) = Right (f x)
    fmap f (Left x) = Left x
\end{lstlisting}

因为有了 Haskell 的标准实现，我们可以直接进行以下操作：

\begin{lstlisting}[language=Haskell]
  ghci> fmap (== "cheeseburger") (Left 1 :: Either Int String)
  Left 1
  ghci> fmap (== "cheeseburger") (Right "fries" :: Either Int String)
  Right False
\end{lstlisting}

\subsubsection*{更多有关函子的思考}

我们已经做了一些有关函子该如何工作的隐式假设。那么将它们显式的展示出来并思考它们的规则就更有帮助了，因为这让我们可以将函子视为一致的，良好行为的
对象。我们仅需记住两个简单的规则。

第一条规则就是函子必须是保持\textit{恒等 identity}的，也就是说将\acode{fmap id}应用至一值时，返回的总是相同的值。

\begin{lstlisting}[language=Haskell]
  ghci> fmap id (Node (Leaf "a") (Leaf "b"))
  Node (Leaf "a") (Leaf "b")
\end{lstlisting}

第二条规则则是函子必须是\textit{可组合的 composable}，也就是说将两个\acode{fmap}组合起来使用与分别两次\acode{fmap}使用的结果是一致的。

\begin{lstlisting}[language=Haskell]
  ghci> (fmap even . fmap length) (Just "twelve")
  Just True
  ghci> fmap (even . length) (Just "twelve")
  Just True
\end{lstlisting}

另一种看待这两天规则的方式是，函子必须保持\textit{形状 shape}。集合的结构不应该受到函子的影响；只有它所包含的值应该改变。

\begin{lstlisting}[language=Haskell]
  ghci> fmap odd (Just 1)
  Just True
  ghci> fmap odd Nothing
  Nothing
\end{lstlisting}

如果你在编写一个\acode{Functor}实例，那么牢记这些规则并且进行了测试是很有帮助的，因为编译器并不能上述列举的规则。另一方面，如果仅仅\textit{使用}
函子，那么规则是“自然而然的”无需记住它们。

\subsection*{为解析编写函子实例}

对于已经调研过得这些类型，我们对\acode{fmap}所预期的行为就显而易见了。相较于\acode{Parse}因为复杂度的缘故会较难理解。一个合理的猜想就是我们所
\acode{fmap}的函数应该被应用在一个解析器的当前结果上，同时不对解析状态做任何修改。

\begin{lstlisting}[language=Haskell]
  instance Functor Parse where
  fmap f parser =
    parser ==> \result ->
      identity (f result)
\end{lstlisting}

这个定义很容易阅读，让我们用几个快速的测试来检查我们是否遵循了函子的规则。

首先检查的是 identity 是否被遵循。首先是一个应该失败的解析：从一个空的字符串中解析一个字节（别忘了\acode{(<\$>)}就是\acode{fmap}）。

\begin{lstlisting}[language=Haskell]
  ghci> :l Parse.hs
  [1 of 2] Compiling Main             ( Parse.hs, interpreted )
  Ok, one module loaded.
  ghci> parse parseByte L.empty
  Left "byte offset 0: no more input"
  ghci> parse (id <$> parseByte) L.empty
  Left "byte offset 0: no more input"
\end{lstlisting}

现在测试一下成功的案例：

\begin{lstlisting}[language=Haskell]
  ghci> let input = L8.pack "foo"
  ghci> L.head input
  102
  ghci> parse parseByte input
  Right 102
  ghci> parse (id <$> parseByte) input
  Right 102
\end{lstlisting}

通过上述结果同样可知我们的函子实例遵循了第二条规则，即保持形状。失败保持失败，成功保持成功。

最后就是组合起来也是保存原有形状的。

\begin{lstlisting}[language=Haskell]
  ghci> :m +Data.Char
  ghci> parse ((chr . fromIntegral) <$> parseByte) input
  Right 'f'
  ghci> parse (chr <$> fromIntegral <$> parseByte) input
  Right 'f'
\end{lstlisting}

\subsection*{为解析使用函子}

所有关于函子的讲解都是为了一个目的：它们可以让我们编写简洁有力的代码。回忆一下之前介绍过的\acode{parseByte}函数。我们总是想要处理 ASCII 字符而不是
\acode{Word8}值。

我们可以模仿\acode{parseByte}那样编写一个\acode{parseChar}函数，不过现在可以通过\acode{Parse}的函子特性来避免这些重复的代码。函子接受一个解析的
结果并为该结果应用一个函数，因此我们需要一个函数可以将\acode{Word8}转换成一个\acode{Char}。

\begin{lstlisting}[language=Haskell]
  w2c :: Word8 -> Char
  w2c = chr . fromIntegral

  parseChar :: Parse Char
  parseChar = w2c <$> parseByte
\end{lstlisting}

可以使用函子来编写一个简洁的“peek”函数。它将在输入的字符串结束时返回\acode{Nothing}；否则返回下一个字符，同时不消耗它（即检查时不会影响当前的解析状态）。

\begin{lstlisting}[language=Haskell]
  peekByte :: Parse (Maybe Word8)
  peekByte = fmap fst . L.uncons . string <$> getState
\end{lstlisting}

同样的方法可以为\acode{parseChar}定义一个更加简洁的\acode{peekChar}版本。

\begin{lstlisting}[language=Haskell]
  peekChar :: Parse (Maybe Char)
  peekChar = fmap w2c <$> peekByte
\end{lstlisting}

注意\acode{peekByte}与\acode{peekChar}都调用了\acode{fmap}，即\acode{(<\$>)}。这是因为\acode{Parse (Maybe a)}类型是一个函子中的函子。
因此我们需要将一个函数提升两次来“走进”里面的函子。

最后让我们编写另一个泛用的组合子，也就是类似于\acode{takeWhile}版本的\acode{Parse}：消费输入直到谓词返回\acode{True}。

\begin{lstlisting}[language=Haskell]
  parseWhile :: (Word8 -> Bool) -> Parse [Word8]
  parseWhile p =
    (fmap p <$> peekByte) ==> \mp ->
      if mp == Just True
        then
          parseByte ==> \b ->
            (b :) <$> parseWhile p
        else identity []
\end{lstlisting}

下面是一个不使用函子的繁琐版本，不过更加直接：

\begin{lstlisting}[language=Haskell]
  parseWhileVerbose p =
  peekByte ==> \mc ->
    case mc of
      Nothing -> identity []
      Just c
        | p c ->
            parseByte ==> \b ->
              parseWhileVerbose p ==> \bs ->
                identity (b : bs)
        | otherwise ->
            identity []
\end{lstlisting}

这个繁琐的版本在不熟悉函子时虽然看似易读，但是在 Haskell 中使用函子更为常见，它的表达更加简洁，因此应该同时成为读与写的本能。

\subsection*{重写 PGM 解析器}

没有新的解析代码时，原始的 PGM 解析函数会是什么样子呢？

\begin{lstlisting}[language=Haskell]
  parseRawPGM =
    parseWhileWith w2c notWhite ==> \header ->
      skipSpaces
        ==>& assert (header == "P5") "invalid raw header"
        ==>& parseNat
        ==> \width ->
          skipSpaces
            ==>& parseNat
            ==> \height ->
              skipSpaces
                ==>& parseNat
                ==> \maxGrey ->
                  parseByte
                    ==>& parseBytes (width * height)
                    ==> \bitmap ->
                      identity (Greymap width height maxGrey bitmap)
    where
      notWhite = (`notElem` " \r\n\t")
\end{lstlisting}

该定义又使用了以下的帮助函数：

\begin{lstlisting}[language=Haskell]
  parseWhileWith :: (Word8 -> a) -> (a -> Bool) -> Parse [a]
  parseWhileWith f p = fmap f <$> parseWhile (p . f)

  parseNat :: Parse Int
  parseNat =
    parseWhileWith w2c isDigit ==> \digits ->
      if null digits
        then bail "no more input"
        else
          let n = read digits
           in if n < 0
                then bail "integer overflow"
                else identity n

  (==>&) :: Parse a -> Parse b -> Parse b
  p ==>& f = p ==> const f

  skipSpaces :: Parse ()
  skipSpaces = parseWhileWith w2c isSpace ==>& identity ()

  assert :: Bool -> String -> Parse ()
  assert True _ = identity ()
  assert False err = bail err
\end{lstlisting}

\acode{(==>&)}组合子像\acode{(==>)}那样将解析器链接起来，不过右侧的解析器会无视左侧所返回的结果。\acode{assert}函数允许我们检查一个属性，当该
属性为\acode{False}时会终止解析并返回一个有用的错误信息。

最后就是检查与修改解析状态。

\begin{lstlisting}[language=Haskell]
  parseBytes :: Int -> Parse L.ByteString
  parseBytes n =
    getState ==> \st ->
      let n' = fromIntegral n
          (h, t) = L.splitAt n' (string st)
          st' = st {offset = offset st + L.length h, string = t}
       in putState st'
            ==>& assert (L.length h == n') "end of input"
            ==>& identity h
\end{lstlisting}

\subsection*{未来的方向}

略

\end{document}