Engineering Lab

Moving portrait pricing into OCaml: tests first - Phase 1

Matching TypeScript and OCaml tests reveal rounding and shipping differences in an experimental pricing library.

Published:

Pricing logic currently spans several parts of the app, from the commission estimator to checkout, discounts, and shipping. I’m experimenting with bringing these rules into one OCaml library with clearer boundaries, so calculations are easier to follow, test, and debug.

The live checkout still uses TypeScript. I started by running the same pricing cases in both languages to check whether they produce the same results.

The experimental library and its tests are available in the OCaml pricing domain repository.

From the current architecture to the proposed domain

Starting point: TypeScript pricing

The estimator and checkout flows use TypeScript rules spread across parameter pricing, all-inclusive prices, discounts, and shipping. This is the production architecture before adding the comparison tests.

Current production architecture: the Next.js estimator and checkout flows use TypeScript pricing, discount, and shipping rules.
Starting point: pricing logic spans several parts of the TypeScript app.

First stage: compare the existing behavior

I added characterization tests to record TypeScript results and matching cases in the separate OCaml experiment. This intermediate stage keeps production checkout on TypeScript while exposing differences in the new implementation.

Intermediate stage: matching characterization vectors compare TypeScript parameter pricing with a separate OCaml experiment, while production checkout stays on TypeScript.
First stage: compare both implementations using matching cases before changing production pricing.

Proposed direction: a reusable OCaml domain

The next stages address the differences found by those tests and bring the pricing rules behind validated domain boundaries. Matching test cases remain the reference for checking behavior as the library develops. Production integration is a later decision; the optional HTTP adapter is not implemented.

Proposed OCaml library with validated inputs, money, commission, discount, and shipping rules, checked against TypeScript results. An HTTP adapter is optional and not implemented.
The plan: bring pricing rules into one library with clear boundaries for inputs and calculations. An HTTP service is only a possible later step.

Why OCaml?

I want types that enforce positive people counts, represent money explicitly, and validate discounts. First, I need to check that the library calculates the same prices as the shop.

What the first tests found

In the September 10 test run, all 57 TypeScript tests passed. In OCaml, seven existing tests and 19 new cases passed. Four new cases failed: three for rounding and one for automatic shipping to Germany.

For an A4 portrait with a five-cent adjustment and a 10% discount, TypeScript returns 12604 cents; OCaml returns 12605. OCaml truncates the discount instead of rounding it. Automatic shipping to Germany returns 1500 cents instead of zero.

Next steps

  1. Fix percentage rounding and make discount calculation available on its own.
  2. Complete support for formats, all-inclusive pricing, and shipping.
  3. Validate inputs and decide how to handle fractional percentages, discounts larger than the price, and invalid people counts.
  4. Run the matching tests again and document any remaining differences.

The tests record existing TypeScript behavior. Some of that behavior still needs a business decision before I carry it into OCaml.

Selected code

The existing TypeScript pricing rules

Source: site/src/lib/core/pricing.ts

TypeScript
export function getPriceBasedOnParameters({
  f,
  reqBody,
  discount,
}: {
  f: (typeof availableFormats)[number];
  reqBody: Pick<
    ManualCheckoutBody,
    'adjustments' | 'peopleAmount' | 'complexityAddon'
  >;
  discount?: DiscountType;
}) {
  return applyDiscount(
    f.basePrice +
      reqBody.adjustments.reduce((sum, adjustment) => {
        return sum + adjustment.price;
      }, 0) +
      (reqBody.peopleAmount > 1
        ? f.peopleAddon * (reqBody.peopleAmount - 1)
        : 0) +
      (reqBody.complexityAddon ? f.complexityAddon : 0),
    discount
  );
}
 
export function getShopItemPrice(args: {
  drawing: Pick<ShopItem, 'priceInCents'>;
  discount: DiscountType;
}) {
  return applyDiscount(args.drawing.priceInCents, args.discount);
}
 
export function applyDiscount(priceCents: number, discount?: DiscountType) {
  if (!discount) return priceCents;
  if (discount.type === 'fixed') {
    priceCents -= discount.value;
  }
 
  if (discount.type === 'percent') {
    const discountCents = Math.round(priceCents * (discount.value / 100));
    priceCents = priceCents - discountCents;
  }
  return priceCents;
}

Matching OCaml test cases

Source: ocaml/test/test_production_pricing.ml

OCaml
open Ocaml_pricing_domain
 
(* Production snapshot and named A4 vectors match src/lib/core/pricing.test.ts.
   Expectations are TypeScript results, including known rounding failures.
   Missing format variants and APIs are documented in pricing-characterization.md. *)
let commission format base person complexity =
  Commission.create ~format ~base_price:(Money.of_cents base)
    ~additional_person_price:(Money.of_cents person)
    ~complexity_price:(Money.of_cents complexity)
 
let a4 = commission Commission.A4 14000 4500 3500
let percent n = Some (Discount.percent n)
let fixed n = Some (Discount.fixed (Money.of_cents n))
 
let vectors = [
  ("base", 1, false, [], None, 14000);
  ("two people", 2, false, [], None, 18500);
  ("three people", 3, false, [], None, 23000);
  ("complexity", 1, true, [], None, 17500);
  ("multiple adjustments", 1, false, [500; 1000], None, 15500);
  ("combined percent", 2, true, [500], percent 10, 20250);
  ("combined fixed", 2, true, [500], fixed 2000, 20500);
  ("percent zero", 1, false, [], percent 0, 14000);
  ("percent full", 1, false, [], percent 100, 0);
  ("fixed zero", 1, false, [], fixed 0, 14000);
  ("fixed full", 1, false, [], fixed 14000, 0);
  ("round below half", 1, false, [4], percent 10, 12604);
  ("round at half", 1, false, [5], percent 10, 12604);
  ("round above half", 1, false, [6], percent 10, 12605);
  ("round subtotal once", 1, false, [3; 3], percent 10, 12605);
 ]