272 lines
6.4 KiB
Haskell
272 lines
6.4 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Model.Product where
|
|
|
|
import Servant.Server
|
|
|
|
import Data.Text as T hiding (head)
|
|
import Data.Time.Calendar (Day)
|
|
import Data.Profunctor.Product (p13)
|
|
|
|
import Data.Aeson
|
|
import Data.Aeson.Types
|
|
|
|
import Data.Int (Int64)
|
|
|
|
import Control.Monad (when)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.Error.Class (throwError)
|
|
|
|
import Control.Arrow ((<<<))
|
|
|
|
import qualified Database.PostgreSQL.Simple as PGS
|
|
|
|
import GHC.Generics
|
|
|
|
import Opaleye as O
|
|
import Opaleye.Constant as C
|
|
|
|
-- internal imports
|
|
|
|
import Types
|
|
|
|
initProduct :: PGS.Query
|
|
initProduct = "create Table if not exists \"product\" (product_id serial primary key, product_ident varchar(128) not null, product_price integer not null, product_amount integer not null, product_vanish integer not null, product_ml integer not null, product_avatar integer, product_supplier integer, product_max_amount integer not null, product_total_bought integer not null, product_amount_per_crate integer not null, product_price_per_crate integer, product_art_nr varchar(128))"
|
|
|
|
productTable :: Table
|
|
( Maybe (Field SqlInt4)
|
|
, Field SqlText
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, FieldNullable SqlInt4
|
|
, FieldNullable SqlInt4
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, FieldNullable SqlInt4
|
|
, FieldNullable SqlText
|
|
)
|
|
( Field SqlInt4
|
|
, Field SqlText
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, FieldNullable SqlInt4
|
|
, FieldNullable SqlInt4
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, Field SqlInt4
|
|
, FieldNullable SqlInt4
|
|
, FieldNullable SqlText
|
|
)
|
|
productTable = table "product" (
|
|
p13
|
|
( tableField "product_id"
|
|
, tableField "product_ident"
|
|
, tableField "product_price"
|
|
, tableField "product_amount"
|
|
, tableField "product_vanish"
|
|
, tableField "product_ml"
|
|
, tableField "product_avatar"
|
|
, tableField "product_supplier"
|
|
, tableField "product_max_amount"
|
|
, tableField "product_total_bought"
|
|
, tableField "product_amount_per_crate"
|
|
, tableField "product_price_per_crate"
|
|
, tableField "product_art_nr"
|
|
)
|
|
)
|
|
|
|
productSelect
|
|
:: PGS.Connection
|
|
-> MateHandler [Product]
|
|
productSelect conn = do
|
|
bevs <- liftIO $ runSelect conn
|
|
( keepWhen (\_ -> C.constant True) <<< queryTable productTable
|
|
) :: MateHandler
|
|
[ ( Int
|
|
, T.Text
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Maybe Int
|
|
, Maybe Int
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Maybe Int
|
|
, Maybe T.Text
|
|
)
|
|
]
|
|
mapM
|
|
(\(i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13) -> return $
|
|
Product i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13
|
|
)
|
|
bevs
|
|
|
|
|
|
getProductPrice
|
|
:: PurchaseDetail
|
|
-> PGS.Connection
|
|
-> MateHandler Int
|
|
getProductPrice (PurchaseDetail bid amount) conn = do
|
|
when (amount < 0) (
|
|
throwError $ err406
|
|
{ errBody = "Amounts less or equal zero are not acceptable"
|
|
}
|
|
)
|
|
bevs <- liftIO $ runSelect conn
|
|
( keepWhen
|
|
(\(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant bid) <<<
|
|
queryTable productTable
|
|
) :: MateHandler
|
|
[ ( Int
|
|
, T.Text
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Maybe Int
|
|
, Maybe Int
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Maybe Int
|
|
, Maybe T.Text
|
|
)
|
|
]
|
|
(amount *) <$> head <$> mapM
|
|
(\(i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13) -> return $
|
|
i3
|
|
)
|
|
bevs
|
|
|
|
|
|
checkProductAvailability
|
|
:: PGS.Connection
|
|
-> PurchaseDetail
|
|
-> MateHandler (Maybe Int) -- | returns maybe missing amount
|
|
checkProductAvailability conn (PurchaseDetail bid amount) = do
|
|
when (amount <= 0) $
|
|
throwError $ err406
|
|
{ errBody = "Amounts less or equal zero are not acceptable"
|
|
}
|
|
bevs <- liftIO $ runSelect conn
|
|
( keepWhen
|
|
(\(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant bid) <<<
|
|
queryTable productTable
|
|
) :: MateHandler
|
|
[ ( Int
|
|
, T.Text
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Maybe Int
|
|
, Maybe Int
|
|
, Int
|
|
, Int
|
|
, Int
|
|
, Maybe Int
|
|
, Maybe T.Text
|
|
)
|
|
]
|
|
realamount <- head <$> mapM
|
|
(\(i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13) -> return $
|
|
i4
|
|
)
|
|
bevs
|
|
if realamount < amount
|
|
then return (Just (amount - realamount))
|
|
else return Nothing
|
|
|
|
|
|
insertProduct
|
|
:: ProductSubmit
|
|
-> Insert [Int]
|
|
insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) = Insert
|
|
{ iTable = productTable
|
|
, iRows =
|
|
[
|
|
( C.constant (Nothing :: Maybe Int)
|
|
, C.constant ident
|
|
, C.constant price
|
|
, C.constant (0 :: Int)
|
|
, C.constant (0 :: Int)
|
|
, C.constant ml
|
|
, C.constant ava
|
|
, C.constant sup
|
|
, C.constant max
|
|
, C.constant (0 :: Int)
|
|
, C.constant apc
|
|
, C.constant ppc
|
|
, C.constant artnr
|
|
)
|
|
]
|
|
, iReturning = rReturning (\(id, _, _, _, _, _, _, _, _, _, _, _, _) -> id)
|
|
, iOnConflict = Nothing
|
|
}
|
|
|
|
|
|
updateProduct
|
|
:: Int
|
|
-> ProductSubmit
|
|
-> Update Int64
|
|
updateProduct sid (ProductSubmit ident price ml ava sup max apc ppc artnr) = Update
|
|
{ uTable = productTable
|
|
, uUpdateWith = updateEasy (\(id_, _, _, amo, van, _, _, _, _, tot, _, _, _) ->
|
|
( id_
|
|
, C.constant ident
|
|
, C.constant price
|
|
, amo
|
|
, van
|
|
, C.constant ml
|
|
, C.constant ava
|
|
, C.constant sup
|
|
, C.constant max
|
|
, tot
|
|
, C.constant apc
|
|
, C.constant ppc
|
|
, C.constant artnr
|
|
)
|
|
)
|
|
, uWhere =
|
|
(\(id_, _, _, _, _, _, _, _, _, _, _, _, _) ->
|
|
id_ .== C.constant sid
|
|
)
|
|
, uReturning = rCount
|
|
}
|
|
|
|
reduceProductAmount
|
|
:: PurchaseDetail
|
|
-> Update Int64
|
|
reduceProductAmount (PurchaseDetail pid amount) = Update
|
|
{ uTable = productTable
|
|
, uUpdateWith = updateEasy
|
|
(\(id_, ident, price, amo, van, ml, ava, sup, max, tot, apc, ppc, artnr) ->
|
|
( id_
|
|
, ident
|
|
, price
|
|
, amo - C.constant amount
|
|
, van
|
|
, ml
|
|
, ava
|
|
, sup
|
|
, max
|
|
, tot + C.constant amount
|
|
, apc
|
|
, ppc
|
|
, artnr
|
|
)
|
|
)
|
|
, uWhere =
|
|
(\(id_, _, _, _, _, _, _, _, _, _, _, _, _) ->
|
|
id_ .== C.constant pid
|
|
)
|
|
, uReturning = rCount
|
|
}
|