nek0/matebeamter
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

fix product refill and add new product creation

Browse source
This commit is contained in:
nek0 2019-12-19 02:43:10 +01:00
parent ad0a795ff0
commit 31f6665fee
10 changed files with 213 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
matebeamter.cabal
View file

@ -30,6 +30,7 @@ executable matebeamter
, Types.Views
, Types.User
, Types.Journal
, Types.Product
, Types.Orphans
, Types.Configuration
, Control

44
src/Control/Product.hs
View file

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

2
src/Main.hs
View file

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

1
src/Types.hs
View file

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

11
src/Types/Orphans.hs
View file

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

17
src/Types/Product.hs
View file

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

2
src/Types/Views.hs
View file

@ -30,4 +30,4 @@ type ProductPriceListPage = H.Html
type ProductRefillPage = H.Html
type productNewPage = H.Html
type ProductNewPage = H.Html

18
src/View/Buy.hs
View file

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

131
src/View/Product.hs
View file

@ -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-" <>
@ -127,6 +127,12 @@ productRefillPage l10n loc mcookie prodList =
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-" <>
@ -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

6
src/View/User.hs
View file

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