用镜头索引遍历

Rea*_*onk 4 haskell haskell-lens

我有一个镜头指向一个 json 文档,例如

doc ^? ((key "body").values)
Run Code Online (Sandbox Code Playgroud)

现在我想用键“key”对 body 中的值进行索引,因为 json 看起来像

{"body": [{"key": 23, "data": [{"foo": 1}, {"foo": 2}]}]}
Run Code Online (Sandbox Code Playgroud)

所以我正在寻找一些可以让我通过另一个镜头进行索引的东西:

doc ^? key "body" . values
      . indexWith (key "key")
      . key "data" . values
      . key "foo" . withIndex
Run Code Online (Sandbox Code Playgroud)

应该返回

[(23, 1), (23, 2)]
Run Code Online (Sandbox Code Playgroud)

MVCE:

#!/usr/bin/env stack
-- stack --resolver lts-11.7 script
-- --package lens
-- --package text
-- --package lens-aeson
{-# LANGUAGE OverloadedStrings #-}
import Control.Lens
import Data.Aeson.Lens
import Data.Text

doc :: Text
doc = "{\"body\": [{\"key\": 23, \"data\": [{\"foo\": 1}, {\"foo\": 2}]}]}"

-- Something akin to Lens -> Traversal -> IndexedTraversal
indexWith :: _
indexWith = undefined

-- should produce [(23, 1), (23, 2)]
indexedBody :: [(Int, Int)]
indexedBody = doc ^? key "body" . values
                   . indexWith (key "key")
                   . key "data" . values
                   . key "foo" . withIndex

main = print indexedBody
Run Code Online (Sandbox Code Playgroud)

Car*_*arl 5

新的、令人作呕的完整答案

\n\n

我终于回到了带有 GHC 的真实计算机,并做了一些更彻底的测试。我发现两件事:1)我的基本想法是有效的。2)按照你想要的方式使用它有很多微妙之处。

\n\n

以下是一些开始实验的扩展定义:

\n\n
{-# Language OverloadedStrings, FlexibleContexts #-}\n\nimport Control.Lens\nimport Data.Aeson\nimport Data.Aeson.Lens\nimport Data.Text\nimport Data.Monoid (First)\nimport Data.Maybe (isJust, fromJust)\n\ndoc :: Text\ndoc = "{\\"body\\": [ {\\"key\\": 23, \\"data\\": [{\\"foo\\": 1}, {\\"foo\\": 2}]}, {\\"key\\": 29, \\"data\\": [{\\"foo\\": 11}, {\\"bar\\": 12}]} ]}"\n\ndoc2 :: Text\ndoc2 = "{\\"body\\": [ {\\"data\\": [{\\"foo\\": 21}, {\\"foo\\": 22}]}, {\\"key\\": 23, \\"data\\": [{\\"foo\\": 1}, {\\"foo\\": 2}]}, {\\"key\\": 29, \\"data\\": [{\\"foo\\": 11}, {\\"bar\\": 12}]} ]}"\n\nsubIndex :: Indexable i p => Getting i s i -> p s fb -> s -> fb\nsubIndex f = reindexed (view f) selfIndex\n\nsubIndex2 :: Indexable (Maybe a) p => Getting (First a) s a -> p s fb -> s -> fb\nsubIndex2 f = reindexed (preview f) selfIndex\n\nsubIndex3 :: (Applicative f, Indexable i p) => Getting (First i) s i -> p s (f s) -> s -> f s\nsubIndex3 f = reindexed fromJust (subIndex2 f . indices isJust)\n
Run Code Online (Sandbox Code Playgroud)\n\n

我定义了 3 个不同的函数变体来完成您想要的操作。第一个,subIndex最正是您在问题标题中所要求的。它需要的是镜头,而不是穿越。这会阻止它完全按照您想要的方式使用。

\n\n
> doc ^@.. key "body" . values . subIndex (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer\n\n<interactive>:61:42: error:\n    \xe2\x80\xa2 No instance for (Monoid Integer) arising from a use of \xe2\x80\x98key\xe2\x80\x99\n    \xe2\x80\xa2 In the first argument of \xe2\x80\x98(.)\xe2\x80\x99, namely \xe2\x80\x98key "key"\xe2\x80\x99\n      In the first argument of \xe2\x80\x98subIndex\xe2\x80\x99, namely\n        \xe2\x80\x98(key "key" . _Integer)\xe2\x80\x99\n      In the first argument of \xe2\x80\x98(<.)\xe2\x80\x99, namely\n        \xe2\x80\x98subIndex (key "key" . _Integer)\xe2\x80\x99\n
Run Code Online (Sandbox Code Playgroud)\n\n

这里的问题是钥匙实际上可能并不在那里。类型系统携带足够的信息来检测此问题,并拒绝编译。您可以通过较小的修改来解决它:

\n\n
> doc ^@.. key "body" . values . subIndex (singular $ key "key" . _Integer) <. key "data" . values . key "foo" . _Integer\n[(23,1),(23,2),(29,11)]\n
Run Code Online (Sandbox Code Playgroud)\n\n

但这singular是对编译器的承诺。如果你错了,事情就会出错:

\n\n
> doc2 ^@.. key "body" . values . subIndex (singular $ key "key" . _Integer) <. key "data" . values . key "foo" . _Integer\n[(*** Exception: singular: empty traversal\nCallStack (from HasCallStack):\n  error, called at src/Control/Lens/Traversal.hs:667:46 in lens-4.16-f58XaBDme4ClErcSwBN5e:Control.Lens.Traversal\n  singular, called at <interactive>:63:43 in interactive:Ghci4\n
Run Code Online (Sandbox Code Playgroud)\n\n

所以,我的下一个想法是使用preview代替view,结果是subIndex2

\n\n
> doc ^@.. key "body" . values . subIndex2 (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer\n[(Just 23,1),(Just 23,2),(Just 29,11)]\n
Run Code Online (Sandbox Code Playgroud)\n\n

Just里面有这些构造函数有点难看,但它有它的优点:

\n\n
> doc2 ^@.. key "body" . values . subIndex2 (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer\n[(Nothing,21),(Nothing,22),(Just 23,1),(Just 23,2),(Just 29,11)]\n
Run Code Online (Sandbox Code Playgroud)\n\n

这样,即使索引丢失,遍历仍然会达到所有常规目标。这可能是解决方案领域中一个有趣的点。当然,在某些用例中它是最佳选择。尽管如此,我认为这并不完全是你想要的。我认为您可能真的想要类似遍历的行为 - 如果没有索引遍历的目标,则跳过所有子项。不幸的是,镜头对这种索引的处理有点严格。我最终得到了subIndex3,它使用该模式的索引级变体map fromJust . filter isJust。它本身是完全安全的,但在面对重构时它有些脆弱。

\n\n

不过它确实有效:

\n\n
> doc ^@.. key "body" . values . subIndex3 (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer\n[(23,1),(23,2),(29,11)]\n
Run Code Online (Sandbox Code Playgroud)\n\n

而且,当索引遍历没有找到任何目标时,它的工作方式可能与您预期的一样:

\n\n
> doc2 ^@.. key "body" . values . subIndex3 (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer\n[(23,1),(23,2),(29,11)]\n
Run Code Online (Sandbox Code Playgroud)\n\n

缺少字段的字典"key"将被忽略,即使其余的遍历中会有目标。

\n\n

所以你就知道了 - 三个相关的选项,每个选项都有优点和缺点。第三个在实现方面相当粗糙,我怀疑它也不会具有最佳性能。但我估计这很可能是你真正想要的。

\n\n

旧的、不完整的答案

\n\n

这不是完整的答案,因为我没有带有 ghc 的计算机 - 我一直在通过与 freenode 上的 lambdabot 聊天进行测试。

\n\n
09:34 <me> > let setIndex f = reindexed (view f) selfIndex in Just (1, [3..6]) ^@.. _Just . setIndex _1 <. _2 . traverse\n09:34 <lambdabot>  [(1,3),(1,4),(1,5),(1,6)]\n
Run Code Online (Sandbox Code Playgroud)\n\n

我认为这是您正在寻找的基本想法,但我尚未将其应用到您的数据中。我将其应用于结构上相似的值,至少证明了该模式。基本思想是使用selfIndex和的组合reindexed来创建具有正确折射率值的索引光学器件。然后,您必须小心使用(<.)类似的操作员,以在各种索引光学器件的组合中保持正确的索引。

\n\n

最后,我转而使用(^@..)来提取(索引,目标)对的列表,而不是使用withIndex. 后者会起作用,但是您需要更加小心如何将各种构图关联在一起。

\n\n

使用 的示例withIndex,请注意,它需要覆盖组合运算符的默认关联才能工作:

\n\n
12:21 <me> > let setIndex f = reindexed (view f) selfIndex in Just (1, [3..6]) ^.. (_Just . setIndex _1 <. _2 . traverse) . withIndex\n12:21 <lambdabot>  [(1,3),(1,4),(1,5),(1,6)]\n
Run Code Online (Sandbox Code Playgroud)\n