将多个地图操作组合成单个 ADT 的遍历

问题描述

给定由多个映射组成的记录，我如何编写允许我将查找分组在一起的遍历（或棱镜，或 Lens' TestLens (Maybe Interim)）？

首先，我目前的尝试。

data TestLens = TL
    { _foo1 :: Map.Map Text Int,_foo2 :: Map.Map Text Bool,_foo3 :: Map.Map Text Text
    } deriving Show
 
tl = TL (Map.fromList [("a",5),("b",6),("c",1),("d",3)])
         (Map.fromList [("b",True),False),True)])
         (Map.fromList [("c","foo"),"bar")])
 
makeLenses ''TestLens
 
data Interim = Interim Int Bool Text deriving Show
data Interim2 = Interim2 Int Bool deriving Show

getonePart s l k = s ^. l . at k
 
interim s k = Interim <$> getonePart s foo1 k <*> getonePart s foo2 k <*> getonePart s foo3 k
interim2 s k = Interim2 <$> getonePart s foo1 k <*> getonePart s foo2 k
doTestStuff = tl ^.. folding (\s -> mapMaybe (interim s) (Map.keys $ s ^. foo1)) 

预期行为是 interim（就目前而言，它是镜头和..不是镜头的混杂）在多个 at 上组合 Map：

interim tl "a" = nothing
interim tl "c" = Just (Interim 1 False "foo")

然后我可以折叠所有可能的键以获得完整的 Interim 列表。

我希望能够做的是在所有可能的 Interim 上构建索引遍历（而不是未索引的折叠），但到目前为止我在 {{ 的组合中没有运气1}} 我需要这里..我怀疑是因为我在 itraversed 和 map 之间切换：

lens

我无法同样确定是否通过制作 itraverseInterim2s = ... > tl ^@.. itraverseInterim2s [("b",Interim2 6 True),Interim2 1 False),Interim2 3 True)] -- and if we assume there exists _1 :: Lens' Interim2 Int > tl & itraverseInterim2s . _1 %~ (+5) TL (Map.fromList [("a",11),8)]) (Map.fromList [("b","bar")]) 、Lens' TestLens (Maybe Interim2)（我认为其中只有一个满足镜头定律）或通过遍历单个元素来更好地解决最后一个行为k -> Prism' TestLens Interim2。

显然，对于我希望能够从 itraverseInterim2s . index k 映射组合中提取的每个 InterimX ADT，我都必须编写较小的样板，但这一点没问题。

解决方法

你有没有考虑过写一些类似的东西：

fanoutTraversal :: Traversal' s a -> Traversal' s b -> Traversal' s (a,b)
fanoutTraversal t1 t2 fab s =
  maybe (pure s) (fmap update . fab) mv
  where
    mv = liftA2 (,) (s ^? t1) (s ^? t2)
    update (c,d) = s & t1 .~ c & t2 .~ d

使用此函数，您可以将 interim 写为：

interim :: Text -> Traversal' TestLens Interim
interim k = (((foo1 . ix k) `fanoutTraversal` (foo2 . ix k)) `fanoutTraversal` (foo3 . ix k)) . interimIso
  where
    interimIso = iso (\((a,b),c) -> Interim a b c) (\(Interim a b c) -> ((a,c))

如果您想使用 at 代替 ix 或使用 IndexedTraversal 代替 Traversal，情况需要稍微改变，但希望这个想法是合理的。

---

如果您的目标是遍历 Interim 中的所有 TestLens，首先将 TestLens 转换为 Map.Map Text Interim 然后遍历该映射可能更容易：

import Control.Lens hiding ((<.>))
import Data.Functor.Apply (Apply(..)) -- could just as well use Map.intersectionWith

manyInterim :: Traversal' TestLens Interim
manyInterim = manyInterim' . traverse

-- Let's use this version of Interim so that we have record access
data Interim = Interim
  { i1 :: Int,i2 :: Bool,i3 :: Text
  } deriving Show

manyInterim' :: Lens' TestLens (Map.Map Text Interim)
manyInterim' = lens sa sbt
  where
    sa TL{..} = Interim <$> _foo1 <.> _foo2 <.> _foo3
    sbt TL{..} interimMap = TL
      { _foo1 = Map.union (i1 <$> interimMap) _foo1,_foo2 = Map.union (i2 <$> interimMap) _foo2,_foo3 = Map.union (i3 <$> interimMap) _foo3
      }