From 73c1acd3687364cad5f52c30fd1587b3bfbbe46f Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 21 Jul 2015 11:37:43 +0200 Subject: [PATCH] cleanup and enabling barcodes for cash payment --- Handler/Barcode.hs | 78 +++++++++++++++++++++---------------- config/routes | 1 + templates/selectCash.hamlet | 3 ++ 3 files changed, 49 insertions(+), 33 deletions(-) diff --git a/Handler/Barcode.hs b/Handler/Barcode.hs index 1ecb852..08198a9 100644 --- a/Handler/Barcode.hs +++ b/Handler/Barcode.hs @@ -1,36 +1,45 @@ module Handler.Barcode where import Import -import Handler.Common -import qualified Data.Text as T getHomeBarcodeR :: Handler Html getHomeBarcodeR = do - c <- lookupGetParam "barcode" - case c of - Just code -> do - be <- runDB $ getBy $ UniqueBarcode code - case be of - Just (Entity _ bar) -> do - case barcodeIsUser bar of - 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 + eub <- handleSelectParam + case eub of + Just (Left uId) -> do + redirect $ SelectR uId + Just (Right _) -> do + setMessageI MsgBarcodeNotUser + redirect $ HomeR Nothing -> do - setMessageI MsgProvideBarcode - redirect HomeR + redirect $ HomeR getSelectBarcodeR :: UserId -> Handler Html 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" case c of Just code -> do @@ -38,18 +47,21 @@ getSelectBarcodeR uId = do case be of Just (Entity _ bar) -> do case barcodeIsUser bar of - False -> do - case barcodeBev bar of - Just bId -> do - redirect $ BuyR uId bId - Nothing -> do - error "Malformed barcode" True -> do - setMessageI MsgBarcodeNotBev - redirect $ SelectR uId + case (barcodeUser bar, barcodeBev bar) of + (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 setMessageI MsgBarcodeUnknown - redirect $ SelectR uId + return Nothing Nothing -> do setMessageI MsgProvideBarcode - redirect $ SelectR uId + return Nothing diff --git a/config/routes b/config/routes index e52e1fa..909dbfb 100644 --- a/config/routes +++ b/config/routes @@ -32,3 +32,4 @@ /newavatar NewAvatarR GET POST /barcode HomeBarcodeR GET /user/#UserId/barcode SelectBarcodeR GET +!/user/cash/barcode SelectCashBarcodeR GET diff --git a/templates/selectCash.hamlet b/templates/selectCash.hamlet index 5c3b061..dd8a43f 100644 --- a/templates/selectCash.hamlet +++ b/templates/selectCash.hamlet @@ -10,3 +10,6 @@ $forall (Entity bId bev) <- beverages $else

#{beverageIdent bev} + +

+