{-# 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 userUpdateTimestamp auth let result = PurchaseResult ( if newBalance < 0 then PurchaseDebtful else PurchaseOK ) missing 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