Как упростить вызов поля по имени полиморфного поля в один класс типов

В предыдущем вопросе я спросил, как можно сделать поле записи полиморфным при использовании DuplicateRecordFields. Я получил отличный ответ на этот вопрос от @user2407038. Он ответил на вопрос моей первоначальной спецификации, предоставив один класс типов для каждого поля, но упомянул, что все это можно упростить до одного класса типов.

(Примечание: это тоже можно обобщить на один класс с дополнительным параметром, соответствующим имени поля; это, вероятно, выходит за рамки этого вопроса).

Я не уверен, как сделать это обобщение. Есть ли у кого-нибудь идеи о том, как это можно сделать?


person Vanson Samuel    schedule 20.11.2017    source источник
comment
Он реализован как таковой в библиотеке, на которую я ссылался в предыдущем ответе (здесь еще раз)   -  person user2407038    schedule 21.11.2017
comment
Я не знаю, как создать экземпляр для HasLens, и я не смог найти никого, кто бы его использовал, когда я гуглил.   -  person Vanson Samuel    schedule 21.11.2017
comment
Взяв пример из предыдущего вопроса, вместо 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.2017
comment
Как бы я назвал это? Это не работает: lensOf $ (_ :: "C")   -  person Vanson Samuel    schedule 21.11.2017


Ответы (1)


Определить такой класс достаточно просто

-- 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