From 31f6665feeea311ffd492dffbea91dffa699bfd6 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 19 Dec 2019 02:43:10 +0100 Subject: [PATCH] fix product refill and add new product creation --- matebeamter.cabal | 1 + src/Control/Product.hs | 44 +++++++++++++- src/Main.hs | 2 + src/Types.hs | 1 + src/Types/Orphans.hs | 11 +++- src/Types/Product.hs | 17 ++++-- src/Types/Views.hs | 2 +- src/View/Buy.hs | 18 +++--- src/View/Product.hs | 135 +++++++++++++++++++++++++++++++++++++++-- src/View/User.hs | 6 ++ 10 files changed, 213 insertions(+), 24 deletions(-) diff --git a/matebeamter.cabal b/matebeamter.cabal index 9168064..450c59d 100644 --- a/matebeamter.cabal +++ b/matebeamter.cabal @@ -30,6 +30,7 @@ executable matebeamter , Types.Views , Types.User , Types.Journal + , Types.Product , Types.Orphans , Types.Configuration , Control diff --git a/src/Control/Product.hs b/src/Control/Product.hs index b2c8165..db00c92 100644 --- a/src/Control/Product.hs +++ b/src/Control/Product.hs @@ -95,4 +95,46 @@ productPostRefill mcookie refills = do productGetNew :: Maybe T.Text -> UserHandler ProductNewPage -productgetNew mcookie = do +productGetNew mcookie = do + (token, muser, loc, l10n, backend) <- controlInit mcookie + case muser of + Just user -> + -- TODO: Fetch avatars and suppliers + return $ productNewPage l10n loc mcookie + Nothing -> + redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing + +productPostNew + :: Maybe T.Text + -> ProductSubmit + -> UserHandler ProductNewPage +productPostNew mcookie (ProductSubmit ident flPrice ml max apc ppc artnr) = do + (token, muser, loc, l10n, backend) <- controlInit mcookie + case muser of + Just user -> do + eresult <- liftIO $ runClientM + (productNew + (mkAuthenticatedRequest token authenticateReq) + (MT.ProductSubmit + ident + (floor $ flPrice * 100) + ml + -- TODO: repleace following two values with real avatar and supplier + Nothing + Nothing + max + apc + (floor <$> fmap (* 100) ppc) + artnr + ) + ) + backend + case eresult of + Right _ -> + throwError $ + addMessage (translate l10n loc "Product created successfully") $ + redirect303 (userOverviewLink (read user) Nothing) + Nothing -> + redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing + where + translate l10n loc = localize l10n loc . gettext diff --git a/src/Main.hs b/src/Main.hs index 39a9fe5..3f40b69 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -88,6 +88,8 @@ userApp initState = serveWithContext userApi EmptyContext $ :<|> productGetPriceList mcookie :<|> productGetRefill mcookie :<|> productPostRefill mcookie + :<|> productGetNew mcookie + :<|> productPostNew mcookie :<|> authControl mcookie :<|> authPostControl mcookie :<|> authLogoutControl mcookie diff --git a/src/Types.hs b/src/Types.hs index 01a99fe..e2bf0b3 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -8,5 +8,6 @@ import Types.Reader as T import Types.Views as T import Types.User as T import Types.Journal as T +import Types.Product as T import Types.Orphans as T import Types.Configuration as T diff --git a/src/Types/Orphans.hs b/src/Types/Orphans.hs index 866fd97..b9df897 100644 --- a/src/Types/Orphans.hs +++ b/src/Types/Orphans.hs @@ -16,6 +16,8 @@ import Web.Internal.FormUrlEncoded import qualified Data.Text as T import Data.Maybe (fromJust) +import Debug.Trace + instance MimeUnrender HTML MT.UserSubmit instance FromForm MT.UserSubmit @@ -45,7 +47,7 @@ instance FromForm [MT.AmountRefill] where fromForm form = let kvs = toListStable form ks = map fst kvs - kpids = filter ("amountRefillproductId" `T.isPrefixOf`) ks + kpids = filter ("amountRefillProductId" `T.isPrefixOf`) ks prods = filter ((`notElem` kpids) . fst) kvs stripPid = snd . T.breakOnEnd "-" digestForm key = @@ -56,7 +58,10 @@ instance FromForm [MT.AmountRefill] where amountCrates = read (T.unpack . fromJust $ lookup ("amountRefillAmountCrates-" <> stripPid key) prods) - in MT.AmountRefill pid amountSingles amountCrates - res = map digestForm kpids + in MT.AmountRefill + (trace (show pid) pid) + (trace (show amountSingles) amountSingles) + (trace (show amountCrates) amountCrates) + res = map digestForm (trace (show kvs) kpids) in Right res diff --git a/src/Types/Product.hs b/src/Types/Product.hs index 78f5ab8..243f32d 100644 --- a/src/Types/Product.hs +++ b/src/Types/Product.hs @@ -1,19 +1,28 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Types.Product where import GHC.Generics +import Servant.API +import Servant.HTML.Blaze +import Web.Internal.FormUrlEncoded + import qualified Data.Text as T data ProductSubmit = ProductSubmit { productSubmitIdent :: T.Text - , productSubmitPrice :: Int + , productSubmitPrice :: Float , productSubmitMl :: Int - , productSubmitAvatar :: Maybe Int - , productSubmitSupplier :: Maybe Int + -- TODO: Create and manage suppliers and avatars + -- , productSubmitAvatar :: Maybe Int + -- , productSubmitSupplier :: Maybe Int , productSubmitMaxAmount :: Int , productSubmitAmountPerCrate :: Int - , productSubmitPricePerCrate :: Maybe Int + , productSubmitPricePerCrate :: Maybe Float , productSubmitArtNr :: Maybe T.Text } deriving (Generic, Show) + +instance MimeUnrender HTML ProductSubmit +instance FromForm ProductSubmit diff --git a/src/Types/Views.hs b/src/Types/Views.hs index 5539915..70e16f1 100644 --- a/src/Types/Views.hs +++ b/src/Types/Views.hs @@ -30,4 +30,4 @@ type ProductPriceListPage = H.Html type ProductRefillPage = H.Html -type productNewPage = H.Html +type ProductNewPage = H.Html diff --git a/src/View/Buy.hs b/src/View/Buy.hs index 72eecf2..fd65366 100644 --- a/src/View/Buy.hs +++ b/src/View/Buy.hs @@ -89,15 +89,15 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie = H.! HA.for ("product-total-" <> fromString (show pid)) $ H.toHtml $ " @ " <> formatMoney price <> "€" -- TODO: ask for currency symbol - H.input - H.! HA.id ("product-total-" <> fromString (show pid)) - H.! HA.class_ "form-control" - H.! HA.name ("productTotal-" <> fromString (show pid)) - H.! HA.type_ "text" - H.! HA.value - (fromString $ T.unpack $ formatMoney $ amount * price) - H.! HA.disabled "" - H.toHtml ("€" :: T.Text) -- TODO: ask for currency symbol + -- H.input + -- H.! HA.id ("product-total-" <> fromString (show pid)) + -- H.! HA.class_ "form-control" + -- H.! HA.name ("productTotal-" <> fromString (show pid)) + -- H.! HA.type_ "text" + -- H.! HA.value + -- (fromString $ T.unpack $ formatMoney $ amount * price) + -- H.! HA.disabled "" + -- H.toHtml ("€" :: T.Text) -- TODO: ask for currency symbol ) ziptups H.div H.! HA.class_ "form-group required" $ do diff --git a/src/View/Product.hs b/src/View/Product.hs index c34cf5f..90a3a1c 100644 --- a/src/View/Product.hs +++ b/src/View/Product.hs @@ -69,7 +69,7 @@ productRefillPage l10n loc mcookie prodList = translate "Matebeamter" <> " - " <> translate "Refill stock" - ) $ do + ) $ H.form H.! HA.method "post" H.! HA.action ("/" <> fromString @@ -112,7 +112,7 @@ productRefillPage l10n loc mcookie prodList = "amount-refill-amount-singeles-" <> fromString (show pid) ) - $ H.toHtml (translate "Amount") + $ H.toHtml (translate "Amount of single items") H.input H.! HA.id ( "amount-refill-amount-singles-" <> @@ -120,13 +120,19 @@ productRefillPage l10n loc mcookie prodList = ) H.! HA.class_ "form-control product-amount" H.! HA.name ( - "amountRefillAmountSingles- " <> + "amountRefillAmountSingles-" <> fromString (show pid) ) H.! HA.type_ "number" H.! HA.min "0" H.! HA.step "1" H.! HA.value "0" + H.label + H.! HA.for ( + "amount-refill-amount-crates-" <> + fromString (show pid) + ) + $ H.toHtml (translate "Amount of full crates") H.input H.! HA.id ( "amount-refill-amount-crates-" <> @@ -134,7 +140,7 @@ productRefillPage l10n loc mcookie prodList = ) H.! HA.class_ "form-control product-amount" H.! HA.name ( - "amountRefillAmountCrates- " <> + "amountRefillAmountCrates-" <> fromString (show pid) ) H.! HA.type_ "number" @@ -156,11 +162,128 @@ productNewPage -> Locale -> Maybe T.Text -> ProductNewPage -productnewPage l10n loc mcookie = +productNewPage l10n loc mcookie = scaffold l10n loc mcookie (initPage $ translate "Matebeamter" <> " - " <> translate "Create new product" - ) $ do + ) $ + H.form + H.! HA.method "post" + H.! HA.action ("/" <> fromString + (show $ linkURI productPostNewLink) + ) + H.! HA.enctype "application/x-www-form-urlencoded" + $ do + H.div H.! HA.class_ "form-group required" $ do + H.label H.! HA.for "ident" $ H.toHtml $ translate "Product name" + H.input + H.! HA.id "ident" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitIdent" + H.! HA.type_ "text" + H.! HA.value "" + H.! HA.required "" + H.div H.! HA.class_ "form-group required" $ do + H.label H.! HA.for "price" $ H.toHtml $ translate "Product price" + H.input + H.! HA.id "price" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitPrice" + H.! HA.type_ "number" + H.! HA.min "0" + H.! HA.step "0.01" + H.! HA.value "0" + H.! HA.required "" + H.div H.! HA.class_ "form-group required" $ do + H.label H.! HA.for "ml" $ H.toHtml $ + translate "Product volume in ml" + H.input + H.! HA.id "ml" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitMl" + H.! HA.type_ "number" + H.! HA.min "0" + H.! HA.step "1" + H.! HA.value "0" + H.! HA.required "" + H.div H.! HA.class_ "form-group required" $ do + H.label H.! HA.for "max-amount" $ H.toHtml $ + translate "Product maximum stock amount" + H.input + H.! HA.id "max-amount" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitMaxAmount" + H.! HA.type_ "number" + H.! HA.min "0" + H.! HA.step "1" + H.! HA.value "0" + H.! HA.required "" + H.div H.! HA.class_ "form-group required" $ do + H.label H.! HA.for "amount-per-crate" $ H.toHtml $ + translate "Product amount per crate" + H.input + H.! HA.id "amount-per-crate" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitAmountPerCrate" + H.! HA.type_ "number" + H.! HA.min "0" + H.! HA.step "1" + H.! HA.value "0" + H.! HA.required "" + H.div H.! HA.class_ "form-group optional" $ do + H.label H.! HA.for "price-per-crate" $ H.toHtml $ + translate "Product price per crate" + H.input + H.! HA.id "price-per-crate" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitPricePerCrate" + H.! HA.type_ "number" + H.! HA.min "0" + H.! HA.step "0.01" + H.! HA.value "0" + H.div H.! HA.class_ "form-group optional" $ do + H.label H.! HA.for "article-number" $ H.toHtml $ + translate "Product article number" + H.input + H.! HA.id "article-number" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitArtNr" + H.! HA.type_ "text" + H.! HA.value "" + H.! HA.required "" + {- -- TODO: Create and manage suppliers and avatars + H.div H.! HA.class_ "form-group optional" $ do + H.label H.! HA.for "supplier" $ H.toHtml $ + translate "Product supplier" + H.select + H.! HA.id "supplier" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitSupplier" + $ do + H.option + H.! HA.value "" + H.! HA.selected "" + $ toHtml $ translate "None" + -- TODO: FILL ME! + H.div H.! HA.class_ "form-group optional" $ do + H.label H.! HA.for "avatar" $ H.toHtml $ + translate "Product avater" + H.select + H.! HA.id "avatar" + H.! HA.class_ "form-control" + H.! HA.name "productSubmitAvatar" + $ do + H.option + H.! HA.value "" + H.! HA.selected "" + $ toHtml $ translate "None" + -- TODO: FILL ME! + -} + 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 diff --git a/src/View/User.hs b/src/View/User.hs index 4a9c290..aeeece7 100644 --- a/src/View/User.hs +++ b/src/View/User.hs @@ -130,6 +130,12 @@ userSettingsPointer l10n locale uid = H.! HA.formaction ("/" <> fromString (show $ linkURI $ journalLink Nothing)) $ H.toHtml $ translate "View Journal" + H.button + H.! HA.type_ "submit" + H.! HA.formmethod "get" + H.! HA.formaction + ("/" <> fromString (show $ linkURI productGetNewLink)) + $ H.toHtml $ translate "Add new product" where translate = localize l10n locale . gettext