haskell - 仅在少数情况下遍历多态结构并执行转换

假设我们以下列方式表示公司层次结构:

{-# LANGUAGE DeriveDataTypeable #-}

import           Data.Data
import           Data.Generics.Aliases
import           Data.Generics.Schemes

data CompanyAsset = Employee Name Salary
                  | Plant Name
                  | Boss Name Performance Salary [CompanyAsset]
                  | Pet Name
                  | Car Id
                  | Guild [CompanyAsset]
                  | Fork CompanyAsset CompanyAsset
                  -- ... and imagine 100 more options that recursively use `CompanyAsset`.
                  deriving (Show, Data)

-- Performance of the department.
data Performance = Good | Bad deriving (Show, Data)

type Name = String

type Id = Int

newtype Salary = Salary Double deriving (Show, Data, Typeable)

raise :: Salary -> Salary

我想定义一个函数来提高公司 Assets 的工资，这些 Assets 没有 Boss 祖先，其部门有 Bad 表现。这样的函数可以很容易地定义如下:

raiseSalaries :: CompanyAsset -> CompanyAsset
raiseSalaries (Boss n Good s as) = Boss n Good (raise s) (raiseSalaries <$> as)
raiseSalaries a@(Boss _ Bad _ _) = a -- The salaries of everything below are not raised if the performance is 'Bad'
raiseSalaries ... -- and from here onwards we have **boilerplate**!

问题是这需要很多样板文件(为了讨论起见，请假设 CompanyAsset 已给出且无法更改)。

所以我的问题是是否有一种方法可以避免上面的样板文件来遍历数据结构。

这个问题与我发布的 similar one 相关，但在这种情况下，使用 everywhere' 无济于事，因为在某些情况下不应提高工资。

最佳答案

这可以通过 Traversal 的 CompanyAsset 来完成。可以自己写，也可以使用lens中的 uniplate 或 plate 。

为了说明，我将明确地为 CompanyAsset 编写一个遍历。它将操作(我在 p 中称为 pure )应用于公司 Assets 的每个直接后代。请注意 traverse_ca pure == pure 。

traverse_ca :: Applicative f => (CompanyAsset -> f CompanyAsset) -> CompanyAsset -> f CompanyAsset
traverse_ca p ca =
  case ca of
    Fork ca1 ca2      -> Fork <$> p ca1 <*> p ca2
    Boss n perf s cas -> Boss n perf s <$> traverse p cas
    Guild cas         -> Guild <$> traverse p cas
    otherwise         -> pure ca

这本身就足以定义 raiseSalaries 而无需任何额外的样板。

import Data.Functor.Identity

raiseSalaries :: CompanyAsset -> CompanyAsset
raiseSalaries (Boss n Good s as) = Boss n Good (raise s) (raiseSalaries <$> as)
raiseSalaries a@(Boss _ Bad _ _) = a -- The salaries of everything below are not raised if the performance is 'Bad'
raiseSalaries a = runIdentity $ traverse_ca (pure . raiseSalaries) a

关于haskell - 仅在少数情况下遍历多态结构并执行转换，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/47327889/