prepare creation of products

This commit is contained in:
nek0 2019-12-17 01:56:22 +01:00
parent 7ad8379125
commit ad0a795ff0
6 changed files with 48 additions and 1 deletions

View file

@ -77,6 +77,11 @@ type UserAPI =
:<|> "product" :> "refill" :<|> "product" :> "refill"
:> ReqBody '[FormUrlEncoded] [MT.AmountRefill] :> ReqBody '[FormUrlEncoded] [MT.AmountRefill]
:> Post '[HTML] ProductRefillPage :> Post '[HTML] ProductRefillPage
:<|> "product" :> "new"
:> Get '[HTML] ProductNewPage
:<|> "product" :> "new"
:> ReqBody '[FormUrlEncoded] ProductSubmit
:> Post '[HTML] UserOverviewPage
:<|> "auth" :<|> "auth"
:> QueryParam "destination" T.Text :> QueryParam "destination" T.Text
:> Get '[HTML] :> Get '[HTML]
@ -112,6 +117,8 @@ type UserAPI =
productGetPriceListLink :<|> productGetPriceListLink :<|>
productGetRefillLink :<|> productGetRefillLink :<|>
productPostRefillLink :<|> productPostRefillLink :<|>
productGetNewLink :<|>
productPostNewLink :<|>
authLink :<|> authLink :<|>
authPostLink :<|> authPostLink :<|>
authLogoutLink authLogoutLink

View file

@ -91,3 +91,8 @@ productPostRefill mcookie refills = do
redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
where where
translate l10n loc = localize l10n loc . gettext translate l10n loc = localize l10n loc . gettext
productGetNew
:: Maybe T.Text
-> UserHandler ProductNewPage
productgetNew mcookie = do

View file

@ -87,7 +87,7 @@ userApp initState = serveWithContext userApi EmptyContext $
:<|> journalPostCheckControl mcookie :<|> journalPostCheckControl mcookie
:<|> productGetPriceList mcookie :<|> productGetPriceList mcookie
:<|> productGetRefill mcookie :<|> productGetRefill mcookie
:<|> (\_ _ -> error "not yet implemented") mcookie :<|> productPostRefill mcookie
:<|> authControl mcookie :<|> authControl mcookie
:<|> authPostControl mcookie :<|> authPostControl mcookie
:<|> authLogoutControl mcookie :<|> authLogoutControl mcookie

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

@ -0,0 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Types.Product where
import GHC.Generics
import qualified Data.Text as T
data ProductSubmit = ProductSubmit
{ productSubmitIdent :: T.Text
, productSubmitPrice :: Int
, productSubmitMl :: Int
, productSubmitAvatar :: Maybe Int
, productSubmitSupplier :: Maybe Int
, productSubmitMaxAmount :: Int
, productSubmitAmountPerCrate :: Int
, productSubmitPricePerCrate :: Maybe Int
, productSubmitArtNr :: Maybe T.Text
} deriving (Generic, Show)

View file

@ -29,3 +29,5 @@ type CashBuyConfirmPage = H.Html
type ProductPriceListPage = H.Html type ProductPriceListPage = H.Html
type ProductRefillPage = H.Html type ProductRefillPage = H.Html
type productNewPage = H.Html

View file

@ -150,3 +150,17 @@ productRefillPage l10n loc mcookie prodList =
$ H.toHtml $ translate "Submit" $ H.toHtml $ translate "Submit"
where where
translate = localize l10n loc . gettext translate = localize l10n loc . gettext
productNewPage
:: L10n
-> Locale
-> Maybe T.Text
-> ProductNewPage
productnewPage l10n loc mcookie =
scaffold l10n loc mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Create new product"
) $ do
where
translate = localize l10n loc . gettext