使用計數器為樹的節點編號

我們有這樣的樹資料型別:

data Tree a = Tree a [Tree a] deriving Show

我們希望編寫一個函式,從遞增計數器為樹的每個節點分配一個數字:

tag::Tree a -> Tree (a, Int)

漫漫長路

首先我們要做很長一段時間,因為它很好地說明了 State monad 的低階機制。

import Control.Monad.State

-- Function that numbers the nodes of a `Tree`.
tag::Tree a -> Tree (a, Int)
tag tree = 
    -- tagStep is where the action happens.  This just gets the ball
    -- rolling, with `0` as the initial counter value.
    evalState (tagStep tree) 0

-- This is one monadic "step" of the calculation.  It assumes that
-- it has access to the current counter value implicitly.
tagStep::Tree a -> State Int (Tree (a, Int))
tagStep (Tree a subtrees) = do
    -- The `get::State s s` action accesses the implicit state
    -- parameter of the State monad.  Here we bind that value to
    -- the variable `counter`.
    counter <- get 

    -- The `put::s -> State s ()` sets the implicit state parameter
    -- of the `State` monad.  The next `get` that we execute will see
    -- the value of `counter + 1` (assuming no other puts in between).
    put (counter + 1)

    -- Recurse into the subtrees.  `mapM` is a utility function
    -- for executing a monadic actions (like `tagStep`) on a list of
    -- elements, and producing the list of results.  Each execution of 
    -- `tagStep` will be executed with the counter value that resulted
    -- from the previous list element's execution.
    subtrees' <- mapM tagStep subtrees  

    return $ Tree (a, counter) subtrees'

重構

將計數器拆分為 postIncrement 操作

我們正在使用當前計數器然後 putting counter + 1 的位可以分成一個 postIncrement 動作,類似於許多 C 風格的語言提供的:

postIncrement::Enum s => State s s
postIncrement = do
    result <- get
    modify succ
    return result

將樹步行拆分為高階函式

樹行走邏輯可以拆分為自己的函式,如下所示:

mapTreeM::Monad m => (a -> m b) -> Tree a -> m (Tree b)
mapTreeM action (Tree a subtrees) = do
    a' <- action a
    subtrees' <- mapM (mapTreeM action) subtrees
    return $ Tree a' subtrees'

有了這個和 postIncrement 功能,我們可以重寫 tagStep

tagStep::Tree a -> State Int (Tree (a, Int))
tagStep = mapTreeM step
    where step::a -> State Int (a, Int)
          step a = do 
              counter <- postIncrement
              return (a, counter)

使用 Traversable

上面的 mapTreeM 解決方案可以很容易地重寫為 Traversable 類的一個例項 :

instance Traversable Tree where
    traverse action (Tree a subtrees) = 
        Tree <$> action a <*> traverse action subtrees

請注意,這要求我們使用 Applicative<*> 運算子)而不是 Monad

有了它,現在我們可以像專業人士一樣寫 tag

tag::Traversable t => t a -> t (a, Int)
tag init t = evalState (traverse step t) 0
    where step a = do tag <- postIncrement
                      return (a, tag)

請注意,這適用於任何 Traversable 型別,而不僅僅是我們的 Tree 型別!

擺脫 Traversable 樣板

GHC 有一個 DeriveTraversable 擴充套件,無需編寫上面的例項:

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}

data Tree a = Tree a [Tree a]
            deriving (Show, Functor, Foldable, Traversable)