3

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

{-# 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

我想定义一个功能，它可以提高公司资产的工资，这些资产没有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已给出且无法更改）。

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

这个问题与我发布的一个类似问题有关，但在这种情况下使用everywhere'不会有帮助，因为在某些情况下不应该提高工资。

4

2 回答 2

2

这可以通过Traversalfor来完成CompanyAsset。您可以自己编写，或使用uniplate或plate从镜头中编写。

为了说明，我要CompanyAsset显式地写一个遍历 for。它将操作（我称之为p）pure应用于公司资产的每个直接后代。请注意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
于 2017-11-16T21:27:08.210 回答
1

使用recursion-schemes以及一些 Template Haskell生成基本CompanyAssetF函子的解决方案：

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

import Data.Functor.Foldable (cata,embed)
import Data.Functor.Foldable.TH (makeBaseFunctor)

$(makeBaseFunctor ''CompanyAsset)

raiseSalaries :: CompanyAsset -> CompanyAsset
raiseSalaries asset = cata go asset raise'
    where
    go c raiser = embed $
        case c of
            BossF _ Bad _ _ -> fmap ($ id) c
            _ -> raiser $ fmap ($ raiser) c
    raise' (BossF name perf salary rec) = BossF name perf (raise salary) rec
    raise' (EmployeeF name salary) = EmployeeF name (raise salary)
    raise' other = other

代数返回一个函数，以使“应该得到提升”信息能够从根流向叶子。

于 2017-11-18T16:24:36.720 回答