2 people like it.
Like the snippet!

Retail with units of measure

Sample retail domain model, using F# types (records and discriminated unions) with JSON sample data using F# Data type provider.

 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: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81:

// ----------------------------------------------
// Domain
// ----------------------------------------------
type [<Measure>] GBP
type [<Measure>] Q

type UnitPrice = decimal<GBP/Q>
type Amount = decimal<GBP>
type Name = string
type Code = string
type Quantity = decimal<Q>

type Product = Code * Name * UnitPrice

type Tender = 
  | Cash 
  | Card of string 
  | Voucher of Code 

type LineItem =
  | SaleItem of Product * Quantity
  | TenderItem of Tender * Amount
  | CancelItem of int

type Basket = list<LineItem>

// ----------------------------------------------
// Data
// ----------------------------------------------

let products =
  [ "A1", "Border oat crumbles", 0.69M<GBP/Q>
    "B1", "Tea", 1.49M<GBP/Q>
    "C1", "Phil's phone", 299.9M<GBP/Q>
    "D1", "Phil's mac", 1200.0M<GBP/Q> ]

let lookup (search:Code) : Product option = 
  products
  |> List.tryFind (fun (code, _, _) -> code = search)

// ----------------------------------------------
// Calculations
// ----------------------------------------------

open System

let total (basket:Basket) =
  basket |> List.sumBy (fun item ->
    match item with
    | SaleItem((_, _, price), q) -> 
        price * q
    | TenderItem(_, value) -> 0.0M<GBP>
    | CancelItem(index) ->
        let cancelled = List.nth basket index
        match cancelled with
        | SaleItem((_, _, price), q) ->
            -1.0M * price * q
        | CancelItem _ | TenderItem _ -> 
            invalidOp "You can only cancel SaleItems!" )
        
let rec purchase (basket:Basket) =
  let code = Console.ReadLine()
  match code, lookup code with
  | "q", _ ->
      printfn "Finished"
      basket
  | _, None -> 
      printfn "Not found: %s" code
      purchase basket
  | _, Some prod ->
      printfn "Adding: %A" prod
      let item = SaleItem(prod, 1.0M<Q>)
      purchase (item::basket)

// ----------------------------------------------
// "User interface"
// ----------------------------------------------

let basket = purchase []
printfn "Purchase: %A" basket
printfn "Total: %A" (total basket)

Multiple items
type MeasureAttribute =
inherit Attribute
new : unit -> MeasureAttribute

Full name: Microsoft.FSharp.Core.MeasureAttribute

--------------------
new : unit -> MeasureAttribute

[<Measure>]
type Q

Full name: Script.Q

type UnitPrice = decimal<GBP/Q>

Full name: Script.UnitPrice

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<_>

[<Measure>]
type GBP

Full name: Script.GBP

type Amount = decimal<GBP>

Full name: Script.Amount

type Name = string

Full name: Script.Name

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 Code = string

Full name: Script.Code

type Quantity = decimal<Q>

Full name: Script.Quantity

type Product = Code * Name * UnitPrice

Full name: Script.Product

type Tender =
  | Cash
  | Card of string
  | Voucher of Code

Full name: Script.Tender

union case Tender.Cash: Tender

union case Tender.Card: string -> Tender

union case Tender.Voucher: Code -> Tender

type LineItem =
  | SaleItem of Product * Quantity
  | TenderItem of Tender * Amount
  | CancelItem of int

Full name: Script.LineItem

union case LineItem.SaleItem: Product * Quantity -> LineItem

union case LineItem.TenderItem: Tender * Amount -> LineItem

union case LineItem.CancelItem: 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<_>

type Basket = LineItem list

Full name: Script.Basket

type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>

val products : (string * string * decimal<GBP/Q>) list

Full name: Script.products

val lookup : search:Code -> Product option

Full name: Script.lookup

val search : Code

type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>

Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>

val tryFind : predicate:('T -> bool) -> list:'T list -> 'T option

Full name: Microsoft.FSharp.Collections.List.tryFind

val code : string

namespace System

val total : basket:Basket -> decimal<GBP>

Full name: Script.total

val basket : Basket

val sumBy : projection:('T -> 'U) -> list:'T list -> 'U (requires member ( + ) and member get_Zero)

Full name: Microsoft.FSharp.Collections.List.sumBy

val item : LineItem

val price : UnitPrice

val q : Quantity

val value : Amount

val index : int

val cancelled : LineItem

val nth : list:'T list -> index:int -> 'T

Full name: Microsoft.FSharp.Collections.List.nth

val invalidOp : message:string -> 'T

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

val purchase : basket:Basket -> Basket

Full name: Script.purchase

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.ReadLine() : string

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

union case Option.None: Option<'T>

union case Option.Some: Value: 'T -> Option<'T>

val prod : Product

val basket : Basket

Full name: Script.basket

Next Version Raw view Test code New version

More information

Link:	http://fssnip.net/kW
Posted:	10 years ago
Author:	Tomas Petricek & Phil Trelford
Tags:	retail , json , type providers