Haskell
ghc
lens
HaskellDay 23

TemplateHaskell不要なレコードアクセサgeneric-lens🙄

おはこんにちクリスマス〜〜🤟🙄🤟
今回はmakeLenses, makePrismsの代替となるgeneric-lensについて紹介します!

ララちゃんの画像.png

本稿は以下の概念を既知とします。

ただしそのいずれかがわからなくとも、単なるlens事例の一つのアバウトとしてもお読みいただけるかもしれません。

まとめ

generic-lensの概観

さてlensパッケージに付いてくるmakeLensesですが、このようにsweetおよびmoonというようなアクセサを、TemplateHaskellを用いて自動定義するものでした。

data Sugar = Sugar
  { _sweet :: String
  , _moon :: Int
  } deriving (Generic, Show)

makeLenses ''Sugar

sugar :: Sugar
sugar = Sugar "me" 1000

sugar ^. sweet
-- "me"

sugar & moon .~ 10003
-- Sugar {sweet = "me", moon = 10003}

これに対してgeneric-lensはTemplateHaskellを用いず、このようにDeriveGenericとGenericなコンビネーターを用いて同じことができます。

data Sugar = Sugar
  { sweet :: String
  , moon :: Int
  } deriving (Generic, Show)

sugar :: Sugar
sugar = Sugar "me" 1000

sugar ^. field @"sweet"
sugar & field @"moon" .~ 10003

パフォーマンスについてですが、アルティメットGHCマジックにより、(Genericインスタンスを?)手書きでない限りmakeLensesと同一レベルのようです。
(-O1では。-O1以外だとどうなんだろ。)

The runtime characteristics of the derived optics is in most cases identical at -O1, in some cases only slightly slower than the hand-written version. This is thanks to GHC's optimiser eliminating the generic overhead.

DeriveGenericの概観

これについては多く語られたものと思いますので、ここでは導入のために大雑把に済ませます :eyes:
正確な情報については以下を参照してください。

ということで……

DeriveGenericはデータ型へのderive (Generic)を許可します。
そして型Aへのderive (Generic)は、そのメタ情報を持つ型Rep Aを生成するものです。

さきほど提示した、derive (Generic)されたSugar型の情報を見てみましょう。
ただし内容を理解する必要はありません。
type instance Rep Sugarが生えていることを確認してください :sunglasses:

>>> :i Sugar
data Sugar = Sugar {sweet :: String, moon :: Int}
        -- Defined at <interactive>:11:1
