{-# 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, fromMaybe) import Control.Monad (when) -- imports from mateamt import qualified "mateamt" Types as MT -- internal imports import Util import Types import View.Scaffold import API buyConfirmPage :: L10n -> Locale -> Int -> [(MT.PurchaseDetail, MT.ProductShortOverview)] -> Int -> Bool -> T.Text -> Maybe T.Text -> T.Text -> H.Html buyConfirmPage l10n locale uid ziptups total forceBuy version mcookie symbol = scaffold l10n locale version mcookie (initPage $ translate "Matebeamter" <> " - " <> translate "Home" ) $ do if not forceBuy then H.p $ H.toHtml $ translate "You are about to buy the following items:" else H.p $ H.toHtml $ translate "The following Items seem out of stock:" H.form H.! HA.method "post" H.! HA.action ("/" <> fromString (show $ linkURI $ purchaseCompleteLink uid forceBuy) ) H.! HA.enctype "application/x-www-form-urlencoded" $ do mapM_ (\( MT.PurchaseDetail pdid amount , MT.ProductShortOverview pid ident price _ _ mava) -> H.div H.! HA.class_ "form-group required" $ do H.input H.! HA.id ("product-select-" <> fromString (show pid)) H.! HA.class_ "form-control" H.! HA.name ("productSelect-" <> fromString (show pid)) H.! HA.type_ "hidden" H.! HA.value "true" H.label H.! HA.for ("product-amount-" <> fromString (show pid)) $ do H.img H.!? ( isJust mava , HA.src (fromString $ show $ fromJust mava) -- TODO: ask for avatar ) H.toHtml ident H.input H.! HA.id ("product-amount-" <> fromString (show pid)) H.! HA.class_ "form-control" H.! HA.name ("productAmount-" <> fromString (show pid)) H.! HA.type_ "number" H.! HA.min "0" H.! HA.step "1" H.! HA.value (fromString $ show amount) -- H.! HA.disabled "" H.label H.! HA.for ("product-total-" <> fromString (show pid)) $ H.toHtml $ " @ " <> formatMoney price <> symbol -- H.input -- H.! HA.id ("product-total-" <> fromString (show pid)) -- H.! HA.class_ "form-control" -- H.! HA.name ("productTotal-" <> fromString (show pid)) -- H.! HA.type_ "text" -- H.! HA.value -- (fromString $ T.unpack $ formatMoney $ amount * price) -- H.! HA.disabled "" -- H.toHtml ("€" :: T.Text) -- TODO: ask for currency symbol ) ziptups H.div H.! HA.class_ "form-group required" $ do H.label H.! HA.for "total-price" $ H.toHtml ("Total price: " :: T.Text) H.input H.! HA.id "total-price" H.! HA.class_ "form-control" H.! HA.name "totalPrice" H.! HA.type_ "text" H.! HA.value (fromString $ T.unpack $ formatMoney total) H.! HA.disabled "" H.toHtml symbol H.div H.! HA.class_ "form-group optional" $ H.button H.! HA.class_ "btn btn-primary" H.! HA.type_ "submit" $ H.toHtml $ if forceBuy then translate "Buy anyway" else translate "Buy" when forceBuy $ H.button H.! HA.class_ "btn btn-primary" H.! HA.formnovalidate "formnovalidate" H.! HA.formmethod "get" H.! HA.formaction ("/" <> fromString (show $ linkURI $ userOverviewLink uid Nothing) ) $ H.toHtml $ translate "Cancel" where translate = localize l10n locale . gettext buyProductsForm :: L10n -> Locale -> [MT.ProductShortOverview] -> H.Html buyProductsForm l10n locale prods = do H.div H.! HA.class_ "tile-list" $ mapM_ (\(MT.ProductShortOverview pid ident price amount ml maid) -> H.div H.! HA.class_ "tile" H.!? ( isJust maid , productBgStyle (fromString $ show $ fromJust maid) ) $ do H.label H.! HA.for ("product-select-" <> fromString (show pid)) $ H.toHtml ident H.! HA.class_ "tile-content form-group optional" H.input H.! HA.id ("product-select-" <> fromString (show pid)) H.! HA.class_ "form-control product-select" H.! HA.class_ "tile-content form-group optional" H.! HA.name ("productSelect-" <> fromString (show pid)) H.! HA.type_ "checkbox" -- H.! HA.value "true" H.div $ 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-primary" H.! HA.type_ "submit" $ H.toHtml $ translate "Proceed" where translate = localize l10n locale . gettext cashBuyOverviewPage :: L10n -> Locale -> T.Text -> Maybe T.Text -> [MT.ProductShortOverview] -> CashBuyOverviewPage cashBuyOverviewPage l10n loc version mcookie psos = scaffold l10n loc version mcookie (initPage $ translate "Matebeamter" <> " - " <> translate "Buy with Cash" ) $ H.form H.! HA.method "post" H.! HA.action ("/" <> fromString ( show $ linkURI cashBuyPostLink )) H.! HA.enctype "application/x-www-form-urlencoded" $ buyProductsForm l10n loc psos where translate = localize l10n loc . gettext