This commit is contained in:
nek0 2019-10-22 20:43:50 +02:00
parent ca78cb1648
commit 05a4acd1dd
6 changed files with 75 additions and 17 deletions

View file

@ -15,6 +15,10 @@ import Data.Text.I18n
import Data.String (fromString) import Data.String (fromString)
import Data.Maybe (fromMaybe)
import Data.List (sortOn)
import Control.Monad.Reader (ask) import Control.Monad.Reader (ask)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
@ -35,7 +39,21 @@ buyControl
:: Maybe T.Text :: Maybe T.Text
-> Int -> Int
-> [MT.PurchaseDetail] -> [MT.PurchaseDetail]
-> UserHandler UserManagePage -> UserHandler BuyConfirmPage
buyControl mcookie uid pds = throwError $ err500 buyControl mcookie uid pds = do
{ errBody = fromString (show pds) (ReadState l10n backend _) <- ask
} let (token, _) = parseTokenAndUser mcookie
loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
pids = map MT.purchaseDetailProduct pds
epsovs <- liftIO $ runClientM
(productShortList (Just MT.AllProducts))
backend
case epsovs of
Right psovs -> do
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)

View file

@ -36,18 +36,6 @@ import Hash
import API import API
import Util import Util
parseTokenAndUser
:: Maybe T.Text
-> (String, Maybe String)
parseTokenAndUser mcookie =
(token, mAuthUser)
where
token = T.unpack $ fromMaybe "secret"
(lookup "x-token" =<< mParsedCookie)
mAuthUser = T.unpack <$>
(lookup "x-auth-user" =<< mParsedCookie)
mParsedCookie = fmap parseCookieText mcookie
userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage
userSelectControl mcookie = do userSelectControl mcookie = do
(ReadState l10n backend _) <- ask (ReadState l10n backend _) <- ask

View file

@ -13,3 +13,5 @@ type UserManagePage = H.Html
type ProductListPage = H.Html type ProductListPage = H.Html
type AuthPage = H.Html type AuthPage = H.Html
type BuyConfirmPage = H.Html

View file

@ -22,6 +22,8 @@ import Data.List.Split (chunksOf)
import Data.String (fromString) import Data.String (fromString)
import Data.Maybe (fromMaybe)
import Web.Cookie import Web.Cookie
import Text.Printf (printf) import Text.Printf (printf)
@ -52,7 +54,7 @@ formatMoney amount = pre <> t <> "," <> c
t = fromString $ reverse (intercalate "." $ chunksOf 3 $ reverse $ fst sp) t = fromString $ reverse (intercalate "." $ chunksOf 3 $ reverse $ fst sp)
c = fromString $ snd sp c = fromString $ snd sp
sp = tail <$> sp = tail <$>
break (== '.') (printf "%.2f" (fromIntegral $ abs amount :: Float)) break (== '.') (printf "%.2f" (abs $ (fromIntegral amount / 100) :: Float))
redirect303 redirect303
:: Link :: Link
@ -71,6 +73,18 @@ parseCookieText = map
(\x -> let (one, two) = T.breakOn "=" x in (one, T.tail two)) (\x -> let (one, two) = T.breakOn "=" x in (one, T.tail two))
. T.splitOn "; " . T.splitOn "; "
parseTokenAndUser
:: Maybe T.Text
-> (String, Maybe String)
parseTokenAndUser mcookie =
(token, mAuthUser)
where
token = T.unpack $ fromMaybe "secret"
(lookup "x-token" =<< mParsedCookie)
mAuthUser = T.unpack <$>
(lookup "x-auth-user" =<< mParsedCookie)
mParsedCookie = fmap parseCookieText mcookie
handleErrors handleErrors
:: (Traversable t, Show (t (Maybe ClientError))) :: (Traversable t, Show (t (Maybe ClientError)))
=> Maybe Int => Maybe Int

View file

@ -4,3 +4,4 @@ module View
import View.Auth as V import View.Auth as V
import View.User as V import View.User as V
import View.Buy as V

View file

@ -26,6 +26,41 @@ import Types
import View.Scaffold import View.Scaffold
import API import API
buyConfirmPage
:: L10n
-> Locale
-> [(MT.PurchaseDetail, MT.ProductShortOverview)]
-> H.Html
buyConfirmPage l10n locale ziptups = scaffold l10n locale (initPage $
translate "Matebeamter" <>
" - " <>
translate "Home"
) $ do
H.p $ H.toHtml $ translate "You are about to buy the following items:"
H.ul $
mapM_
(\( MT.PurchaseDetail pdid amount
, MT.ProductShortOverview pid ident price _ _ mava) ->
H.li $ do
H.img
H.!?
( isJust mava
, HA.src (fromString $ show $ fromJust mava) -- TODO: ask for avatar
)
H.toHtml
(fromString (show amount)
<> " "
<> ident
<> " @ "
<> formatMoney price
<> " "
-- <> "€" -- TODO: ask for currency symbol
)
)
ziptups
where
translate = localize l10n locale . gettext
buyProductsForm buyProductsForm
:: L10n :: L10n
-> Locale -> Locale