5 people like it.

Tesco in 70 lines of code

Domain model for the Tesco checkout implemented in F# using discriminated unions (in 20 lines of code) and console-based user interface for scanning products and calculating the total price.

Representation of the checkout domain model

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 

// Type aliases to make domain code readable
type Code = string
type Price = decimal
type Quantity = decimal
type Amount = decimal
type Name = string

/// For every product, we store code, name and price
type Product = Product of Code * Name * Price

/// Different options of payment
type TenderType = 
  | Cash
  | Card
  | Voucher

/// Represents scanned entries at checkout
type LineItem = 
  | Sale of Product * Quantity
  | Cancel of int
  | Tender of Amount * TenderType

Database of products and lookup

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 

let products =
  [ Product("50082728", "Lynx Africa", 0.99M);
    Product("9781933988924", "Real World FP", 29.99M) ]

/// Lookup product in the 'products' list
let lookup query = 
  products |> Seq.tryFind (fun (Product(code, _, _)) ->
    code = query)

/// Calculate the tototal price for scanned items
/// (Cancellation is not supported yet)
let calculateTotal (items:seq<LineItem>) =
  items |> Seq.sumBy (fun item ->
    match item with
    | Sale(Product(_, _, price), quantity) ->
        price * quantity
    | Cancel n -> 
        failwith "Not implemented"
    | Tender _ -> 0.0M )

Console-based user interface

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 

open System

/// Active pattern that succeeds if product
/// with the specified code exists (and returns it)
let (|LookupProduct|_|) code = lookup code

/// Active pattern that succeeds if code 
/// represents cancellation ("C<index>")
let (|CancelCode|_|) (code:string) = 
  if code.StartsWith("C") then Some(int(code.Substring(1)))
  else None

/// The main program loop
let main() = 
  let items = new ResizeArray<LineItem>()
  let mutable finished = false
  while not finished do
    Console.Write("> ")
    match Console.ReadLine() with
    | null
    | "" -> 
        let total = calculateTotal items
        printfn "TOTAL: %A" total
        finished <- true
    | CancelCode id ->
        printfn "Cancel: %d" id
        items.Add(Cancel(id))
    | LookupProduct prod ->
        items.Add(Sale(prod, 1.0M))
        let (Product(_, name, price)) = prod
        printfn "Added: %s (%A)" name price
    | _ -> 
        printfn "Unknown product"
      
printfn "WELCOME TO TESCO"
main()
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
type Price = decimal

Full name: Script.Price
Multiple items
val decimal : value:'T -> decimal (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.decimal

--------------------
type decimal = System.Decimal

Full name: Microsoft.FSharp.Core.decimal

--------------------
type decimal<'Measure> = decimal

Full name: Microsoft.FSharp.Core.decimal<_>
type Quantity = decimal

Full name: Script.Quantity
type Amount = decimal

Full name: Script.Amount
type Name = string

Full name: Script.Name
Multiple items
union case Product.Product: Code * Name * Price -> Product

--------------------
type Product = | Product of Code * Name * Price

Full name: Script.Product


 For every product, we store code, name and price
type Code = string

Full name: Script.Code
type TenderType =
  | Cash
  | Card
  | Voucher

Full name: Script.TenderType


 Different options of payment
union case TenderType.Cash: TenderType
union case TenderType.Card: TenderType
union case TenderType.Voucher: TenderType
type LineItem =
  | Sale of Product * Quantity
  | Cancel of int
  | Tender of Amount * TenderType

Full name: Script.LineItem


 Represents scanned entries at checkout
union case LineItem.Sale: Product * Quantity -> LineItem
union case LineItem.Cancel: int -> LineItem
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
union case LineItem.Tender: Amount * TenderType -> LineItem
val products : Product list

Full name: Script.products
val lookup : query:Code -> Product option

Full name: Script.lookup


 Lookup product in the 'products' list
val query : Code
module Seq

from Microsoft.FSharp.Collections
val tryFind : predicate:('T -> bool) -> source:seq<'T> -> 'T option

Full name: Microsoft.FSharp.Collections.Seq.tryFind
val code : Code
val calculateTotal : items:seq<LineItem> -> decimal

Full name: Script.calculateTotal


 Calculate the tototal price for scanned items
 (Cancellation is not supported yet)
val items : seq<LineItem>
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
val sumBy : projection:('T -> 'U) -> source:seq<'T> -> 'U (requires member ( + ) and member get_Zero)

Full name: Microsoft.FSharp.Collections.Seq.sumBy
val item : LineItem
val price : Price
val quantity : Quantity
val n : int
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
namespace System
val code : string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
String.StartsWith(value: string) : bool
String.StartsWith(value: string, comparisonType: StringComparison) : bool
String.StartsWith(value: string, ignoreCase: bool, culture: Globalization.CultureInfo) : bool
union case Option.Some: Value: 'T -> Option<'T>
String.Substring(startIndex: int) : string
String.Substring(startIndex: int, length: int) : string
union case Option.None: Option<'T>
val main : unit -> unit

Full name: Script.main


 The main program loop
val items : ResizeArray<LineItem>
type ResizeArray<'T> = Collections.Generic.List<'T>

Full name: Microsoft.FSharp.Collections.ResizeArray<_>
val mutable finished : bool
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console
Console.Write(value: string) : unit
   (+0 other overloads)
Console.Write(value: obj) : unit
   (+0 other overloads)
Console.Write(value: uint64) : unit
   (+0 other overloads)
Console.Write(value: int64) : unit
   (+0 other overloads)
Console.Write(value: uint32) : unit
   (+0 other overloads)
Console.Write(value: int) : unit
   (+0 other overloads)
Console.Write(value: float32) : unit
   (+0 other overloads)
Console.Write(value: decimal) : unit
   (+0 other overloads)
Console.Write(value: float) : unit
   (+0 other overloads)
Console.Write(buffer: char []) : unit
   (+0 other overloads)
Console.ReadLine() : string
val total : decimal
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
active recognizer CancelCode: string -> int option

Full name: Script.( |CancelCode|_| )


 Active pattern that succeeds if code
 represents cancellation ("C<index>")
val id : int
Collections.Generic.List.Add(item: LineItem) : unit
active recognizer LookupProduct: Code -> Product option

Full name: Script.( |LookupProduct|_| )


 Active pattern that succeeds if product
 with the specified code exists (and returns it)
val prod : Product
val name : Name

More information

Link:http://fssnip.net/bz
Posted:12 years ago
Author:Tomas Petricek
Tags: tesco , domain modelling , dsl , discriminated unions , tutorial

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.