Lensの仕組みがわかった

#はじめに
投稿しようと思ったらすでに書こうとしていた内容が存在しておりました。
Lensってなに？どういう仕組みなの？
が、自分なりの文章で投稿します。

#Lensとは
レコード型の要素に対して便利なゲッターとセッターを提供してくれます。
なぜか、ゲッターとセッターは同じ関数が使えてしまいます。

{-# LANGUAGE TemplateHaskell #-}
import Control.Lens

data Hoge = Hoge{
    _hVal :: Int,
    _fuga :: Fuga
}deriving Show
data Fuga = Fuga{
    _fVal :: String,
    _piyo :: Piyo
}deriving Show
newtype Piyo = Piyo{_pVal :: [Int]}deriving Show

makeLenses ''Hoge
makeLenses ''Fuga
makeLenses ''Piyo

hoge :: Hoge
hoge = Hoge { _hVal = 123
            , _fuga = Fuga { _fVal = "aaaa", _piyo = Piyo { _pVal = [] } }
            }
-------------------------
-- ゲッターの例
-------------------------
>>> hoge ^. hVal
123

>>> hoge ^. fuga
Fuga {_fVal = "aaaa", _piyo = Piyo {_pVal = []}}

>>> hoge ^. fuga . piyo . pVal
[]

-------------------------
-- セッターの例
-------------------------
>>> hoge & hVal .~ 99999
Hoge {_hVal = 99999, _fuga = Fuga {_fVal = "aaaa", _piyo = Piyo {_pVal = []}}}

>>> hoge & fuga.piyo.pVal .~ [1..3]
Hoge {_hVal = 123, _fuga = Fuga {_fVal = "aaaa", _piyo = Piyo {_pVal = [1,2,3]}}}

#Lensを自作してみる
まずは、セッターとゲッターを自作することを考える。
Haskellはまず、型から考えるのだ。

Getter演算子とSetter演算子は以下のような型になるはずだ。

(^.) :: s -> Lens s a -> a
(.~) :: Lens s a -> a -> s -> s

sがデータ型でaが要素の型だ
上の例のhValならsがHogeでaがIntになるはずだ。

hVal :: Lens Hoge Int

まずは、型を合わせずにそれぞれを定義してみる。

Getter

type LensGetter s a = s -> a

hValGetter :: LensGetter Hoge Int
hValGetter hoge = _hVal hoge

(^.) :: s -> LensGetter s a -> a
s ^. getter = getter s

Setter

type LensSetter s a = a -> s -> s

hValSetter :: LensSetter Hoge Int
hValSetter a hoge = hoge{_hVal = a}

(.~) :: LensSetter s a -> a -> s -> s
setter .~ a = \s -> setter a s

GetterとSetterの型を合わせる

Getterは最後に要素の型aがほしいし、Setterはレコード型がほしい
ので、両方をタプルで抱き合わせて型を合わせてしまおう。

さらに、Setterはセットするために要素aが引数にほしいがGetterにはいらない。
でも、型を合わせるためにGetterにも無駄に引数を増やすことにする。

type Lens s a = a -> s -> (a, s)

hVal :: Lens Hoge Int
hVal a hoge = (_hVal hoge, hoge { _hVal = a })

(^.) :: s -> Lens s a -> a
s ^. getter = fst $ getter ？ s

(.~) :: Lens s a -> a -> s -> s
setter .~ a = \s -> snd $ setter a s

これで、とりあえず型はそろったが、Getter演算子(^.)が定義できなくなってしまった・・・

まてよ、setterはそもそも演算子側(.~)で書き換える要素をもらえるから・・・

type Lens s a = (a -> a) -> s -> (a, s)

hVal :: Lens Hoge Int
hVal f hoge = (_hVal hoge, hoge { _hVal = f (_hVal hoge) })

(^.) :: s -> Lens s a -> a
s ^. getter = fst $ getter id s

(.~) :: Lens s a -> a -> s -> s
setter .~ a = \s -> snd $ setter (\_ -> a) s

よし。うまく型が揃った！！！

>>> hoge ^. hVal
123

>>> hoge & (hVal .~ 999)
Hoge {_hVal = 999}

でも、このままだと本物のLensみたいにうまく合成ができない・・・

そこで、僕はあきらめて答えを見た。

(^.) :: s -> Getting a s a -> a
type Getting r s a = (a -> Const r a) -> s -> Const r s
(.~) :: ASetter s t a b -> b -> s -> t
type ASetter s t a b = (a -> Identity b) -> s -> Identity t

rとかsとかtとかbとか無駄にいっぱいあってよくわからんが、
GetterはConstをつかって、SetterはIdentityをつかうのか・・・

！！！！謎はすべて解けた！！！！

type Lens f s a = (a -> f a) -> s -> f s

(^.) :: s -> Lens (Const a) s a -> a
s ^. getter = getConst $ getter Const s

(.~) :: Lens Identity s a -> a -> s -> s
setter .~ a = \s -> runIdentity $ setter (\_ -> Identity a) s

hVal :: Functor f => Lens f Hoge Int
hVal f hoge = fmap (\a -> hoge { _hVal = a }) (f (_hVal hoge))

fuga :: Functor f => Lens f Hoge Fuga
fuga f hoge= fmap (\a -> hoge { _fuga = a }) (f (_fuga hoge))

piyo :: Functor f => Lens f Fuga Piyo
piyo f fuga = fmap (\a -> fuga { _piyo = a }) (f (_piyo fuga))

pVal :: Functor f => Lens f Piyo [Int]
pVal f piyo = fmap (\a -> piyo { _pVal = a }) (f (_pVal piyo))

>>> hoge ^. hVal
123

>>> hoge ^. (fuga . piyo . pVal)
[]

>>> hoge & (hVal .~ 999)
Hoge {_hVal = 999, _fuga = Fuga {_fVal = "aaaa", _piyo = Piyo {_pVal = []}}}

>>> hoge & ((fuga . piyo . pVal) .~ [1..3])
Hoge {_hVal = 123, _fuga = Fuga {_fVal = "aaaa", _piyo = Piyo {_pVal = [1,2,3]}}}

というわけで、キモはConstとIdentityを使って、GetterとSetterをFuctorで共通化することにあったらしい。

最後に

Lens作った人、頭よすぎでしょ！！！！！！

2021/03/16 追記

Functorで共通化しなくても、タプルでもうまく合成できることがわかったので追記。

Lensを以下のように定義してあげることでConstとIdentityつかわなくても共通化できます。
タプルもFunctorなので各要素に対するLensの定義はそのままです。

type Lens r s a = (a -> (r, a)) -> s -> (r, s)

(^.) :: s -> Lens a s a -> a
s ^. lens = fst $ lens (\a -> (a, a)) s

(.~) :: Lens () s a -> a -> s -> s
lens .~ a = snd . lens (const ((), a))

hVal :: Lens r Hoge Int
hVal f hoge = fmap (\a -> hoge {_hVal = a}) (f (_hVal hoge))

fuga :: Lens r Hoge Fuga
fuga f hoge = fmap (\a -> hoge {_fuga = a}) (f (_fuga hoge))

piyo :: Lens r Fuga Piyo
piyo f fuga = fmap (\a -> fuga {_piyo = a}) (f (_piyo fuga))

pVal :: Lens r Piyo [Int]
pVal f piyo = fmap (\a -> piyo {_pVal = a}) (f (_pVal piyo))