어떻게 내가이 기능을 작성했습니다

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

내가 수입

편집은 아마도 내가 @ CDK의 아이디어에 가까운 얻을 ifoldr을 사용할 수를 포함 시켰습니다?

편집 여기

내가있어 가장 가까운입니다.

--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의 유형 서명에 존재합니다. 내 새 배의 begin 위치에 무엇을 넣을 지 알 수 없습니다. 타입이 f i x 일 필요가 있지만, 하스켈에게 x을 가져 오는 방법을 알려주는 방법이 begin과 같은 타입이어야합니다.

Answer 1

주로 내 자신의 이해에 대한

(그리고 그 내 사랑하는 rubber duck) :

가정하자 내가 가진 내가 overMaps sumLengths가되고 싶어요

문자열 (그래서 fold sumLengths ["a","bbb"] 수율 4)의 길이를 추가하는 폴드 sumLengths 접어 그는 프랑스와 네덜란드의 사전을 말한다 소요되며, lookup D "bread" 물론 문제는 그래서입니다 9 (length("pain") + length("brood"))

것을 D 같은 새 사전을 만든다 모든 사전에 단어가 나타나지 않을 수도 있습니다. lookup D "sex"은 length("sexe")입니다. 네덜란드어는 매우 번거롭기 때문에 :-) 우리 접이식의 가치는입니다.

이는, 우리가 모두 함께 우리의 begin 값을해야 단지 (아래 참조, 우리가 대신 우리 Map의 Applicative의 인스턴스를 사용할 수있는 경우) Map k에 step 기능을 들어 올릴 할 수 없음을 의미합니다 방법.

" 기본 값"은 아래의 새 클래스 Fusable의 구성원 fuseWith입니다. 원래 코드는 step'이지만 약간 (예 : overF sumLengths) 목록이 있으므로 일반화되어 있습니다. 우리가 함께 begin 값을 복용에 대해 걱정하지 않는 경우

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] 

, 우리는 어떤 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과 비슷합니다. 그러나 다른 결과를 제공합니다 : 즉시,리스트의리스트를 접는 경우 목록이 너무 짧은 함께, 결과는 내가 typeclass`Hoogle에서 Fold`을 찾을 수 없습니다

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