2019-08-14 16:04:16 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Control.Product where
|
|
|
|
|
|
|
|
import Servant
|
|
|
|
|
|
|
|
import Control.Monad (void)
|
|
|
|
|
|
|
|
import Control.Monad.Reader (ask)
|
|
|
|
|
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import Types
|
|
|
|
import Model
|
|
|
|
|
|
|
|
productNew :: Maybe Int -> ProductSubmit -> MateHandler Int
|
|
|
|
productNew (Just _) bevsub = do
|
|
|
|
conn <- rsConnection <$> ask
|
|
|
|
bevid <- insertProduct bevsub conn
|
|
|
|
void $ insertNewEmptyAmount bevid bevsub conn
|
|
|
|
return bevid
|
|
|
|
productNew Nothing _ =
|
|
|
|
throwError $ err403
|
|
|
|
|
|
|
|
productOverview :: Int -> MateHandler ProductOverview
|
|
|
|
productOverview pid = do
|
|
|
|
conn <- rsConnection <$> ask
|
|
|
|
productOverviewSelectSingle pid conn
|
|
|
|
|
|
|
|
productStockRefill :: Maybe Int -> [AmountRefill] -> MateHandler ()
|
|
|
|
productStockRefill (Just _) amorefs = do
|
|
|
|
if all ((>= 0) . amountRefillAmount) amorefs
|
|
|
|
then do
|
|
|
|
conn <- rsConnection <$> ask
|
|
|
|
void $ manualProductAmountRefill amorefs conn
|
|
|
|
else
|
2019-09-06 19:44:31 +00:00
|
|
|
throwError $ err400
|
|
|
|
{ errBody = "Amounts less than 0 are not acceptable."
|
2019-08-14 16:04:16 +00:00
|
|
|
}
|
|
|
|
productStockRefill Nothing _ =
|
|
|
|
throwError $ err403
|
2019-09-06 19:44:31 +00:00
|
|
|
{ errBody = "No Authentication present."
|
2019-08-14 16:04:16 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
productStockUpdate :: Maybe Int -> [AmountUpdate] -> MateHandler ()
|
|
|
|
productStockUpdate (Just _) amoups = do
|
|
|
|
if all ((>= 0) . amountUpdateRealAmount) amoups
|
|
|
|
then do
|
|
|
|
conn <- rsConnection <$> ask
|
|
|
|
void $ manualProductAmountUpdate amoups conn
|
|
|
|
else
|
2019-09-06 19:44:31 +00:00
|
|
|
throwError $ err400
|
|
|
|
{ errBody = "Amounts less than 0 are not acceptable."
|
2019-08-14 16:04:16 +00:00
|
|
|
}
|
|
|
|
productStockUpdate Nothing _ =
|
|
|
|
throwError $ err403
|
2019-09-06 19:44:31 +00:00
|
|
|
{ errBody = "No Authentication present."
|
2019-08-14 16:04:16 +00:00
|
|
|
}
|
|
|
|
|
2019-09-09 10:57:08 +00:00
|
|
|
productList :: Maybe ProductRefine :> MateHandler [ProductOverview]
|
|
|
|
productList mrefine = do
|
2019-08-14 16:04:16 +00:00
|
|
|
conn <- rsConnection <$> ask
|
2019-09-09 10:57:08 +00:00
|
|
|
productOverviewSelect (fromMaybe AvailableProducts mrefine) conn
|