2

一些伪代码：

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 :: Bor lookup foo a5 :: A1（因为这是 的简写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我正在寻找实现它的工具吗？

4

1 回答 1

1

我假设您实际上并不想要多个映射 - 也就是说，给定的键应该恰好对应一个值，而不是映射中的A1值和a1s映射中的另一个A2值a2s等。

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

data A6 = A6 A3 A4

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

无论如何，您可以使用Data泛型和一些来自lens's 的助手来做到这一点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遍历 from 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递归遍历 term 中所有 typev的子项dat。查询返回第firstOf一个匹配的术语，或者Nothing如果没有找到术语。（该do块在Maybemonad 中运行。）

要执行索引遍历，我们还可以使用biplate, 修改 usingtaking 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)
于 2021-07-03T04:55:40.063 回答