prepare creation of products
This commit is contained in:
parent
7ad8379125
commit
ad0a795ff0
6 changed files with 48 additions and 1 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
19
src/Types/Product.hs
Normal 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)
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue