we demand extended measures

This commit is contained in:
Astro 2016-01-24 01:27:58 +01:00
parent 4c2c09bdfa
commit a5b2dca922
10 changed files with 48 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

@ -61,8 +61,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

26
Handler/Demand.hs Normal file
View File

@ -0,0 +1,26 @@
-- 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
let audio = lookup level $ [1..] `zip` map StaticR
[audio_air_alarm_mp3,
audio_nuclear_alarm_mp3,
audio_alarm_loud_pulsating_mp3]
$(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

BIN
static/audio/air-alarm.mp3 Normal file

Binary file not shown.

Binary file not shown.

Binary file not shown.

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%;
}

7
templates/demand.hamlet Normal file
View File

@ -0,0 +1,7 @@
$doctype 5
<p #demand-warning>
_{MsgPurchaseDebtful}
$maybe src <- audio
<audio src=@{src} autoplay style="display:hidden">

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