zgo-backend/src/Order.hs

251 lines
6.6 KiB
Haskell
Raw Normal View History

2022-05-11 20:04:46 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Order where
import Data.Aeson
import qualified Data.Bson as B
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Clock
import Database.MongoDB
import GHC.Generics
import Test.QuickCheck
-- | Type to represent a ZGo order
data ZGoOrder =
ZGoOrder
{ q_id :: Maybe ObjectId
, qaddress :: T.Text
, qsession :: T.Text
, qtimestamp :: UTCTime
, qclosed :: Bool
, qcurrency :: T.Text
, qprice :: Double
, qtotal :: Double
, qtotalZec :: Double
, qlines :: [LineItem]
2022-05-24 15:20:10 +00:00
, qpaid :: Bool
2022-08-03 19:13:33 +00:00
, qexternalInvoice :: T.Text
, qshortCode :: T.Text
2022-05-11 20:04:46 +00:00
}
deriving (Eq, Show, Generic)
instance ToJSON ZGoOrder where
2022-08-03 19:13:33 +00:00
toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC) =
2022-05-11 20:04:46 +00:00
case i of
Just oid ->
object
[ "_id" .= show oid
, "address" .= a
, "session" .= s
, "timestamp" .= ts
, "closed" .= c
, "currency" .= cur
, "price" .= p
, "total" .= t
, "totalZec" .= tZ
, "lines" .= l
2022-05-24 15:20:10 +00:00
, "paid" .= paid
2022-08-03 19:13:33 +00:00
, "externalInvoice" .= eI
, "shortCode" .= sC
2022-05-11 20:04:46 +00:00
]
Nothing ->
object
[ "_id" .= ("" :: String)
, "address" .= a
, "session" .= s
, "timestamp" .= ts
, "closed" .= c
, "currency" .= cur
, "price" .= p
, "total" .= t
, "totalZec" .= tZ
, "lines" .= l
2022-05-24 15:20:10 +00:00
, "paid" .= paid
2022-08-03 19:13:33 +00:00
, "externalInvoice" .= eI
, "shortCode" .= sC
2022-05-11 20:04:46 +00:00
]
instance FromJSON ZGoOrder where
parseJSON =
withObject "Order" $ \obj -> do
i <- obj .: "_id"
a <- obj .: "address"
s <- obj .: "session"
ts <- obj .: "timestamp"
c <- obj .: "closed"
cur <- obj .: "currency"
p <- obj .: "price"
t <- obj .: "total"
tZ <- obj .: "totalZec"
l <- obj .: "lines"
2022-05-24 15:20:10 +00:00
pd <- obj .: "paid"
2022-08-03 19:13:33 +00:00
eI <- obj .: "externalInvoice"
sC <- obj .: "shortCode"
2022-05-11 20:04:46 +00:00
pure $
ZGoOrder
(if not (null i)
then Just (read i)
else Nothing)
a
s
ts
c
cur
p
t
tZ
l
2022-05-24 15:20:10 +00:00
pd
2022-08-03 19:13:33 +00:00
eI
sC
2022-05-11 20:04:46 +00:00
instance Val ZGoOrder where
2022-08-03 19:13:33 +00:00
val (ZGoOrder i a s ts c cur p t tZ l pd eI sC) =
2022-05-11 20:04:46 +00:00
if isJust i
then Doc
[ "_id" =: i
, "address" =: a
, "session" =: s
, "timestamp" =: ts
, "closed" =: c
, "currency" =: cur
, "price" =: p
, "total" =: t
, "totalZec" =: tZ
, "lines" =: l
2022-05-24 15:20:10 +00:00
, "paid" =: pd
2022-08-03 19:13:33 +00:00
, "externalInvoice" =: eI
, "shortCode" =: sC
2022-05-11 20:04:46 +00:00
]
else Doc
[ "address" =: a
, "session" =: s
, "timestamp" =: ts
, "closed" =: c
, "currency" =: cur
, "price" =: p
, "total" =: t
, "totalZec" =: tZ
, "lines" =: l
2022-05-24 15:20:10 +00:00
, "paid" =: pd
2022-08-03 19:13:33 +00:00
, "externalInvoice" =: eI
, "shortCode" =: sC
2022-05-11 20:04:46 +00:00
]
cast' (Doc d) = do
i <- B.lookup "_id" d
a <- B.lookup "address" d
s <- B.lookup "session" d
ts <- B.lookup "timestamp" d
c <- B.lookup "closed" d
cur <- B.lookup "currency" d
p <- B.lookup "price" d
t <- B.lookup "total" d
tZ <- B.lookup "totalZec" d
l <- B.lookup "lines" d
2022-05-24 15:20:10 +00:00
pd <- B.lookup "paid" d
2022-08-03 19:13:33 +00:00
eI <- B.lookup "externalInvoice" d
sC <- B.lookup "shortCode" d
Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC)
2022-05-11 20:04:46 +00:00
cast' _ = Nothing
-- Type to represent an order line item
data LineItem =
LineItem
2022-05-19 13:24:52 +00:00
{ lqty :: Double
2022-05-11 20:04:46 +00:00
, lname :: T.Text
, lcost :: Double
}
deriving (Eq, Show)
instance ToJSON LineItem where
2022-05-19 13:24:52 +00:00
toJSON (LineItem q n c) = object ["qty" .= q, "name" .= n, "cost" .= c]
2022-05-11 20:04:46 +00:00
instance FromJSON LineItem where
parseJSON =
withObject "LineItem" $ \obj -> do
q <- obj .: "qty"
n <- obj .: "name"
c <- obj .: "cost"
2022-05-19 13:24:52 +00:00
pure $ LineItem q n c
2022-05-11 20:04:46 +00:00
instance Val LineItem where
2022-05-19 13:24:52 +00:00
val (LineItem q n c) = Doc ["qty" =: q, "name" =: n, "cost" =: c]
2022-05-11 20:04:46 +00:00
cast' (Doc d) = do
q <- B.lookup "qty" d
n <- B.lookup "name" d
c <- B.lookup "cost" d
2022-05-19 13:24:52 +00:00
Just (LineItem q n c)
2022-05-11 20:04:46 +00:00
cast' _ = Nothing
-- Database actions
upsertOrder :: ZGoOrder -> Action IO ()
upsertOrder o = do
2022-05-24 15:20:10 +00:00
let order = val $ updateOrderTotals o
2022-05-11 20:04:46 +00:00
case order of
2022-08-26 22:10:59 +00:00
Doc d ->
if isJust (q_id o)
then upsert (select ["_id" =: q_id o] "orders") d
else insert_ "orders" d
2022-08-21 21:59:23 +00:00
_ -> return ()
upsertXeroOrder :: ZGoOrder -> Action IO ()
upsertXeroOrder o = do
let order = val $ updateOrderTotals o
case order of
Doc d -> upsert (select ["externalInvoice" =: qexternalInvoice o, "shortCode" =: qshortCode o] "orders") d
2022-05-11 20:04:46 +00:00
_ -> return ()
2022-05-24 15:20:10 +00:00
-- | Function to update order totals from items
updateOrderTotals :: ZGoOrder -> ZGoOrder
updateOrderTotals o =
ZGoOrder
(q_id o)
(qaddress o)
(qsession o)
(qtimestamp o)
(qclosed o)
(qcurrency o)
(qprice o)
(newTotal o)
(if qprice o /= 0
then roundZec (newTotal o / qprice o)
2022-05-24 15:20:10 +00:00
else 0)
(qlines o)
(qpaid o)
2022-08-03 19:13:33 +00:00
(qexternalInvoice o)
(qshortCode o)
2022-05-24 15:20:10 +00:00
where
newTotal :: ZGoOrder -> Double
newTotal x = foldr tallyItems 0 (qlines x)
tallyItems :: LineItem -> Double -> Double
tallyItems y z = (lqty y * lcost y) + z
2022-05-11 20:04:46 +00:00
findOrder :: T.Text -> Action IO (Maybe Document)
2022-05-19 13:24:52 +00:00
findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders")
2022-05-11 20:04:46 +00:00
2022-08-20 13:09:46 +00:00
findXeroOrder :: T.Text -> T.Text -> T.Text -> Action IO (Maybe Document)
findXeroOrder a i s = findOne (select ["address" =: a, "externalInvoice" =: i, "shortCode" =: s] "orders")
2022-05-11 20:04:46 +00:00
findOrderById :: String -> Action IO (Maybe Document)
findOrderById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "orders")
2022-05-12 19:59:29 +00:00
findAllOrders :: T.Text -> Action IO [Document]
2022-07-26 15:46:35 +00:00
findAllOrders a = rest =<< find (select ["address" =: a] "orders") {sort = ["timestamp" =: (negate 1 :: Int)]}
2022-05-12 19:59:29 +00:00
2022-05-11 20:04:46 +00:00
deleteOrder :: String -> Action IO ()
deleteOrder i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "orders")
2022-07-22 19:01:08 +00:00
markOrderPaid :: (String, Double) -> Action IO ()
markOrderPaid (i, a) = do
let
modify
2022-07-22 19:01:08 +00:00
(select ["_id" =: (read i :: B.ObjectId), "totalZec" =: a] "orders")
["$set" =: ["paid" =: True]]
-- | Helper function to round to 8 decimal places
roundZec :: Double -> Double
roundZec n = fromInteger (round $ n * (10 ^ 8)) / (10.0 ^^ 8)