は、多型の構造を横断し、ほんの数例で

Question

変換を行って、我々は次の方法で会社の階層を表しているとします

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

そして、私はそうではない会社の資産の給与を上げる機能をdefneしたいと思います部門がBadのパフォーマンスを持つ祖先Bossを持っている次のような機能を簡単に定義することができます。

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'を使用しても給与を引き上げるべきではない場合があるので、助けになりません。

Answer 1

TraversalをCompanyAssetとして実行することができます。あなた自身で書くこともできますし、レンズからuniplateまたはplateを使用することもできます。

説明のため、私はCompanyAssetのトラバーサルを明示的に記述します。これは、企業資産の直接の子孫のそれぞれに操作（pureのようにpと呼ぶ）を適用します。 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 

Answer 2

recursion-schemesを使用する溶液、およびまたa bit of 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 

を代数から流れるように情報を「上げる取得する必要があり、」有効にするために関数を返します葉の根。