Just $ A sandbox

プログラミングと計算機科学とかわいさ

Lens from Scratch

久しぶりのLensの記事です.
5億回は繰り返されてきたであろうLens再実装を通して, Lens, Getter, Setter, Iso, Equality, Traversal, Prism, Foldの仕組みを理解するのが目的です.

亜Lens family

Getter

Getterは基本的にはConstをかぶせる操作とそれを剥がす操作で実現可能です.
つまりgetConst (Const k) = kですが, このConst kがデータであり, getConstは値を取り出すgetterになります.

アクセサの型がGetting r s aであるとき, sからaを取り出せる(=s -> aなるgetterである)という意味です.

(^.)はGetterとデータから具体的に値を取り出し, toは函数をGetterに変換するための函数です.

type Getting r s a = (a -> Const r a) -> s -> Const r s
 
(^.) :: s -> Getting a s a -> a
s ^. l = getConst (l Const s)
 
to :: (s -> a) -> Getting r s a
to f = \k -> Const . getConst . k . f

Tuple

タプルに対するGettingアクセサが定義できます. 2変数の場合は

-- case: 2-tuple
_1 :: Getting r (a,b) a
_1 = to fst

とすることで, (a,b) ^. _1 == aが実現できます.
あるいは, 任意個のTupleに対してこの_1_2を使いたい場合は, 本家のパッケージのように型クラスで定義します.

class TupleIndex t a | t -> a where
  _1 :: Getting r t a
 
instance TupleIndex (a,b) a where _1 = to (\(a,_) -> a)
instance TupleIndex (a,b,c) a where _1 = to (\(a,_,_) -> a)

List

リストに対してもアクセサを提供できます.

ix :: Int -> Getting r [a] a
ix n = to (!! n)

例としては[1..10] ^. ix 7 == 8のようになります.

Setter

Setter(ここではSetting型)にはIdentityが使われます.
Identity xIdentity yに書き換える操作がsetterで実現できます.

(.~)はSetting s t a b型のアクセサに対し, データsbによって書き換えtを得る操作に対応します.
(%~)は函数を適用し, setsは函数をSetterに変換します.

type Setting s t a b = (a -> Identity b) -> s -> Identity t
 
infixr 4 .~
(.~) :: Setting s t a b -> b -> s -> t
(.~) l = (runIdentity .) . (l . const . Identity)

(%~) :: Setting s t a b -> (a -> b) -> s -> t
(%~) l f = runIdentity . l (Identity . f)
 
sets :: ((a -> b) -> s -> t) -> Setting s t a b
sets h = \k -> Identity . h (runIdentity . k)

Lens

さて, GetterとSetterの定義はよく似ています.
少々天下り的に導入したこれらの定義はいずれもLensの具体例になっています. (LensはGetterとSetterを一般化した概念)
定義より, GetterやSetterに対する函数はLensに対しても使えます.

lensはgetterとsetterをLensに変換する函数です.
accessor = lens getter setterのようにして使います.

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
 
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens g h = \f s -> fmap (h s) (f (g s))

Tuple

さて先ほど定義した_1はGetterではなくLensになるように拡張します.
これによって_1がGetterとしてもSetterとしても働くようになります.

class TupleIndex s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _1 :: Lens s t a b
 
