如何解决使用`generics-sop`推导投影函数 示例
我将如何派生函数
getField :: (Generic a,HasDatatypeInfo a) => Proxy (name :: Symbol) -> a -> b
使用 Symbol
库,使用类型级字符串 (generics-sop
) 从任意记录投影字段?
这类似于Retrieving record function in generic SOP,但我有以下问题:
- OP 没有解释如何走最后一英里来获得我想要的签名。
- OP 定义了复杂的特殊用途助手类型,我很想避免这种情况
- 给定的解决方案仅在运行时出错,但编译时匹配应该是可能的,因为类型级别
DataTypeInfo
是通过DatatypeInfoOf
类型系列提供的(很好,但不是必需的).
lens-sop
包也seems to do something similar,但我不知道如何让它对我有用。
我也更喜欢使用 IsProductType
类型类的解决方案。
解决方法
我知道这是一个乱七八糟的答案,并不是您真正想要的,但这是我现在能做的最好的。请注意,这适用于产品类型和总和类型,其中所有构造函数具有指定的字段名称。
我认为这可以通过将名称查找与产品处理的其余部分分开来稍微简化。即:使用数据类型信息来计算字段编号(作为一元自然数),然后使用该数字来挖掘代码。不幸的是,PowerBI_App
似乎没有很好的工具来处理列表压缩,所以我最终“手工”做了很多事情。
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
,
从 0.1.1.0 版开始,records-sop
提供了 this function:
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 的回答也支持和类型。
感谢@kosmikus,generics-sop
的合著者和 records-sop
的作者,在回答这个问题时实现了这一点!
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。