遍历将多个 map 操作组合成单个 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（就目前而言，它是 lens 和..不是 lens 的混合物）将 at 组合到多个 Maps:

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

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

我想做的是在所有可能的 Interim 上构建索引遍历（而不是非索引折叠），但到目前为止，我还没有运气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，事情需要稍微改变一下，但这个想法是有希望的声音。

如果你的目标是遍历[=19=]中的所有Interim，那么先将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
      }

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

Traversal to combine multiple map operations into single ADT

haskell

traversal

lenses

haskell-lens