proper handling of pure whitespace barcodes.

This commit is contained in:
nek0 2015-07-21 18:56:24 +02:00
parent 323cfddb90
commit 4e3c496845
4 changed files with 42 additions and 42 deletions

View file

@ -7,6 +7,7 @@ import qualified Data.List as L
import qualified Data.Text.Lazy.Encoding as E
import qualified Data.Text.Read as R
import Data.Maybe
import qualified Data.Char as C
import Yesod.Form.Functions
import Text.Shakespeare.Text
import Network.Mail.Mime
@ -93,53 +94,52 @@ handleBarcodes :: Either UserId BeverageId -> [Text] -> Handler ()
handleBarcodes (Left uId) nbs = do
raws <- runDB $ selectList [BarcodeUser ==. Just uId] []
obs <- return $ map (barcodeCode . entityVal) raws
case length nbs > length obs of
True -> do
sect <- return $ nbs L.\\ obs
_ <- mapM (\b -> runDB $ insert $ Barcode
toDel <- return $ obs L.\\ nbs
toAdd <- return $ nbs L.\\ obs
_ <- mapM (\b -> runDB $ insert_ $ Barcode
b
True
(Just uId)
Nothing
) sect
return ()
False -> do
sect <- return $ obs L.\\ nbs
ents <- mapM (runDB . getBy . UniqueBarcode) sect
) toAdd
ents <- mapM (runDB . getBy . UniqueBarcode) toDel
mapM_ (runDB . delete . entityKey . fromJust) ents
handleBarcodes (Right bId) nbs = do
raws <- runDB $ selectList [BarcodeBev ==. Just bId] []
obs <- return $ map (barcodeCode . entityVal) raws
case length nbs > length obs of
True -> do
sect <- return $ nbs L.\\ obs
toDel <- return $ obs L.\\ nbs
toAdd <- return $ nbs L.\\ obs
_ <- mapM (\b -> runDB $ insert $ Barcode
b
False
Nothing
(Just bId)
) sect
return ()
False -> do
sect <- return $ obs L.\\ nbs
ents <- mapM (runDB . getBy . UniqueBarcode) sect
) toAdd
ents <- mapM (runDB . getBy . UniqueBarcode) toDel
mapM_ (runDB . delete . entityKey . fromJust) ents
handleGetParam :: Maybe Text -> Either UserId BeverageId -> Handler ()
handleGetParam Nothing _ =
return ()
handleGetParam (Just b) eub = do
e <- runDB $ getBy $ UniqueBarcode b
f <- return $ T.filter C.isAlphaNum b
case (T.length f) > 0 of
True -> do
e <- runDB $ getBy $ UniqueBarcode f
case e of
Nothing -> do
_ <- case eub of
Left uId -> do
-- should usernames containing, among other, spaces cause problems, replace b for f here
runDB $ insert_ $ Barcode b True (Just uId) Nothing
Right bId -> do
-- and here
runDB $ insert_ $ Barcode b False Nothing (Just bId)
setMessageI MsgBarcodeAdded
Just _ ->
setMessageI MsgBarcodeDuplicate
False -> do
setMessageI MsgProvideBarcode
amountField :: (RenderMessage (HandlerSite m) FormMessage, Show a, Monad m, Integral a) => Field m a
amountField = Field

View file

@ -102,7 +102,7 @@ AvatarInUseError: Avatar nelze smazat dokud je v užitku
Volume: Objem v l
CorrectedAmount: Stráta
BarcodeNotUser: Tento kód není pro uživatele, ale pro produkt
ProvideBarcode: Prosím zadej kód
ProvideBarcode: Prosím zadej správný kód
BarcodeNotBev: Tento kód není pro produkt, ale pro uživatele
BarcodeUnknown: Tento kód je neznámý
BarcodeField: Čárový kódy

View file

@ -102,7 +102,7 @@ AvatarInUseError: Avatare können nicht gelöscht werden, solange sie in Benutzu
Volume: Volumen in l
CorrectedAmount: Schwund
BarcodeNotUser: Dieser Barcode ist keinem Benutzer zugeordnet, sondern einem Produkt
ProvideBarcode: Bitte Barcode angeben
ProvideBarcode: Bitte korrekten Barcode angeben
BarcodeNotBev: Dieser Barcode ist keinem Produkt zugeordnet, sondern einem Benutzer
BarcodeUnknown: Dieser Barcode ist unbekannt
BarcodeField: Barcodes

View file

@ -102,7 +102,7 @@ AvatarInUseError: You can not delete avatars that are currently in use
Volume: Volume in l
CorrectedAmount: Loss
BarcodeNotUser: This barcode is no user, but a product
ProvideBarcode: Please provide a barcode
ProvideBarcode: Please provide a correct barcode
BarcodeNotBev: This barcode is no product, but a user
BarcodeUnknown: This barcode is unknown
BarcodeField: Barcodes