yammat/Handler/Barcode.hs

95 lines
2.7 KiB
Haskell
Raw Normal View History

2015-08-09 19:16:33 +00:00
-- yammat - Yet Another MateMAT
-- Copyright (C) 2015 Amedeo Molnár
--
-- 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/>.
2015-07-20 23:14:21 +00:00
module Handler.Barcode where
import Import
2015-07-20 23:42:52 +00:00
getHomeBarcodeR :: Handler Html
2015-07-21 07:14:38 +00:00
getHomeBarcodeR = do
eub <- handleSelectParam
case eub of
2015-09-14 22:49:13 +00:00
Just (Left uId) ->
redirect $ SelectR uId
Just (Right _) -> do
setMessageI MsgBarcodeNotUser
2015-09-14 22:49:13 +00:00
redirect HomeR
Nothing ->
redirect HomeR
2015-07-20 23:28:05 +00:00
2015-07-20 23:42:52 +00:00
getSelectBarcodeR :: UserId -> Handler Html
2015-07-21 07:14:38 +00:00
getSelectBarcodeR uId = do
eub <- handleSelectParam
case eub of
2015-09-14 22:49:13 +00:00
Just (Right bId) ->
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
2015-09-14 22:49:13 +00:00
Just (Right bId) ->
redirect $ BuyCashR bId
Just (Left _) -> do
setMessageI MsgBarcodeNotBev
2015-09-14 22:49:13 +00:00
redirect SelectCashR
Nothing ->
redirect SelectCashR
2015-10-11 18:07:12 +00:00
getRestockBarcodeR :: Handler Html
getRestockBarcodeR = do
eub <- handleSelectParam
case eub of
Just (Right bId) ->
redirect $ UpstockR bId
Just (Left _) -> do
setMessageI MsgBarcodeNotBev
redirect RestockR
Nothing ->
redirect RestockR
handleSelectParam :: Handler (Maybe (Either UserId BeverageId))
handleSelectParam = do
2015-07-21 07:14:38 +00:00
c <- lookupGetParam "barcode"
case c of
Just code -> do
be <- runDB $ getBy $ UniqueBarcode code
case be of
2015-09-14 22:49:13 +00:00
Just (Entity _ bar) ->
if barcodeIsUser bar
then
case (barcodeUser bar, barcodeBev bar) of
(Just uId, Nothing) ->
return $ Just $ Left uId
_ ->
error "Malformed barcode"
2015-09-14 22:49:13 +00:00
else
case (barcodeBev bar, barcodeUser bar) of
(Just bId, Nothing) ->
return $ Just $ Right bId
_ ->
2015-07-21 07:14:38 +00:00
error "Malformed barcode"
Nothing -> do
setMessageI MsgBarcodeUnknown
return Nothing
2015-07-21 07:14:38 +00:00
Nothing -> do
setMessageI MsgProvideBarcode
return Nothing