cleanup and enabling barcodes for cash payment

This commit is contained in:
nek0 2015-07-21 11:37:43 +02:00
parent b6ee74b0a5
commit 73c1acd368
3 changed files with 49 additions and 33 deletions

View file

@ -1,36 +1,45 @@
module Handler.Barcode where module Handler.Barcode where
import Import import Import
import Handler.Common
import qualified Data.Text as T
getHomeBarcodeR :: Handler Html getHomeBarcodeR :: Handler Html
getHomeBarcodeR = do getHomeBarcodeR = do
c <- lookupGetParam "barcode" eub <- handleSelectParam
case c of case eub of
Just code -> do Just (Left uId) -> do
be <- runDB $ getBy $ UniqueBarcode code redirect $ SelectR uId
case be of Just (Right _) -> do
Just (Entity _ bar) -> do setMessageI MsgBarcodeNotUser
case barcodeIsUser bar of redirect $ HomeR
True -> do
case barcodeUser bar of
Just uId -> do
redirect $ SelectR uId
Nothing -> do
error "Malformed barcode"
False -> do
setMessageI MsgBarcodeNotUser
redirect HomeR
Nothing -> do
setMessageI MsgBarcodeUnknown
redirect HomeR
Nothing -> do Nothing -> do
setMessageI MsgProvideBarcode redirect $ HomeR
redirect HomeR
getSelectBarcodeR :: UserId -> Handler Html getSelectBarcodeR :: UserId -> Handler Html
getSelectBarcodeR uId = do getSelectBarcodeR uId = do
eub <- handleSelectParam
case eub of
Just (Right bId) -> do
redirect $ BuyR uId bId
Just (Left _) -> do
setMessageI MsgBarcodeNotBev
redirect $ SelectR uId
Nothing ->
redirect $ SelectR uId
getSelectCashBarcodeR :: Handler Html
getSelectCashBarcodeR = do
eub <- handleSelectParam
case eub of
Just (Right bId) -> do
redirect $ BuyCashR bId
Just (Left _) -> do
setMessageI MsgBarcodeNotBev
redirect $ SelectCashR
Nothing -> do
redirect $ SelectCashR
handleSelectParam :: Handler (Maybe (Either UserId BeverageId))
handleSelectParam = do
c <- lookupGetParam "barcode" c <- lookupGetParam "barcode"
case c of case c of
Just code -> do Just code -> do
@ -38,18 +47,21 @@ getSelectBarcodeR uId = do
case be of case be of
Just (Entity _ bar) -> do Just (Entity _ bar) -> do
case barcodeIsUser bar of case barcodeIsUser bar of
False -> do
case barcodeBev bar of
Just bId -> do
redirect $ BuyR uId bId
Nothing -> do
error "Malformed barcode"
True -> do True -> do
setMessageI MsgBarcodeNotBev case (barcodeUser bar, barcodeBev bar) of
redirect $ SelectR uId (Just uId, Nothing) ->
return $ Just $ Left uId
_ ->
error "Malformed barcode"
False -> do
case (barcodeBev bar, barcodeUser bar) of
(Just bId, Nothing) ->
return $ Just $ Right bId
_ ->
error "Malformed barcode"
Nothing -> do Nothing -> do
setMessageI MsgBarcodeUnknown setMessageI MsgBarcodeUnknown
redirect $ SelectR uId return Nothing
Nothing -> do Nothing -> do
setMessageI MsgProvideBarcode setMessageI MsgProvideBarcode
redirect $ SelectR uId return Nothing

View file

@ -32,3 +32,4 @@
/newavatar NewAvatarR GET POST /newavatar NewAvatarR GET POST
/barcode HomeBarcodeR GET /barcode HomeBarcodeR GET
/user/#UserId/barcode SelectBarcodeR GET /user/#UserId/barcode SelectBarcodeR GET
!/user/cash/barcode SelectCashBarcodeR GET

View file

@ -10,3 +10,6 @@ $forall (Entity bId bev) <- beverages
$else $else
<a href=@{BuyCashR bId}> <a href=@{BuyCashR bId}>
<p>#{beverageIdent bev} <p>#{beverageIdent bev}
<form action=@{SelectCashBarcodeR} method=GET>
<input type=hidden #barcodeInput name=barcode>