问题
In a previous question I asked how a record field can be made polymorphic when using DuplicateRecordFields. I got an excellent answer for this from @user2407038. He answered the question to my initial spec providing one type class per field, but he mentioned that it could all be simplified into one typeclass.
(Note: this too can be generalized to a single class with an additional parameter corresponding to the field name; this is probably outside the scope of this question).
I'm not sure how to go about doing this generalization. Does anybody have any ideas on how this can accomplished?
回答1:
Defining such a class is easy enough
-- s has a field named field of type a and setting it to b turns the s into a t
class HasLens field s t a b | field s -> a, field t -> b, field s b -> t, field t a -> s where
-- Fundeps are pretty common sense, and also appear in the library linked in the comments
lensOf :: Functor f => (a -> f b) -> s -> f t
-- Not sure why the library linked above includes f in the class head...
You'll notice that field
appears nowhere in lensOf
's type, so this class would be unusable as is, because the inferencer can never figure out what it should be. You have these options:
Old:
class HasLens name s t a b | ... where
lensOf :: Functor f => Proxy name -> (a -> f b) -> s -> f t
-- Or Proxy#, which has no runtime overhead, or forall proxy. Functor f => proxy name -> ...
The Proxy
argument is a dummy; it is never used for anything except telling the compiler about name
. Usage is unbearably ugly, though:
lensOf (Proxy :: Proxy "field")
-- or proxy#, or undefined
New:
{-# LANGUAGE AllowAmbiguousTypes, TypeApplications #-}
Now you use explicit type applications to set name
at the call site (also make sure that name
is first in the class head, or else the order of type arguments will get messed up).
lensOf @"field"
Fuller example:
{-# LANGUAGE AllowAmbiguousTypes
, DataKinds
, FlexibleContexts
, FlexibleInstances
, FunctionalDependencies
, NoMonomorphismRestriction
, PolyKinds
, ScopedTypeVariables
, TypeApplications
#-}
import Control.Lens
class HasLens x s t a b | x s -> a, x t -> b, x s b -> t, x t a -> s where
lensOf :: Functor f => (a -> f b) -> s -> f t
data Tup2 a b = Tup2 { _left2 :: a, _right2 :: b } deriving Show
data Tup3 a b c = Tup3 { _left3 :: a, _middle3 :: b, _right3 :: c } deriving Show
instance HasLens "left" (Tup2 a b) (Tup2 a' b) a a' where
lensOf = lens _left2 $ \t x -> t { _left2 = x }
instance HasLens "left" (Tup3 a b c) (Tup3 a' b c) a a' where
lensOf = lens _left3 $ \t x -> t { _left3 = x }
instance HasLens "right" (Tup2 a b) (Tup2 a b') b b' where
lensOf = lens _right2 $ \t x -> t { _right2 = x }
instance HasLens "right" (Tup3 a b c) (Tup3 a b c') c c' where
lensOf = lens _right3 $ \t x -> t { _right3 = x }
swap' :: forall xlr xrl l r xll xrr. (HasLens "left" xlr xrr l r, HasLens "right" xlr xll r l, HasLens "left" xll xrl l r, HasLens "right" xrr xrl r l) => xlr -> xrl
swap' x = x & lensOf @"left" .~ x^#lensOf @"right" @xlr @xll @r @l
& lensOf @"right" .~ x^#lensOf @"left" @xlr @xrr @l @r
main = do out $ Tup2 5 6
out $ Tup3 'l' 'm' 'r'
out $ Tup2 "l" 'r'
out $ Tup3 17 [5,10] "a"
where out = print . swap'
来源:https://stackoverflow.com/questions/47401763/how-to-simplify-calling-a-field-on-a-polymorphic-field-name-into-one-typeclass