commence product pages

matebeamter.cabal

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

src/API.hs

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

src/Control.hs

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

src/Control/Product.hs

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

src/Types/Views.hs

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

src/View.hs

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

src/View/Product.hs

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