all Technical posts

Practically Applying F# Lenses in a Domain Model Context

Lens-based manipulation of domain models is a logical consequence when using immutable types. This post will go over some practical implementations of how you can use lenses in your application.

Why lenses can be helpful

Lenses were created because immutable types by themselves impose a problem: we can’t change data. We can only create a copy with the applied changes, and lenses are the solution. They make the whole get/set model system as a first-citizen in your language.
This post is by no means an attempt to fully explain lenses in-depth. See the following resources for more information on this topic:

This post will use the Aether F# lenses library because I prefer their way of composing and describing lenses. Other libraries available also have the same kind of functionality and composability. Moreover, things can always be extended.

Lenses in fully closed domain models

Domain models are very strict by themselves, and assignment with ‘just another value’ is tricky. Validation is key here. The initial creation of the model goes through predefined specifications, and so the assignment via lenses should go through the same specifications.

Let’s start with an existing domain model I mentioned in a previous post, where I tried to describe guests at a concert during the COVID-19 pandemic.

open FPrimitive
type Age =
private Age of int with
static member create x = specModel Age x {
inclusiveBetween 1 120 "age should be between 1-120 years (inclusive)" }
static member value (Age x) = x
type TestResult =
| Positive
| Negative with
static member create x =
Spec.def
|> Spec.verify (fun x -> Union.isUnionCase<TestResult> (x)) "test result should be either 'Positive' or 'Negative'"
|> Spec.createModelWith Union.create<TestResult> x
type RecoveryTime =
private RecoveryTime of TimeSpan with
static member create x = specModel RecoveryTime x {
greaterThanOrEqual TimeSpan.Zero "recovery time should be a positive time range" }
type CoronaPass =
| Vaccinated
| Tested of TestResult
| Recovered of RecoveryTime
type Guest =
{ Age : Age
Pass : CoronaPass option } with
static member create age pass = result {
if Age.value age < 12 && Option.isSome pass
then return! Spec.error "age-pass" "only adults can have a corona pass"
else return { Age = age; Pass = pass } }

The scenario is: you want to inspect if a guest has tested positive for COVID-19. Since the Guest.Pass is an optional type, and also a discriminated union, we can’t just select this. We have to pattern-match it twice before we have access to the test result. Setting a new test result is also tedious because one has to take into account the copy syntax and the optional constructor Some.

let mark = { Age = Age 10; Pass = Some (Tested Positive) }
match mark.Pass with
| Some (Tested result) -> // Inspect test result.
| _ -> ()
{ mark with Pass = Some (Tested Negative) }

Lenses are here to fix that and to make sure that all selections/assignments are handled the same. First of all, we have to tell Aether about our model.

[<AutoOpen>]
module Optics =
type Guest with
static member pass_ =
Prism.create (fun g -> g.Pass) (fun x g -> { g with Pass = Some x })
type CoronaPass with
static member testResult_ =
Prism.create (function | Tested result -> Some result | _ -> None)
(fun r _ -> Tested r)

Note that Prism.create is a function to create the necessary tuple that Aether needs. Now we have everything to compose our lens and get/set our test result.

let mark = { Age = Age 10; Pass = Some (Tested Positive) }
let pass_tested = Compose.prism Guest.pass_ CoronaPass.testResult_
let testResult = Optic.get pass_tested mark
let updatedMark = Optic.set pass_tested Negative mark

The selection of the lens pass_tested is made to link the Guest.Pass with the CoronaPass.Tested. Imagine how powerful this system is in a very big model, where all you have to do is describe the links between the models that need accessing or updating. The trick is to stop the lens selection when you encounter validation, as lenses will not be able to return a Result type — only options. Let the consumer worry about the validation and only let them ‘pass-in’ valid models. A lens for the recovery time should stop at RecoveryTime and not provide a link to the DateTimeOffset , so they are required to ‘pass-in’ a validated recovery time.

This system is a great example of hiding details and focusing on the domain of your application. In the next parts, special operators will be used instead of the Optic model (get : ^., set : ^=) and Compose (lens : >->, prism : >?>) to further focus on the values and types.

Lenses in tough DTO conversions

A second place where lenses can be a great tool is when a tedious DTO (data transfer object) needs to be converted to your beautifully described domain model. You don’t want to take in the hard-to-follow or chaotic way the DTO is described into your domain. In the context of performance or efficiency, certain choices could be made to make the DTO more easily transferable, but that should stop when the DTO enters your domain.

In this part, we’ll use a library book with a due date. A book can be lent once and renewed once, but not more. ISBN is left out to keep it simple.

type AsciiString =
private AsciiString of string with
static member create x = specModel AsciiString x {
notNullOrWhiteSpace "ASCII string should not be blank"
matches "^[A-Za-z]( [A-Za-z])*$" "ASCII string should be a single word or sentence" }
type Book =
private { Title : AsciiString
Author : AsciiString } with
static member create title author isbn = result {
let! title = AsciiString.create title
let! author = AsciiString.create author
let! isbn = ISBN.create isbn
return { Title = title; Author = author; ISBN = isbn } }
static member get { Title = AsciiString title; Author = AsciiString author; ISBN = ISBN13 isbn } =
title, author, isbn
type DueDate =
private | FirstDue of DateTimeOffset
| SecondDue of DateTimeOffset * DateTimeOffset with
static member create dates =
match dates with
| [|x|] -> Ok <| FirstDue x
| [|x; y|] when x > y -> Spec.error "second-duedate" "requires a second due date that is after the first due date"
| [|x; y|] -> Ok <| SecondDue (x, y)
| _ -> Spec.error "duedate" "requires a first or second due date, three or more lendings are not allowed"
static member get = function
| FirstDue x -> [|x|]
| SecondDue (x, y) -> [|x; y|]
type Loan =
{ Book : Book
Due : DueDate }

Imagine that you have to communicate with a system that describes books and due dates in a very peculiar way. Here are some examples:

book: UBIK;(philip k dick)
01/02/2022

book: THIRTEEN;(richard k morgan)
12/04/2022,30/04/2022

Our DTO could be nothing more than string. We’d do the deserialization later.

type LoanDto =
{ Book : string
DueDates : string }

In this case, lenses provide a single way to round-trip between the two. Firstly, let us check how the due dates are formed. It’s a list of dates separated with a comma (,). The lens for this property will be in three parts:

  1. select the due dates string
  2. split the string on comma
  3. parse each element into a DateTimeOffset

Once we have the date model, we have the correct input for the domain model.

type LoanDto with
static member dueDates_ =
let dueDates_ =
Lens.create
(fun x -> x.DueDates)
(fun dates x -> { x with DueDates = dates })
let stringArr_ =
Epimorphism.create
(fun (x : string) -> Option.ofObj x |> Option.map (fun x -> x.Split(',')))
(fun xs -> String.Join(',', xs))
let dateTimeOffset_ =
Epimorphism.create
(fun xs -> let r = Array.map DateTimeOffset.tryParse xs |> Array.choose id
if Seq.length r = Seq.length xs then Some r else None)
(Array.map string)
dueDates_ >-> stringArr_ >?> dateTimeOffset_

Epimorphisms are represented here as partial lenses. Options are returned by the getter and are composed by >?>.
Parsing the book structure is a bit harder and will require us to actually parse the input. We can use FParsec to do the heavy lifting for us.

type LoanDto with
static member book_ =
let pheader = pstring "book: "
let psep = pchar ';'
let ptitle = many1Chars asciiUpper
let pauthor = many1Chars (asciiLower <|> pchar ' ') |> between (pchar '(') (pchar ')')
let pisbn = many1Chars digit |> between (pchar '/') (pchar '/')
let pbook = pipe2 (pheader >>. ptitle .>> psep) pauthor (fun title author -> (title, author))
let book_ =
Lens.create
(fun x -> x.Book)
(fun raw x -> { x with Book = raw })
let stringTuple_ =
Epimorphism.create
(fun x -> match run pbook x with
| ParserResult.Success (result, _, _) -> Some result
| ParserResult.Failure (msg, _, _) -> None)
(fun (title, author) -> sprintf "book: %s;(%s)" (title.ToUpper()) (author.ToLower()))
book_ >-> stringTuple_

For more information on FParsec, see these beautiful guided docs of the library. With all this in place, we have fixed the ‘from and to’ from our DTO data model and domain model. Using lenses to guide us, we have a solid system that hides the hard parts and provides us with simple functionality.

module Dto =
let toLoan dto = result {
let! due =
dto ^. LoanJson .dueDates_
|> Option.fold (fun _ x -> DueDate.create x)
(Spec.error "duedate" "cannot correctly deserialize book due dates")
let! book =
dto ^. LoanJson .book_
|> Option.fold (fun _ (title, author) -> Book.create title author)
(Spec.error "book" "cannot correctly deserialize book structure")
return { Book = book; Due = due } }
let ofLoan model =
{ Book = ""; DueDates = "" }
|> (DueDate.get model.Due) ^= LoanJson.dueDates_
|> (Book.get model.Book) ^= LoanJson.book_

Lenses in recursive types

As a last practical example, we can take a quick look at recursive types (Catamorphisms). When a type is represented as a recursion, the interaction with the type is a lot harder. Lenses can also help here as they provide us with a link towards the property of the model you want to change, without specifying how deep that property is located.

To make this as simple as possible, let’s use Scott Wlaschin’s gift example. We could have used a product system, file system, family tree… but that would point the focus on the complexity of the type rather than the flexibility of lenses.

type Color = Black | Brown | White
type Flavor = Strawberry | Blueberry
type Gift =
| Chocolate of Color
| Candy of Flavor
| Boxed of Gift
| Wrapped of Gift

This model will help us create a recursive structure: a chocolate wrapped in paper and boxed, for example.

Before we dive into creating lenses for this type, we should make it easy for ourselves and provide a fold for this. As this is a ‘foldable type’, we can navigate through our model in an easy fashion.

module Gift =
let rec foldBack fChocolate fCandy fBoxed fWrapped gen gift =
let recurse = foldBack fChocolate fCandy fBoxed fWrapped
match gift with
| Chocolate c -> gen (fChocolate c)
| Candy f -> gen (fCandy f)
| Boxed g -> recurse (fBoxed >> gen) g
| Wrapped g -> recurse (fWrapped >> gen) g

Without going into too much detail, the backwards folding function will go through the model and run a provided function on each type if finds. So, Boxed (Wrapped (Chocolate Black)) will run for us from Boxed towards Chocolate and have a ‘hook’ function on each level.

There are two things we can do here. First, let’s say we want to change the kind of chocolate in the gift. That would give us this lens:

type Gift with
static member chocolate_color_ =
Prism.create
(fun gift -> foldBack Some (fun _ -> None) id id id gift)
(fun color gift -> foldBack (fun _ -> Chocolate color) Candy Boxed Wrapped id gift)
let gift = Boxed (Wrapped (Chocolate Black))
let color = gift ^. Gift.chocolate_color_
let updated_color = gift |> Brown ^= Gift.chocolate_color_
// Boxed (Wrapped (Chocolate Brown))

If we would want to actually change the contents of the gift, we should change the kind of return type of our foldable function towards the Chocolate type itself. This way we can change it to Candy, for example.

type Gift with
static member chocolate_item_ =
Prism.create
(fun gift -> foldBack (fun c -> Some (Chocolate c)) (fun _ -> None) id id id gift)
(fun chocolate gift -> foldBack (fun _ -> chocolate) Candy Boxed Wrapped id gift)
let gift = Boxed (Wrapped (Chocolate Black))
let item = gift ^. Gift.chocolate_item_
let updated_content = gift |> Candy Strawberry ^= Gift.chocolate_item_
// Boxed (Wrapped (Candy Strawberry))

Conclusion

We’ve seen a lot of different use-cases of F# lenses practically applied in a domain context. We’ve seen closed domain model applications, DTO conversions and recursive types. There are many more but these three give you an idea of what’s possible. It’s definitely abstract and complex at first, and one has to go through some mental shifts. But the result is cleaner and more understandable code. Isn’t that what we are all striving for?

Thanks so much for staying with me,
Stijn

Subscribe to our RSS feed

Hi there,
how can we help?

Got a project in mind?

Connect with us

Let's talk

Let's talk

Thanks, we'll be in touch soon!

Call us

Thanks, we've sent the link to your inbox

Invalid email address

Submit

Your download should start shortly!

Stay in Touch - Subscribe to Our Newsletter

Keep up to date with industry trends, events and the latest customer stories

Invalid email address

Submit

Great you’re on the list!