[英]Deriving projection functions using `generics-sop`
How would I go about deriving the function我将如何 go 关于派生 function
getField :: (Generic a, HasDatatypeInfo a) => Proxy (name :: Symbol) -> a -> b
to project a field from an arbitrary record using a type-level string ( Symbol
), using the generics-sop
library?使用generics-sop
库使用类型级字符串 ( Symbol
) 从任意记录中投影字段?
This is similar to Retrieving record function in generic SOP , but I have the following problems:这类似于Retrieving record function in generic SOP ,但我有以下问题:
DataTypeInfo
is provided through the DatatypeInfoOf
type family (nice to have, but not necessary).给定的解决方案仅在运行时出错,但编译时匹配应该是可能的,因为类型级别的DataTypeInfo
是通过DatatypeInfoOf
类型族提供的(很高兴拥有,但不是必需的)。 The lens-sop
package also seems to do something similar , but I can't work out how to make it work for me. lens-sop
package 似乎也做了类似的事情,但我不知道如何让它对我有用。
I would also prefer a solution that uses the IsProductType
typeclass.我也更喜欢使用IsProductType
类型类的解决方案。
I know this is a mess of an answer and not really what you were looking for, but it's the best I can do right now.我知道这是一个混乱的答案,并不是您真正想要的,但这是我现在能做的最好的。 Note that this works for both product types and sum types where all the constructors have the specified field name.请注意,这适用于所有构造函数都具有指定字段名称的产品类型和总和类型。
I think this could likely be simplified somewhat by separating the name lookup from the rest of the product handling.我认为通过将名称查找与产品处理的 rest 分开,这可能会有所简化。 That is: use the datatype info to calculate the field number (as a unary natural), then use that number to dig through the code.即:使用数据类型信息来计算字段编号(作为一元自然数),然后使用该数字来挖掘代码。 Unfortunately, generics-sop
doesn't seem to have really wonderful facilities for working with list zipping, so I ended up doing a lot "by hand".不幸的是, 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
As of version 0.1.1.0, records-sop
provides this function :从 0.1.1.0 版开始, records-sop
提供了这个 function :
getField :: forall s a b ra. (IsRecord a ra, IsElemOf s b ra) => a -> b
which needs the field name supplied as a type application rather than a proxy, like so:它需要作为类型应用程序而不是代理提供的字段名称,如下所示:
data Foo = Foo { bar :: Int }
getField @"bar" (Foo 42) === 42
This provides compile-time extraction, although it will still need a bit of casting around to fit in with existing code in my project that manipulates standard generics-sop
metadata.这提供了编译时提取,尽管它仍然需要一些转换以适应我的项目中操作标准generics-sop
元数据的现有代码。
This only works on single-constructor types.这仅适用于单构造函数类型。 @dfeuer's answer also supports sum types. @dfeuer 的回答也支持 sum 类型。
Thank you @kosmikus, the coauthor of generics-sop
and author of records-sop
, for implementing this in response to this question!感谢@kosmikus, generics-sop
的合著者和records-sop
的作者,为了回答这个问题而实现了这个!
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.