From d52fbdc6388b6c329c7ea66865d0d80a301ff8b1 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 13 Dec 2019 23:46:50 +0100 Subject: [PATCH] commence product pages --- matebeamter.cabal | 2 ++ src/API.hs | 3 +++ src/Control.hs | 1 + src/Control/Product.hs | 37 +++++++++++++++++++++++++++++ src/Types/Views.hs | 2 ++ src/View.hs | 1 + src/View/Product.hs | 53 ++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 99 insertions(+) create mode 100644 src/Control/Product.hs create mode 100644 src/View/Product.hs diff --git a/matebeamter.cabal b/matebeamter.cabal index 73b4bfe..9168064 100644 --- a/matebeamter.cabal +++ b/matebeamter.cabal @@ -37,12 +37,14 @@ executable matebeamter , Control.User , Control.Buy , Control.Journal + , Control.Product , View , View.Scaffold , View.Auth , View.User , View.Buy , View.Journal + , View.Product -- other-extensions: build-depends: base ^>=4.12.0.0 , mateamt diff --git a/src/API.hs b/src/API.hs index 6a4abc1..e41d453 100644 --- a/src/API.hs +++ b/src/API.hs @@ -70,6 +70,8 @@ type UserAPI = :<|> "journal" :> "check" :> ReqBody '[FormUrlEncoded] CashCheck :> Post '[HTML] JournalPage + :<|> "product" + :> Get '[HTML] ProductPriceListPage :<|> "auth" :> QueryParam "destination" T.Text :> Get '[HTML] @@ -102,6 +104,7 @@ type UserAPI = journalLink :<|> journalGetCheckLink :<|> journalPostCheckLink :<|> + productGetPriceList :<|> authLink :<|> authPostLink :<|> authLogoutLink diff --git a/src/Control.hs b/src/Control.hs index 3bd5729..ac05d44 100644 --- a/src/Control.hs +++ b/src/Control.hs @@ -6,3 +6,4 @@ import Control.Auth as C import Control.User as C import Control.Buy as C import Control.Journal as C +import Control.Product as C diff --git a/src/Control/Product.hs b/src/Control/Product.hs new file mode 100644 index 0000000..905f37e --- /dev/null +++ b/src/Control/Product.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +module Control.Product where + +import qualified Data.Text as T + +-- imports from "mateamt" + +import qualified "mateamt" Types as MT + +-- internal imports + +import Types +import View +import Util +import Client +import ClientAuth +import API +import Hash + +productGetPriceList + :: Maybe T.Text + -> UserHandler PruductPriceListPage +productGetPriceList mcookie = do + (token, muser, loc, l10n, backend) <- controlInit mcookie + elist <- liftIO $ runClientM + (productShortList + (Just MT.AllProducts) + ) + backend + case elist of + Right list -> + return (productPriceListPage l10n loc mcookie list) + Left err -> + throwError $ + addMessage (fromString $ show err) $ + redirect303 userSelectLink diff --git a/src/Types/Views.hs b/src/Types/Views.hs index 3edd6ba..b8f1d88 100644 --- a/src/Types/Views.hs +++ b/src/Types/Views.hs @@ -25,3 +25,5 @@ type JournalCheckPage = H.Html type CashBuyOverviewPage = H.Html type CashBuyConfirmPage = H.Html + +type ProductPriceListPage = H.Html diff --git a/src/View.hs b/src/View.hs index cf121e8..d9d05e5 100644 --- a/src/View.hs +++ b/src/View.hs @@ -6,3 +6,4 @@ import View.Auth as V import View.User as V import View.Buy as V import View.Journal as V +import View.Product as V diff --git a/src/View/Product.hs b/src/View/Product.hs new file mode 100644 index 0000000..7615948 --- /dev/null +++ b/src/View/Product.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +module View.Product where + +import qualified Data.Text as T +import Text.I18n + +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as HA + +-- imports from "mateamt" + +import qualified "mateamt" Types as MT + +-- internal imports + +import Types +import Util +import View.Scaffold +import API + +productPriceListPage + :: L10n + -> Locale + -> maybe T.Text + -> [MT.ProductShortOverview] + -> UserHandler ProductPriceListPage +productPriceListPage l10n loc mcookie list = + scaffold l10n loc mcookie (initPage $ + translate "Matebeamter" <> + " - " <> + translate "Price List" + ) $ do + H.table $ do + H.thead $ + H.tr $ do + H.th (H.toHtml $ translate "ID") + H.th (H.toHtml $ translate "Name") + H.th (H.toHtml $ translate "Amount") + H.th (H.toHtml $ translate "Volume") + H.th (H.toHtml $ translate "Price") + mapM_ + (\(MT.ProductShortOverview pid ident price amount ml _) -> + H.tr $ do + H.td (H.toHtml $ show pid) + H.td (H.toHtml ident) + H.td (H.toHtml $ show amount) + H.td (H.toHtml $ (fromString $ show ml) <> " ml") + H.td (H.toHtml $ (formatMoney price) -- TODO: Add Currency symbol + ) + list + where + translate = localize l10n loc . gettext