diff --git a/Handler/Barcode.hs b/Handler/Barcode.hs
index 7786ef8..1ecb852 100644
--- a/Handler/Barcode.hs
+++ b/Handler/Barcode.hs
@@ -3,11 +3,53 @@ module Handler.Barcode where
import Import
import Handler.Common
import qualified Data.Text as T
-import Text.Blaze.Internal
-import Text.Shakespeare.Text
getHomeBarcodeR :: Handler Html
-getHomeBarcodeR = return mempty
+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
+ Nothing -> do
+ setMessageI MsgProvideBarcode
+ redirect HomeR
getSelectBarcodeR :: UserId -> Handler Html
-getSelectBarcodeR uId = return mempty
+getSelectBarcodeR uId = 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
+ 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
+ Nothing -> do
+ setMessageI MsgBarcodeUnknown
+ redirect $ SelectR uId
+ Nothing -> do
+ setMessageI MsgProvideBarcode
+ redirect $ SelectR uId
diff --git a/Handler/Common.hs b/Handler/Common.hs
index f3f76cd..fc532ab 100644
--- a/Handler/Common.hs
+++ b/Handler/Common.hs
@@ -3,8 +3,10 @@ module Handler.Common where
import Data.FileEmbed (embedFile)
import qualified Data.Text as T
+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 Yesod.Form.Functions
import Text.Shakespeare.Text
import Network.Mail.Mime
@@ -21,6 +23,12 @@ getRobotsR :: Handler TypedContent
getRobotsR = return $ TypedContent typePlain
$ toContent $(embedFile "config/robots.txt")
+removeItem :: Eq a => a -> [a] -> [a]
+removeItem _ [] = []
+removeItem x (y:ys)
+ | x == y = removeItem x ys
+ | otherwise = y : (removeItem x ys)
+
updateCashier :: Int -> Text -> Handler ()
updateCashier amount desc = do
mCashier <- runDB $ selectFirst [] [Desc CashierId]
@@ -73,6 +81,66 @@ volumeField = Field
showVal = either id (pack . showA)
showA x = show ((fromIntegral x :: Double) / 1000)
+barcodeField = Field
+ { fieldParse = parseHelper $ Right . removeItem "" . L.nub . T.splitOn ", "
+ , fieldView = \theId name attrs val isReq -> toWidget [hamlet|$newline never
+
+ |]
+ , fieldEnctype = UrlEncoded
+ }
+
+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
+ b
+ True
+ (Just uId)
+ Nothing
+ ) sect
+ return ()
+ False -> do
+ sect <- return $ obs L.\\ nbs
+ ents <- mapM (runDB . getBy . UniqueBarcode) sect
+ 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
+ _ <- 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
+ 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
+ case e of
+ Nothing -> do
+ _ <- case eub of
+ Left uId -> do
+ runDB $ insert_ $ Barcode b True (Just uId) Nothing
+ Right bId -> do
+ runDB $ insert_ $ Barcode b False Nothing (Just bId)
+ setMessageI MsgBarcodeAdded
+ Just _ ->
+ setMessageI MsgBarcodeDuplicate
+
amountField :: (RenderMessage (HandlerSite m) FormMessage, Show a, Monad m, Integral a) => Field m a
amountField = Field
{ fieldParse = parseHelper $ \s ->
diff --git a/Handler/Modify.hs b/Handler/Modify.hs
index 14643ed..76fc62b 100644
--- a/Handler/Modify.hs
+++ b/Handler/Modify.hs
@@ -8,7 +8,11 @@ getModifyR bId = do
mBev <- runDB $ get bId
case mBev of
Just bev -> do
- (modifyWidget, enctype) <- generateFormPost $ modifyForm bev
+ p <- lookupGetParam "barcode"
+ _ <- handleGetParam p (Right bId)
+ rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
+ bs <- return $ map (barcodeCode . entityVal) rawbs
+ (modifyWidget, enctype) <- generateFormPost $ modifyForm bev bs
defaultLayout $ do
$(widgetFile "modify")
Nothing -> do
@@ -20,17 +24,19 @@ postModifyR bId = do
mBev <- runDB $ get bId
case mBev of
Just bev -> do
- ((res, _), _) <- runFormPost $ modifyForm bev
+ rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
+ bs <- return $ map (barcodeCode . entityVal) rawbs
+ ((res, _), _) <- runFormPost $ modifyForm bev bs
case res of
FormSuccess nBev -> do
runDB $ update bId
- [ BeverageIdent =. beverageIdent nBev
- , BeveragePrice =. beveragePrice nBev
- , BeverageAmount =. beverageAmount nBev
- , BeverageAlertAmount =. beverageAlertAmount nBev
- , BeverageCorrectedAmount +=. ((beverageAmount nBev) - (beverageAmount bev))
- , BeverageMl =. beverageMl nBev
- , BeverageAvatar =. beverageAvatar nBev
+ [ BeverageIdent =. modBevIdent nBev
+ , BeveragePrice =. modBevPrice nBev
+ , BeverageAmount =. modBevAmount nBev
+ , BeverageAlertAmount =. modBevAlertAmount nBev
+ , BeverageCorrectedAmount +=. ((modBevAmount nBev) - (beverageAmount bev))
+ , BeverageMl =. modBevMl nBev
+ , BeverageAvatar =. modBevAvatar nBev
]
setMessageI MsgEditSuccess
redirect $ SummaryR
@@ -41,15 +47,25 @@ postModifyR bId = do
setMessageI MsgItemUnknown
redirect $ SummaryR
-modifyForm :: Beverage -> Form Beverage
-modifyForm bev = renderDivs $ Beverage
+data ModBev = ModBev
+ { modBevIdent :: Text
+ , modBevPrice :: Int
+ , modBevAmount :: Int
+ , modBevAlertAmount :: Int
+ , modBevMl :: Int
+ , modBevAvatar :: Maybe AvatarId
+ , modBevBarcodes :: Maybe [Text]
+ }
+
+modifyForm :: Beverage -> [Text] -> Form ModBev
+modifyForm bev bs = renderDivs $ ModBev
<$> areq textField (fieldSettingsLabel MsgName) (Just $ beverageIdent bev)
<*> areq currencyField (fieldSettingsLabel MsgPrice) (Just $ beveragePrice bev)
<*> areq amountField (fieldSettingsLabel MsgCurrentStock) (Just $ beverageAmount bev)
<*> areq amountField (fieldSettingsLabel MsgAnnouncedStock) (Just $ beverageAlertAmount bev)
- <*> pure (beverageCorrectedAmount bev)
<*> areq volumeField (fieldSettingsLabel MsgVolume) (Just $ beverageMl bev)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ beverageAvatar bev)
+ <*> aopt barcodeField (fieldSettingsLabel MsgBarcodeField) (Just $ Just bs)
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
diff --git a/Handler/NewUser.hs b/Handler/NewUser.hs
index a50fda0..5f3485e 100644
--- a/Handler/NewUser.hs
+++ b/Handler/NewUser.hs
@@ -42,6 +42,7 @@ newUserForm secs = renderDivs $ User
data UserConf = UserConf
{ userConfEmail :: Maybe Text
, userConfAvatar :: Maybe AvatarId
+ , userConfBarcode :: Maybe [Text]
}
getModifyUserR :: UserId -> Handler Html
@@ -49,9 +50,13 @@ getModifyUserR uId = do
mUser <- runDB $ I.get uId
case mUser of
Just user -> do
- (modifyUserWidget, enctype) <- generateFormPost $ modifyUserForm user
+ p <- lookupGetParam "barcode"
+ _ <- handleGetParam p (Left uId)
+ rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
+ bs <- return $ map (barcodeCode . entityVal) rawbs
+ (modifyUserWidget, enctype) <- generateFormPost $ modifyUserForm user bs
defaultLayout $ do
- $(widgetFile "modifyUser")
+ $(widgetFile "modifyUser")
Nothing -> do
setMessageI MsgUserUnknown
redirect $ HomeR
@@ -61,7 +66,9 @@ postModifyUserR uId = do
mUser <- runDB $ I.get uId
case mUser of
Just user -> do
- ((res, _), _) <- runFormPost $ modifyUserForm user
+ rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
+ bs <- return $ map (barcodeCode . entityVal) rawbs
+ ((res, _), _) <- runFormPost $ modifyUserForm user bs
case res of
FormSuccess uc -> do
runDB $ update uId
@@ -69,6 +76,7 @@ postModifyUserR uId = do
, UserAvatar =. userConfAvatar uc
]
liftIO $ notify user (userConfEmail uc)
+ handleBarcodes (Left uId) (fromMaybe [] $ userConfBarcode uc)
setMessageI MsgUserEdited
redirect $ SelectR uId
_ -> do
@@ -78,10 +86,11 @@ postModifyUserR uId = do
setMessageI MsgUserUnknown
redirect $ HomeR
-modifyUserForm :: User -> Form UserConf
-modifyUserForm user = renderDivs $ UserConf
+modifyUserForm :: User -> [Text] -> Form UserConf
+modifyUserForm user bs = renderDivs $ UserConf
<$> aopt emailField (fieldSettingsLabel MsgEmailNotify) (Just $ userEmail user)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ userAvatar user)
+ <*> aopt barcodeField (fieldSettingsLabel MsgBarcodeField) (Just $ Just bs)
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
diff --git a/config/models b/config/models
index b892e9e..7641baa 100644
--- a/config/models
+++ b/config/models
@@ -33,5 +33,12 @@ Avatar
ident Text
data ByteString
deriving Typeable Show
+Barcode
+ code Text
+ isUser Bool
+ user UserId Maybe
+ bev BeverageId Maybe
+ UniqueBarcode code
+ deriving Show
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
diff --git a/messages/cz.msg b/messages/cz.msg
index a7fcc51..b2dfdaf 100644
--- a/messages/cz.msg
+++ b/messages/cz.msg
@@ -101,3 +101,10 @@ AvatarDeleted: Avatar úspěšně smazán
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
+BarcodeNotBev: Tento kód není pro produkt, ale pro uživatele
+BarcodeUnknown: Tento kód je neznámý
+BarcodeField: Čárový kódy
+BarcodeAdded: Kód zadán
+BarcodeDuplicate: Tento kód se již používá
diff --git a/messages/de.msg b/messages/de.msg
index ed027d4..f61c2aa 100644
--- a/messages/de.msg
+++ b/messages/de.msg
@@ -101,3 +101,10 @@ AvatarDeleted: Avatar gelöscht
AvatarInUseError: Avatare können nicht gelöscht werden, solange sie in Benutzung sind.
Volume: Volumen in l
CorrectedAmount: Schwund
+BarcodeNotUser: Dieser Barcode ist keinem Benutzer zugeordnet, sondern einem Produkt
+ProvideBarcode: Bitte Barcode angeben
+BarcodeNotBev: Dieser Barcode ist keinem Produkt zugeordnet, sondern einem Benutzer
+BarcodeUnknown: Dieser Barcode ist unbekannt
+BarcodeField: Barcodes
+BarcodeAdded: Barcode erfolgreich hinzugefügt
+BarcodeDuplicate: Dieser barcode wird schon verwendet
diff --git a/messages/en.msg b/messages/en.msg
index e919cee..64f3fd8 100644
--- a/messages/en.msg
+++ b/messages/en.msg
@@ -100,3 +100,11 @@ DeleteAvatar: Delete avatar
AvatarDeleted: Avatar successfully deleted
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
+BarcodeNotBev: This barcode is no product, but a user
+BarcodeUnknown: This barcode is unknown
+BarcodeField: Barcodes
+BarcodeAdded: barcode succesfully added
+BarcodeDuplicate: This barcode is already in use
diff --git a/static/js/barcode.js b/static/js/barcode.js
index c73aff3..0daad22 100644
--- a/static/js/barcode.js
+++ b/static/js/barcode.js
@@ -10,18 +10,26 @@ function showBarcode(text) {
function barcodeKeyPress(event) {
var key = String.fromCharCode(event.charCode)
- if (event.keyCode === 13) {
- var input = document.getElementById('barcodeInput')
- if (input) {
- input.setAttribute('value', barcodeBuf)
- input.parentNode.submit()
- return
+ var focused = document.activeElement
+ if (! focused || focused == document.body) {
+ focused = null
+ } else if (document.querySelector) {
+ focused = document.querySelector(":focus")
+ }
+ if (focused == null || focused.tagName != "INPUT") {
+ if (event.keyCode === 13) {
+ var input = document.getElementById('barcodeInput')
+ if (input) {
+ input.setAttribute('value', barcodeBuf)
+ input.parentNode.submit()
+ return
+ }
+ barcodeBuf = ""
+ event.preventDefault()
+ } else {
+ barcodeBuf += key
+ showBarcode(barcodeBuf)
+ event.preventDefault()
}
- barcodeBuf = ""
- event.preventDefault()
- } else {
- barcodeBuf += key
- showBarcode(barcodeBuf)
- event.preventDefault()
}
}
diff --git a/templates/modify.hamlet b/templates/modify.hamlet
index 7f39b8a..9618be8 100644
--- a/templates/modify.hamlet
+++ b/templates/modify.hamlet
@@ -9,3 +9,6 @@ $doctype 5
_{MsgDeleteItem}
+
+