yammat/Handler/Restock.hs

97 lines
3.1 KiB
Haskell
Raw Normal View History

2015-08-09 19:16:33 +00:00
-- yammat - Yet Another MateMAT
-- Copyright (C) 2015 Amedeo Molnár
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
2015-04-04 04:46:33 +00:00
module Handler.Restock where
import Import
import Handler.Common
getRestockR :: Handler Html
getRestockR = do
2015-04-09 11:47:27 +00:00
beverages <- runDB $ selectList [] [Asc BeverageIdent]
2015-04-04 04:46:33 +00:00
defaultLayout $ do
$(widgetFile "restock")
getUpstockR :: BeverageId -> Handler Html
getUpstockR bId = do
mBev <- runDB $ get bId
case mBev of
Just bev -> do
(upstockWidget, enctype) <- generateFormPost upstockForm
defaultLayout $ do
$(widgetFile "upstock")
Nothing -> do
2015-04-09 22:40:58 +00:00
setMessageI MsgItemUnknown
2015-04-04 04:46:33 +00:00
redirect $ HomeR
postUpstockR :: BeverageId -> Handler Html
postUpstockR bId = do
mBev <- runDB $ get bId
case mBev of
Just bev -> do
((res, _), _) <- runFormPost upstockForm
case res of
FormSuccess c -> do
case c > 0 of
True -> do
runDB $ update bId [BeverageAmount +=. c]
2015-04-09 22:40:58 +00:00
setMessageI MsgStockedUp
2015-04-04 04:46:33 +00:00
redirect $ HomeR
False -> do
2015-04-09 22:40:58 +00:00
setMessageI MsgNotStockedUp
2015-04-04 04:46:33 +00:00
redirect $ UpstockR bId
_ -> do
2015-04-09 22:40:58 +00:00
setMessageI MsgStockupError
2015-04-04 04:46:33 +00:00
redirect $ UpstockR bId
Nothing -> do
2015-04-09 22:40:58 +00:00
setMessageI MsgItemUnknown
2015-04-04 04:46:33 +00:00
redirect $ HomeR
upstockForm :: Form Int
upstockForm = renderDivs
2015-04-13 12:09:47 +00:00
$ areq amountField (fieldSettingsLabel MsgAmountAdded) (Just 1)
2015-04-04 04:46:33 +00:00
getNewArticleR :: Handler Html
getNewArticleR = do
(newArticleWidget, enctype) <- generateFormPost newArticleForm
defaultLayout $ do
$(widgetFile "newArticle")
postNewArticleR :: Handler Html
postNewArticleR = do
((result, _), _) <- runFormPost newArticleForm
case result of
FormSuccess bev -> do
runDB $ insert_ bev
2015-04-09 22:40:58 +00:00
setMessageI MsgItemAdded
2015-04-04 04:46:33 +00:00
redirect $ HomeR
_ -> do
2015-04-09 22:40:58 +00:00
setMessageI MsgItemNotAdded
2015-04-04 04:46:33 +00:00
redirect $ HomeR
newArticleForm :: Form Beverage
newArticleForm = renderDivs $ Beverage
2015-04-09 22:40:58 +00:00
<$> areq textField (fieldSettingsLabel MsgName) Nothing
<*> areq currencyField (fieldSettingsLabel MsgPrice) (Just 100)
<*> areq amountField (fieldSettingsLabel MsgAmount) (Just 0)
<*> areq amountField (fieldSettingsLabel MsgAmountWarning) (Just 0)
2015-05-19 03:37:22 +00:00
<*> pure 0
2015-05-03 16:01:30 +00:00
<*> areq volumeField (fieldSettingsLabel MsgVolume) (Just 500)
2015-04-16 00:51:08 +00:00
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing
2015-04-16 00:12:03 +00:00
where
2015-04-16 00:51:08 +00:00
avatars = do
2015-04-16 00:12:03 +00:00
ents <- runDB $ selectList [] [Asc AvatarIdent]
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents