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

united beverage creation and modification

Browse source
This commit is contained in:
nek0 2016-07-21 17:09:03 +02:00
parent cb54edf1c8
commit a39db41d8e
2 changed files with 50 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
Handler/Modify.hs
View file

@ -27,7 +27,7 @@ getModifyR bId =
let bs = map (barcodeCode . entityVal) rawbs let bs = map (barcodeCode . entityVal) rawbs
(modifyWidget, enctype) <- generateFormPost (modifyWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm $ renderBootstrap3 BootstrapBasicForm
$ modifyForm bev bs $ modifyForm (Just bev) bs
defaultLayout $ defaultLayout $
$(widgetFile "modify") $(widgetFile "modify")
) )
@ -39,7 +39,7 @@ postModifyR bId =
let bs = map (barcodeCode . entityVal) rawbs let bs = map (barcodeCode . entityVal) rawbs
((res, _), _) <- runFormPost ((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm $ renderBootstrap3 BootstrapBasicForm
$ modifyForm bev bs $ modifyForm (Just bev) bs
case res of case res of
FormSuccess nBev -> do FormSuccess nBev -> do
runDB $ update bId runDB $ update bId
@ -79,20 +79,37 @@ data ModBev = ModBev
, modBevArtNr :: Maybe Text , modBevArtNr :: Maybe Text
} }
modifyForm :: Beverage -> [Text] -> AForm Handler ModBev modifyForm :: Maybe Beverage -> [Text] -> AForm Handler ModBev
modifyForm bev bs = ModBev modifyForm (Just bev) bs = ModBev
<$> areq textField (bfs MsgName) (Just $ beverageIdent bev) <$> areq textField (bfs MsgName) (Just $ beverageIdent bev)
<*> areq currencyField (bfs MsgPrice) (Just $ beveragePrice bev) <*> areq currencyField (bfs MsgPrice) (Just $ beveragePrice bev)
<*> areq amountField (bfs MsgCurrentStock) (Just $ beverageAmount bev) <*> areq amountField (bfs MsgCurrentStock) (Just $ beverageAmount bev)
<*> areq amountField (bfs MsgAnnouncedStock) (Just $ beverageAlertAmount bev) <*> areq amountField (bfs MsgAnnouncedStock) (Just $ beverageAlertAmount bev)
<*> areq amountField (bfs MsgMaxAmount) (Just $ beverageMaxAmount bev) <*> areq amountField (bfs MsgMaxAmount) (Just $ beverageMaxAmount bev)
<*> areq volumeField (bfs MsgVolume) (Just $ beverageMl bev) <*> areq volumeField (bfs MsgVolume) (Just $ beverageMl bev)
<*> aopt amountField (bfs MsgAmountPerCrate) (Just $ beveragePerCrate bev) <*> aopt amountField (bfs MsgAmountPerCrate) (Just $ beveragePerCrate bev)
<*> aopt currencyField (bfs MsgPricePerCrate) (Just $ beveragePricePerCrate bev) <*> aopt currencyField (bfs MsgPricePerCrate) (Just $ beveragePricePerCrate bev)
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ beverageAvatar bev) <*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ beverageAvatar bev)
<*> aopt barcodeField (bfs MsgBarcodeField) (Just $ Just bs) <*> aopt barcodeField (bfs MsgBarcodeField) (Just $ Just bs)
<*> aopt (selectField sups) (bfs MsgSelectSupplier) (Just $ beverageSupplier bev) <*> aopt (selectField sups) (bfs MsgSelectSupplier) (Just $ beverageSupplier bev)
<*> aopt textField (bfs MsgArtNr) (Just $ beverageArtNr bev) <*> aopt textField (bfs MsgArtNr) (Just $ beverageArtNr bev)
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where
avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent
sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent
modifyForm Nothing _ = ModBev
<$> areq textField (bfs MsgName) Nothing
<*> areq currencyField (bfs MsgPrice) Nothing
<*> areq amountField (bfs MsgCurrentStock) Nothing
<*> areq amountField (bfs MsgAnnouncedStock) Nothing
<*> areq amountField (bfs MsgMaxAmount) Nothing
<*> areq volumeField (bfs MsgVolume) Nothing
<*> aopt amountField (bfs MsgAmountPerCrate) Nothing
<*> aopt currencyField (bfs MsgPricePerCrate) Nothing
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<*> aopt barcodeField (bfs MsgBarcodeField) Nothing
<*> aopt (selectField sups) (bfs MsgSelectSupplier) Nothing
<*> aopt textField (bfs MsgArtNr) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit) <* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where where
avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent

41
Handler/Restock.hs
View file

@ -17,6 +17,7 @@ module Handler.Restock where
import Import import Import
import Handler.Common import Handler.Common
import Handler.Modify
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
getRestockR :: Handler Html getRestockR :: Handler Html
@ -70,38 +71,32 @@ upstockForm = UpstockAmount
getNewArticleR :: Handler Html getNewArticleR :: Handler Html
getNewArticleR = do getNewArticleR = do
(newArticleWidget, enctype) <- generateFormPost (newArticleWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm newArticleForm $ renderBootstrap3 BootstrapBasicForm $ modifyForm Nothing []
defaultLayout $ defaultLayout $
$(widgetFile "newArticle") $(widgetFile "newArticle")
postNewArticleR :: Handler Html postNewArticleR :: Handler Html
postNewArticleR = do postNewArticleR = do
((result, _), _) <- runFormPost ((result, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm newArticleForm $ renderBootstrap3 BootstrapBasicForm $ modifyForm Nothing []
case result of case result of
FormSuccess bev -> do FormSuccess nBev -> do
runDB $ insert_ bev bId <- runDB $ insert $ Beverage
(modBevIdent nBev)
(modBevPrice nBev)
(modBevAmount nBev)
(modBevAlertAmount nBev)
0
(modBevMl nBev)
(modBevAvatar nBev)
(modBevSupp nBev)
(modBevMaxAmount nBev)
(modBevPC nBev)
(modBevArtNr nBev)
(modBevPricePC nBev)
handleBarcodes (Right bId) (fromMaybe [] $ modBevBarcodes nBev)
setMessageI MsgItemAdded setMessageI MsgItemAdded
redirect RestockR redirect RestockR
_ -> do _ -> do
setMessageI MsgItemNotAdded setMessageI MsgItemNotAdded
redirect RestockR redirect RestockR
newArticleForm :: AForm Handler Beverage
newArticleForm = (\a b c d e f g h i j k l -> Beverage a b c d e i j k f g l h)
<$> areq textField (bfs MsgName) Nothing
<*> areq currencyField (bfs MsgPrice) (Just 100)
<*> areq amountField (bfs MsgAmount) (Just 0)
<*> areq amountField (bfs MsgAmountWarning) (Just 0)
<*> pure 0
<*> areq amountField (bfs MsgMaxAmount) (Just 200)
<*> aopt amountField (bfs MsgAmountPerCrate) (Just $ Just 20)
<*> aopt currencyField (bfs MsgPricePerCrate) Nothing
<*> areq volumeField (bfs MsgVolume) (Just 500)
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<*> aopt (selectField sups) (bfs MsgSelectSupplier) Nothing
<*> aopt textField (bfs MsgArtNr) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where
avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent
sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent