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

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

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

Answer 1

主要是为了我自己的理解(以及我心爱的rubber duck):

假设我有一个 Fold sumLengths 来添加字符串的长度(因此 fold sumLengths ["a","bbb"] 得到 4)

我希望 overMaps sumLengths 成为一个 Fold，它采用法语和荷兰语词典，并创建一个新词典 D ，这样查找 D“bread” 为 9 (length("pain") + length("brood"))

问题当然是有些单词可能不会出现在所有词典中:查找 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 不是 适用!)

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 :-(