如何使这个折叠更通用

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我的新折叠的位置.它需要是Type,f i x但我不知道如何告诉Haskell如何采用x与它相同的类型begin.

Answer 1

主要是我自己的理解（以及我心爱的橡皮鸭的理解）：

假设我有一个 FoldsumLengths可以增加字符串的长度（因此fold sumLengths ["a","bbb"]得到 4）

我想overMaps sumLengths成为一个 Fold，它需要一本法语和一本荷兰语词典，并制作一本新词典，D例如 lookup D "bread"9 ( length("pain") + length("brood"))

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

这意味着仅仅将step函数提升到Map k（在这种情况下，我们可以使用 的任何实例Applicative来代替我们的 Map，见下文）是行不通的，我们必须begin一路获取我们的值。

这个“加上默认值”就是下面一个新类的lift成员。它是 您原始代码中的 ，但（稍微）概括化了，例如，我们还有一个for 列表列表。fuseWithFusablestep'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 :-(