building confirmation page

This commit is contained in:
nek0 2019-10-23 20:35:07 +02:00
parent 05a4acd1dd
commit 2c798c3e7e
3 changed files with 48 additions and 21 deletions

View file

@ -32,7 +32,10 @@ type UserAPI =
:> Get '[HTML] UserOverviewPage
:<|> "user" :> Capture "id" Int :> "buy"
:> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
:> Post '[HTML] UserManagePage
:> Post '[HTML] BuyConfirmPage
:<|> "purchasecomplete"
:> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
:> Post '[HTML] UserSelectPage
:<|> "user" :> Capture "id" Int :> "manage" :> Get '[HTML] UserManagePage
:<|> "user" :> Capture "id" Int :> "manage"
:> ReqBody '[FormUrlEncoded] MT.UserDetailsSubmit
@ -64,6 +67,7 @@ type UserAPI =
( userSelectLink :<|>
userOverviewLink :<|>
buyLink :<|>
purchaseCompleteLink :<|>
userManageLink :<|>
userManageDetailsSubmitLink :<|>
userManageAuthCreateLink :<|>

View file

@ -40,7 +40,9 @@ buyControl
-> Int
-> [MT.PurchaseDetail]
-> UserHandler BuyConfirmPage
buyControl mcookie uid pds = do
buyControl mcookie uid pds =
if not (null pds)
then do
(ReadState l10n backend _) <- ask
let (token, _) = parseTokenAndUser mcookie
loc = Locale
@ -51,9 +53,21 @@ buyControl mcookie uid pds = do
backend
case epsovs of
Right psovs -> do
let currentPsovs = filter ((`elem` pids) . MT.productShortOverviewId) psovs
let currentPsovs = filter
((`elem` pids) . MT.productShortOverviewId)
psovs
ziptup = sortOn (MT.productShortOverviewIdent . snd) (zip
(sortOn MT.purchaseDetailProduct pds)
(sortOn MT.productShortOverviewId currentPsovs)
)
return (buyConfirmPage l10n loc ziptup)
total = foldl
(\acc
( MT.PurchaseDetail _ amount
, MT.ProductShortOverview _ _ price _ _ _) ->
acc + (max 0 amount) * price
)
0
ziptup
return (buyConfirmPage l10n loc ziptup total)
else
throwError (redirect303 $ userOverviewLink uid Nothing)

View file

@ -30,8 +30,9 @@ buyConfirmPage
:: L10n
-> Locale
-> [(MT.PurchaseDetail, MT.ProductShortOverview)]
-> Int
-> H.Html
buyConfirmPage l10n locale ziptups = scaffold l10n locale (initPage $
buyConfirmPage l10n locale ziptups total = scaffold l10n locale (initPage $
translate "Matebeamter" <>
" - " <>
translate "Home"
@ -48,16 +49,24 @@ buyConfirmPage l10n locale ziptups = scaffold l10n locale (initPage $
, HA.src (fromString $ show $ fromJust mava) -- TODO: ask for avatar
)
H.toHtml
(fromString (show amount)
(fromString (show $ max 0 amount)
<> " "
<> ident
<> " @ "
<> formatMoney price
<> " "
-- <> "€" -- TODO: ask for currency symbol
<> " : "
<> formatMoney ((max 0 amount) * price)
)
)
ziptups
H.p $ H.toHtml $
(translate "Total price")
<> ": "
<> formatMoney total
-- <> "€" -- TODO: ask for currency symbol
H.form
where
translate = localize l10n locale . gettext
@ -105,6 +114,6 @@ buyProductsForm l10n locale prods = do
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Buy"
$ H.toHtml $ translate "Proceed"
where
translate = localize l10n locale . gettext