diff --git a/project.clj b/project.clj index 6af2c8d..f07652a 100644 --- a/project.clj +++ b/project.clj @@ -2,6 +2,7 @@ :description "FIXME: write description" :url "http://example.com/FIXME" :dependencies [[org.clojure/clojure "1.6.0"] + [org.clojure/data.json "0.2.6"] [lib-noir "0.8.1"] [compojure "1.1.6"] [ring-server "0.3.1"] diff --git a/src/vending/core.clj b/src/vending/core.clj index 4859d37..54bdacb 100644 --- a/src/vending/core.clj +++ b/src/vending/core.clj @@ -26,9 +26,11 @@ (def item-prices {:caramel-wafer 10 :teacake 16 :snowball 22}) + (defn coin-value [coin] (coin-values coin)) + (defn coins-value [coins] "Sum the value of this list of coins." (cond coins (apply + (map coin-value coins)) @@ -36,35 +38,71 @@ (defn message-machine [machine message] - "Return a machine with this message" + "Return a machine like this machine but with this message" (assoc (dissoc machine :message) :message (.toString message))) + (defn coin-return [machine] "Return all tendered coins in this machine." - (message-machine (assoc (dissoc machine :tendered) :change (:tendered machine)) "Coins returned")) + (message-machine + (assoc (dissoc machine :tendered) :change (:tendered machine)) + "Coins returned")) + (defn add-coin [machine coin] "Add this coin to this machine." (if - (member? (keys coin-values) coin) - (message-machine (assoc (dissoc machine :tendered) :tendered (cons coin (:tendered machine))) (str "Added a " coin)) - (message-machine (assoc (dissoc machine :change) :change (cons coin (:change machine))) (str "Sorry, this machine doesn't accept " coin "s")))) + (member? (keys coin-values) coin) + (message-machine + (assoc (dissoc machine :tendered) :tendered (cons coin (:tendered machine))) + (str "Added a " coin)) + (message-machine + (assoc (dissoc machine :change) :change (cons coin (:change machine))) + (str "Sorry, this machine doesn't accept " coin "s")))) + (defn add-coins [machine coins] "Add these coins to this machine" - (cond (empty? coins) machine - true (add-coins (add-coin machine (first coins)) (rest coins)))) + (if (empty? coins) machine + (add-coins (add-coin machine (first coins)) (rest coins)))) + + +(defn add-merk + "Return a machine like this machine but with one merk added." + [machine] + (add-coin machine :merk)) + + +(defn add-bawbee + "Return a machine like this machine but with one bawbee added." + [machine] + (add-coin machine :bawbee)) + + +(defn add-plack + "Return a machine like this machine but with one plack added." + [machine] + (add-coin machine :plack)) + + +(defn add-bodle + "Return a machine like this machine but with one bodle added." + [machine] + (add-coin machine :bodle)) + (defn magic-inc [maybenum] "A wrapper round inc which treats nil as zero." (cond (nil? maybenum) 1 true (inc maybenum))) + (defn sum-coin [coin sums] "Adds this coin (assumed to be on of :merk, :plack, :bawbee, :bodle) to this map of sums." (update-in sums [coin] magic-inc)) + (defn sum-coins "takes a list in the form (:merk :merk :bawbee :plack :bodle) and returns a wallet {:merk 2 :plack 1 :bawbee 1 :bodle 1}. Optional second argument: an @@ -76,56 +114,64 @@ true (sum-coins (rest coins) (sum-coin (first coins) sums))))) - (defn subtract-denomination [list position] "given a list of four numbers and a position, return a similar list with one subtracted from the number at this position in the list" (cond (= (count list) position)(cons (- (first list) 1) (rest list)) true (cons (first list) (subtract-denomination (rest list) position)))) -(defn subtract-nickle [list] + +(defn subtract-bodle [list] (subtract-denomination list 1)) + (defn subtract-bawbee [list] (subtract-denomination list 2)) + (defn subtract-plack [list] (subtract-denomination list 3)) + (defn subtract-merk [list] (subtract-denomination list 4)) -(defn- in-make-change [amount merk plack bawbee bodle] + +(defn- in-make-change [amount merk bawbee plack bodle] "Given this amount of change to make, and this number each of merks, placks, bawbees and bodles, return a tuple (merk plack bodle bawbee) which indicates the number remaining after making change, or nil if not possible" (cond - (= amount 0) (list merk plack bawbee bodle) + (= amount 0) (list merk bawbee plack bodle) (and (>= amount (:merk coin-values)) (> merk 0)) - (in-make-change (- amount (:merk coin-values)) (- merk 1) plack bawbee bodle) - (and (>= amount (:plack coin-values)) (> plack 0)) - (in-make-change (- amount (:plack coin-values)) merk (- plack 1) bawbee bodle) + (in-make-change (- amount (:merk coin-values)) (- merk 1) bawbee plack bodle) (and (>= amount (:bawbee coin-values)) (> bawbee 0)) - (in-make-change (- amount (:bawbee coin-values)) merk plack (- bawbee 1) bodle) + (in-make-change (- amount (:bawbee coin-values)) merk (- bawbee 1) plack bodle) + (and (>= amount (:plack coin-values)) (> plack 0)) + (in-make-change (- amount (:plack coin-values)) merk bawbee (- plack 1) bodle) (and (>= amount (:bodle coin-values)) (> bodle 0)) - (in-make-change (- amount (:bodle coin-values)) merk plack bawbee (- bodle 1)))) + (in-make-change (- amount (:bodle coin-values)) merk bawbee plack (- bodle 1)))) + (defn n-of [elt n] "return a list of n instances of elt" (cond (<= n 0) nil true (cons elt (n-of elt (dec n))))) + (defn to-coins [quadtuple] - "Given a list in the form (merks placks bawbies bodles), return a + "Given a list in the form (merks bawbies placks bodles), return a flat list of coin symbols" - (remove nil? - (flatten - (list - (n-of :merk (nth quadtuple 0)) - (n-of :plack (nth quadtuple 1)) - (n-of :bawbee (nth quadtuple 2)) - (n-of :bodle (nth quadtuple 3)) - )))) + (let [n (count quadtuple)] + (remove nil? + (flatten + (list + (n-of :merk (if (> n 0) (nth quadtuple 0) 0)) + (n-of :bawbee (if (> n 1) (nth quadtuple 1) 0)) + (n-of :plack (if (> n 2) (nth quadtuple 2) 0)) + (n-of :bodle (if (> n 3) (nth quadtuple 3) 0)) + ))))) + (defn make-change [amount coins] "Given this amount of change to make, and this number each of merks, placks, bawbees @@ -133,11 +179,11 @@ number of each remaining after making change, or nil if not possible" (to-coins (let [merk (:merk coins) - plack (:plack coins) bawbee (:bawbee coins) + plack (:plack coins) bodle (:bodle coins)] - (map #(- %1 %2) (map #(or % 0) (list merk plack bawbee bodle)) - (apply in-make-change (map #(or % 0) (list amount merk plack bawbee bodle))) + (map #(- %1 %2) (map #(or % 0) (list merk bawbee plack bodle)) + (apply in-make-change (map #(or % 0) (list amount merk bawbee plack bodle))) )))) @@ -164,30 +210,36 @@ the keys of these maps, using this default when no value present" (in-op-maps op (union (keys map1) (keys map2)) map1 map2 dflt)) + (defn add-wallets [wallet1 wallet2] (op-maps + wallet1 wallet2 0)) + (defn subtract-change-machine [machine change] "return a copy of this machine which has this amount of change removed from its coins" (let [coins (:coins machine)] (assoc (dissoc machine :coins) :coins (subtract-change coins change)))) + (defn make-change-machine [machine change] "given this machine and these numbers of coins to remove, return a copy of the machine with the coins removed" (cond (empty? change) machine true (assoc (dissoc (subtract-change-machine machine change) :change ) :change change ))) + (defn remove-from-stock [machine item] "return a copy of this machine with one fewer of this item in stock" (update-in machine [:stock item] dec)) + (defn deliver-item [machine item] "Remove an item matching this item from stock and add it to the output hopper" (remove-from-stock (assoc (dissoc machine :output) :output (cons item (:output machine))) item)) + (defn store-coins-machine [machine] ;; add the tendered coins to the coin stacks (let [wallet (sum-coins (:tendered machine))] @@ -195,30 +247,34 @@ (dissoc (dissoc machine :tendered) :coins) :coins (add-wallets wallet (:coins machine))))) + (defn get-item [machine item] (let [item-price (item item-prices) coins (:coins machine) tendered (coins-value (:tendered machine)) - change (make-change (- tendered item-price) coins)] -;; (print (list "hello" item-price coins tendered change )) + change (if + (> tendered item-price) (make-change (- tendered item-price) coins))] + (print (list "hello" item-price coins tendered change )) (cond (> 0 (item (:stock machine))) (message-machine (coin-return machine) (str "Sorry, " item " not in stock")) - (<= tendered item-price) (message-machine machine "Please insert more money") - (= change '(0 0 0 0)) (message-machine (coin-return machine) "Sorry, I don't have enough change.") + (< tendered item-price) (message-machine machine "Please insert more money") + (= change '()) (message-machine (coin-return machine) "Sorry, I don't have enough change.") true (message-machine (store-coins-machine (make-change-machine (deliver-item machine item) change)) (str "Enjoy your " item))))) + (defn get-caramel-wafer [machine] (get-item machine :caramel-wafer)) + (defn get-teacake [machine] (get-item machine :teacake)) (defn get-snowball [machine] (get-item machine :snowball)) -;; (get-caramel-wafer (add-coin (add-coin (make-default-machine) :merk) :merk)) + diff --git a/src/vending/handler.clj b/src/vending/handler.clj index 17e78cf..6d18564 100644 --- a/src/vending/handler.clj +++ b/src/vending/handler.clj @@ -1,6 +1,7 @@ (ns vending.handler (:require [compojure.core :refer [defroutes]] [vending.routes.home :refer [home-routes]] + [vending.routes.json :refer [json-routes]] [vending.middleware :as middleware] [noir.util.middleware :refer [app-handler]] [compojure.route :as route] @@ -44,7 +45,7 @@ (def app (app-handler ;; add your application routes here - [home-routes app-routes] + [home-routes json-routes app-routes] ;; add custom middleware here :middleware [middleware/template-error-page middleware/log-request] diff --git a/src/vending/routes/json.clj b/src/vending/routes/json.clj new file mode 100644 index 0000000..ffbd4de --- /dev/null +++ b/src/vending/routes/json.clj @@ -0,0 +1,82 @@ +(ns ^{:doc "A set of REST requests which manipulate a vending machine held in the session server-side." + :author "Simon Brooke"} + vending.routes.json + (:use compojure.core) + (:require [clojure.data.json :as json] + [noir.session :as session] + [vending.core :as machine] + [vending.util :as util])) + + +(defn- perform-action + "Apply this function to the machine in the session, if there is one, or else to a new default + machine; cache the result in the session; and return a JSON formatted representation of the result." + [function] + (let [machine (apply function (list (or (session/get :machine) (machine/make-default-machine))))] + (session/put! :machine machine) + (json/write-str machine))) + + +;;; Each of these action functions perform an action on the machine in the session, if there is one, +;;; or on a new default machine if there is no machine in the session. They return (and cache in the +;;; session) the new state of the machine after the action; the machine returned is returned as a +;;; JSON string. + +(defn coin-return-action + "Return all the coins that have been tendered since the last sale." + [] + (perform-action machine/coin-return)) + + +(defn add-merk-action + "Insert one merk into the coin slot of the machine in the session." + [] + (perform-action machine/add-merk)) + + +(defn add-bawbee-action + "Insert one bawbee into the coin slot of the machine in the session." + [] + (perform-action machine/add-bawbee)) + + +(defn add-plack-action + "Insert one plack into the coin slot of the machine in the session." + [] + (perform-action machine/add-plack)) + + +(defn add-bodle-action + "Insert one bodle into the coin slot of the machine in the session." + [] + (perform-action machine/add-bodle)) + + +(defn select-caramel-wafer-action + "Request one caramel wafer from the machine in the session." + [] + (perform-action machine/get-caramel-wafer)) + + +(defn select-teacake-action + "Request one teacake from the machine in the session." + [] + (perform-action machine/get-teacake)) + + +(defn select-snowball-action + "Request one snowball from the machine in the session." + [] + (perform-action machine/get-snowball)) + + +(defroutes json-routes + (GET "/coin-return" [] (coin-return-action)) + (GET "/add-merk" [] (add-merk-action)) + (GET "/add-bawbee" [] (add-bawbee-action)) + (GET "/add-plack" [] (add-plack-action)) + (GET "/add-bodle" [] (add-bodle-action)) + (GET "/select-caramel-wafer" [] (select-caramel-wafer-action)) + (GET "/select-teacake" [] (select-teacake-action)) + (GET "/select-snowball" [] (select-snowball-action)) + )