{-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-} module View.Buy where import Servant.Links import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as HA import qualified Data.Text as T import Data.String (fromString) import Data.Text.I18n import Data.Maybe (isJust, fromJust) -- imports from mateamt import qualified "mateamt" Types as MT -- internal imports import Util import Types import View.Scaffold 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 :: L10n -> Locale -> [MT.ProductShortOverview] -> H.Html buyProductsForm l10n locale prods = do mapM_ (\(MT.ProductShortOverview pid ident price amount ml maid) -> H.div $ do H.div H.! HA.class_ "form-group optional" H.!? ( isJust maid , productBgStyle (fromString $ show $ fromJust maid) ) $ do H.label H.! HA.for ("product-select-" <> fromString (show pid)) $ H.toHtml ident H.input H.! HA.id ("product-select-" <> fromString (show pid)) H.! HA.class_ "form-control product-select" H.! HA.name ("productSelect-" <> fromString (show pid)) H.! HA.type_ "checkbox" H.! HA.value "true" H.div H.! HA.class_ "form-group optional" $ do H.label H.! HA.for ("product-amount-" <> fromString (show pid)) $ H.toHtml (translate "Amount") H.input H.! HA.id ("product-amount-" <> fromString (show pid)) H.! HA.class_ "form-control product-amount" H.! HA.name ("productAmount-" <> fromString (show pid)) H.! HA.type_ "number" H.! HA.min "0" H.! HA.step "1" H.! HA.value "1" ) prods H.div H.! HA.class_ "form-group optional" $ H.button H.! HA.class_ "btn btn-default" H.! HA.type_ "submit" $ H.toHtml $ translate "Buy" where translate = localize l10n locale . gettext