Added a Json REST handler.

This commit is contained in:
simon 2016-11-24 11:34:12 +00:00
parent dfa8ccd0ac
commit 78977d9fef
4 changed files with 174 additions and 34 deletions

View file

@ -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"]

View file

@ -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))

View file

@ -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]

View file

@ -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))
)