instance TupleIndex (a,b) (a',b) a a' where
  _1 = lens (\(a,_) -> a) (\(_,y) b -> (b,y))
instance TupleIndex (a,b,c) (a',b,c) a a' where
  _1 = lens (\(a,_,_) -> a) (\(_,y,z) b -> (b,y,z))

List

Listに対するアクセサixも同様にLensに拡張します.

ix :: Int -> Lens [a] [a] a a
ix n = lens (!! n) (\ts x -> take n ts ++ [x] ++ drop (n+1) ts)

Traversal

次はTraversalです. これはLensより少し制約の強いもので, 大体traverseができるようなデータです.

bothは2-tupleの両方の値に一度に処理をするようなTraversalです.
both %~ f $ (a,b) == (f a, f b)みたいに使います.

type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
 
traverseOf :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf = id
 
both :: Traversal (a,a) (b,b) a b
both = \k (x,y) -> (,) <$> k x <*> k y

Each

Traversalに対する処理をさせるために, Traversalなアクセサを定義します.
例えば本家のパッケージではEachという, リストや配列の全ての要素に対する操作を行うアクセサが提供されています.

class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where
  each :: Traversal s t a b
 
instance Each [a] [b] a b where
  each = traverse

例えばtraverseOf each print [1,2,3]はリストの各値を表示して, [(),(),()]を返します.

Fold

FoldはTraversalよりさらに制約が強い型です. ただしここではTraversalもFoldも一般化していないので同じものになっています.

folding函数をFoldに変換します. (^..)は結果をリストにして返すのでFoldとともによく使われます.

type Fold s a = forall f. (Applicative f) => (a -> f a) -> s -> f s
 
infixl 8 ^..
(^..) :: s -> Getting (Endo [a]) s a -> [a]
s ^.. l = (appEndo $ getConst $ l (Const . Endo . (:)) s) []
 
folding :: Foldable f => (s -> f a) -> Fold s a
folding h = \k s -> traverse_ k (h s) *> pure s

例として[[1,2],[3]] ^.. traverse . traverse == [1,2,3][1,2,3] ^.. folding tail == [2,3]です.

Iso

IsoはLensの(->)をProfunctorに一般化したものです.
(亜)Lensは本来ここにあるよりもっと一般化された型ですが, 今の場合は必要以上に一般化しない方針で実装をしているのでここで初めてProfunctorが登場します.

Profunctorp a bが合った時, aとbの両方に(反変的に)函数が作用するようなデータです.

Isoは大体Iso s s a aの形で使い, s -> aa -> sの2つの変換を保持するLensのようなものです.

class Profunctor p where
  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
  dimap f g = lmap f . rmap g
 
  lmap :: (a -> b) -> p b c -> p a c
  lmap f = dimap f id
 
  rmap :: (b -> c) -> p a b -> p a c
  rmap = dimap id
 
instance Profunctor (->) where
  dimap f g k = g . k . f

type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
 
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso sa bt = dimap sa (fmap bt)
 
enum :: Enum a => Iso Int Int a a
enum = iso toEnum fromEnum
 
curried :: Iso ((a, b) -> c) ((d, e) -> f) (a -> b -> c) (d -> e -> f)
curried = iso curry uncurry
 
reversed :: Iso String String String String
reversed = iso reverse reverse

Equality

本家のパッケージにはIsoより更に制約の弱いEqualityという型もあります.
Isoから更にProfunctorとFunctorの制約を外したものですが, 制約がないせいでほとんど何も出来ないためあまり役に立つことはないでしょう.

type Equality s t a b = forall p f. p a (f b) -> p s (f t)
 
simple :: Equality a a a a
simple = id

Prism

PrismはLensに制約を加えたものです. ここではPrismも一般化されていないのでFoldと同じものになっています.

Prismは大体LensですがEitherを主に扱うためのものです.
prism函数をPrismに変換し, _LeftはEitherのLeftへのアクセサです.

type Prism s t a b = forall f. Applicative f => (a -> f b) -> s -> (f t)
 
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism bt sta = \k s -> case sta s of
  Left t -> pure t
  Right a -> fmap bt $ k a
 
_Left :: Prism (Either a c) (Either b c) a b
_Left = \k s -> case s of
  Left a -> fmap Left $ k a
  Right c -> pure $ Right c

さてこのままではPrismを何かのデータ型に作用させることができませんが, 次のReviewによってそれが可能になります.

Review

ReviewはPrismの(->)の部分を一般化します.

ReviewはPrismの最初と最後の(->)の部分をProfunctorに一般化します. これによって, ReviewはProfunctorの間の変換になります.

ここで, Tagged s bbのみをデータとしてもち, sは幽霊型になっているデータです.

instance Profunctor Tagged where
  dimap _ g = Tagged . g . unTagged

type Review s a = forall p f. (Applicative f) => p a (f a) -> p s (f s)
type AReview s a = Tagged a (Identity a) -> Tagged s (Identity s)
 
re :: AReview s a -> Getting r a s
re r = to (runIdentity . unTagged . r . Tagged . Identity)
 
review :: AReview s a -> a -> s
review r a = a ^. re r

さて, ここでAReviewは(->)ではなくTaggedというProfunctorを使っています.
このため今の定義ではAReviewはPrismにはなりません. よってPrismの定義もProfunctorを使ったものに変えて, reviewがPrismに対しても使えるようにしましょう.

Prism再び

ところで, Prismの定義をProfunctorに書き換えると, prism_Leftの定義は描き直す必要があります.
しかし実はprismを定義するためには(prismがEitherを扱うこととの兼ね合いで)Profunctorでは不十分で, もっと制約の強い(ここではChoice)型クラスが必要になります.

class (Profunctor p) => Choice p where
  left' :: p a b -> p (Either a c) (Either b c)
  left' = dimap (either Right Left) (either Right Left) . right'
 
  right' :: p a b -> p (Either c a) (Either c b)
  right' = dimap (either Right Left) (either Right Left) . left'
 
instance Choice (->) where
  left' k (Left a) = Left $ k a
  left' _ (Right c) = Right c
 
instance Choice Tagged where
  left' = Tagged . Left . unTagged

type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
 
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism bt sta = dimap sta (either pure (fmap bt)) . right'
 
_Left :: Prism (Either a c) (Either b c) a b
_Left = prism Left (either Right (Left . Right))

これでAReviewはPrismとなり, review _Left "hoge" == Left "hoge"のようにreviewが使えるようになります.

Cons

今定義されたPrismを使ってConsを定義します.
ConsはリストやVectorなどの, 先頭が定義できるようなデータを表します.

(<|)はConsの先頭に要素を追加するような函数です.
また, _headはConsの先頭の要素へのアクセサです.

class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _Cons :: Prism s t (a,s) (b,t)
 
instance Cons [a] [b] a b where
  _Cons = prism (uncurry (:)) $ \ass -> case ass of
    (a:as) -> Right (a,as)
    [] -> Left []
 
infixr 5 <|
(<|) :: Cons s s a a => a -> s -> s
a <| s = review _Cons (a,s)

_head :: Cons s s a a => Traversal s s a a
_head = \k s -> _Cons (\(a,s') -> (,) <$> k a <*> pure s') s

0 <| [1,2,3] == [0,1,2,3]のように使います.

参考

終わりに

これで, Control.Lensにある亜Lensファミリーの重要と思われる型の大部分はカバーできたと思います.
あとの細々したところは実際の実装を追うのがよいでしょう.
Lensは巨大で複雑ですがこのように一つ一つ1から実装していけばそこまで難しくはないと思います. 個々のレベルではIdentityとかConstとかTaggedとかを使って型合わせゲームしているだけでちゃんと動きます.

というわけで以上です.
最後にコード全体を載せておきます.