我怎样才能使这个折叠更通用？

Question

我写了这个函数：

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
module Hierarchy where

import           Control.Applicative
import qualified Control.Foldl       as CF
import           Control.Foldl (Fold(..))
import           Control.Lens hiding (Fold)
import qualified Data.Foldable       as F
import qualified Data.Map.Lazy       as M
import           Data.Monoid         (Monoid (..), Sum (Sum))
import           Data.Profunctor
import           Data.Set (Set)
import           Data.Maybe
import           Data.Text           (Text)

overMaps :: (Ord k) => Fold a b -> Fold (M.Map k a) (M.Map k b)
overMaps (Fold step begin done) = Fold step' M.empty (fmap done)   
  where
  step' acc m = M.foldrWithKey insert acc m
  insert k el acc = M.insert k (step (fromMaybe begin $ M.lookup k acc) el) acc

我觉得我缺少了一些基本的抽象，这可以使它更笼统，更简洁。

有人能给我一些指点，说明我怎样才能用现代的Haskellisms来使这件事更好吗？

编辑代码在这里https://github.com/boothead/hierarchy/blob/master/src/Hierarchy.hs

我已经把进口的东西

编辑，也许我可以使用ifoldr来接近@cdk的想法？

编辑

这是我最近的一次。

--overFoldable :: (Ord k) => Fold a b -> Fold (M.Map k a) (M.Map k b)
overFoldable :: (Ord i, At (f i a), FoldableWithIndex i (f i), Monoid (f i x))
             => Fold a b -> Fold (f i a) (f i b)
overFoldable (Fold step begin done) = Fold step' mempty (fmap done)
  where
  step' acc m = Lens.ifoldr insert acc m
  insert k el acc = Lens.at k %~ return . flip step el . fromMaybe begin $ acc

在这里，第一个(注释)类型签名工作。现在问题在于存在的x，在Fold :: (x -> a -> x) -> x -> (x -> b) -> Fold a b的类型签名中，我不知道该把什么放在新折叠的begin位置上。它需要f i x类型，但我不知道如何告诉Haskell如何将x与begin的类型相同。

Answer 1

主要是为了我自己的理解(以及我心爱的橡胶鸭)：

假设我有一个折叠sumLengths，它可以增加字符串的长度(因此fold sumLengths ["a","bbb"]生成4)

我想让overMaps sumLengths成为一个折页，比如一本法语和一本荷兰词典，并制作一本新的字典D，使lookup D "bread" is 9 (length("pain") + length("brood"))。

当然，问题是有些词可能不会出现在所有的字典中：lookup D "sex"是length("sexe")，因为我们荷兰语非常简单:-)所以我们需要我们的折叠的begin值，不仅在我们的折叠开始，而且可能在任何时候。

这意味着它不能仅仅将step函数提升到Map k (在这种情况下，我们可以使用Applicative的任何实例而不是我们的Map，参见下面)，我们必须始终保持begin值。

这个"lift +默认值“是下面一个新类Fusable的成员fuseWith。这是您的原始代码中的step'，但是(稍微)泛化了，例如，我们也有一个用于列表列表的overF sumLengths。

import Data.Map as M hiding (map)
import qualified Control.Foldl       as CF
import Control.Foldl (Fold(..))
import Control.Applicative
import Data.Foldable as F
import Data.Maybe

--- the Fusable class:
class Functor f => Fusable f where
  fuseWith :: x -> (x -> a -> x) -> f x -> f a -> f x 
  emptyf   :: f a 

--- Map k is a Fusable (whenever k has an ordering)
instance (Ord k) => Fusable (Map k) where
   fuseWith x f xmap amap = M.foldrWithKey insert xmap amap where    
      insert k el xmap = M.insert k (f (fromMaybe x $ M.lookup k xmap) el) xmap 
   emptyf = M.empty

--- Lists are Fusable
instance Fusable [] where
  fuseWith  = zipWithDefault where
    zipWithDefault dx f [] ys = zipWith f (repeat dx) ys
    zipWithDefault dx f xs [] = xs
    zipWithDefault dx f (x:xs) (y:ys) = (f x y) : zipWithDefault dx f xs ys
  emptyf = []

--- The generalised overMaps:
overF :: (Fusable f) => Fold a b  -> Fold (f a) (f b)
overF (Fold step begin done) = Fold (fuseWith begin step) emptyf (fmap done)

--- some tests
testlist = [(1,4),(3,99),(7,999)]
testlist2 = [(1,15),(2,88)]

test  = CF.fold (overF CF.sum)  $ map fromList [testlist, testlist2] 
-- fromList [(1,19),(2,88),(3,99),(7,999)]
test2 = CF.fold (overF $ CF.premap snd CF.sum) [testlist, testlist2] 
-- [19,187,999]

如果我们不担心使用begin值，我们可以使用任何Applicative (Map k不是Applicative!)

overA :: (Applicative f) => Fold a b -> Fold (f a) (f b)
overA (Fold step begin done) = Fold (liftA2 step) (pure begin) (fmap done)

它看起来确实很像overF。但是它给出了不同的结果:当折叠到一个列表上时，一旦出现一个太短的列表，结果就会被截断。

test3 = CF.fold (overA $ CF.premap snd CF.sum) $  map ZipList [testlist, testlist2] 
-- ZipList [19,187]  -- *where* is my third element :-(