Haskell 反射 : does record have field?

Question

GHC 泛型工具可让您检查构造函数名称，但字段名称呢？

假设我有一个数据类型

data Foo
  = F {f :: Int}
  | OO {oo :: String}
  | Foo {f :: Int, oo :: String}

我有以下数据

aFoo :: Foo

我可以这样写:

ooMay :: Foo -> Maybe String
ooMay f@(Foo {}) = Just (oo f)
ooMay f@(OO {}) = Just (oo f)
ooMay f@(F {}) = Nothing

由我知道可以安全使用的构造函数保护访问器 oo。

有没有办法用泛型来写这个？是否存在类似 fieldMay 的东西？

ooMay :: Foo -> Maybe String
ooMay f = fieldMay "oo" f

Answer 1

是的，这是可行的。字段名称作为 M1 的参数写入 Rep类型构造函数(Meta 参数)。 Haddock 掩盖了 M1，基于示例 Generic 的类忽略了其中的信息，但现在我们需要它。

只是为了让我们知道我们正在处理什么:

ghci> :kind! Rep Foo
Rep Foo :: * -> *
= D1
    ('MetaData "Foo" "Ghci1" "interactive" 'False)
    (C1
       ('MetaCons "F" 'PrefixI 'True)
       (S1
          ('MetaSel
             ('Just "f") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (Rec0 Int))
     :+: (C1
            ('MetaCons "OO" 'PrefixI 'True)
            (S1
               ('MetaSel
                  ('Just "oo")
                  'NoSourceUnpackedness
                  'NoSourceStrictness
                  'DecidedLazy)
               (Rec0 String))
          :+: C1
                ('MetaCons "Foo" 'PrefixI 'True)
                (S1
                   ('MetaSel
                      ('Just "f") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 Int)
                 :*: S1
                       ('MetaSel
                          ('Just "oo")
                          'NoSourceUnpackedness
                          'NoSourceStrictness
                          'DecidedLazy)
                       (Rec0 String))))

所以我们基本上只是搜索 S1 并选择名称正确的那个。为简单起见，我们只查看事先具有正确类型的那些。

class GFieldMay rep a where
    gFieldMay :: String -> rep p -> Maybe a
-- fields of the right type might match the name
instance {-# OVERLAPS #-} Selector s => GFieldMay (M1 S s (K1 i a)) a where
    gFieldMay name m@(M1 (K1 x))
      | name == selName m = Just x
      | otherwise = Nothing
-- any other fields must be pruned (no deep search)
instance {-# OVERLAPPING #-} GFieldMay (M1 S s f) a where
    gFieldMay _ _ = Nothing
-- drill through any other metadata
instance {-# OVERLAPPABLE #-} GFieldMay f a => GFieldMay (M1 i m f) a where
    gFieldMay name (M1 x) = gFieldMay name x
-- search both sides of products
instance (GFieldMay l a, GFieldMay r a) => GFieldMay (l :*: r) a where
    gFieldMay name (l :*: r) = gFieldMay name l <|> gFieldMay name r
-- search the given side of sums
instance (GFieldMay l a, GFieldMay r a) => GFieldMay (l :+: r) a where
    gFieldMay name (L1 x) = gFieldMay name x
    gFieldMay name (R1 x) = gFieldMay name x

就是这样

fieldMay :: (Generic a, GFieldMay (Rep a) f) => String -> a -> Maybe f
fieldMay name = gFieldMay name . from

哒哒!

main = putStr $ unlines $
  [ show x ++ ": " ++ show (fieldMay "oo" x :: Maybe String)
  | x <- [F 42, OO "5", Foo 42 "5"]]
-- F {f = 42}: Nothing
-- OO {oo = "5"}: Just "5"
-- Foo {f = 42, oo = "5"}: Just "5"