others - Haskell - 如何使用递归scheme而不是显式递归来遍历类型?

83 5

考虑以下代码:


import Data.Maybe (fromMaybe)



data MyStructure = Foo Int | Bar String MyStructure | Baz MyStructure MyStructure | Qux Bool Bool MyStructure MyStructure deriving(Eq,Show)



makeReplacements :: [(MyStructure, MyStructure)] -> MyStructure -> MyStructure


makeReplacements replacements structure = fromMaybe (descend structure) (lookup structure replacements)


 where


 descend :: MyStructure -> MyStructure


 descend (Foo x) = Foo x


 descend (Bar x y) = Bar x (makeReplacements replacements y)


 descend (Baz x y) = Baz (makeReplacements replacements x) (makeReplacements replacements y)


 descend (Qux x y z w) = Qux x y (makeReplacements replacements z) (makeReplacements replacements w)



它定义了递归数据类型,以及执行搜索,并且通过遍历来替换的函数,但是我使用了显式递归,我希望能改用递归scheme。


{-# LANGUAGE DeriveTraversable, TypeFamilies #-}



import Data.Maybe (fromMaybe)


import Data.Functor.Foldable (Base, Recursive(..), Corecursive(..))



data MyStructure = Foo Int | Bar String MyStructure | Baz MyStructure MyStructure | Qux Bool Bool MyStructure MyStructure deriving(Eq,Show)



makeReplacements :: [(MyStructure, MyStructure)] -> MyStructure -> MyStructure


makeReplacements replacements structure = fromMaybe (descend structure) (lookup structure replacements)


 where


 descend :: MyStructure -> MyStructure


 descend = embed . fmap (makeReplacements replacements) . project



-- begin code that would normally be auto-generated


data MyStructureF r = FooF Int | BarF String r | BazF r r | QuxF Bool Bool r r deriving(Foldable,Traversable)



instance Functor MyStructureF where


 fmap _ (FooF x) = FooF x


 fmap f (BarF x y) = BarF x (f y)


 fmap f (BazF x y) = BazF (f x) (f y)


 fmap f (QuxF x y z w) = QuxF x y (f z) (f w)



type instance Base MyStructure = MyStructureF



instance Recursive MyStructure where


 project (Foo x) = FooF x


 project (Bar x y) = BarF x y


 project (Baz x y) = BazF x y


 project (Qux x y z w) = QuxF x y z w



instance Corecursive MyStructure where


 embed (FooF x) = Foo x


 embed (BarF x y) = Bar x y


 embed (BazF x y) = Baz x y


 embed (QuxF x y z w) = Qux x y z w


-- end code that would normally be auto-generated



descend (Baz x y) = Baz x (makeReplacements replacements y)(忘记在x内替换),然而,这个仍然是显式递归,因为我仍然在它自己的定义中使用makeReplacements。

时间: 原作者:

61 5

我找到了一个相当满意的解决方案:


makeReplacements replacements = apo coalg


 where


 coalg :: MyStructure -> MyStructureF (Either MyStructure MyStructure)


 coalg structure = case lookup structure replacements of


 Just replacement -> Left <$> project replacement


 Nothing -> Right <$> project structure




makeReplacements replacements = para alg


 where


 alg :: MyStructureF (MyStructure, MyStructure) -> MyStructure


 alg structure = case lookup (embed $ fst <$> structure) replacements of


 Just replacement -> replacement


 Nothing -> embed $ snd <$> structure



原作者:
...