Merge pull request #89 from astro/demand

we demand extended measures, this time without public shaming
This commit is contained in:
rys ostrovid 2016-03-18 22:17:37 +01:00
commit cc29424057
7 changed files with 41 additions and 2 deletions

View file

@ -55,6 +55,7 @@ import Handler.Barcode
import Handler.Transfer import Handler.Transfer
import Handler.Supplier import Handler.Supplier
import Handler.SupplierActions import Handler.SupplierActions
import Handler.Demand
-- This line actually creates our YesodDispatch instance. It is the second half -- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

View file

@ -64,8 +64,12 @@ postBuyR uId bId = do
setMessageI MsgPurchaseSuccess setMessageI MsgPurchaseSuccess
redirect HomeR redirect HomeR
True -> do True -> do
setMessageI MsgPurchaseDebtful let level = case userBalance user - price of
redirect HomeR balance
| balance <= -5000 -> 3
| balance <= -1000 -> 2
| otherwise -> 1
redirect $ DemandR level
_ -> do _ -> do
setMessageI MsgErrorOccured setMessageI MsgErrorOccured
redirect HomeR redirect HomeR

22
Handler/Demand.hs Normal file
View file

@ -0,0 +1,22 @@
-- yammat - Yet Another MateMAT
-- Copyright (C) 2015 Amedeo Molnár, Astro
--
-- 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/>.
module Handler.Demand where
import Import
getDemandR :: Int -> Handler Html
getDemandR level = defaultLayout $ do
$(widgetFile "demand")

View file

@ -43,3 +43,4 @@
/supply/#SupplierId/modify ModifySupplierR GET POST /supply/#SupplierId/modify ModifySupplierR GET POST
/supply/#SupplierId/digest SupplierDigestR GET /supply/#SupplierId/digest SupplierDigestR GET
/supply/#SupplierId/delete DeleteSupplierR GET /supply/#SupplierId/delete DeleteSupplierR GET
/demand/#Int DemandR GET

View file

@ -275,3 +275,9 @@ input[type], button {
#barcodeContent { #barcodeContent {
text-align: center; text-align: center;
} }
#demand-warning {
color: red;
font-weight: bold;
font-size: 150%;
}

4
templates/demand.hamlet Normal file
View file

@ -0,0 +1,4 @@
$doctype 5
<p #demand-warning>
_{MsgPurchaseDebtful}

View file

@ -39,6 +39,7 @@ library
Handler.Transfer Handler.Transfer
Handler.Supplier Handler.Supplier
Handler.SupplierActions Handler.SupplierActions
Handler.Demand
if flag(dev) || flag(library-only) if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT -DHTTP_CLIENT cpp-options: -DDEVELOPMENT -DHTTP_CLIENT