Add tax calculations
This commit is contained in:
parent
a20271db6d
commit
9bd94843b4
GPG key ID:
65122AD495A7F5B2
2 changed files with 73 additions and 56 deletions
30
src/Order.hs
30
src/Order.hs
|
|
@ -210,9 +210,9 @@ instance Val LineItem where
|
|||
cast' _ = Nothing
|
||||
|
||||
-- Database actions
|
||||
upsertOrder :: ZGoOrder -> Action IO ()
|
||||
upsertOrder o = do
|
||||
let order = val $ updateOrderTotals o
|
||||
upsertOrder :: ZGoOrder -> Double -> Double -> Action IO ()
|
||||
upsertOrder o taxRate vatRate = do
|
||||
let order = val $ updateOrderTotals o taxRate vatRate
|
||||
case order of
|
||||
Doc d ->
|
||||
if isJust (q_id o)
|
||||
|
|
@ -222,14 +222,14 @@ upsertOrder o = do
|
|||
|
||||
insertWooOrder :: ZGoOrder -> Action IO Database.MongoDB.Value
|
||||
insertWooOrder o = do
|
||||
let order = val $ updateOrderTotals o
|
||||
let order = val $ updateOrderTotals o 0 0
|
||||
case order of
|
||||
Doc d -> insert "orders" d
|
||||
_ -> fail "Couldn't parse order"
|
||||
|
||||
upsertXeroOrder :: ZGoOrder -> Action IO ()
|
||||
upsertXeroOrder o = do
|
||||
let order = val $ updateOrderTotals o
|
||||
let order = val $ updateOrderTotals o 0 0
|
||||
case order of
|
||||
Doc d ->
|
||||
upsert
|
||||
|
|
@ -242,8 +242,8 @@ upsertXeroOrder o = do
|
|||
_ -> return ()
|
||||
|
||||
-- | Function to update order totals from items
|
||||
updateOrderTotals :: ZGoOrder -> ZGoOrder
|
||||
updateOrderTotals o =
|
||||
updateOrderTotals :: ZGoOrder -> Double -> Double -> ZGoOrder
|
||||
updateOrderTotals o taxRate vatRate =
|
||||
ZGoOrder
|
||||
(q_id o)
|
||||
(qaddress o)
|
||||
|
|
@ -252,9 +252,9 @@ updateOrderTotals o =
|
|||
(qclosed o)
|
||||
(qcurrency o)
|
||||
(qprice o)
|
||||
(newTotal o)
|
||||
(newTotal o taxRate vatRate)
|
||||
(if qprice o /= 0
|
||||
then roundZec (newTotal o / qprice o)
|
||||
then roundZec (newTotal o taxRate vatRate / qprice o)
|
||||
else 0)
|
||||
(qlines o)
|
||||
(qpaid o)
|
||||
|
|
@ -265,8 +265,13 @@ updateOrderTotals o =
|
|||
(qvat o)
|
||||
(qtip o)
|
||||
where
|
||||
newTotal :: ZGoOrder -> Double
|
||||
newTotal x = foldr tallyItems 0 (qlines x) + qtax o + qvat o + qtip o
|
||||
updateTax :: ZGoOrder -> Double -> Double
|
||||
updateTax x t = roundFiat $ itemsTotal (qlines x) * t / 100.0
|
||||
itemsTotal :: [LineItem] -> Double
|
||||
itemsTotal = foldr tallyItems 0
|
||||
newTotal :: ZGoOrder -> Double -> Double -> Double
|
||||
newTotal x tR vR =
|
||||
itemsTotal (qlines x) + updateTax x tR + updateTax x vR + qtip x
|
||||
tallyItems :: LineItem -> Double -> Double
|
||||
tallyItems y z = (lqty y * lcost y) + z
|
||||
|
||||
|
|
@ -306,3 +311,6 @@ markOrderPaid (i, a) = do
|
|||
-- | Helper function to round to 8 decimal places
|
||||
roundZec :: Double -> Double
|
||||
roundZec n = fromInteger (round $ n * (10 ^ 8)) / (10.0 ^^ 8)
|
||||
|
||||
roundFiat :: Double -> Double
|
||||
roundFiat n = fromInteger (round $ n * (10 ^ 2)) / (10.0 ^^ 2)
|
||||
|
|
|
|||
|
|
@ -768,7 +768,7 @@ routes pipe config = do
|
|||
_ <-
|
||||
liftAndCatchIO $
|
||||
run $
|
||||
upsertOrder newOrder
|
||||
upsertOrder newOrder 0 0
|
||||
finalOrder <-
|
||||
liftAndCatchIO $
|
||||
run $
|
||||
|
|
@ -1437,27 +1437,22 @@ routes pipe config = do
|
|||
case cast' . Doc =<< user of
|
||||
Nothing -> status unauthorized401
|
||||
Just u -> do
|
||||
dbOrder <-
|
||||
liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q))
|
||||
case cast' . Doc =<< dbOrder of
|
||||
Nothing -> do
|
||||
if uaddress u == qaddress q
|
||||
then do
|
||||
if qtoken q == ""
|
||||
then do
|
||||
t <- liftIO generateToken
|
||||
_ <-
|
||||
liftAndCatchIO $
|
||||
run (upsertOrder $ setOrderToken (T.pack t) q)
|
||||
status created201
|
||||
else do
|
||||
_ <-
|
||||
liftAndCatchIO $ access pipe master dbName (upsertOrder q)
|
||||
status created201
|
||||
else status forbidden403
|
||||
Just dbO -> do
|
||||
if qaddress q == qaddress dbO && qsession q == qsession dbO
|
||||
then do
|
||||
owner <- liftAndCatchIO $ run $ findOwner (uaddress u)
|
||||
case cast' . Doc =<< owner of
|
||||
Nothing -> status badRequest400
|
||||
Just o -> do
|
||||
let taxRate =
|
||||
if otax o
|
||||
then otaxValue o
|
||||
else 0
|
||||
let vatRate =
|
||||
if ovat o
|
||||
then ovatValue o
|
||||
else 0
|
||||
dbOrder <-
|
||||
liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q))
|
||||
case cast' . Doc =<< dbOrder of
|
||||
Nothing -> do
|
||||
if uaddress u == qaddress q
|
||||
then do
|
||||
if qtoken q == ""
|
||||
|
|
@ -1465,15 +1460,49 @@ routes pipe config = do
|
|||
t <- liftIO generateToken
|
||||
_ <-
|
||||
liftAndCatchIO $
|
||||
run (upsertOrder $ setOrderToken (T.pack t) q)
|
||||
run
|
||||
(upsertOrder
|
||||
(setOrderToken (T.pack t) q)
|
||||
taxRate
|
||||
vatRate)
|
||||
status created201
|
||||
else do
|
||||
_ <-
|
||||
liftAndCatchIO $
|
||||
access pipe master dbName (upsertOrder q)
|
||||
access
|
||||
pipe
|
||||
master
|
||||
dbName
|
||||
(upsertOrder q taxRate vatRate)
|
||||
status created201
|
||||
else status forbidden403
|
||||
else status forbidden403
|
||||
Just dbO -> do
|
||||
if qaddress q == qaddress dbO && qsession q == qsession dbO
|
||||
then do
|
||||
if uaddress u == qaddress q
|
||||
then do
|
||||
if qtoken q == ""
|
||||
then do
|
||||
t <- liftIO generateToken
|
||||
_ <-
|
||||
liftAndCatchIO $
|
||||
run
|
||||
(upsertOrder
|
||||
(setOrderToken (T.pack t) q)
|
||||
taxRate
|
||||
vatRate)
|
||||
status created201
|
||||
else do
|
||||
_ <-
|
||||
liftAndCatchIO $
|
||||
access
|
||||
pipe
|
||||
master
|
||||
dbName
|
||||
(upsertOrder q taxRate vatRate)
|
||||
status created201
|
||||
else status forbidden403
|
||||
else status forbidden403
|
||||
--Delete order
|
||||
Web.Scotty.delete "/api/order/:id" $ do
|
||||
oId <- param "id"
|
||||
|
|
@ -1538,26 +1567,6 @@ routes pipe config = do
|
|||
Just tP -> do
|
||||
status ok200
|
||||
Web.Scotty.json $ toJSON (tP :: LangComponent)
|
||||
where
|
||||
saveOrder :: Pipe -> T.Text -> User -> ZGoOrder -> ActionM ()
|
||||
saveOrder pipe dbName u q = do
|
||||
if uaddress u == qaddress q
|
||||
then do
|
||||
if qtoken q == ""
|
||||
then do
|
||||
t <- liftIO generateToken
|
||||
_ <-
|
||||
liftAndCatchIO $
|
||||
access
|
||||
pipe
|
||||
master
|
||||
dbName
|
||||
(upsertOrder $ setOrderToken (T.pack t) q)
|
||||
status created201
|
||||
else do
|
||||
_ <- liftAndCatchIO $ access pipe master dbName (upsertOrder q)
|
||||
status created201
|
||||
else status forbidden403
|
||||
{-post "/api/setlang" $ do-}
|
||||
{-langComp <- jsonData-}
|
||||
{-_ <--}
|
||||
|
|
|
|||
Loading…
Reference in a new issue