遍历将多个映射操作组合成单个 ADT

Question

给定一个由多个映射组成的记录，我如何编写一个遍历（或棱镜，或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), ("c", False), ("d", True)])
         (Map.fromList [("c", "foo"), ("d", "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多个Maps：

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

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

我想做的是在所有可能的Interims 上建立一个索引遍历（而不是一个未索引的折叠），但到目前为止我在itraversed我的组合中没有运气需要在这里..我怀疑是因为我在map 和lens 之间切换：

itraverseInterim2s = ...

> tl ^@.. itraverseInterim2s
[("b", Interim2 6 True), ("c", Interim2 1 False), ("d", Interim2 3 True)]
-- and if we assume there exists _1 :: Lens' Interim2 Int
> tl & itraverseInterim2s . _1 %~ (+5)
TL (Map.fromList [("a", 5), ("b", 11), ("c", 6), ("d", 8)])
         (Map.fromList [("b", True), ("c", False), ("d", True)])
         (Map.fromList [("c", "foo"), ("d", "bar")])

我无法确定是否通过制作Lens' TestLens (Maybe Interim2)、k -> Prism' TestLens Interim2（我认为其中只有一个满足镜头定律）或使用itraverseInterim2s . index k 遍历单个元素来更好地解决最后一个行为。

显然，对于每个InterimX ADT，我希望能够从fooX 映射的组合中提取我将不得不编写小样板，但这一点很好。

Answer 1

你有没有考虑过写这样的东西：

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,b),c))

如果您想使用at 而不是ix 或使用IndexedTraversal 而不是Traversal，则需要稍作改动，但希望这个想法是合理的。

---

如果您的目标是遍历TestLens 中的所有Interims，可能更容易先将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
      }