tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

shipping.tri (1952B)


      1 !import bd2c14d6db6b69308a5252a8e839705a55d30e815f012900b094315263e08d81 *
      2 !export v1
      3 !export v2
      4 
      5 -- Shipping policy: arguments are destination, cart subtotal in cents, grams.
      6 -- Destinations: domestic, regional, international. Grams: 1..5000.
      7 -- Try result = v1 "domestic" 8000 1500.
      8 -- Change v1 to v2: domestic free shipping changes from $75 to $100.
      9 -- Otherwise domestic costs $4.99/$5.99, regional $9.99, international $19.99.
     10 -- Packages above 1kg add $2.50. Subtotals are bounded to $10,000.
     11 -- The bundle hash + export pins the policy used to reproduce a quote later.
     12 -- Records use [fieldName tag value]: 0 = text, 1 = natural, 2 = Boolean.
     13 -- Base supplies canonical-natural checks, arithmetic and Booleans.
     14 
     15 failure message = [["status" 0 "error"] ["message" 0 message]]
     16 
     17 baseRate 1 "domestic" = 499
     18 baseRate _ "domestic" = 599
     19 baseRate _ "regional" = 999
     20 baseRate _ _ = 1999
     21 
     22 paidRate version zone grams = case lte_? grams 1000 of
     23   ^true = baseRate version zone
     24   _ = add 250 <| baseRate version zone
     25 
     26 freeThreshold 1 = 7500
     27 freeThreshold _ = 10000
     28 
     29 amount version zone subtotal grams = case and? (equal? zone "domestic") (lte_? (freeThreshold version) subtotal) of
     30   ^true = 0
     31   _ = paidRate version zone grams
     32 
     33 quote version zone subtotal grams = case and? (isNat? subtotal) (isNat? grams) of
     34   ^true = case or? (equal? zone "domestic") (or? (equal? zone "regional") (equal? zone "international")) of
     35     ^true = case and? (lte_? subtotal 1000000) (and? (lte_? 1 grams) (lte_? grams 5000)) of
     36       ^true = [["status" 0 "ok"] ["policyVersion" 1 version]
     37         ["destination" 0 zone] ["shippingCents" 1 (amount version zone subtotal grams)]]
     38       _ = failure "Subtotal must be <=1000000 cents; grams must be 1..5000."
     39     _ = failure "Unknown destination."
     40   _ = failure "Subtotal and grams must be canonical natural numbers."
     41 
     42 v1 zone subtotal grams = quote 1 zone subtotal grams
     43 v2 zone subtotal grams = quote 2 zone subtotal grams