Yet another extensible records for Haskell

# はじめに

Haskellにおける拡張可能レコードは [extensible](https://hackage.haskell.org/package/extensible) が有名ですが、
今回新たな拡張可能レコードライブラリを作ったので紹介します。

## Row polymorphism
Row polymorphismとは特定のフィールドを持ったレコード型ならなんでも渡せるような関数を書く方法です。
例えばPureScriptでは以下のような`Int`型のフィールド`foo`を持つ任意のレコードを渡せる関数`f`を定義することができます。

```haskell
f :: forall r. { foo :: Int | r } -> Int
f x = x.foo + 1

>>> f { foo : 10, bar : True } 
11
>>> f { foo : 3 } 
4
```

Haskellでもextensibleを使うとRow polymorphismを再現できます。

```haskell
import Data.Extensible
import Control.Lens

f :: Lookup xs "foo" Int => Record xs -> Int
f = x ^. #foo + 1

>>> f ( #foo @= 11 <: #bar @= True <: nil )
11
>>> f ( #foo @= 3 <: nil )
4
```

## レコードの拡張と部分適用
さて、あるレコードに対して、特定のフィールドを追加したい場合はどのようにしたら良いでしょうか？
extensibleでは`(<:)`演算子を使ってレコードを拡張できます。

```haskell
extendBar :: Record xs -> Record ("bar" :> Bool ': xs)
extendBar x = #bar @= True <: x
```

この演算子をつかってフィールドの**部分適用**はできるでしょうか？
ここでいう部分適用とは必要なフィールドのうち一部分だけを渡すことです。
例えば、`foo`フィールドと`bar`フィールドが必要なレコードを引数にとる関数`f`のうち、
`bar`フィールドだけ部分適用した`applyBarF`を定義することです。

```haskell
f :: (Lookup xs "foo" Int, Lookup xs "bar" Bool) => Record xs -> Int
f = ...

applyBarF :: Lookup xs "foo" Int => Record xs -> Int
applyBarF = ???
```

直感的には以下のように書けそうです。

```haskell
applyBarF :: Lookup xs "foo" Int => Record xs -> Int
applyBarF x = f (#bar @= True <: x) 
```

しかし残念ながら型エラーが発生します。（もしこの型エラーの直し方をご存知の方がいたら教えていただけると嬉しいです）


```console
Extensible.hs:18:15: error:
    • Couldn't match type ‘Type.Membership.Internal.Elaborate
                             "bar"
                             ((0 ':> Bool) : Type.Membership.Internal.FindAssoc 1 "bar" xs)’
                     with ‘'Type.Membership.Internal.Expecting (n0 ':> Bool)’
        arising from a use of ‘f’
      The type variable ‘n0’ is ambiguous
    • In the expression: f (#bar @= True <: x)
      In an equation for ‘applyBarF’: applyBarF x = f (#bar @= True <: x)
    • Relevant bindings include
        x :: Record xs (bound at tmp/Extensible.hs:18:11)
        applyBarF :: Record xs -> Int (bound at tmp/Extensible.hs:18:1)
   |
18 | applyBarF x = f (#bar @= True <: x)
```

以下のように`foo`フィールドを取り出してきて別のレコードを作れば動きますが、いちいち
フィールドを取り出すのは面倒でしょう。

```haskell
applyBarF :: Lookup xs "foo" Int => Record xs -> Int
applyBarF x = f (#bar @= True <: #foo @= (x ^. #foo) <: nil) 
```

ちなみにPureScriptなら部分適用ができます。

```haskell
import Prim.Row
import Record
import Type.Proxy

f :: forall r. { foo:: Int, bar :: Boolean | r} -> Int
f x = ...

applyBarF :: forall r. Lacks "bar" r => { foo :: Int | r } -> Int
applyBarF x = f (insert (Proxy :: Proxy "bar") true x)
```

## レコード拡張のコスト
さて、フィールド数$n$のレコードを$d$個のフィールドで拡張するときに発生する計算コストはどれだけでしょうか？

- extensibleではレコードは配列として実装されています。配列の拡張を行うので$\mathcal{O}(n+d)$の時間がかかります。
- PureScriptではレコードはJavaScriptのレコード（おそらくハッシュテーブル）で表現されます。拡張時にはレコードのコピーを行うので$\mathcal{O}(n+d)$の時間がかかります。

フィールド数が多くレコードの拡張が頻繁に発生する場合、このコストは無視できません。

## Nominal Subtyping
さて、今回は以下のようなレコード型ライブラリを紹介します。

- Row polymorphismを実現
- レコードの部分適用に正しく型が付けられる
- フィールド数$n$のレコードに$d$個のフィールドを追加するコストが$\mathcal{O}(d)$

これを実現する基本的なアイデアはNominal Subtypingです。

extensibleやPureScriptのレコードはstructural subtypingであり、
レコードを拡張すると全く別の型になります。

![Untitled Diagram.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/67228/89b7e199-e2b4-a000-4cc3-6a594a1cb747.png)

一方、Nominal Subtypingではレコード同士の親子関係を定義し、親レコードをポインタで持つようにします。
![Untitled Diagram-Page-2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/67228/8dd8c9c3-d1e3-4ac4-260b-fe8b7602c199.png)

こうすることで、レコードの拡張を$\mathcal{O}(d)$のコストで実現できます。[^1]
あとは型レベルプログラミングで頑張ると先祖レコードのフィールドにも自在にアクセスできるようになり、
Row polymorphismやレコード部分適用を実現できます。

[^1]: もちろんこのやり方にするとフィールドを取得する際にレコードの親子関係を線形走査する必要があり、ネストの深いところにあるフィールドを取得するのにコストがかかるという欠点はあります。

# Nominal Extensible Records
## 使い方
今回紹介するレコード型の実装はhierarchical-envというライブラリにまとめています。

https://hackage.haskell.org/package/hierarchical-env


まず、以下の言語拡張を有効にしてモジュールをインポートしましょう。

```haskell:Env.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Env where

import Control.Env.Hierarchical
import Control.Lens
```

### レコードの宣言
hierarchical-envでは各レコードを普通のデータ型として宣言します。
手始めに`Int`型と`String`型をフィールドに持つ`Env1`型を定義して、`deriveEnv ''Env1`と呪文を唱えます。

```haskell:Env.hs
data Env1 = Env1 Int String deriving (Show)

deriveEnv ''Env1

env1 = Env1 1 "hoge"
```

各フィールドには`getL`レンズをつかってアクセスします。

```console
$ ghci Env.hs 
> import Control.Lens
> import Control.Env.Hierarchical
> env1 ^. getL :: Int
1
> env1 ^. getL :: String
"hoge"
> env1 & getL .~ "fuga"
Env1 1 "fuga"
```

### フィールド名
レコードと言いつつフィールド名は本質的でないので今のところサポートしていません。
名前をつけたい（同じ型のフィールドを複数持ちたい）場合は`newtype`でフィールドの型に名前をつけるスタイルを推奨しています。

```haskell:Env.hs
data Env2 = Env2 Port APIKey HostName deriving (Show)

newtype Port = Port Int deriving (Show)

newtype APIKey = APIKey String deriving (Show)

newtype HostName = HostName String deriving (Show)

deriveEnv ''Env2
```

```console
> env2 ^. getL :: Port
Port 1234
> env2 & getL .~ APIKey "PRODUCTION_KEY"
Env2 (Port 1234) (APIKey "PRODUCTION_KEY") (HostName "localhost")
```

### レコード拡張
さて、お待ちかねのレコードの拡張です。親レコードを`Extends`型で包んだフィールドを追加することでレコードの親子関係を宣言します。

```haskell:Env.hs
data Env3 = Env3 LogFilePath (Extends Env2) deriving (Show)

newtype LogFilePath = LogFilePath String deriving (Show)

deriveEnv ''Env3

env3 = Env3 (LogFilePath "system.log") (Extends env2)
```

拡張したレコードでは親レコードのフィールドにも`getL`でアクセスできます。

```console
> env3 ^. getL :: Port
Port 1234
> env3 ^. getL :: LogFilePath 
LogFilePath "system.log"
```

### Row Polymorphism
`Has x env`型制約をつかってRow Polymorphismを表現できます。

```haskell:Env.hs
f :: (Has LogFilePath env, Has HostName env) => env -> IO ()
f env = do
  print $ (env ^. getL :: LogFilePath)
  print $ (env ^. getL :: HostName)
```

以下のように`env3`は引数に渡せますが、`env2`は`LogFilePath`を持たないのでエラーとなります。

```console
> f env3
LogFilePath "system.log"
HostName "localhost"
> f env2

<interactive>:23:1: error:
    • No environment has LogFilePath
    • In the expression: f env2
      In an equation for ‘it’: it = f env2
```

### レコードの部分適用

親レコードに型変数を指定することでレコードの部分適用ができます。

```haskell:Env.hs
data Env4 env = Env4 LogFilePath (Extends env) deriving(Show)

deriveEnv ''Env4

g :: Has HostName env => env -> IO ()
g env = f (Env4 (LogFilePath "error.log") $ Extends env)
```

```console
> g env2
LogFilePath "error.log"
HostName "localhost"
```

## 作り方
ここから先はライブラリの実装についての説明です。
型レベルプログラミングをバリバリ使っています。ご了承ください。

### 方法1: Hasを型クラスとして実装する
一番素朴な実装方法は`Has x env`を以下のような型クラスにすることでしょう。

```haskell
class Has x env where
  getL :: Lens' env x
```

この場合は各レコードとそのフィールド毎にインスタンスを定義します。
例えば以下のようなレコードでは

```haskell
data Env1 = Env1 Int Bool

data Env2 = Env2 Char (Extends Env1)
```

次のインスタンスを宣言すれば良いです。

```haskell
instance Has Int Env1 where
  getL f (Env1 x1 x2) = fmap (\y1 -> Env1 y1 x2) (f x1)

instance Has Bool Env1 where
  getL f (Env1 x1 x2) = fmap (\y2 -> Env1 x1 y2) (f x2)

instance Has Char Env2 where
  getL f (Env2 x1 x2) = fmap (\y1 -> Env2 y1 x2) (f x1)

instance {-# OVERLAPS #-} Has x Env1 => Has x Env2 where
  getL = superL . getL
    where
      superL f (Env2 x1 (Extends x2)) = fmap (\y2 -> Env2 x1 (Extends y2)) (f x2)  
```

この方法はシンプルで良いのですが、フィールドの型が具体的に分かっている必要があります。
普通のデータ型ならフィールドの型は分かっているので問題ないのですが、拡張可能レコード等のインスタンスを宣言できません。

```haskell
instance ??? => Has x (Record xs) where
  getL = ???
```

うまく宣言できない理由は、`x`が自身のフィールドなのか親レコードのフィールドなのかを`Record xs`の形のみから判断できないためです。
 
### 方法2: 型レベル計算による実装

こちらの方法が実際にhierarchical-envで採用されている方法になります。

`Has x env`を二つの型クラス`Trans env route`と`Field x env'`に分解します。

```haskell
type Has x env = (Trans env route, Field x env')
  where -- 実際にはwhere記法なんてものはないので展開しています。 
    route = FindEnv x env (Addr env)
    env' = Target env route
```

`Trans env route`型クラスは型レベルリスト`route`に従って親レコードを辿ると、`Target env route`型に遷移できることを表します。
一方`Field x env'`型クラスは`env'`型の（直接の）フィールドに`x`があることを表します。

```haskell
class Trans env route where
  type Target env route
  transL :: Lens' env (Target env route)

instance Trans s '[] where
  type Target s '[] = s
  transL = id

instance (Environment s, Super s ~ t, Trans t l) => Trans s (t : l) where
  type Target s (t : l) = Target t l
  transL = superL . transL @t @l

class Field x env where
  fieldL :: Lens' env x
```

これらを組み合わせると`getL`を定義できます。

```haskell
getL :: forall x env. Has x env => Lens' env x
getL = transL @env @(FindEnv x env (Addr env)) . fieldL
```

下図のように`transL`で型`x`をフィールドにもつレコードまで遷移し、`fieldL`で型`x`にアクセスするというイメージです。

![Untitled Diagram-Page-3.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/67228/e5208e18-b7cc-4015-3879-55ee5e342d16.png)

問題は**型`x`をフィールドに持つレコードを見つける**ことです。これを型レベル計算で求めるところがポイントです。

型族`FindEnv x env envs`と`Addr env`がその責務を担っています。
探索する際には「各レコードのフィールドのリスト」や「各レコードの親クラス」が必要なのですが、これらは`Environment`型クラスで宣言します。

```haskell
-- | 親レコードのリスト`envs`を辿りながら、`f`をフィールドに持つレコードを探します
type family FindEnv (f :: Type) env (envs :: [Type]) :: [Type] where
  FindEnv f env (env' ': envs) = If (Member f (Fields env)) '[] (env' : FindEnv f env' envs)
  FindEnv f env '[] = TypeError ('Text "No environment has " ':<>: 'ShowType f)

-- | レコード`env`の先祖レコードのリストを返します。
type family Addr a :: [Type] where
  Addr Root = '[]
  Addr a = Super a ': Addr (Super a)

-- | 各レコードが実装する型クラス
class Environment env where
  -- | 親レコード
  type Super env
  -- | フィールドの型のリスト
  type Fields env :: [Type]
  -- | 親レコードへのLens
  superL :: Lens' env (Super env)
```

このやり方では`Environment env`と`Field x env`のインスタンスがボイラープレートとして定義する必要があります。

例えば

```haskell
data Env1 = Env1 Int Bool

data Env2 = Env2 Char (Extends Env1)
```

に対して、以下のようなインスタンスを宣言します。
実際にはTemplateHaskell`deriveEnv`を使って自動生成します。

```haskell
instance Environment Env1 where
  type Super Env1 = Root
  type Fields Env1 = '[Int, Bool]
  superL f e = fmap (const e) (f Root)

instance Field Int Env1 where
  fieldL f (Env1 x1 x2) = fmap (\y1 -> Env1 y1 x2) (f x1)

instance Field Bool Env1 where
  fieldL f (Env1 x1 x2) = fmap (\y2 -> Env1 x1 y2) (f x2)

instance Environment Env2 where
  type Super Env2 = Env1 
  type Fields Env2 = '[Char]
  superL f (Env2 x1 (Extends x2)) = fmap (\y2 -> Env2 x1 (Extends y2)) (f x2)

instance Field Char Env2 where
  fieldL f (Env2 x1 x2) = fmap (\y1 -> Env2 y1 x2) (f x1)
```

# まとめ
今回紹介した[hierarchical-env](https://hackage.haskell.org/package/hierarchical-env)は以下のような特徴を持っています。

- Row polymorphismを実現
- レコードの部分適用に正しく型が付けられる
- フィールド数$n$のレコードに$d$個のフィールドを追加するコストが$\mathcal{O}(d)$

このライブラリはレコードの拡張が部分適用が頻繁におこるユースケース（特にDependency Injection)で力を発揮します。 具体的な応用例は以下のチュートリアルをご覧ください。

https://zenn.dev/autotaker/articles/hierarchical-env-tutorial

是非使ってみていただけるとうれしいです。