refactored Beverage to Product

This commit is contained in:
nek0 2019-07-18 17:09:26 +02:00
parent 920bed1fa3
commit 867481e9d1
8 changed files with 98 additions and 98 deletions

View file

@ -25,11 +25,11 @@ executable mateamt
other-modules: API
, Model
, Model.User
, Model.Beverage
, Model.Product
, Model.Auth
, Types
, Types.Auth
, Types.Beverage
, Types.Product
, Types.Reader
, Types.Refine
, Types.User

View file

@ -31,12 +31,12 @@ type UserAPI =
:<|> "details" :> AuthProtect "header-auth"
:> Capture "id" Int :> ReqBody '[JSON] UserDetailsSubmit :> Post '[JSON] ()
)
:<|> "beverage" :>
( "list" :> Get '[JSON] [Beverage]
:<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] BeverageSubmit
:<|> "product" :>
( "list" :> Get '[JSON] [Product]
:<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] ProductSubmit
:> Post '[JSON] Int
:<|> "update" :> AuthProtect "header-auth"
:> Capture "id" Int :> ReqBody '[JSON] BeverageSubmit :> Post '[JSON] ()
:> Capture "id" Int :> ReqBody '[JSON] ProductSubmit :> Post '[JSON] ()
)
:<|> "auth" :>
( "get" :> ReqBody '[JSON] Int :> Post '[JSON] AuthInfo

View file

@ -46,7 +46,7 @@ main = do
"host='localhost' port=5432 dbname='mateamt' user='mateamt' password='mateamt'"
store <- newTVarIO empty
execute_ conn initUser
execute_ conn initBeverage
execute_ conn initProduct
execute_ conn initToken
withStdoutLogger $ \log -> do
let settings = setPort 3000 $ setLogger log defaultSettings
@ -65,7 +65,7 @@ app initState =
authProxy
(`runReaderT` initState)
( users :<|>
beverages :<|>
products :<|>
auth
)
@ -146,27 +146,27 @@ users =
{ errBody = "Wrong Authentication present"
}
beverages =
products =
list :<|>
new :<|>
update
where
list :: MateHandler [Beverage]
list :: MateHandler [Product]
list = do
conn <- rsConnection <$> ask
beverageSelect conn
productSelect conn
new :: Maybe Int -> BeverageSubmit -> MateHandler Int
new :: Maybe Int -> ProductSubmit -> MateHandler Int
new (Just _) bevsub = do
conn <- rsConnection <$> ask
head <$> (liftIO $ runInsert_ conn (insertBeverage bevsub))
head <$> (liftIO $ runInsert_ conn (insertProduct bevsub))
new Nothing _ =
throwError $ err403
update :: Maybe Int -> Int -> BeverageSubmit -> MateHandler ()
update :: Maybe Int -> Int -> ProductSubmit -> MateHandler ()
update (Just _) bid bevsub = do
conn <- rsConnection <$> ask
void $ liftIO $ runUpdate_ conn (updateBeverage bid bevsub)
void $ liftIO $ runUpdate_ conn (updateProduct bid bevsub)
update Nothing _ _ =
throwError $ err403

View file

@ -3,5 +3,5 @@ module Model
) where
import Model.User as M
import Model.Beverage as M
import Model.Product as M
import Model.Auth as M

View file

