具有成分查找和更新的地图记录？

Question

一些伪代码：

data A = A
data B = B
data C = C
data D = D
data E = E
data F = F
data G = G

data A1 = A1 A B C
data A2 = A2 A
data A3 = A3 B C D
data A4 = A4 D E F
data A5 = A5 A1 A4 G

data Foo k = Foo
    {
        a1s :: Map.Map k A1,
        a2s :: Map.Map k A2,
        a3s :: Map.Map k A3,
        a4s :: Map.Map k A4,
        a5s :: Map.Map k A5,
--and my attempted solution would use
        -- e.g. [(A1, [(A, Unit), (B, Unit), (C, Unit)]), (A5, [(A1, Composite), (A4, Composite), (G, Unit) ]) ]
        componentMap :: Map.Map Type (Set Type),

        -- e.g. [(A, [A1, A2]), (A1, [A5, A1]) ]
        compositeMap :: Map.Map Type (Set Type)
    }

我想构建某种数据结构，如下所示。从这里开始，我想：

lookup :: Foo k -> k -> Either FailureReason v个人价值观；如果我们假设我们已经填充了地图，我想要 lookup foo a1 :: A1，但也想要传递实例，例如 lookup foo a1 :: B 或 lookup foo a5 :: A1（因为这是 shorthand for getA1fromA5 $ lookup foo a5) 和 lookup foo a5 :: B。我正在考虑 FailureReason = WrongType | NotPresent 但这可能太过分了。
遍历类型，例如对 (k, D) 的（索引）遍历，它应该命中 A3, A4, A5

这可以作为对 componentMap 和 compositeMap 的递归搜索来实现。只要它们是手动填充的。

由于上面看起来非常递归，我觉得这有一个 GHC.Generics 解决方案。可能是 lens/optics + generic-lens/generic-optics 个？

或者我的解决方案是否不需要 generics 及其同类，而只是编写一些遍历和镜头来索引我的结构？

那么问题就变成了：这个功能是否已经存在于某些库中？如果不是，Generics 是我正在寻找的实现它的工具吗？

Answer 1

我假设您实际上并不需要这里的多个映射——也就是说，给定的键应该恰好对应一个值，而不是 a1s 映射中的 A1 值，并且来自 a2s 地图等的另一个 A2 值

此外，如果在单个值中有多个特定类型的匹配项，例如，如果您有以下类型的值，您还没有说出您想做什么：

data A6 = A6 A3 A4

并尝试检索或遍历 D 类型的术语。下面，我假设您只想检索 and/or 遍历遇到的“第一个”（例如，仅 A3 中的 D，忽略 A4 中的 A4）。 =38=]

无论如何，您可以使用 Data 泛型和来自 lens 的 Data.Data.Lens.

的一些助手来完成此操作

不需要特殊的数据类型。一个简单的 Map 就足够了，用一个 sum 类型来表示你想要存储的值的集合：

data Dat = D_A1 A1 | D_A2 A2 | D_A3 A3 | D_A4 A4 | D_A5 A5 deriving (Data)
type Foo k dat = Map k dat

要通过键查找（可能嵌套很深的）值，我们可以使用 biplate 遍历 lens:

lookupFoo :: (Ord k, Typeable v, Data dat) => k -> Foo k dat -> Maybe v
lookupFoo k foo = do
  dat <- Map.lookup k foo
  firstOf biplate dat

这里，biplate递归遍历dat项中所有v类型的子项。 firstOf 查询 returns 第一个匹配词或 Nothing 如果没有找到词。（do 块在 Maybe monad 中是运行。）

要执行索引遍历，我们也可以使用biplate，使用taking 1修改为仅遍历第一个匹配项：

itraverseFoo :: (Applicative f, Typeable v, Data dat) => (k -> v -> f v) -> Foo k dat -> f (Foo k dat)
itraverseFoo f foo = Map.traverseWithKey f' foo
  where f' k dat = taking 1 biplate (f k) dat

完整代码：

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ExplicitForAll #-}

import Control.Lens
import Control.Monad.Writer
import Data.Data
import Data.Data.Lens
import Data.Map (Map)
import qualified Data.Map as Map

data Dat = D_A1 A1 | D_A2 A2 | D_A3 A3 | D_A4 A4 | D_A5 A5 | D_A6 A6 deriving (Data)
type Foo k dat = Map k dat

lookupFoo :: (Ord k, Typeable v, Data dat) => k -> Foo k dat -> Maybe v
lookupFoo k foo = do
  dat <- Map.lookup k foo
  firstOf biplate dat

itraverseFoo :: (Applicative f, Typeable v, Data dat) => (k -> v -> f v) -> Foo k dat -> f (Foo k dat)
itraverseFoo f foo = Map.traverseWithKey f' foo
  where f' k dat = taking 1 biplate (f k) dat

data A = A deriving (Data, Show)
data B = B deriving (Data, Show)
data C = C deriving (Data, Show)
data D = D deriving (Data, Show)
data E = E deriving (Data, Show)
data F = F deriving (Data, Show)
data G = G deriving (Data, Show)

data A1 = A1 A B C deriving (Data, Show)
data A2 = A2 A deriving (Data, Show)
data A3 = A3 B C D deriving (Data, Show)
data A4 = A4 D E F deriving (Data, Show)
data A5 = A5 A1 A4 G deriving (Data, Show)
data A6 = A6 A3 A4 deriving (Data, Show)

foo :: Foo String Dat
foo = Map.fromList [ ("a1", D_A1 (A1 A B C))
                   , ("a3", D_A3 (A3 B C D))
                   , ("a4", D_A4 (A4 D E F))
                   , ("a5", D_A5 (A5 (A1 A B C) (A4 D E F) G))
                   , ("a6", D_A6 (A6 (A3 B C D) (A4 D E F)))
                   ]

find :: forall a k. k -> a -> Writer [k] a
find k a = tell [k] >> pure a

main = do
  print $ (lookupFoo "a1" foo :: Maybe A1)
  print $ (lookupFoo "a1" foo :: Maybe B)
  print $ (lookupFoo "a5" foo :: Maybe A1)
  print $ (lookupFoo "a5" foo :: Maybe B)
  print $ execWriter (itraverseFoo (find @D) foo)

具有成分查找和更新的地图记录？

Record of maps with compositional lookups and updates?

haskell

data-structures

ghc-generics