Определить такой класс достаточно просто
-- 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...
Вы заметите, что field
нигде не встречается в типе lensOf
, так что этот класс будет непригоден для использования как есть, потому что модуль вывода никогда не сможет понять, каким он должен быть. У вас есть следующие варианты:
Старый:
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 -> ...
Аргумент Proxy
является фиктивным; он никогда не используется ни для чего, кроме сообщения компилятору о name
. Однако использование невыносимо уродливо:
lensOf (Proxy :: Proxy "field")
-- or proxy#, or undefined
Новый:
{-# LANGUAGE AllowAmbiguousTypes, TypeApplications #-}
Теперь вы используете приложения с явным типом для установки name
в месте вызова (также убедитесь, что name
стоит первым в заголовке класса, иначе порядок аргументов типа будет перепутан).
lensOf @"field"
Полный пример:
{-# 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'
person
HTNW
schedule
21.11.2017
instance (b ~ b0, b' ~ b0') => FieldC (X1 a b) (X1 a b') b0 b0'
у вас будетinstance (b ~ b0, b' ~ b0', Functor f) => HasLens "C" f (X1 a b) (X1 a b') b0 b0'
. Обратите внимание, что здесьf
становится параметром класса типов; и есть дополнительный параметр, представляющий имя поля (строка уровня типа, которая технически может быть чем угодно, т. е. она не должна каким-либо образом относиться к имени поля записи). - person user2407038   schedule 21.11.2017lensOf $ (_ :: "C")
- person Vanson Samuel   schedule 21.11.2017