cleanup and enabling barcodes for cash payment

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

config/routes

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

templates/selectCash.hamlet

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