make proper refill options

This commit is contained in:
nek0 2019-12-15 00:03:49 +01:00
parent b923b89cf5
commit e176fdbd10
4 changed files with 85 additions and 38 deletions

View File

@ -37,14 +37,29 @@ productStockRefill
:: Maybe (Int, AuthMethod)
-> [AmountRefill]
-> MateHandler ()
productStockRefill (Just _) amorefs =
if all ((>= 0) . amountRefillAmount) amorefs
then do
conn <- asks rsConnection
void $ manualProductAmountRefill amorefs conn
productStockRefill (Just _) amorefs = do
conn <- asks rsConnection
prods <- mapM
(\refill -> productSelectSingle (amountRefillProductId refill) conn)
amorefs
if all (not . null) prods
then
if
all
(\refill ->
(>= 0) (amountRefillAmountSingles refill) &&
(>= 0) (amountRefillAmountCrates refill)
)
amorefs
then do
void $ manualProductAmountRefill amorefs conn
else
throwError $ err400
{ errBody = "Amounts less than 0 are not acceptable."
}
else
throwError $ err400
{ errBody = "Amounts less than 0 are not acceptable."
{ errBody = "Non-existent Products are non-refillable."
}
productStockRefill Nothing _ =
throwError $ err401

View File

@ -193,36 +193,6 @@ manualProductAmountUpdate aups conn =
aups
manualProductAmountRefill
:: [AmountRefill]
-> PGS.Connection
-> MateHandler [Int]
manualProductAmountRefill aups conn =
mapM
(\(AmountRefill pid amount) -> do
oldamount <- getLatestAmountByProductId pid conn
oldprice <- getLatestPriceByProductId pid conn
head <$> liftIO (do
now <- getCurrentTime
runInsert_ conn $ Insert
{ iTable = amountTable
, iRows =
[
( C.constant pid
, C.constant now
, C.constant (oldamount + amount)
, C.constant oldprice
, C.constant False
)
]
, iReturning = rReturning (\(id_, _, _, _, _) -> id_)
, iOnConflict = Nothing
}
)
)
aups
postBuyProductAmountUpdate
:: PurchaseDetail
-> PGS.Connection

View File

@ -5,6 +5,7 @@
module Model.Product where
import Data.Text as T hiding (head, foldl)
import Data.Time (getCurrentTime)
import Data.Time.Clock (UTCTime)
import Data.Profunctor.Product (p9)
@ -100,6 +101,35 @@ productSelect conn = do
prods
productSelectSingle
:: Int
-> PGS.Connection
-> MateHandler [Product]
productSelectSingle pid conn = do
prods <- liftIO $ runSelect conn
( limit 1
(keepWhen (
\(id_, _, _, _, _, _, _, _, _) -> id_ .== C.constant pid
) <<< queryTable productTable)
) :: MateHandler
[ ( Int
, T.Text
, Int
, Maybe Int
, Maybe Int
, Int
, Int
, Maybe Int
, Maybe T.Text
)
]
mapM
(\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> return $
Product i1 i2 i3 i4 i5 i6 i7 i8 i9
)
prods
productOverviewSelect
:: ProductRefine
-> PGS.Connection
@ -281,3 +311,34 @@ insertProduct (ProductSubmit ident _ ml ava sup maxi apc ppc artnr) conn =
, iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _) -> id_)
, iOnConflict = Nothing
}
manualProductAmountRefill
:: [AmountRefill]
-> PGS.Connection
-> MateHandler [Int]
manualProductAmountRefill aups conn =
mapM
(\(AmountRefill pid amountSingles amountCrates) -> do
oldamount <- getLatestAmountByProductId pid conn
oldprice <- getLatestPriceByProductId pid conn
perCrate <- (productAmountPerCrate . head) <$>
productSelectSingle pid conn
head <$> liftIO (do
now <- getCurrentTime
runInsert_ conn $ Insert
{ iTable = amountTable
, iRows =
[
( C.constant pid
, C.constant now
, C.constant (oldamount + amountSingles + perCrate * amountCrates)
, C.constant oldprice
, C.constant False
)
]
, iReturning = rReturning (\(id_, _, _, _, _) -> id_)
, iOnConflict = Nothing
}
)
)
aups

View File

@ -18,8 +18,9 @@ instance FromJSON AmountUpdate
data AmountRefill = AmountRefill
{ amountRefillProductId :: Int
, amountRefillAmount :: Int
{ amountRefillProductId :: Int
, amountRefillAmountSingles :: Int
, amountRefillAmountCrates :: Int
}
deriving (Show, Generic)