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

25
Handler/Modify.hs
View file

@ -27,7 +27,7 @@ getModifyR bId =
let bs = map (barcodeCode . entityVal) rawbs
(modifyWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifyForm bev bs
$ modifyForm (Just bev) bs
defaultLayout $
$(widgetFile "modify")
)
@ -39,7 +39,7 @@ postModifyR bId =
let bs = map (barcodeCode . entityVal) rawbs
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifyForm bev bs
$ modifyForm (Just bev) bs
case res of
FormSuccess nBev -> do
runDB $ update bId
@ -79,8 +79,8 @@ data ModBev = ModBev
, modBevArtNr :: Maybe Text
}
modifyForm :: Beverage -> [Text] -> AForm Handler ModBev
modifyForm bev bs = ModBev
modifyForm :: Maybe Beverage -> [Text] -> AForm Handler ModBev
modifyForm (Just bev) bs = ModBev
<$> areq textField (bfs MsgName) (Just $ beverageIdent bev)
<*> areq currencyField (bfs MsgPrice) (Just $ beveragePrice bev)
<*> areq amountField (bfs MsgCurrentStock) (Just $ beverageAmount bev)
@ -97,6 +97,23 @@ modifyForm bev bs = ModBev
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)
where
avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent
sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent
getDeleteBeverageR :: BeverageId -> Handler Html
getDeleteBeverageR bId =

41
Handler/Restock.hs
View file

@ -17,6 +17,7 @@ module Handler.Restock where
import Import
import Handler.Common
import Handler.Modify
import Data.Maybe (fromJust)
getRestockR :: Handler Html
@ -70,38 +71,32 @@ upstockForm = UpstockAmount
getNewArticleR :: Handler Html
getNewArticleR = do
(newArticleWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm newArticleForm
$ renderBootstrap3 BootstrapBasicForm $ modifyForm Nothing []
defaultLayout $
$(widgetFile "newArticle")
postNewArticleR :: Handler Html
postNewArticleR = do
((result, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm newArticleForm
$ renderBootstrap3 BootstrapBasicForm $ modifyForm Nothing []
case result of
FormSuccess bev -> do
runDB $ insert_ bev
FormSuccess nBev -> do
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
redirect RestockR
_ -> do
setMessageI MsgItemNotAdded
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