From 12ce0e41e50acaf01eb520114915bcdf3afd1e23 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 14 Dec 2019 08:34:01 +0100 Subject: [PATCH] add the roice list on the user select page --- src/API.hs | 4 ++-- src/Control/Product.hs | 9 ++++++++- src/Main.hs | 1 + src/View/Product.hs | 12 +++++++----- src/View/Scaffold.hs | 9 +++++++++ 5 files changed, 27 insertions(+), 8 deletions(-) diff --git a/src/API.hs b/src/API.hs index e41d453..0dda5e1 100644 --- a/src/API.hs +++ b/src/API.hs @@ -70,7 +70,7 @@ type UserAPI = :<|> "journal" :> "check" :> ReqBody '[FormUrlEncoded] CashCheck :> Post '[HTML] JournalPage - :<|> "product" + :<|> "product" :> "list" :> Get '[HTML] ProductPriceListPage :<|> "auth" :> QueryParam "destination" T.Text @@ -104,7 +104,7 @@ type UserAPI = journalLink :<|> journalGetCheckLink :<|> journalPostCheckLink :<|> - productGetPriceList :<|> + productGetPriceListLink :<|> authLink :<|> authPostLink :<|> authLogoutLink diff --git a/src/Control/Product.hs b/src/Control/Product.hs index 905f37e..f1f59e7 100644 --- a/src/Control/Product.hs +++ b/src/Control/Product.hs @@ -2,8 +2,15 @@ {-# LANGUAGE PackageImports #-} module Control.Product where +import Servant +import Servant.Client + +import Data.String (fromString) + import qualified Data.Text as T +import Control.Monad.IO.Class (liftIO) + -- imports from "mateamt" import qualified "mateamt" Types as MT @@ -20,7 +27,7 @@ import Hash productGetPriceList :: Maybe T.Text - -> UserHandler PruductPriceListPage + -> UserHandler ProductPriceListPage productGetPriceList mcookie = do (token, muser, loc, l10n, backend) <- controlInit mcookie elist <- liftIO $ runClientM diff --git a/src/Main.hs b/src/Main.hs index 6aafaf6..4ff7b9c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -85,6 +85,7 @@ userApp initState = serveWithContext userApi EmptyContext $ :<|> journalControl mcookie :<|> journalGetCheckControl mcookie :<|> journalPostCheckControl mcookie + :<|> productGetPriceList mcookie :<|> authControl mcookie :<|> authPostControl mcookie :<|> authLogoutControl mcookie diff --git a/src/View/Product.hs b/src/View/Product.hs index 7615948..e8c4559 100644 --- a/src/View/Product.hs +++ b/src/View/Product.hs @@ -2,8 +2,10 @@ {-# LANGUAGE PackageImports #-} module View.Product where +import Data.String (fromString) + import qualified Data.Text as T -import Text.I18n +import Data.Text.I18n import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as HA @@ -22,9 +24,9 @@ import API productPriceListPage :: L10n -> Locale - -> maybe T.Text + -> Maybe T.Text -> [MT.ProductShortOverview] - -> UserHandler ProductPriceListPage + -> ProductPriceListPage productPriceListPage l10n loc mcookie list = scaffold l10n loc mcookie (initPage $ translate "Matebeamter" <> @@ -45,8 +47,8 @@ productPriceListPage l10n loc mcookie list = 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 + H.td (H.toHtml $ (fromString $ show ml :: T.Text) <> " ml") + H.td (H.toHtml $ (formatMoney price)) -- TODO: Add Currency symbol ) list where diff --git a/src/View/Scaffold.hs b/src/View/Scaffold.hs index 518e2ec..e79c9de 100644 --- a/src/View/Scaffold.hs +++ b/src/View/Scaffold.hs @@ -40,5 +40,14 @@ scaffold l10n locale mcookie page content = template page $ do ) H.div H.! HA.id "main" H.! HA.role "main" $ content + H.hr + H.footer $ H.form $ + H.button + H.! HA.formmethod "get" + H.! HA.formaction ("/" <> + (fromString $ show $ linkURI productGetPriceListLink)) + $ H.toHtml $ translate "Price List" where message = lookup "message" =<< fmap parseCookieText mcookie + translate = localize l10n locale . gettext + getLogin = snd . parseTokenAndUser