commence product pages

This commit is contained in:
nek0 2019-12-13 23:46:50 +01:00
parent eed646a2f3
commit d52fbdc638
7 changed files with 99 additions and 0 deletions

View file

@ -37,12 +37,14 @@ executable matebeamter
, Control.User , Control.User
, Control.Buy , Control.Buy
, Control.Journal , Control.Journal
, Control.Product
, View , View
, View.Scaffold , View.Scaffold
, View.Auth , View.Auth
, View.User , View.User
, View.Buy , View.Buy
, View.Journal , View.Journal
, View.Product
-- other-extensions: -- other-extensions:
build-depends: base ^>=4.12.0.0 build-depends: base ^>=4.12.0.0
, mateamt , mateamt

View file

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

View file

@ -6,3 +6,4 @@ import Control.Auth as C
import Control.User as C import Control.User as C
import Control.Buy as C import Control.Buy as C
import Control.Journal as C import Control.Journal as C
import Control.Product as C

37
src/Control/Product.hs Normal file
View file

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

View file

@ -25,3 +25,5 @@ type JournalCheckPage = H.Html
type CashBuyOverviewPage = H.Html type CashBuyOverviewPage = H.Html
type CashBuyConfirmPage = H.Html type CashBuyConfirmPage = H.Html
type ProductPriceListPage = H.Html

View file

@ -6,3 +6,4 @@ import View.Auth as V
import View.User as V import View.User as V
import View.Buy as V import View.Buy as V
import View.Journal as V import View.Journal as V
import View.Product as V

53
src/View/Product.hs Normal file
View file

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