如何使用带镜头的重载记录字段?

时间:2016-01-24 00:19:55

标签: haskell typeclass lens

可以将类与镜头混合以模拟重载的记录字段,直到某一点。例如,请参阅Control.Lens.TH中的makeFields。我试图弄清楚是否有一种很好的方法可以为某些类型重复使用与镜头相同的名称,为其他类型重复使用遍历。值得注意的是,考虑到产品的总和,每种产品都可以具有透镜,这将降低到总和的遍历。我能想到的最简单的事情就是**:

首先尝试

class Boo booey where
  type Con booey :: (* -> *) -> Constraint
  boo :: forall f . Con booey f => (Int -> f Int) -> booey -> f booey

这适用于简单的事情,例如

data Boop = Boop Int Char
instance Boo Boop where
  type Con Boop = Functor
  boo f (Boop i c) = (\i' -> Boop i' c) <$> f i

但是只要你需要更复杂的东西,它就会落在脸上,比如

instance Boo boopy => Boo (Maybe boopy) where
无论基础Traversal的选择如何,

都应该能够产生Boo

第二次尝试

我尝试过的下一件事,就是约束Con家族。这有点粗糙。首先,改变班级:

class LTEApplicative c where
  lteApplicative :: Applicative a :- c a

class LTEApplicative (Con booey) => Boo booey where
  type Con booey :: (* -> *) -> Constraint
  boo :: forall f . Con booey f => (Int -> f Int) -> booey -> f booey

这会使Boo个实例携带显式证据,使其boo生成Traversal' booey Int。更多的东西:

instance LTEApplicative Applicative where
  lteApplicative = Sub Dict

instance LTEApplicative Functor where
  lteApplicative = Sub Dict

-- flub :: Boo booey => Traversal booey booey Int Int
flub :: forall booey f . (Boo booey, Applicative f) => (Int -> f Int) -> booey -> f booey
flub = case lteApplicative of
         Sub (Dict :: Dict (Con booey f)) -> boo

instance Boo boopy => Boo (Maybe boopy) where
  type Con (Maybe boopy) = Applicative
  boo _ Nothing = pure Nothing
  boo f (Just x) = Just <$> hum f x
    where hum :: Traversal' boopy Int
          hum = flub

基础Boop示例不变。

为什么这仍然很糟糕

我们现在boo在适当的情况下生成LensTraversal,我们始终使用作为Traversal但是每当我们想要这样做时,我们必须首先拖入它确实存在的证据。当然,对于实现重载记录字段而言,太不方便了!有没有更好的方法?

**此代码使用以下内容编译(可能不是最小的):

{-# LANGUAGE PolyKinds, TypeFamilies,
     TypeOperators, FlexibleContexts,
     ScopedTypeVariables, RankNTypes,
     KindSignatures #-}

import Control.Lens
import Data.Constraint

1 个答案:

答案 0 :(得分:3)

以下对我有用:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

import Control.Lens

data Boop = Boop Int Char deriving (Show)

class HasBoo f s where
  boo :: LensLike' f s Int

instance Functor f => HasBoo f Boop where
  boo f (Boop a b) = flip Boop b <$> f a

instance (Applicative f, HasBoo f s) => HasBoo f (Maybe s) where
  boo = traverse . boo

如果我们确保强制执行所有相关的功能依赖(就像here),它也可以缩放到多态字段。让一个完全多态的超载场很少有用或者是个好主意;我举例说明了这种情况,因为从那里可以随时单变化(或者我们可以约束多态字段,例如name字段到IsString)。

{-# LANGUAGE
  UndecidableInstances, MultiParamTypeClasses,
  FlexibleInstances, FunctionalDependencies, TemplateHaskell #-}

import Control.Lens

data Foo a b = Foo {_fooFieldA :: a, _fooFieldB :: b} deriving Show

makeLenses ''Foo

class HasFieldA f s t a b | s -> a, t -> b, s b -> t, t a -> s where
  fieldA :: LensLike f s t a b

instance Functor f => HasFieldA f (Foo a b) (Foo a' b) a a' where
  fieldA = fooFieldA

instance (Applicative f, HasFieldA f s t a b) => HasFieldA f (Maybe s) (Maybe t) a b where
  fieldA = traverse . fieldA

对于所有“has”功能,也可以使用单个类:

{-# LANGUAGE
  UndecidableInstances, MultiParamTypeClasses,
  RankNTypes, TypeFamilies, DataKinds,
  FlexibleInstances, FunctionalDependencies,
  TemplateHaskell #-}

import Control.Lens hiding (has)
import GHC.TypeLits
import Data.Proxy

class Has (sym :: Symbol) f s t a b | s sym -> a, sym t -> b, s b -> t, t a -> s where
  has' :: Proxy sym -> LensLike f s t a b

data Foo a = Foo {_fooFieldA :: a, _fooFieldB :: Int} deriving Show
makeLenses ''Foo

instance Functor f => Has "fieldA" f (Foo a) (Foo a') a a' where
  has' _ = fooFieldA

使用GHC 8,可以添加

{-# LANGUAGE TypeApplications #-}

并避免使用代理:

has :: forall (sym :: Symbol) f s t a b. Has sym f s t a b => LensLike f s t a b
has = has' (Proxy :: Proxy sym)

instance (Applicative f, Has "fieldA" f s t a b) => Has "fieldA" f (Maybe s) (Maybe t) a b where
  has' _ = traverse . has @"fieldA"

示例:

> Just (Foo 0 1) ^? has @"fieldA"
Just 0
> Foo 0 1 & has @"fieldA" +~ 10
Foo {_fooFieldA = 10, _fooFieldB = 1}