mateamt/src/Control/Product.hs

78 lines
1.8 KiB
Haskell
Raw Normal View History

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)
2019-09-09 11:17:43 +00:00
import Data.Maybe (fromMaybe)
2019-08-14 16:04:16 +00:00
-- internal imports
import Types
import Model
2019-09-15 12:59:22 +00:00
productNew
:: Maybe (Int, AuthMethod)
-> ProductSubmit
-> MateHandler Int
2019-08-14 16:04:16 +00:00
productNew (Just _) bevsub = do
conn <- rsConnection <$> ask
bevid <- insertProduct bevsub conn
void $ insertNewEmptyAmount bevid bevsub conn
return bevid
productNew Nothing _ =
2019-09-11 11:54:18 +00:00
throwError $ err401
2019-08-14 16:04:16 +00:00
2019-09-15 12:59:22 +00:00
productOverview
:: Int
-> MateHandler ProductOverview
2019-08-14 16:04:16 +00:00
productOverview pid = do
conn <- rsConnection <$> ask
productOverviewSelectSingle pid conn
2019-09-15 12:59:22 +00:00
productStockRefill
:: Maybe (Int, AuthMethod)
-> [AmountRefill]
-> MateHandler ()
2019-08-14 16:04:16 +00:00
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 _ =
2019-09-11 11:54:18 +00:00
throwError $ err401
2019-09-06 19:44:31 +00:00
{ errBody = "No Authentication present."
2019-08-14 16:04:16 +00:00
}
2019-09-15 12:59:22 +00:00
productStockUpdate
:: Maybe (Int, AuthMethod)
-> [AmountUpdate]
-> MateHandler ()
2019-08-14 16:04:16 +00:00
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 _ =
2019-09-11 11:54:18 +00:00
throwError $ err401
2019-09-06 19:44:31 +00:00
{ errBody = "No Authentication present."
2019-08-14 16:04:16 +00:00
}
2019-09-15 12:59:22 +00:00
productList
:: Maybe ProductRefine
-> MateHandler [ProductOverview]
2019-09-09 10:57:08 +00:00
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