Làm thế nào tôi có thể làm cho lần này chung chung hơn

Question

Tôi đã viết chức năng này:

{-# 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 

Tôi cảm thấy như tôi đang thiếu một số trừu tượng cơ bản có thể làm cho này tổng quát hơn, và gọn gàng hơn.

Có ai có thể cho tôi một số gợi ý về cách sử dụng bất kỳ Haskellisms hiện đại nào ở đây để cải thiện điều này không?

chỉnh sửa Mã này là ở đây https://github.com/boothead/hierarchy/blob/master/src/Hierarchy.hs

và tôi đã bao gồm nhập khẩu

chỉnh sửa Có lẽ tôi có thể sử dụng ifoldr để có được gần gũi hơn với ý tưởng @ cdk không?

chỉnh sửa

Dưới đây là gần nhất tôi đã có.

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

Đây là chữ ký loại đầu tiên (nhận xét) hoạt động. Bây giờ vấn đề nằm trong sự tồn tại x trong chữ ký loại Fold :: (x -> a -> x) -> x -> (x -> b) -> Fold a b Tôi không thể tìm ra những gì để đặt ở vị trí begin của lần mới của tôi. Nó cần phải được loại f i x nhưng tôi không biết làm thế nào để nói với Haskell làm thế nào để có x để được cùng loại như begin.

Answer 1

Chủ yếu cho sự hiểu biết của riêng tôi (và của tôi yêu quý rubber duck):

Giả sử tôi có một Fold sumLengths có thêm độ dài của chuỗi (để fold sumLengths ["a","bbb"] sản lượng 4)

Tôi muốn overMaps sumLengths trở thành một gấp rằng có nói một người Pháp và một cuốn từ điển tiếng Hà Lan, và làm cho một từ điển mới D mà lookup D "bread" là 9 (length("pain") + length("brood"))

vấn đề tất nhiên là như vậy tôi từ có thể không xảy ra trong tất cả các từ điển: lookup D "sex" là length("sexe") vì chúng tôi Hà Lan rất thận trọng :-) Vì vậy, chúng tôi cần giá trị begin lần đầu tiên của chúng tôi không chỉ ở đầu của lần của chúng tôi, nhưng có thể bất cứ lúc nào.

Điều này có nghĩa nó sẽ không làm gì để vừa nâng step chức năng để Map k (trong trường hợp đó chúng ta có thể sử dụng bất kỳ trường hợp Applicative thay vì của chúng tôi Map, xem dưới đây), chúng ta phải lấy giá trị begin của chúng tôi dọc theo đường.

Giá trị "lift cộng với giá trị mặc định" là thành viên fuseWith của lớp mới Fusable bên dưới. Đây là mã số step' trong mã ban đầu của bạn, nhưng (hơi) được khái quát hóa để chúng tôi cũng có một số overF sumLengths cho danh sách các danh sách.

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] 

Nếu chúng ta không phải lo lắng về việc giá trị begin cùng, chúng ta có thể sử dụng bất kỳ Applicative (Map k không phải là Applicative!)

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

Nó chắc chắn trông rất giống overF. Nhưng nó cho kết quả khác nhau: khi xếp chồng lên danh sách danh sách, ngay khi danh sách xuất hiện quá ngắn, kết quả bị cắt ngắn

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