ネストしたレコードの更新 (F#)

ネストしたレコードの下層のほうを更新しようとすると下記のような記述となります。

本来なら上層に下層を更新するメンバー関数を用意しておくのが理想ですが、面倒な場合用に簡素な記述で更新できる関数を実装します。

type Container = { Value : int }
type Child = { Container : Container }
type Root = { Child : Child }

let record1 = { Child = { Container = { Value = 100 } } }

let record2 = { record1 with Child = { record1.Child with Container = { record1.Child.Container with Value = record1.Child.Container.Value + 1 } } }

目標とする記述

カリー化されていな理由は後程説明します。

let record2 = Root.Update(record1.Child.Container.Value, ((+) 1))

updateNestedRecord

Exprで受け取ることにより、ターゲットまでの道のりを解析できるようにします。

ValueWithNameが出現するまで、PropertyGetでPropertyInfoを取得します。

updateRecordは後程実装します。

let updateNestedRecord<'a> (expr : Expr<'a>) (update : 'a -> 'a) =
    let rec loop expr propertyInfos =
        match expr with
        | PropertyGet(Some parent, info, _) -> loop parent (info::propertyInfos)
        | ValueWithName(x, _, _) -> updateRecord x propertyInfos update
        | _ -> failwith "invalid expression"
    loop expr []

updateRecord

各階層のインスタンスを取得し、各々に変更を加えていきます。

updateFieldは後程実装します。

let updateRecord record (propertyInfos : PropertyInfo list) (update : 'a -> 'a) =
    let values = 
        propertyInfos
        |> List.scan (fun parent info -> info.GetValue(parent)) record
        |> List.rev

    let newValue = values |> List.head :?> 'a |> update :> obj

    values |> List.tail |> List.zip (propertyInfos |> List.rev)
    |> List.fold (fun state (info, parent) -> updateField parent info state) newValue

updateField

PropertyInfoで示されるFieldを更新します。

let updateField record propertyInfo value =
    let index = 
        FSharpType.GetRecordFields(record.GetType())
        |> Array.findIndex ((=) propertyInfo)
    let values = FSharpValue.GetRecordFields(record)
    values.[index] <- value
    FSharpValue.MakeRecord(record.GetType(), values)

updateNestedRecord全体

open System.Reflection
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Reflection

let updateNestedRecord<'a> (expr : Expr<'a>) (update : 'a -> 'a) =
    let updateField record propertyInfo value =
        let index = 
            FSharpType.GetRecordFields(record.GetType())
            |> Array.findIndex ((=) propertyInfo)
        let values = FSharpValue.GetRecordFields(record)
        values.[index] <- value
        FSharpValue.MakeRecord(record.GetType(), values)

    let updateRecord record (propertyInfos : PropertyInfo list) (update : 'a -> 'a) =
        let values = 
            propertyInfos
            |> List.scan (fun parent info -> info.GetValue(parent)) record
            |> List.rev
        let newValue = values |> List.head :?> 'a |> update :> obj
        values |> List.tail |> List.zip (propertyInfos |> List.rev)
        |> List.fold (fun state (info, parent) -> updateField parent info state) newValue

    let rec loop expr propertyInfos =
        match expr with
        | PropertyGet(Some parent, info, _) -> loop parent (info::propertyInfos)
        | ValueWithName(x, _, _) -> updateRecord x propertyInfos update
        | _ -> failwith "invalid expression"
    loop expr []

Rootにメンバ追加

通常Exprは<@ record1.Child.Container.Value @>のように記述する必要がありますが、ReflectedDefinition属性をつけることにより<@ @>を省略できます。

ただしReflectedDefinitionはカリー化された引数には現状利用できません。

type Root = 
    { Child : Child }
    static member Update([<ReflectedDefinition>] field, update) = updateNestedRecord field update :?> Root

動作確認

下記の記述により、レコードの下層部が更新されていることを確認できます。

[<EntryPoint>]
let main argv = 
    let record1 = { Child = { Container = { Value = 100 } } }

    let record2 = Root.Update(record1.Child.Container.Value, ((+) 1)) 
    0