@ -1,6 +1,6 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Model.Beverage where
module Model.Product where
import Data.Text as T
import Data.Time.Calendar (Day)
@ -26,10 +26,10 @@ import Opaleye.Constant as C
import Types
initBeverage :: PGS.Query
initBeverage = "create Table if not exists \"beverage\" (beverage_id serial primary key, beverage_ident varchar(128) not null, beverage_price integer not null, beverage_amount integer not null, beverage_vanish integer not null, beverage_ml integer not null, beverage_avatar integer, beverage_supplier integer, beverage_max_amount integer not null, beverage_total_bought integer not null, beverage_amount_per_crate integer not null, beverage_price_per_crate integer, beverage_art_nr varchar(128))"
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))"
beverageTable :: Table
productTable :: Table
( Maybe (Field SqlInt4)
, Field SqlText
, Field SqlInt4
@ -58,30 +58,30 @@ beverageTable :: Table
, FieldNullable SqlInt4
, FieldNullable SqlText
)
beverageTable = table "beverage" (
productTable = table "product" (
p13
( tableField "beverage_id"
, tableField "beverage_ident"
, tableField "beverage_price"
, tableField "beverage_amount"
, tableField "beverage_vanish"
, tableField "beverage_ml"
, tableField "beverage_avatar"
, tableField "beverage_supplier"
, tableField "beverage_max_amount"
, tableField "beverage_total_bought"
, tableField "beverage_amount_per_crate"
, tableField "beverage_price_per_crate"
, tableField "beverage_art_nr"
( 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"
)
)
beverageSelect
productSelect
:: PGS.Connection
-> MateHandler [Beverage]
beverageSelect conn = do
-> MateHandler [Product]
productSelect conn = do
bevs <- liftIO $ runSelect conn
( keepWhen (\_ -> C.constant True) <<< queryTable beverageTable
( keepWhen (\_ -> C.constant True) <<< queryTable productTable
) :: MateHandler
[ ( Int
, T.Text
@ -100,16 +100,16 @@ beverageSelect conn = do
]
mapM
(\(i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13) -> return $
Beverage i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13
Product i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13
)
bevs
insertBeverage
:: BeverageSubmit
insertProduct
:: ProductSubmit
-> Insert [Int]
insertBeverage (BeverageSubmit ident price ml ava sup max apc ppc artnr) = Insert
{ iTable = beverageTable
insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) = Insert
{ iTable = productTable
, iRows =
[
( C.constant (Nothing :: Maybe Int)
@ -132,12 +132,12 @@ insertBeverage (BeverageSubmit ident price ml ava sup max apc ppc artnr) = Inser
}
updateBeverage
updateProduct
:: Int
-> BeverageSubmit
-> ProductSubmit
-> Update Int64
updateBeverage sid (BeverageSubmit ident price ml ava sup max apc ppc artnr) = Update
{ uTable = beverageTable
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

View file

@ -3,7 +3,7 @@ module Types
) where
import Types.Auth as T
import Types.Beverage as T
import Types.Product as T
import Types.Refine as T
import Types.Reader as T
import Types.User as T

View file

@ -1,50 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
module Types.Beverage where
import GHC.Generics
import Data.Aeson
import qualified Data.Text as T
data Beverage = Beverage
{ beverageId :: Int
, beverageIdent :: T.Text
, beveragePrice :: Int
, beverageAmount :: Int
, beverageVanish :: Int
, beverageMl :: Int
, beverageAvatar :: Maybe Int
, beverageSupplier :: Maybe Int
, beverageMaxAmount :: Int
, beverageTotalBought :: Int
, beverageAmountPerCrate :: Int
, beveragePricePerCrate :: Maybe Int
, beverageArtNr :: Maybe T.Text
} deriving (Generic, Show)
instance ToJSON Beverage where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Beverage
data BeverageSubmit = BeverageSubmit
{ beverageSubmitIdent :: T.Text
, beverageSubmitPrice :: Int
-- , beverageSubmitAmount :: Int
-- , beverageSubmitVanish :: Int
, beverageSubmitMl :: Int
, beverageSubmitAvatar :: Maybe Int
, beverageSubmitSupplier :: Maybe Int
, beverageSubmitMaxAmount :: Int
-- , beverageSubmitTotalBought :: Int
, beverageSubmitAmountPerCrate :: Int
, beverageSubmitPricePerCrate :: Maybe Int
, beverageSubmitArtNr :: Maybe T.Text
} deriving (Generic, Show)
instance ToJSON BeverageSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BeverageSubmit

50
src/Types/Product.hs Normal file
View file

@ -0,0 +1,50 @@
{-# LANGUAGE DeriveGeneric #-}
module Types.Product where
import GHC.Generics
import Data.Aeson
import qualified Data.Text as T
data Product = Product
{ productId :: Int
, productIdent :: T.Text
, productPrice :: Int
, productAmount :: Int
, productVanish :: Int
, productMl :: Int
, productAvatar :: Maybe Int
, productSupplier :: Maybe Int
, productMaxAmount :: Int
, productTotalBought :: Int
, productAmountPerCrate :: Int
, productPricePerCrate :: Maybe Int
, productArtNr :: Maybe T.Text
} deriving (Generic, Show)
instance ToJSON Product where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Product
data ProductSubmit = ProductSubmit
{ productSubmitIdent :: T.Text
, productSubmitPrice :: Int
-- , productSubmitAmount :: Int
-- , productSubmitVanish :: Int
, productSubmitMl :: Int
, productSubmitAvatar :: Maybe Int
, productSubmitSupplier :: Maybe Int
, productSubmitMaxAmount :: Int
-- , productSubmitTotalBought :: Int
, productSubmitAmountPerCrate :: Int
, productSubmitPricePerCrate :: Maybe Int
, productSubmitArtNr :: Maybe T.Text
} deriving (Generic, Show)
instance ToJSON ProductSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProductSubmit