ぼくのかんがえた最強の拡張可能レコード

動機

GHCに、OverloadedRecordFields(ORF)という拡張の導入が提案されている。

(Records/OverloadedRecordFields/Design – GHCより) Haskellのレコードの深刻な欠点は、フィールドをオーバーロードできないことだ。例えば、

data Person  = Person  { personId :: Int, name :: String }
data Address = Address { personId :: Int, address :: String }

と定義したとき、personIdはどちらを参照すべきかわからない。よくある対策としてデータ型に接頭辞をつけるという方法があるが、コードやフィールド間の関係が不明瞭になる。モジュール単位で修飾するという方法もあるが、レコードごとにモジュールを作るのは非実用的だ。

そこで、personIdをその型によって解決するような、多相なフィールドの写像を扱いたい。r { x :: t }で、rxという名前の、型tのフィールドを持つことを表す、新しい形の制約の記法が必要となる。そうすれば、以下のような記述が可能になる。

getPersonId :: r { personId :: Int } => r -> Int
getPersonId e = personId e

問題点

最も大きな問題は、フィールドがファーストクラスでないことである。 lensなどのライブラリは、フィールドをデータとして表すことにより、合成などの演算を可能にしている。しかし、ORFのフィールドの概念は制約としてのみ現れる。残念ながら、Haskellは制約レベルのプログラミングは得意ではないため、非常に扱いにくいのだ。

解決

ならばORFに代わる最強の多相レコードを作ってやろう、と私は立ち上がった。仕様は以下の通りだ。

  • フィールドは値であり、フィールド名と、それが指し示す対象を型によって決めることができる。
  • レコードの型は、フィールド名の集まりによって決まる。
  • フィールドはLensとして扱える(重要)。
  • レコードの構築にフィールドを使える。必要なフィールドが欠けている場合、型エラーになる。

まず、フィールド名を型に対応させるために型族を用いる。

type family FieldValue (s :: Symbol) :: *

Symbol型レベル文字列の型(DataKinds拡張を使う)で、*は値の型である。 type instance FieldValue "foo" = Barと定義すれば、名前"foo"に型Barを対応させることができる。 そして、フィールドの型を以下のように定義する。

data Field (s :: Symbol) = Field { getField :: FieldValue s }

そして、Fieldの拡張可能な集まりとして、レコードを実現する。「拡張可能な集まり」のために、拙作のextensibleを利用した。

extensibleパッケージでは、積の表現として(:*)という型を定義している。型h :* [a, b, c, …](型レベルリストを使用していることに注意されたい)は、(h a, h b, h c, …)のタプルに相当する。直接(a, b, c, …)と対応させない理由は、すぐに明らかになる。

積を扱うのに必要なAPIはこの3つだ。

Nil :: h :* []
(<:*) :: h x -> h :* xs -> h :* (x : xs)
sector :: (x ∈ xs) => Lens' (h :* xs) (h x)

Nilと(<:*)はnilとcons、sectorは、積の特定の要素に対するLensである。x ∈ xsは、型レベルリストxsの中にxがただ一つ存在することを表す。

ちなみに、xがない場合、Couldn't match type ‘Missing x’ with ‘Expecting one’xが重複している場合は‘Couldn't match type ‘Ambiguous x’ with ‘Expecting one’というエラーが出る。地味な売りの一つだ。

そんなわけで、Field :* '["foo", "bar", "baz"]とすると、(Field "foo", Field "bar", Field "baz")相当になり、その中身は、foo, bar, bazがFieldValueが指し示す型になるのだ。レコードの型を以下のように定義しよう。

type Record = (:*) Field

FieldValueインスタンスと、Lens (x ∈ xs) => Lens' (Record xs) (FieldValue x)はできれば一緒に生成したいが、こんなのはTemplate Haskellをちょいと練ればすぐにできるだろう。

mkField "personId" [t|Int|] -- personId :: ("personId" ∈ xs) => Lens' (Record xs) Int
mkField "name" [t|String|]
mkField "address" [t|String|]

getPersonIdはORF版と同じくらいシンプルに表現でき、言語自体を拡張する必要もない。

getPersonId :: ("personId" ∈ xs) => Record xs -> Int
getPersonId = view personId

さて、問題は最後の要件だ。定義したLensをそのまま使い、こんな風に書ければ理想的ではある。

(@=) :: ((s ∈ xs) => Lens' (Record xs) (FieldValue s)) -> FieldValue s -> Field s
(@=) _ = Field

fubuki :: Record '["personId", "name"]
fubuki = personId @= 1
     <:* name @= "吹雪"
     <:* Nil

しかし、mkFieldによって生成されるLensと、型族FieldValueは、どちらもフィールド名を具体化するのには使えず、(@=)は作れないのだ!この世の終わりだー!

諦めるのはまだ早い。実は、既存のLensのインターフェイスを損なうことなく、フィールド名をLensに忍ばせることが可能なのである。

ちょっとした型クラスを用意する。

class Labelable s p where
  unlabel :: proxy s -> p a b -> a -> b

instance Labelable s (->) where
  unlabel _ = id
  {-# INLINE unlabel #-}

フィールドの型を以下のように定義し直す。比較のため、普通のLens'の場合をその下に書く。

type FieldLens s = forall f p xs. (Functor f, Labelable s p, s ∈ xs)
  => p (FieldValue s) (f (FieldValue s)) -> Record xs -> f (Record xs)

-- Lens' (Record xs) (FieldValue s) = forall f. (Functor f)
--  => (FieldValue s -> f (FieldValue s)) -> Record xs -> f (Record xs)

-- field f = sector (fmap Field . unlabel f . getField)のような形になる(実際は型アノテーションが必要)

(->)Labelable p => pに一般化しているのがポイントだ。これを使うことによって、以下のように単相な「代表」を構成し、フィールド名の曖昧性を排除できるのだ!

data LabelPhantom s a b

instance (s ~ t) => Labelable s (LabelPhantom t) where
  unlabel _ = error "Impossible"

type FieldName s = LabelPhantom s (FieldValue s) (Proxy (FieldValue s))
  -> Record '[s] -> Proxy (Record '[s])

これのおかげで、無事に(@=)コンビネータを定義できる。

(@=) :: FieldName s -> FieldValue s -> Field s
(@=) _ = Field

めでたしめでたし…いや、志の高い諸君ならば、束縛の順番を入れ替えても大丈夫なようにしたいだろう。そんなときのために、Data.Extensible.Inclusionshrink関数が使える。

shrink :: (xs ⊆ ys) => h :* ys -> h :* xs

前に定義したように、Recordは単なる型シノニムなので、shrinkを適用することによって順番を自由に入れ替えられる(し、一部を切り出すこともできる)。もちろん、型エラーの読みやすさは損なわれていないので、気になる人は試してみるとよいだろう。

fubuki :: Record '["personId", "name"]
fubuki = shrink 
       $ name @= "吹雪"
     <:* personId @= 1
     <:* Nil

こうして、街に平和が訪れためうー!型レベルプログラミングのおかげだね!

このアイデアの実装はGitHubextensibleのリポジトリにあり、次のextensibleのリリースに組み込む予定だ。

結論

OverloadedRecordFieldsなんていらんかったんや!