instance [safe] Show Sugar -- Defined at <interactive>:14:24
instance [safe] Generic Sugar -- Defined at <interactive>:14:15
type instance Rep Sugar
  = D1
      ('MetaData "Sugar" "Ghci1" "interactive" 'False)
      (C1
         ('MetaCons "Sugar" 'PrefixI 'True)
         (S1
            ('MetaSel
               ('Just "sweet")
               'NoSourceUnpackedness
               'NoSourceStrictness
               'DecidedLazy)
            (Rec0 String)
          :*: S1
                ('MetaSel
                   ('Just "moon")
                   'NoSourceUnpackedness
                   'NoSourceStrictness
                   'DecidedLazy)
                (Rec0 Int)))
        -- Defined at <interactive>:14:15

各ライブラリはDefaultSignatures拡張とこの型Rep aへの使って、任意のaへのインスタンスを実装することができます。

例えばそのライブラリが以下のようなSerialize型クラスを提供するとします。
その場合ユーザーは同じく以下のように、derive (Generic)することのみでinstance Serialize宣言することができます。
明示的なput実装を書く必要がないのです。

data Bit = I | O
  deriving (Show)

class Serialize a where
  put :: a -> [Bit]
  default put :: (Generic a, GSerialize (Rep a)) => a -> [Bit]
  put = gput . from

instance Serialize Sugar

つまりDeriveGenericは、ユーザーに変わって型クラスのインスタンスを自動生成してくれるものです!

これの実用例としてはData.Aesonが有名かもしれません :alien:


この実装の全体は以下にあります。

generic-lensの詳細

準備が終わりましたので、ここから本編です!
generic-lensの提供するコンビネータ―を紹介します :dog2:

以下の公式ページに書いてあるものと、公式ページには書いていないいくつかのものを、順に見ていきましょう。

いくつかの種別として、データ型とその値を定義しておきます :sunglasses:

  • 単純な直積: Sugar
  • 単純な直和: Fluffy
  • 同じ型を1つ以上含む直積: Point
  • 一方が他方を包含するような型: Skeleton, Sans
data Sugar = Sugar
  { sweet :: String
  , moon :: Int
  } deriving (Generic, Show)

sugar :: Sugar
sugar = Sugar "me" 1000

data Fluffy = Asgore { kind :: String }
            | Toriel { kind :: String, aggressive :: () }
  deriving (Generic, Show)

asgore :: Fluffy
asgore = Asgore ":)"

toriel :: Fluffy
toriel = Toriel ":D" ()

data Point = Point Int Int
  deriving (Generic, Show)

point :: Point
point = Point 100 200

newtype Skeleton = Skeleton
  { skeleton :: String
  } deriving (Generic, Show)

data Sans = Sans
  { skeleton :: String
  , lazy :: Int
  } deriving (Generic, Show)

sans :: Sans
sans = Sans ";E" 1

Lens

field

fieldはあるレコードの名前を型として受け取り、それにアクセスします。

-- 直積
sugar ^. field @"sweet"
sugar & field @"moon" .~ 10003
-- "me"
-- Sugar {sweet = "me", moon = 10003}

-- 直和
asgore ^. field @"kind"
toriel ^. field @"kind"
-- ":)"
-- ":D"

ただしAsgoreaggressiveを含んでいないため、以下はコンパイル不可です。

-- Not able to
toriel ^. field @"aggressive"

position

positionは引数の番目を受け取り、それにアクセスします。

sugar ^. position @1
sugar ^. position @2
-- "me"
-- 1000

(10, ("yours", "mine")) ^. position @2 . position @1
-- "yours"

asgore ^. position @1
toriel ^. position @1
-- ":)"
-- ":D"

ただしAsgoreが2引数目を含んでいないため、以下はコンパイル不可です。

-- Not able to
toriel ^. position @2

typed

typedはレコードの型を受け取り、その値を返します。

sugar ^. typed @String
asgore ^. typed @String
-- "me"
-- ":)"

ただしAsgore()を含んでいないため、
またPointIntが一意的でない(Intのレコードが2つある)ため、
以下はコンパイル不可です。

-- Not able to
toriel ^. typed @()
point ^. typed @Int

supar

superは構造的部分型関係S <: TSTに型付けます。

……えっ?
なんかいきなり趣が違くない? :thinking:

sans ^. super @Skeleton
upcast sans :: Skeleton
-- Skeleton {skeleton = ";E"}
-- Skeleton {skeleton = ";E"}

the

theはfield・position・typicalの全てを合わせたコンビネータ―です。

  • Symobl ==> field
  • Nat ==> position
  • Type ==> typed
sugar ^. the @String
asgore ^. the @1
sans ^. the @"skeleton" -- I'm Sans. Sans the skeleton ;E

-- "me"
-- ":)"
-- ";E"

Prism

generic-lensはlensesの他にprismsも提供しています。
いずれもその値コンストラクタについて言及するもののようです。

_Ctor

_Ctorは値コンストラクタ名を引数に取って、それにアクセスします。

sugar  ^? _Ctor @"Sugar"
toriel ^? _Ctor @"Toriel"
-- Just ("me",1000)
-- Just (":D",())

asgore ^? _Ctor @"Toriel"
-- Nothing

_Typed

_Typedはレコードの型を受け取り、その値を返します。

asgore ^? _Typed @String
toriel ^? _Typed @(String, ())
-- Just ":)"
-- Just (":D",())

FluffyStringAsgoreですが、Toriel(String, ())であるため、以下は失敗します。

toriel ^? _Typed @String
-- Nothing

()Fluffyの値コンストラクタは存在しないため、以下はコンパイル不可です。

-- Not able to
toriel ^? _Typed @()

_As

the同様、_Asは_Ctor, _Typedの合わせです。

  • Symbol => _Ctor
  • Type => _Typed
toriel ^? _As @"Toriel"
asgore ^? _As @String
-- Just (":D",())
-- Just ":)"

???

最後にConstraintsに関するコンビネータ―constraints'を見て、終わります。

twice :: (Applicative f, Num a) => a -> f a
twice = pure . (*2)
constraints' @Num (twice @Identity) point
-- Identity (Point 200 400)

うおおおおお! めっちゃすごくて感動しました!

ってあれ? これもうLensもPrismも関係ないじゃないですか。

まとめ

generic-lensは以下のlensesとprismsを提供してくれました。
またmakeLensesとは違いGenerics由来なので、TemplateHaskellから来る不毛な戦いに遭遇することを回避できます。
(まあそのような不毛な戦いに遭遇することは、あまり多くないとは思いますが :thinking:

>>> :t field
field :: (HasField field s t a b, Functor f)
      => (a -> f b) -> s -> f t

>>> :t position
position :: (HasPosition i s t a b, Functor f)
         => (a -> f b) -> s -> f t

>>> :t typed
typed :: (HasType a s, Functor f)
      => (a -> f a) -> s -> f s

>>> :t super
super :: (Subtype sup sub, Functor f)
      => (sup -> f sup) -> sub -> f sub

>>> :t the
the :: (HasType b s, Functor f)
    => (b -> f b) -> s -> f s

>>> :t _Ctor
_Ctor :: ( AsConstructor ctor s t a b
         , Profunctor.Choice.Choice p
         , Applicative f
         ) => p a (f b) -> p s (f t)

>>> :t _Typed
_Typed :: ( AsType a s
          , Profunctor.Choice.Choice p
          , Applicative f
          ) => p a (f a) -> p s (f s)

>>> :t _As
_As :: ( AsType a s
       , Profunctor.Choice.Choice p
       , Applicative f
       ) => p a (f a) -> p s (f s)

>>> :t constraints'
constraints' :: ( Generic s
                , GHasConstraints' c (GHC.Generics.Rep s)
                , Applicative f
                ) => (forall a. c a => a -> f a) -> s -> f s

メリークリスマス! :santa: :snowman: