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"
:> 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

View File

@ -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

View File

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

View File

@ -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

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" $
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