From 12ce0e41e50acaf01eb520114915bcdf3afd1e23 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Sat, 14 Dec 2019 08:34:01 +0100
Subject: [PATCH] add the roice list on the user select page

---
 src/API.hs             |  4 ++--
 src/Control/Product.hs |  9 ++++++++-
 src/Main.hs            |  1 +
 src/View/Product.hs    | 12 +++++++-----
 src/View/Scaffold.hs   |  9 +++++++++
 5 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/src/API.hs b/src/API.hs
index e41d453..0dda5e1 100644
--- a/src/API.hs
+++ b/src/API.hs
@@ -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
diff --git a/src/Control/Product.hs b/src/Control/Product.hs
index 905f37e..f1f59e7 100644
--- a/src/Control/Product.hs
+++ b/src/Control/Product.hs
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
index 6aafaf6..4ff7b9c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -85,6 +85,7 @@ userApp initState = serveWithContext userApi EmptyContext $
     :<|> journalControl mcookie
     :<|> journalGetCheckControl mcookie
     :<|> journalPostCheckControl mcookie
+    :<|> productGetPriceList mcookie
     :<|> authControl mcookie
     :<|> authPostControl mcookie
     :<|> authLogoutControl mcookie
diff --git a/src/View/Product.hs b/src/View/Product.hs
index 7615948..e8c4559 100644
--- a/src/View/Product.hs
+++ b/src/View/Product.hs
@@ -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
diff --git a/src/View/Scaffold.hs b/src/View/Scaffold.hs
index 518e2ec..e79c9de 100644
--- a/src/View/Scaffold.hs
+++ b/src/View/Scaffold.hs
@@ -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