[kazinator]

TXR Lisp:

  (defstruct product nil
    sku
    price)
  
  (defstruct event nil)
  
  (defstruct add-to-basket event
    product
    quantity)
  
  (defstruct line nil
    product-sku
    quantity
    line-total)
  
  (defstruct basket nil
    lines
    total
    (:postinit (me)
      (set me.total [reduce-left + me.lines 0 (usl line-total)])))
  
  (defvarl empty-basket (new basket))
  
  (defun build-line (product quantity)
    (new line
         product-sku product.sku
         quantity quantity
         line-total (* quantity product.price)))
  
  (defmeth basket add-to (me product quantity)
    (flet ((transform-line (line)
             (if (equal line.product-sku product.sku)
               (build-line product (+ line.quantity quantity))
               line)))
      (let* ((transformed-lines [mapcar transform-line me.lines])
             (product-already-in-basket (nequal transformed-lines me.lines)))
        (if product-already-in-basket
          (new basket lines transformed-lines)
          (new basket lines (cons (build-line product quantity) me.lines))))))
  
  (defmeth basket update (me event)
    event.(add-to me))
  
  (defmeth add-to-basket add-to (me basket)
    basket.(add-to me.product me.quantity))

REPL:

  $ txr -i typemodel.tl 
  1> (new add-to-basket product (new product sku 42 price 5) quantity 4)
  #S(add-to-basket product #S(product sku 42 price 5) quantity 4)
  2> (new basket)
  #S(basket lines nil total 0)
  3> *1.(add-to *2)
  #S(basket lines (#S(line product-sku 42 quantity 4 line-total 20)) total 20)

(The silly implementation of the product-already-in-basket is a literal transliteration of the original.)

If you see me designing programs like this in real life, just whack me on the head, please!

[kazinator]

Here is a version of basket add-to with a recursive local function for doing the insert, avoiding the clumsy mapcar and "did we insert or not" check copied from the F# code.

  (defmeth basket add-to (me product quantity)
    (labels ((insert (lines)
               (tree-case lines
                 ((line . rest) (if (equal line.product-sku product.sku)
                                  (cons (build-line product
                                                    (+ line.quantity quantity))
                                        rest)
                                  (cons line (insert rest))))
                 (() (list (build-line product quantity))))))
      (new basket lines (insert me.lines))))