mateamt/src/Control/Buy.hs

116 lines
3 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Control.Buy where
import Control.Monad (void, foldM, unless)
import Control.Monad.Reader (asks)
import Data.Maybe (fromJust)
import qualified Data.Text as T
import Text.Printf (printf)
-- internal imports
import Control.User
import Types
import Model
import Util
buy
:: Maybe (Int, AuthMethod)
-> [PurchaseDetail]
-> MateHandler PurchaseResult
buy auth pds = do
conn <- asks rsConnection
(missing, real) <-
foldM
(\(ms, rs) pd -> do
mmiss <- checkProductAvailability pd conn
case mmiss of
Just miss -> return
-- If there is less items in stock than ordered
( (pd {purchaseDetailAmount = miss}):ms
-- Add number of missing items
, pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs
-- purchase remaining items in stock
)
Nothing -> return
-- There are at least as many items in stock as ordered
( ms -- Missing items do not change
, pd:rs -- Add everything to purchase
)
)
([], [])
pds
mapM_ (`postBuyProductAmountUpdate` conn) real
price <- foldM
(\total pd ->
fmap (+ total) (getLatestTotalPrice pd conn)
)
0
real
case auth of
Just (auid, _) -> do
void $ addToUserBalance auid (-price) conn
newBalance <- userBalanceSelect conn auid
void $ userUpdateTimestamp auth
let result = PurchaseResult
( if newBalance < 0
then PurchaseDebtful
else PurchaseOK
)
missing
void $ userNotify auth real result
return result
Nothing -> do
void $ insertNewJournalEntry
(JournalSubmit
Nothing
BuyCash
price
)
conn
return $ PurchaseResult
(PayAmount price)
missing
amountUpdate
:: [PurchaseDetail]
-> MateHandler ()
amountUpdate details = do
conn <- asks rsConnection
notify <- foldM (\acc pd@(PurchaseDetail pid _) -> do
void $ postBuyProductAmountUpdate pd conn
newAmout <- getLatestAmountByProductId pid conn
minAmout <- productMinAmount . fromJust <$> productSelectSingle pid conn
if newAmout < minAmout
then return (pid : acc)
else return acc
)
[]
details
unless (null notify) $
do
messageText <- T.pack . mconcat . map (<> "\n") . (\insert ->
[ printf (__ "Hello,")
, ""
, printf (__ "Following products are low on stock:")
]
++
insert
++
[ ""
, __ "Please consider ordering and refilling those products."
, __ "\nSincerely,\nMateamt"
]) <$>
mapM
(\pid -> do
name <- productIdent . fromJust <$> productSelectSingle pid conn
amount <- getLatestAmountByProductId pid conn
return (printf (__ "%s (Amout remaining: %d)") name amount)
)
notify
sendAdminNotification (__ "Low sotck alert") messageText