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

View file

@ -40,20 +40,34 @@ buyControl
-> Int -> Int
-> [MT.PurchaseDetail] -> [MT.PurchaseDetail]
-> UserHandler BuyConfirmPage -> UserHandler BuyConfirmPage
buyControl mcookie uid pds = do buyControl mcookie uid pds =
(ReadState l10n backend _) <- ask if not (null pds)
let (token, _) = parseTokenAndUser mcookie then do
loc = Locale (ReadState l10n backend _) <- ask
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) let (token, _) = parseTokenAndUser mcookie
pids = map MT.purchaseDetailProduct pds loc = Locale
epsovs <- liftIO $ runClientM (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
(productShortList (Just MT.AllProducts)) pids = map MT.purchaseDetailProduct pds
backend epsovs <- liftIO $ runClientM
case epsovs of (productShortList (Just MT.AllProducts))
Right psovs -> do backend
let currentPsovs = filter ((`elem` pids) . MT.productShortOverviewId) psovs case epsovs of
ziptup = sortOn (MT.productShortOverviewIdent . snd) (zip Right psovs -> do
(sortOn MT.purchaseDetailProduct pds) let currentPsovs = filter
(sortOn MT.productShortOverviewId currentPsovs) ((`elem` pids) . MT.productShortOverviewId)
) psovs
return (buyConfirmPage l10n loc ziptup) ziptup = sortOn (MT.productShortOverviewIdent . snd) (zip
(sortOn MT.purchaseDetailProduct pds)
(sortOn MT.productShortOverviewId currentPsovs)
)
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 :: L10n
-> Locale -> Locale
-> [(MT.PurchaseDetail, MT.ProductShortOverview)] -> [(MT.PurchaseDetail, MT.ProductShortOverview)]
-> Int
-> H.Html -> H.Html
buyConfirmPage l10n locale ziptups = scaffold l10n locale (initPage $ buyConfirmPage l10n locale ziptups total = scaffold l10n locale (initPage $
translate "Matebeamter" <> translate "Matebeamter" <>
" - " <> " - " <>
translate "Home" translate "Home"
@ -48,16 +49,24 @@ buyConfirmPage l10n locale ziptups = scaffold l10n locale (initPage $
, HA.src (fromString $ show $ fromJust mava) -- TODO: ask for avatar , HA.src (fromString $ show $ fromJust mava) -- TODO: ask for avatar
) )
H.toHtml H.toHtml
(fromString (show amount) (fromString (show $ max 0 amount)
<> " " <> " "
<> ident <> ident
<> " @ " <> " @ "
<> formatMoney price <> formatMoney price
<> " " <> " "
-- <> "€" -- TODO: ask for currency symbol -- <> "€" -- TODO: ask for currency symbol
<> " : "
<> formatMoney ((max 0 amount) * price)
) )
) )
ziptups ziptups
H.p $ H.toHtml $
(translate "Total price")
<> ": "
<> formatMoney total
-- <> "€" -- TODO: ask for currency symbol
H.form
where where
translate = localize l10n locale . gettext translate = localize l10n locale . gettext
@ -105,6 +114,6 @@ buyProductsForm l10n locale prods = do
H.button H.button
H.! HA.class_ "btn btn-default" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ translate "Buy" $ H.toHtml $ translate "Proceed"
where where
translate = localize l10n locale . gettext translate = localize l10n locale . gettext