matebeamter/src/View/Product.hs

153 lines
4.8 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
module View.Product where
import Servant.Links
import Data.String (fromString)
import qualified Data.Text as T
import Data.Text.I18n
import Data.Maybe (fromJust, isJust)
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]
-> 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 :: T.Text) <> " ml")
H.td (H.toHtml $ (formatMoney price)) -- TODO: Add Currency symbol
)
list
where
translate = localize l10n loc . gettext
productRefillPage
:: L10n
-> Locale
-> Maybe T.Text
-> [MT.ProductShortOverview]
-> ProductRefillPage
productRefillPage l10n loc mcookie prodList =
scaffold l10n loc mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Refill stock"
) $ do
H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString
(show $ linkURI productPostRefillLink)
)
H.! HA.enctype "application/x-www-form-urlencoded"
$ do
mapM_
(\(MT.ProductShortOverview pid ident price amount ml maid) -> do
H.div
H.! HA.class_ "form-group optional"
H.!?
( isJust maid
, productBgStyle (fromString $ show $ fromJust maid)
)
$ do
H.label
H.! HA.for (
"amount-refill-product-id-" <>
fromString (show pid)
)
$ H.toHtml ident
H.input
H.! HA.id (
"amount-refill-product-id-" <>
fromString (show pid)
)
H.! HA.class_ "form-control product-select"
H.! HA.name (
"amountRefillProductId-" <>
fromString (show pid)
)
H.! HA.type_ "checkbox"
H.! HA.value "true"
H.div
H.! HA.class_ "form-group optional"
$ do
H.label
H.! HA.for (
"amount-refill-amount-singeles-" <>
fromString (show pid)
)
$ H.toHtml (translate "Amount")
H.input
H.! HA.id (
"amount-refill-amount-singles-" <>
fromString (show pid)
)
H.! HA.class_ "form-control product-amount"
H.! HA.name (
"amountRefillAmountSingles- " <>
fromString (show pid)
)
H.! HA.type_ "number"
H.! HA.min "0"
H.! HA.step "1"
H.! HA.value "0"
H.input
H.! HA.id (
"amount-refill-amount-crates-" <>
fromString (show pid)
)
H.! HA.class_ "form-control product-amount"
H.! HA.name (
"amountRefillAmountCrates- " <>
fromString (show pid)
)
H.! HA.type_ "number"
H.! HA.min "0"
H.! HA.step "1"
H.! HA.value "0"
)
prodList
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
where
translate = localize l10n loc . gettext