haskell 用'generics-sop'导出投影函数

xwbd5t1u  于 2022-11-14  发布在  其他
关注(0)|答案(2)|浏览(111)

我该如何推导函数

getField :: (Generic a, HasDatatypeInfo a) => Proxy (name :: Symbol) -> a -> b

使用类型级别字符串(Symbol)从任意记录中投影字段,使用generics-sop库?
这类似于Retrieving record function in generic SOP,但我有以下问题:

  • OP没有解释如何走完最后一英里才能得到我想要的签名。
  • OP定义了复杂的特殊用途的helper类型,我非常希望避免这种类型
  • 给定的解决方案只在运行时出错,但编译时匹配应该是可能的,因为类型级别的DataTypeInfo是通过DatatypeInfoOf类型家族提供的(拥有它很好,但不是必需的)。

lens-sop包似乎也做了类似的事情,但我不知道如何让它为我工作。
我也更喜欢使用IsProductType类型类的解决方案。

umuewwlo

umuewwlo1#

我知道这是一个混乱的答案,并不是你真正想要的,但这是我现在能做的最好的。注意,这对乘积类型和求和类型都有效,其中 * 所有 * 构造函数都有指定的字段名。
我认为,通过将名称查找与产品处理的其余部分分离开来,这可能会有所简化。即:使用datatypeinfo来计算字段编号(作为一元自然数),然后使用该编号来挖掘代码。不幸的是,generics-sop似乎没有真正出色的工具来处理列表压缩,所以我最终做了很多“手工”工作。

{-# language EmptyCase, GADTs, TypeFamilies, DataKinds, TypeOperators, RankNTypes #-}
{-# language UndecidableInstances, UndecidableSuperClasses #-}
{-# language AllowAmbiguousTypes, TypeApplications, MultiParamTypeClasses,
  FlexibleContexts, FlexibleInstances, MagicHash, UnboxedTuples, ScopedTypeVariables #-}
{-# language ConstraintKinds #-}
{-# OPTIONS_GHC -Wall #-}

module Data.Proj where
import Data.Kind (Type, Constraint)
import Generics.SOP
import Generics.SOP.Type.Metadata as GST
import GHC.TypeLits
import Data.Type.Equality (type (==))

-- This is what you were looking for, but slightly more flexible.
genericPrj :: forall s b a.
  ( Generic a
  , HasFieldNS s b (GetConstructorInfos (DatatypeInfoOf a)) (Code a))
  => a -> b
genericPrj a = case genericPrj# @s a of (# b #) -> b

-- This version lets you force the *extraction* of a field without
-- forcing the field itself.
genericPrj# :: forall s b a.
  ( Generic a
  , HasFieldNS s b (GetConstructorInfos (DatatypeInfoOf a)) (Code a))
  => a -> (# b #)
genericPrj# a = case from a of
  SOP xs -> extraction @s @b @(GetConstructorInfos (DatatypeInfoOf a)) @(Code a) xs

-- | Extract info about the constructor(s) from 'GST.DatatypeInfo'.
type family GetConstructorInfos (inf :: GST.DatatypeInfo) :: [GST.ConstructorInfo] where
  GetConstructorInfos ('GST.ADT _ _ infos _) = infos
  GetConstructorInfos ('GST.Newtype _ _ info) = '[info]

class HasFieldNS (s :: Symbol) b (cis :: [GST.ConstructorInfo]) (code :: [[Type]]) where
  extraction :: NS (NP I) code -> (# b #)
instance HasFieldNS s b cis '[] where
  extraction x = case x of
instance (HasFieldNP' s b r c, HasFieldNS s b cis cs, rec ~ 'GST.Record q r, VerifyRecord rec)
    => HasFieldNS s b (rec ': cis) (c ': cs) where
  extraction (Z x) = extractIt @s @b @rec @c x
  extraction (S x) = extraction @s @b @cis @cs x

type family VerifyRecord rec :: Constraint where
  VerifyRecord ('GST.Record _ _) = ()
  VerifyRecord _ = TypeError ('Text "Constructor is not in record form.")

-- | Given info about a constructor, a list of its field types, and the name and
-- type of a field, produce an extraction function.
class HasFieldNP (s :: Symbol) b (ci :: GST.ConstructorInfo) (fields :: [Type]) where
  extractIt :: NP I fields -> (# b #)
instance (HasFieldNP' s b fi fields, ci ~ 'GST.Record _cn fi)
    => HasFieldNP s b ci fields where
  extractIt = extractIt' @s @_ @fi

class HasFieldNP' (s :: Symbol) b (fi :: [GST.FieldInfo]) (fields :: [Type]) where
  extractIt' :: NP I fields -> (# b #)

class TypeError ('Text "Can't find field " ':<>: 'ShowType s)
    => MissingField (s :: Symbol) where
  impossible :: a

instance MissingField s => HasFieldNP' s b fi '[] where
  extractIt' = impossible @s ()

instance HasFieldNP'' s b (fi == s) field fis fields =>
  HasFieldNP' s b ('GST.FieldInfo fi ': fis) (field ': fields) where
  extractIt' = extractIt'' @s @b @(fi == s) @field @fis @fields

class HasFieldNP'' (s :: Symbol) b (match :: Bool) (field :: Type) (fis :: [GST.FieldInfo]) (fields :: [Type]) where
  extractIt'' :: NP I (field ': fields) -> (# b #)
instance b ~ field => HasFieldNP'' _s b 'True field fis fields where
  extractIt'' (I x :* _) = (# x #)
instance (HasFieldNP' s b fis fields) => HasFieldNP'' s b 'False _field fis fields where
  extractIt'' (_ :* fields) = extractIt' @s @b @fis fields

示例

data Foo
  = Foo {blob :: Int, greg :: String}
  | Bar {hello :: Char, blob :: Int}
deriveGeneric ''Foo

genericPrj @"blob" (Foo 12 "yo") ===> 12
genericPrj @"blob" (Bar 'x' 5) ===> 5
genericPrj# @"blob" (Bar 'x' 5) ===> (# 5 #)

myAbsurd :: Void -> a
myAbsurd = genericPrj @"whatever"

data Booby a
  = Booby {foo :: a}
  | Bobby {bar :: a}
deriveGeneric ''Booby

genericPrj @"foo" (Booby 'a')
-- Type error because Bobby has no foo field
lstz6jyr

lstz6jyr2#

自www.example.com版本起0.1.1.0,records-sop提供此功能:

getField :: forall s a b ra. (IsRecord a ra, IsElemOf s b ra) => a -> b

它需要作为类型应用程序而不是代理提供的字段名,如下所示:

data Foo = Foo { bar :: Int }

getField @"bar" (Foo 42) === 42

这提供了编译时提取,尽管它仍然需要一些转换,以适应我的项目中操作标准generics-sop元数据的现有代码。
这只对单构造函数类型有效。@dfeuer的答案也支持sum类型。
感谢@kosmikus,generics-sop的合著者和records-sop的作者,为回答这个问题而实现了这一点!

相关问题