add the roice list on the user select page

This commit is contained in:
nek0 2019-12-14 08:34:01 +01:00
parent d52fbdc638
commit 12ce0e41e5
5 changed files with 27 additions and 8 deletions

View file

@ -70,7 +70,7 @@ type UserAPI =
:<|> "journal" :> "check" :<|> "journal" :> "check"
:> ReqBody '[FormUrlEncoded] CashCheck :> ReqBody '[FormUrlEncoded] CashCheck
:> Post '[HTML] JournalPage :> Post '[HTML] JournalPage
:<|> "product" :<|> "product" :> "list"
:> Get '[HTML] ProductPriceListPage :> Get '[HTML] ProductPriceListPage
:<|> "auth" :<|> "auth"
:> QueryParam "destination" T.Text :> QueryParam "destination" T.Text
@ -104,7 +104,7 @@ type UserAPI =
journalLink :<|> journalLink :<|>
journalGetCheckLink :<|> journalGetCheckLink :<|>
journalPostCheckLink :<|> journalPostCheckLink :<|>
productGetPriceList :<|> productGetPriceListLink :<|>
authLink :<|> authLink :<|>
authPostLink :<|> authPostLink :<|>
authLogoutLink authLogoutLink

View file

@ -2,8 +2,15 @@
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
module Control.Product where module Control.Product where
import Servant
import Servant.Client
import Data.String (fromString)
import qualified Data.Text as T import qualified Data.Text as T
import Control.Monad.IO.Class (liftIO)
-- imports from "mateamt" -- imports from "mateamt"
import qualified "mateamt" Types as MT import qualified "mateamt" Types as MT
@ -20,7 +27,7 @@ import Hash
productGetPriceList productGetPriceList
:: Maybe T.Text :: Maybe T.Text
-> UserHandler PruductPriceListPage -> UserHandler ProductPriceListPage
productGetPriceList mcookie = do productGetPriceList mcookie = do
(token, muser, loc, l10n, backend) <- controlInit mcookie (token, muser, loc, l10n, backend) <- controlInit mcookie
elist <- liftIO $ runClientM elist <- liftIO $ runClientM

View file

@ -85,6 +85,7 @@ userApp initState = serveWithContext userApi EmptyContext $
:<|> journalControl mcookie :<|> journalControl mcookie
:<|> journalGetCheckControl mcookie :<|> journalGetCheckControl mcookie
:<|> journalPostCheckControl mcookie :<|> journalPostCheckControl mcookie
:<|> productGetPriceList mcookie
:<|> authControl mcookie :<|> authControl mcookie
:<|> authPostControl mcookie :<|> authPostControl mcookie
:<|> authLogoutControl mcookie :<|> authLogoutControl mcookie

View file

@ -2,8 +2,10 @@
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
module View.Product where module View.Product where
import Data.String (fromString)
import qualified Data.Text as T 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 as H
import qualified Text.Blaze.Html5.Attributes as HA import qualified Text.Blaze.Html5.Attributes as HA
@ -22,9 +24,9 @@ import API
productPriceListPage productPriceListPage
:: L10n :: L10n
-> Locale -> Locale
-> maybe T.Text -> Maybe T.Text
-> [MT.ProductShortOverview] -> [MT.ProductShortOverview]
-> UserHandler ProductPriceListPage -> ProductPriceListPage
productPriceListPage l10n loc mcookie list = productPriceListPage l10n loc mcookie list =
scaffold l10n loc mcookie (initPage $ scaffold l10n loc mcookie (initPage $
translate "Matebeamter" <> translate "Matebeamter" <>
@ -45,8 +47,8 @@ productPriceListPage l10n loc mcookie list =
H.td (H.toHtml $ show pid) H.td (H.toHtml $ show pid)
H.td (H.toHtml ident) H.td (H.toHtml ident)
H.td (H.toHtml $ show amount) H.td (H.toHtml $ show amount)
H.td (H.toHtml $ (fromString $ show ml) <> " ml") H.td (H.toHtml $ (fromString $ show ml :: T.Text) <> " ml")
H.td (H.toHtml $ (formatMoney price) -- TODO: Add Currency symbol H.td (H.toHtml $ (formatMoney price)) -- TODO: Add Currency symbol
) )
list list
where where

View file

@ -40,5 +40,14 @@ scaffold l10n locale mcookie page content = template page $ do
) )
H.div H.! HA.id "main" H.! HA.role "main" $ H.div H.! HA.id "main" H.! HA.role "main" $
content 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 where
message = lookup "message" =<< fmap parseCookieText mcookie message = lookup "message" =<< fmap parseCookieText mcookie
translate = localize l10n locale . gettext
getLogin = snd . parseTokenAndUser