Add tax and tip fields to order
This commit is contained in:
parent
50925970fc
commit
9c44d0443e
GPG key ID:
65122AD495A7F5B2
3 changed files with 58 additions and 7 deletions
39
src/Order.hs
39
src/Order.hs
|
|
@ -30,10 +30,13 @@ data ZGoOrder = ZGoOrder
|
|||
, qexternalInvoice :: T.Text
|
||||
, qshortCode :: T.Text
|
||||
, qtoken :: T.Text
|
||||
, qtax :: Double
|
||||
, qvat :: Double
|
||||
, qtip :: Double
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON ZGoOrder where
|
||||
toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk) =
|
||||
toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk qT qV tip) =
|
||||
case i of
|
||||
Just oid ->
|
||||
object
|
||||
|
|
@ -51,6 +54,9 @@ instance ToJSON ZGoOrder where
|
|||
, "externalInvoice" .= eI
|
||||
, "shortCode" .= sC
|
||||
, "token" .= tk
|
||||
, "taxAmount" .= qT
|
||||
, "vatAmount" .= qV
|
||||
, "tipAmount" .= tip
|
||||
]
|
||||
Nothing ->
|
||||
object
|
||||
|
|
@ -68,6 +74,9 @@ instance ToJSON ZGoOrder where
|
|||
, "externalInvoice" .= eI
|
||||
, "shortCode" .= sC
|
||||
, "token" .= tk
|
||||
, "taxAmount" .= qT
|
||||
, "vatAmount" .= qV
|
||||
, "tipAmount" .= tip
|
||||
]
|
||||
|
||||
instance FromJSON ZGoOrder where
|
||||
|
|
@ -87,6 +96,9 @@ instance FromJSON ZGoOrder where
|
|||
eI <- obj .: "externalInvoice"
|
||||
sC <- obj .: "shortCode"
|
||||
tk <- obj .: "token"
|
||||
qT <- obj .: "taxAmount"
|
||||
qV <- obj .: "vatAmount"
|
||||
tip <- obj .: "tipAmount"
|
||||
pure $
|
||||
ZGoOrder
|
||||
(if not (null i)
|
||||
|
|
@ -105,9 +117,12 @@ instance FromJSON ZGoOrder where
|
|||
eI
|
||||
sC
|
||||
tk
|
||||
qT
|
||||
qV
|
||||
tip
|
||||
|
||||
instance Val ZGoOrder where
|
||||
val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
|
||||
val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip) =
|
||||
if isJust i
|
||||
then Doc
|
||||
[ "_id" =: i
|
||||
|
|
@ -124,6 +139,9 @@ instance Val ZGoOrder where
|
|||
, "externalInvoice" =: eI
|
||||
, "shortCode" =: sC
|
||||
, "token" =: tk
|
||||
, "taxAmount" =: qT
|
||||
, "vatAmount" =: qV
|
||||
, "tipAmount" =: tip
|
||||
]
|
||||
else Doc
|
||||
[ "address" =: a
|
||||
|
|
@ -139,6 +157,9 @@ instance Val ZGoOrder where
|
|||
, "externalInvoice" =: eI
|
||||
, "shortCode" =: sC
|
||||
, "token" =: tk
|
||||
, "taxAmount" =: qT
|
||||
, "vatAmount" =: qV
|
||||
, "tipAmount" =: tip
|
||||
]
|
||||
cast' (Doc d) = do
|
||||
i <- B.lookup "_id" d
|
||||
|
|
@ -155,7 +176,10 @@ instance Val ZGoOrder where
|
|||
eI <- B.lookup "externalInvoice" d
|
||||
sC <- B.lookup "shortCode" d
|
||||
tk <- B.lookup "token" d
|
||||
Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk)
|
||||
qT <- B.lookup "taxAmount" d
|
||||
qV <- B.lookup "vatAmount" d
|
||||
tip <- B.lookup "tipAmount" d
|
||||
Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip)
|
||||
cast' _ = Nothing
|
||||
|
||||
-- Type to represent an order line item
|
||||
|
|
@ -237,15 +261,18 @@ updateOrderTotals o =
|
|||
(qexternalInvoice o)
|
||||
(qshortCode o)
|
||||
(qtoken o)
|
||||
(qtax o)
|
||||
(qvat o)
|
||||
(qtip o)
|
||||
where
|
||||
newTotal :: ZGoOrder -> Double
|
||||
newTotal x = foldr tallyItems 0 (qlines x)
|
||||
newTotal x = foldr tallyItems 0 (qlines x) + qtax o + qvat o + qtip o
|
||||
tallyItems :: LineItem -> Double -> Double
|
||||
tallyItems y z = (lqty y * lcost y) + z
|
||||
|
||||
setOrderToken :: T.Text -> ZGoOrder -> ZGoOrder
|
||||
setOrderToken token (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
|
||||
ZGoOrder i a s ts c cur p t tZ l pd eI sC token
|
||||
setOrderToken token (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip) =
|
||||
ZGoOrder i a s ts c cur p t tZ l pd eI sC token qT qV tip
|
||||
|
||||
findOrder :: T.Text -> Action IO (Maybe Document)
|
||||
findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders")
|
||||
|
|
|
|||
|
|
@ -761,6 +761,9 @@ routes pipe config = do
|
|||
(xr_shortCode
|
||||
invReq)
|
||||
(T.pack tk)
|
||||
0
|
||||
0
|
||||
0
|
||||
_ <-
|
||||
liftAndCatchIO $
|
||||
run $
|
||||
|
|
@ -1040,6 +1043,9 @@ routes pipe config = do
|
|||
[T.pack sUrl, "-", ordId, "-", orderKey])
|
||||
""
|
||||
(T.pack tk)
|
||||
0
|
||||
0
|
||||
0
|
||||
newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
|
||||
status ok200
|
||||
Web.Scotty.json
|
||||
|
|
|
|||
20
test/Spec.hs
20
test/Spec.hs
|
|
@ -325,6 +325,9 @@ main = do
|
|||
""
|
||||
""
|
||||
"testToken4321"
|
||||
0
|
||||
0
|
||||
0
|
||||
req <-
|
||||
testPostJson "/api/order" $
|
||||
A.object ["payload" A..= A.toJSON testOrder]
|
||||
|
|
@ -352,6 +355,9 @@ main = do
|
|||
""
|
||||
""
|
||||
"testToken4321"
|
||||
0
|
||||
0
|
||||
0
|
||||
req <-
|
||||
testPostJson "/api/order" $
|
||||
A.object ["payload" A..= A.toJSON testOrder]
|
||||
|
|
@ -379,6 +385,9 @@ main = do
|
|||
""
|
||||
""
|
||||
"testToken4321"
|
||||
0
|
||||
0
|
||||
0
|
||||
req <-
|
||||
testPostJson "/api/order" $
|
||||
A.object ["payload" A..= A.toJSON testOrder]
|
||||
|
|
@ -851,6 +860,9 @@ main = do
|
|||
""
|
||||
""
|
||||
"testToken1234"
|
||||
0
|
||||
0
|
||||
0
|
||||
let ordTest = val myOrder
|
||||
case ordTest of
|
||||
Doc oT -> access p master "test" (insert_ "orders" oT)
|
||||
|
|
@ -1368,6 +1380,9 @@ startAPI config = do
|
|||
""
|
||||
""
|
||||
"testToken1234"
|
||||
0
|
||||
0
|
||||
0
|
||||
let ordTest = val myOrder
|
||||
case ordTest of
|
||||
Doc oT -> access pipe master "test" (insert_ "orders" oT)
|
||||
|
|
@ -1433,7 +1448,10 @@ instance Arbitrary ZGoOrder where
|
|||
pd <- arbitrary
|
||||
eI <- arbitrary
|
||||
sc <- arbitrary
|
||||
ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary
|
||||
tk <- arbitrary
|
||||
qT <- arbitrary
|
||||
qV <- arbitrary
|
||||
ZGoOrder i a s ts c cur p t tZ l pd eI sc tk qT qV <$> arbitrary
|
||||
|
||||
instance Arbitrary LineItem where
|
||||
arbitrary = do
|
||||
|
|
|
|||
Loading…
Reference in a new issue