From 165ba6318e4d0f51332cffb570e7e211733cadb3 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 11 Oct 2015 20:07:12 +0200 Subject: [PATCH] added supplier management --- .dir-locals.el | 4 - .ghci | 3 - .gitignore | 0 Application.hs | 2 + Foundation.hs | 2 + Handler/Avatar.hs | 3 +- Handler/Barcode.hs | 12 ++ Handler/Buy.hs | 0 Handler/CashCheck.hs | 0 Handler/Common.hs | 0 Handler/Home.hs | 0 Handler/Journal.hs | 0 Handler/Modify.hs | 20 +++- Handler/NewUser.hs | 0 Handler/Payout.hs | 0 Handler/Restock.hs | 12 +- Handler/Select.hs | 0 Handler/Summary.hs | 64 +++++++---- Handler/Supplier.hs | 97 ++++++++++++++++ Handler/SupplierActions.hs | 108 ++++++++++++++++++ Handler/Transfer.hs | 0 Import.hs | 0 Import/NoFoundation.hs | 0 LICENSE.md | 0 Migration/0.0.0-0.0.1/Migration.hs | 0 Model.hs | 0 README.md | 0 Settings.hs | 0 Settings/StaticFiles.hs | 0 app/DevelMain.hs | 0 app/devel.hs | 0 app/main.hs | 0 config/favicon.ico | Bin config/keter.yml | 0 config/models | 21 ++++ config/robots.txt | 0 config/routes | 7 ++ config/settings.yml | 0 config/test-settings.yml | 0 messages/cz.msg | 0 messages/de.msg | 24 ++++ messages/en.msg | 0 messages/fr.msg | 0 messages/pl.msg | 0 static/css/bootstrap.css | 0 static/css/main.css | 0 static/fonts/glyphicons-halflings-regular.eot | Bin static/fonts/glyphicons-halflings-regular.svg | 0 static/fonts/glyphicons-halflings-regular.ttf | Bin .../fonts/glyphicons-halflings-regular.woff | Bin static/images/cz.svg | 0 static/images/de.svg | 0 static/images/en.svg | 0 static/images/es.svg | 0 static/images/fr.svg | 0 static/images/hr.svg | 0 static/images/jbo.svg | 0 static/images/pl.svg | 0 static/images/ru.svg | 0 static/js/barcode.js | 0 static/js/crementing.js | 0 templates/avatars.hamlet | 0 templates/buy.hamlet | 0 templates/buyCash.hamlet | 0 templates/cashCheck.hamlet | 0 templates/copyright.hamlet | 0 templates/default-layout-wrapper.hamlet | 0 templates/default-layout.hamlet | 2 + templates/home.hamlet | 0 templates/homepage.hamlet | 0 templates/homepage.julius | 0 templates/homepage.lucius | 0 templates/journal.hamlet | 0 templates/journalPage.hamlet | 0 templates/modify.hamlet | 0 templates/modifyAvatar.hamlet | 0 templates/modifySupplier.hamlet | 8 ++ templates/modifyUser.hamlet | 0 templates/newArticle.hamlet | 0 templates/newAvatar.hamlet | 0 templates/newSupplier.hamlet | 8 ++ templates/newUser.hamlet | 0 templates/payout.hamlet | 0 templates/reactivate.hamlet | 0 templates/recharge.hamlet | 0 templates/restock.hamlet | 3 + templates/select.hamlet | 0 templates/selectCash.hamlet | 0 templates/summary.hamlet | 0 templates/supplier.hamlet | 14 +++ templates/supplierActions.hamlet | 13 +++ templates/transfer.hamlet | 0 templates/transferSelect.hamlet | 0 templates/uploadJson.hamlet | 0 templates/upstock.hamlet | 0 test/Handler/CommonSpec.hs | 0 test/Handler/HomeSpec.hs | 0 test/Spec.hs | 0 test/TestImport.hs | 0 yammat.cabal | 42 ++++--- 100 files changed, 416 insertions(+), 53 deletions(-) delete mode 100644 .dir-locals.el delete mode 100644 .ghci mode change 100644 => 100755 .gitignore mode change 100644 => 100755 Application.hs mode change 100644 => 100755 Foundation.hs mode change 100644 => 100755 Handler/Avatar.hs mode change 100644 => 100755 Handler/Barcode.hs mode change 100644 => 100755 Handler/Buy.hs mode change 100644 => 100755 Handler/CashCheck.hs mode change 100644 => 100755 Handler/Common.hs mode change 100644 => 100755 Handler/Home.hs mode change 100644 => 100755 Handler/Journal.hs mode change 100644 => 100755 Handler/Modify.hs mode change 100644 => 100755 Handler/NewUser.hs mode change 100644 => 100755 Handler/Payout.hs mode change 100644 => 100755 Handler/Restock.hs mode change 100644 => 100755 Handler/Select.hs mode change 100644 => 100755 Handler/Summary.hs create mode 100755 Handler/Supplier.hs create mode 100755 Handler/SupplierActions.hs mode change 100644 => 100755 Handler/Transfer.hs mode change 100644 => 100755 Import.hs mode change 100644 => 100755 Import/NoFoundation.hs mode change 100644 => 100755 LICENSE.md mode change 100644 => 100755 Migration/0.0.0-0.0.1/Migration.hs mode change 100644 => 100755 Model.hs mode change 100644 => 100755 README.md mode change 100644 => 100755 Settings.hs mode change 100644 => 100755 Settings/StaticFiles.hs mode change 100644 => 100755 app/DevelMain.hs mode change 100644 => 100755 app/devel.hs mode change 100644 => 100755 app/main.hs mode change 100644 => 100755 config/favicon.ico mode change 100644 => 100755 config/keter.yml mode change 100644 => 100755 config/models mode change 100644 => 100755 config/robots.txt mode change 100644 => 100755 config/routes mode change 100644 => 100755 config/settings.yml mode change 100644 => 100755 config/test-settings.yml mode change 100644 => 100755 messages/cz.msg mode change 100644 => 100755 messages/de.msg mode change 100644 => 100755 messages/en.msg mode change 100644 => 100755 messages/fr.msg mode change 100644 => 100755 messages/pl.msg mode change 100644 => 100755 static/css/bootstrap.css mode change 100644 => 100755 static/css/main.css mode change 100644 => 100755 static/fonts/glyphicons-halflings-regular.eot mode change 100644 => 100755 static/fonts/glyphicons-halflings-regular.svg mode change 100644 => 100755 static/fonts/glyphicons-halflings-regular.ttf mode change 100644 => 100755 static/fonts/glyphicons-halflings-regular.woff mode change 100644 => 100755 static/images/cz.svg mode change 100644 => 100755 static/images/de.svg mode change 100644 => 100755 static/images/en.svg mode change 100644 => 100755 static/images/es.svg mode change 100644 => 100755 static/images/fr.svg mode change 100644 => 100755 static/images/hr.svg mode change 100644 => 100755 static/images/jbo.svg mode change 100644 => 100755 static/images/pl.svg mode change 100644 => 100755 static/images/ru.svg mode change 100644 => 100755 static/js/barcode.js mode change 100644 => 100755 static/js/crementing.js mode change 100644 => 100755 templates/avatars.hamlet mode change 100644 => 100755 templates/buy.hamlet mode change 100644 => 100755 templates/buyCash.hamlet mode change 100644 => 100755 templates/cashCheck.hamlet mode change 100644 => 100755 templates/copyright.hamlet mode change 100644 => 100755 templates/default-layout-wrapper.hamlet mode change 100644 => 100755 templates/default-layout.hamlet mode change 100644 => 100755 templates/home.hamlet mode change 100644 => 100755 templates/homepage.hamlet mode change 100644 => 100755 templates/homepage.julius mode change 100644 => 100755 templates/homepage.lucius mode change 100644 => 100755 templates/journal.hamlet mode change 100644 => 100755 templates/journalPage.hamlet mode change 100644 => 100755 templates/modify.hamlet mode change 100644 => 100755 templates/modifyAvatar.hamlet create mode 100755 templates/modifySupplier.hamlet mode change 100644 => 100755 templates/modifyUser.hamlet mode change 100644 => 100755 templates/newArticle.hamlet mode change 100644 => 100755 templates/newAvatar.hamlet create mode 100755 templates/newSupplier.hamlet mode change 100644 => 100755 templates/newUser.hamlet mode change 100644 => 100755 templates/payout.hamlet mode change 100644 => 100755 templates/reactivate.hamlet mode change 100644 => 100755 templates/recharge.hamlet mode change 100644 => 100755 templates/restock.hamlet mode change 100644 => 100755 templates/select.hamlet mode change 100644 => 100755 templates/selectCash.hamlet mode change 100644 => 100755 templates/summary.hamlet create mode 100755 templates/supplier.hamlet create mode 100755 templates/supplierActions.hamlet mode change 100644 => 100755 templates/transfer.hamlet mode change 100644 => 100755 templates/transferSelect.hamlet mode change 100644 => 100755 templates/uploadJson.hamlet mode change 100644 => 100755 templates/upstock.hamlet mode change 100644 => 100755 test/Handler/CommonSpec.hs mode change 100644 => 100755 test/Handler/HomeSpec.hs mode change 100644 => 100755 test/Spec.hs mode change 100644 => 100755 test/TestImport.hs mode change 100644 => 100755 yammat.cabal diff --git a/.dir-locals.el b/.dir-locals.el deleted file mode 100644 index a44395f..0000000 --- a/.dir-locals.el +++ /dev/null @@ -1,4 +0,0 @@ -((haskell-mode . ((haskell-indent-spaces . 4) - (haskell-process-use-ghci . t))) - (hamlet-mode . ((hamlet/basic-offset . 4) - (haskell-process-use-ghci . t)))) diff --git a/.ghci b/.ghci deleted file mode 100644 index 6967081..0000000 --- a/.ghci +++ /dev/null @@ -1,3 +0,0 @@ -:set -i.:config:dist/build/autogen -:set -DDEVELOPMENT -:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable diff --git a/.gitignore b/.gitignore old mode 100644 new mode 100755 diff --git a/Application.hs b/Application.hs old mode 100644 new mode 100755 index 29577eb..5356f19 --- a/Application.hs +++ b/Application.hs @@ -53,6 +53,8 @@ import Handler.CashCheck import Handler.Avatar import Handler.Barcode import Handler.Transfer +import Handler.Supplier +import Handler.SupplierActions -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the diff --git a/Foundation.hs b/Foundation.hs old mode 100644 new mode 100755 index 9af1df8..878b1d6 --- a/Foundation.hs +++ b/Foundation.hs @@ -31,6 +31,7 @@ import Data.List.Split import Text.Printf + prependZero :: Text -> Text prependZero t0 | T.null t1 = t1 @@ -135,6 +136,7 @@ instance Yesod App where $(widgetFile "default-layout") withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") + -- The page to be redirected to when authentication is required. -- authRoute _ = Just $ AuthR LoginR diff --git a/Handler/Avatar.hs b/Handler/Avatar.hs old mode 100644 new mode 100755 index 4bdd492..2937339 --- a/Handler/Avatar.hs +++ b/Handler/Avatar.hs @@ -141,7 +141,8 @@ getAvatarDeleteR aId = do Just _ -> do c <- runDB $ selectList [UserAvatar ==. Just aId] [] d <- runDB $ selectList [BeverageAvatar ==. Just aId] [] - if null c && null d + e <- runDB $ selectList [SupplierAvatar ==. Just aId] [] + if null c && null d && null e then do runDB $ delete aId setMessageI MsgAvatarDeleted diff --git a/Handler/Barcode.hs b/Handler/Barcode.hs old mode 100644 new mode 100755 index 0bcc18a..826b6a1 --- a/Handler/Barcode.hs +++ b/Handler/Barcode.hs @@ -53,6 +53,18 @@ getSelectCashBarcodeR = do Nothing -> redirect SelectCashR +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 c <- lookupGetParam "barcode" diff --git a/Handler/Buy.hs b/Handler/Buy.hs old mode 100644 new mode 100755 diff --git a/Handler/CashCheck.hs b/Handler/CashCheck.hs old mode 100644 new mode 100755 diff --git a/Handler/Common.hs b/Handler/Common.hs old mode 100644 new mode 100755 diff --git a/Handler/Home.hs b/Handler/Home.hs old mode 100644 new mode 100755 diff --git a/Handler/Journal.hs b/Handler/Journal.hs old mode 100644 new mode 100755 diff --git a/Handler/Modify.hs b/Handler/Modify.hs old mode 100644 new mode 100755 index 2a714e7..79380c9 --- a/Handler/Modify.hs +++ b/Handler/Modify.hs @@ -52,6 +52,11 @@ postModifyR bId = do , BeverageCorrectedAmount +=. (modBevAmount nBev - beverageAmount bev) , BeverageMl =. modBevMl nBev , BeverageAvatar =. modBevAvatar nBev + , BeverageSupplier =. modBevSupp nBev + , BeverageMaxAmount =. modBevMaxAmount nBev + , BeveragePerCrate =. modBevPC nBev + , BeverageArtNr =. modBevArtNr nBev + , BeveragePricePerCrate =. modBevPricePC nBev ] handleBarcodes (Right bId) (fromMaybe [] $ modBevBarcodes nBev) setMessageI MsgEditSuccess @@ -68,9 +73,14 @@ data ModBev = ModBev , modBevPrice :: Int , modBevAmount :: Int , modBevAlertAmount :: Int + , modBevMaxAmount :: Int , modBevMl :: Int + , modBevPC :: Maybe Int + , modBevPricePC :: Maybe Int , modBevAvatar :: Maybe AvatarId , modBevBarcodes :: Maybe [Text] + , modBevSupp :: Maybe SupplierId + , modBevArtNr :: Maybe Text } modifyForm :: Beverage -> [Text] -> Form ModBev @@ -79,13 +89,17 @@ modifyForm bev bs = renderDivs $ ModBev <*> areq currencyField (fieldSettingsLabel MsgPrice) (Just $ beveragePrice bev) <*> areq amountField (fieldSettingsLabel MsgCurrentStock) (Just $ beverageAmount bev) <*> areq amountField (fieldSettingsLabel MsgAnnouncedStock) (Just $ beverageAlertAmount bev) + <*> areq amountField (fieldSettingsLabel MsgMaxAmount) (Just $ beverageMaxAmount bev) <*> areq volumeField (fieldSettingsLabel MsgVolume) (Just $ beverageMl bev) + <*> aopt amountField (fieldSettingsLabel MsgAmountPerCrate) (Just $ beveragePerCrate bev) + <*> aopt currencyField (fieldSettingsLabel MsgPricePerCrate) (Just $ beveragePricePerCrate bev) <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ beverageAvatar bev) <*> aopt barcodeField (fieldSettingsLabel MsgBarcodeField) (Just $ Just bs) + <*> aopt (selectField sups) (fieldSettingsLabel MsgSelectSupplier) (Just $ beverageSupplier bev) + <*> aopt textField (fieldSettingsLabel MsgArtNr) Nothing where - avatars = do - ents <- runDB $ selectList [] [Asc AvatarIdent] - optionsPairs $ map (\ent -> (avatarIdent $ entityVal ent, entityKey ent)) ents + avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent + sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent getDeleteBeverageR :: BeverageId -> Handler Html getDeleteBeverageR bId = do diff --git a/Handler/NewUser.hs b/Handler/NewUser.hs old mode 100644 new mode 100755 diff --git a/Handler/Payout.hs b/Handler/Payout.hs old mode 100644 new mode 100755 diff --git a/Handler/Restock.hs b/Handler/Restock.hs old mode 100644 new mode 100755 index 618d6db..aaa70d0 --- a/Handler/Restock.hs +++ b/Handler/Restock.hs @@ -83,15 +83,19 @@ postNewArticleR = do redirect HomeR newArticleForm :: Form Beverage -newArticleForm = renderDivs $ Beverage +newArticleForm = renderDivs $ (\a b c d e f g h i j k-> Beverage a b c d g h i j e f k) <$> areq textField (fieldSettingsLabel MsgName) Nothing <*> areq currencyField (fieldSettingsLabel MsgPrice) (Just 100) <*> areq amountField (fieldSettingsLabel MsgAmount) (Just 0) <*> areq amountField (fieldSettingsLabel MsgAmountWarning) (Just 0) + <*> areq amountField (fieldSettingsLabel MsgMaxAmount) (Just 200) + <*> aopt amountField (fieldSettingsLabel MsgAmountPerCrate) (Just $ Just 20) <*> pure 0 <*> areq volumeField (fieldSettingsLabel MsgVolume) (Just 500) <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing + <*> aopt (selectField sups) (fieldSettingsLabel MsgSelectSupplier) Nothing + <*> aopt textField (fieldSettingsLabel MsgArtNr) Nothing + <*> aopt currencyField (fieldSettingsLabel MsgPricePerCrate) Nothing where - avatars = do - ents <- runDB $ selectList [] [Asc AvatarIdent] - optionsPairs $ map (\ent -> (avatarIdent $ entityVal ent, entityKey ent)) ents + avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent + sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent diff --git a/Handler/Select.hs b/Handler/Select.hs old mode 100644 new mode 100755 diff --git a/Handler/Summary.hs b/Handler/Summary.hs old mode 100644 new mode 100755 index cb01620..2bb4ecd --- a/Handler/Summary.hs +++ b/Handler/Summary.hs @@ -47,18 +47,26 @@ data BevStore = BevStore { bevStoreIdent :: Text , bevStorePrice :: Int , bevStoreAmount :: Int + , bevStoreMaxAmount :: Int + , bevStorePerCrate :: Maybe Int , bevStoreAlertAmount :: Int , bevStoreMl :: Int + , bevStoreArtNr :: Maybe Text + , bevStorePricePerCrate :: Maybe Int } instance ToJSON BevStore where - toJSON (BevStore ident price amount alertAmount ml) = + toJSON (BevStore ident price amount alertAmount maxAmount perCrate ml artNr ppc) = object [ "name" .= ident , "price" .= price , "amount" .= amount , "alertAt" .= alertAmount + , "max" .= maxAmount + , "perCrate" .= perCrate , "ml" .= ml + , "artNr" .= artNr + , "pricePerCrate" .= ppc ] instance FromJSON BevStore where @@ -66,8 +74,12 @@ instance FromJSON BevStore where <$> o .: "name" <*> o .: "price" <*> o .: "amount" + <*> o .: "max" + <*> o .:? "perCrate" <*> o .: "alertAt" <*> o .: "ml" + <*> o .:? "artNr" + <*> o .:? "pricePerCrate" -- For errors parseJSON _ = mzero @@ -80,8 +92,12 @@ getInventoryJsonR = do (beverageIdent bev) (beveragePrice bev) (beverageAmount bev) + (beverageMaxAmount bev) + (beveragePerCrate bev) (beverageAlertAmount bev) (beverageMl bev) + (beverageArtNr bev) + (beveragePricePerCrate bev) ) bevs getUploadInventoryJsonR :: Handler Html @@ -99,7 +115,7 @@ postUploadInventoryJsonR = do then do source <- runResourceT $ fileSource file $$ sinkLbs let bevs = fromMaybe [] (decode source :: Maybe [BevStore]) - I.mapM_ insOrUpd bevs + _ <- I.mapM insOrUpd bevs setMessageI MsgRestoreSuccess redirect HomeR else do @@ -113,23 +129,29 @@ uploadJsonForm :: Form FileInfo uploadJsonForm = renderDivs $ areq fileField (fieldSettingsLabel MsgSelectFile) Nothing -insOrUpd :: BevStore -> Handler () +insOrUpd :: BevStore -> Handler (Entity Beverage) insOrUpd bev = do - meb <- runDB $ getBy $ UniqueBeverage $ bevStoreIdent bev - case meb of - Just eb -> - runDB $ update (entityKey eb) - [ BeveragePrice =. bevStorePrice bev - , BeverageAmount =. bevStoreAmount bev - , BeverageAlertAmount =. bevStoreAlertAmount bev - , BeverageMl =. bevStoreMl bev - ] - Nothing -> - runDB $ insert_ $ Beverage - (bevStoreIdent bev) - (bevStorePrice bev) - (bevStoreAmount bev) - (bevStoreAlertAmount bev) - 0 - (bevStoreMl bev) - Nothing + nbev <- return $ Beverage + (bevStoreIdent bev) + (bevStorePrice bev) + (bevStoreAmount bev) + (bevStoreAlertAmount bev) + 0 + (bevStoreMl bev) + Nothing + Nothing + (bevStoreMaxAmount bev) + (bevStorePerCrate bev) + (bevStoreArtNr bev) + (bevStorePricePerCrate bev) + runDB $ upsert nbev + [ BeverageIdent =. bevStoreIdent bev + , BeveragePrice =. bevStorePrice bev + , BeverageAmount =. bevStoreAmount bev + , BeverageAlertAmount =. bevStoreAlertAmount bev + , BeverageMl =. bevStoreMl bev + , BeverageMaxAmount =. bevStoreMaxAmount bev + , BeveragePerCrate =. bevStorePerCrate bev + , BeverageArtNr =. bevStoreArtNr bev + , BeveragePricePerCrate =. bevStorePricePerCrate bev + ] diff --git a/Handler/Supplier.hs b/Handler/Supplier.hs new file mode 100755 index 0000000..4e5ff8b --- /dev/null +++ b/Handler/Supplier.hs @@ -0,0 +1,97 @@ +module Handler.Supplier where + +import Import +import Data.Maybe + +getSupplierR :: Handler Html +getSupplierR = do + sups <- runDB $ selectList [] [Desc SupplierIdent] + defaultLayout $ + $(widgetFile "supplier") + +getNewSupplierR :: Handler Html +getNewSupplierR = do + (newSupplierWidget, enctype) <- generateFormPost newSupplierForm + defaultLayout $ + $(widgetFile "newSupplier") + +postNewSupplierR :: Handler Html +postNewSupplierR = do + ((res, _), _) <- runFormPost newSupplierForm + case res of + FormSuccess sup -> do + runDB $ insert_ sup + setMessageI MsgSupplierCreated + redirect SupplierR + _ -> do + setMessageI MsgSupplierNotCreated + redirect SupplierR + +newSupplierForm :: Form Supplier +newSupplierForm = renderDivs $ Supplier + <$> areq textField (fieldSettingsLabel MsgName) Nothing + <*> areq textareaField (fieldSettingsLabel MsgAddress) Nothing + <*> areq textField (fieldSettingsLabel MsgTelNr) Nothing + <*> areq emailField (fieldSettingsLabel MsgEmail) Nothing + <*> areq textField (fieldSettingsLabel MsgCustomerId) Nothing + <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing + where + avatars = do + ents <- runDB $ selectList [] [Asc AvatarIdent] + optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents + +data SupConf = SupConf + { supConfAddr :: Textarea + , supConfTel :: Text + , supConfEmail :: Text + , supConfCustomerId :: Text + , supConfAvatar :: Maybe AvatarId + } + +getModifySupplierR :: SupplierId -> Handler Html +getModifySupplierR sId = do + mSup <- runDB $ get sId + case mSup of + Just sup -> do + (modifySupplierWidget, enctype) <- generateFormPost $ modifySupplierForm sup + defaultLayout $ + $(widgetFile "modifySupplier") + Nothing -> do + setMessageI MsgSupplierUnknown + redirect $ SupplierR + +postModifySupplierR :: SupplierId -> Handler Html +postModifySupplierR sId = do + mSup <- runDB $ get sId + case mSup of + Just sup -> do + ((res, _), _) <- runFormPost $ modifySupplierForm sup + case res of + FormSuccess msup -> do + runDB $ update sId + [ SupplierAddress =. supConfAddr msup + , SupplierTel =. supConfTel msup + , SupplierEmail =. supConfEmail msup + , SupplierCustomerId =. supConfCustomerId msup + , SupplierAvatar =. supConfAvatar msup + ] + setMessageI MsgSupplierEdited + redirect SupplierR + _ -> do + setMessageI MsgSupplierNotEdited + redirect SupplierR + Nothing -> do + setMessageI MsgSupplierUnknown + redirect SupplierR + +modifySupplierForm :: Supplier -> Form SupConf +modifySupplierForm sup = renderDivs $ SupConf + <$> areq textareaField (fieldSettingsLabel MsgAddress) (Just $ supplierAddress sup) + <*> areq textField (fieldSettingsLabel MsgTelNr) (Just $ supplierTel sup) + <*> areq textField (fieldSettingsLabel MsgEmail) (Just $ supplierEmail sup) + <*> areq textField (fieldSettingsLabel MsgCustomerId) (Just $ supplierCustomerId sup) + <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ supplierAvatar sup) + where + avatars = do + ents <- runDB $ selectList [] [Asc AvatarIdent] + optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents diff --git a/Handler/SupplierActions.hs b/Handler/SupplierActions.hs new file mode 100755 index 0000000..93d57fa --- /dev/null +++ b/Handler/SupplierActions.hs @@ -0,0 +1,108 @@ +module Handler.SupplierActions where + +import Import +import Handler.Common +import qualified Data.Text as T + +getSupplierActionsR :: SupplierId -> Handler Html +getSupplierActionsR sId = do + mSup <- runDB $ get sId + case mSup of + Just sup -> + defaultLayout $ + $(widgetFile "supplierActions") + Nothing -> do + setMessageI MsgSupplierUnknown + redirect SupplierR + +data BevDigest = BevDigest + { bdCrates :: Int + , bdTotal :: Int + , bdBev :: Beverage + } + +getSupplierDigestR :: SupplierId -> Handler Html +getSupplierDigestR sId = do + mSup <- runDB $ get sId + case mSup of + Just sup -> do + master <- getYesod + bevs <- runDB $ selectList [BeverageSupplier ==. (Just sId)] [Desc BeverageIdent] + digests <- return $ map genBevDigest bevs + w <- return $ [whamlet|$newline always + + #{supplierIdent sup}
+ #{unTextarea $ supplierAddress sup}
+ #{supplierTel sup}
+ #{supplierEmail sup}
+
+ + _{MsgCustomerId}: #{supplierCustomerId sup} + + + + +
_{MsgArtNr} + _{MsgName} + _{MsgVolume} + _{MsgCrateCount} + _{MsgPricePerCrate} + _{MsgTotalValue} + $forall dig <- digests + $if bdCrates dig > 0 +
#{fromMaybe "" $ beverageArtNr $ bdBev dig} + #{beverageIdent $ bdBev dig} + #{formatIntVolume $ beverageMl $ bdBev dig} + #{T.pack $ show $ bdCrates dig} + #{formatIntCurrency $ fromMaybe 0 $ beveragePricePerCrate $ bdBev dig} #{appCurrency $ appSettings master} + #{formatIntCurrency $ bdTotal dig} #{appCurrency $ appSettings master} + _{MsgBuyValue} + #{formatIntCurrency $ sum $ map bdTotal digests} #{appCurrency $ appSettings master} + |] + tableLayout w + Nothing -> do + setMessageI MsgSupplierUnknown + redirect SupplierR + +-- tableLayout :: Widget -> WidgetT site0 IO () +tableLayout widget = do + cont <- widgetToPageContent $ do + $(combineStylesheets 'StaticR + [ css_bootstrap_css + , css_main_css + ]) + widget + withUrlRenderer [hamlet|$newline never + $doctype 5 + + + + ^{pageHead cont} + + ^{pageBody cont} + |] + +genBevDigest :: Entity Beverage -> BevDigest +genBevDigest bev = + BevDigest amount (amount * (fromMaybe 0 $ beveragePricePerCrate $ entityVal bev)) (entityVal bev) + where + amount = + ((beverageMaxAmount (entityVal bev) - beverageAmount (entityVal bev)) `div` ( fromMaybe 1 $ beveragePerCrate (entityVal bev))) + +getDeleteSupplierR :: SupplierId -> Handler Html +getDeleteSupplierR sId = do + mSup <- runDB $ get sId + case mSup of + Just sup -> do + a <- runDB $ selectList [BeverageSupplier ==. (Just sId)] [] + if null a + then do + runDB $ delete sId + setMessageI MsgSupplierDeleted + redirect SupplierR + else do + setMessageI MsgSupplierInUseError + redirect SupplierR + Nothing -> do + setMessageI MsgSupplierUnknown + redirect SupplierR diff --git a/Handler/Transfer.hs b/Handler/Transfer.hs old mode 100644 new mode 100755 diff --git a/Import.hs b/Import.hs old mode 100644 new mode 100755 diff --git a/Import/NoFoundation.hs b/Import/NoFoundation.hs old mode 100644 new mode 100755 diff --git a/LICENSE.md b/LICENSE.md old mode 100644 new mode 100755 diff --git a/Migration/0.0.0-0.0.1/Migration.hs b/Migration/0.0.0-0.0.1/Migration.hs old mode 100644 new mode 100755 diff --git a/Model.hs b/Model.hs old mode 100644 new mode 100755 diff --git a/README.md b/README.md old mode 100644 new mode 100755 diff --git a/Settings.hs b/Settings.hs old mode 100644 new mode 100755 diff --git a/Settings/StaticFiles.hs b/Settings/StaticFiles.hs old mode 100644 new mode 100755 diff --git a/app/DevelMain.hs b/app/DevelMain.hs old mode 100644 new mode 100755 diff --git a/app/devel.hs b/app/devel.hs old mode 100644 new mode 100755 diff --git a/app/main.hs b/app/main.hs old mode 100644 new mode 100755 diff --git a/config/favicon.ico b/config/favicon.ico old mode 100644 new mode 100755 diff --git a/config/keter.yml b/config/keter.yml old mode 100644 new mode 100755 diff --git a/config/models b/config/models old mode 100644 new mode 100755 index 5008efe..c12e0b8 --- a/config/models +++ b/config/models @@ -6,6 +6,7 @@ User avatar AvatarId Maybe UniqueUser ident deriving Typeable Show + Beverage ident Text price Int @@ -14,26 +15,36 @@ Beverage correctedAmount Int default=0 ml Int default=500 avatar AvatarId Maybe + supplier SupplierId Maybe + maxAmount Int default=0 + perCrate Int Maybe + artNr Text Maybe + pricePerCrate Int Maybe UniqueBeverage ident deriving Typeable Show + Transaction description Text amount Int time UTCTime deriving Typeable Show + Cashier balance Int created UTCTime default=now() deriving Typeable Show + CashCheck balance Int time UTCTime deriving Typeable Show + Avatar ident Text data ByteString hash ByteString default='fill_me!' deriving Typeable Show + Barcode code Text isUser Bool @@ -42,4 +53,14 @@ Barcode UniqueBarcode code deriving Show +Supplier + ident Text + address Textarea + tel Text + email Text + customerId Text + avatar AvatarId Maybe + UniqueSupplier ident + deriving Show + -- By default this file is used in Model.hs (which is imported by Foundation.hs) diff --git a/config/robots.txt b/config/robots.txt old mode 100644 new mode 100755 diff --git a/config/routes b/config/routes old mode 100644 new mode 100755 index 78eaddf..9d8872b --- a/config/routes +++ b/config/routes @@ -34,5 +34,12 @@ /barcode HomeBarcodeR GET /user/#UserId/barcode SelectBarcodeR GET !/user/cash/barcode SelectCashBarcodeR GET +/restock/barcode RestockBarcodeR GET /user/#UserId/transfer TransferSelectR GET /user/#UserId/to/#UserId TransferR GET POST +/supply SupplierR GET +/newsupply NewSupplierR GET POST +/supply/#SupplierId SupplierActionsR GET +/supply/#SupplierId/modify ModifySupplierR GET POST +/supply/#SupplierId/digest SupplierDigestR GET +/supply/#SupplierId/delete DeleteSupplierR GET diff --git a/config/settings.yml b/config/settings.yml old mode 100644 new mode 100755 diff --git a/config/test-settings.yml b/config/test-settings.yml old mode 100644 new mode 100755 diff --git a/messages/cz.msg b/messages/cz.msg old mode 100644 new mode 100755 diff --git a/messages/de.msg b/messages/de.msg old mode 100644 new mode 100755 index 59e1a0c..3ca59cd --- a/messages/de.msg +++ b/messages/de.msg @@ -115,3 +115,27 @@ TransferComplete: Transfer abgeschlossen TransferError: Fehler beim Transfer PreviousPage: vorherige Seite NextPage: nächste Seite +MaxAmount: Maximale Lagermenge +AmountPerCrate: Anzahl pro Kasten +SelectSupplier: Lieferanten wählen +CreateSupplier: Neuen Lieferanten anlegen +SupplierCreated: Neuer Lieferant wurde erstellt +SupplierNotCreated: Neuer Lieferant konnte nicht angelegt werden +Suppliers: Lieferanten +NewSupplier: Neuer Lieferant +Address: Adresse +TelNr: Telefonnummer +Email: Email +EditSupplier: Lieferanten bearbeiten +SupplierUnknown: Dieser Lieferant ist nicht bekannt +SupplierEdited: Lieferant wurde bearbeitet +SupplierNotEdited: Lieferant konnte nicht bearbeitet werden +CreateSupplierDigest: Bestellübersicht für diesen Lieferanten erstellen +DeleteSupplier: diesen Lieferanten löschen +SupplierDeleted: Lieferant erfolgreich gelöscht +SupplierInUseError: Dieser Lieferant wird noch von Produkten benutzt. +ArtNr: Artikelnummer +PricePerCrate: Preis Pro Kasten +CrateCount: AnzahlKästen +BuyValue: Zahlbetrag +CustomerId: Kundennummer diff --git a/messages/en.msg b/messages/en.msg old mode 100644 new mode 100755 diff --git a/messages/fr.msg b/messages/fr.msg old mode 100644 new mode 100755 diff --git a/messages/pl.msg b/messages/pl.msg old mode 100644 new mode 100755 diff --git a/static/css/bootstrap.css b/static/css/bootstrap.css old mode 100644 new mode 100755 diff --git a/static/css/main.css b/static/css/main.css old mode 100644 new mode 100755 diff --git a/static/fonts/glyphicons-halflings-regular.eot b/static/fonts/glyphicons-halflings-regular.eot old mode 100644 new mode 100755 diff --git a/static/fonts/glyphicons-halflings-regular.svg b/static/fonts/glyphicons-halflings-regular.svg old mode 100644 new mode 100755 diff --git a/static/fonts/glyphicons-halflings-regular.ttf b/static/fonts/glyphicons-halflings-regular.ttf old mode 100644 new mode 100755 diff --git a/static/fonts/glyphicons-halflings-regular.woff b/static/fonts/glyphicons-halflings-regular.woff old mode 100644 new mode 100755 diff --git a/static/images/cz.svg b/static/images/cz.svg old mode 100644 new mode 100755 diff --git a/static/images/de.svg b/static/images/de.svg old mode 100644 new mode 100755 diff --git a/static/images/en.svg b/static/images/en.svg old mode 100644 new mode 100755 diff --git a/static/images/es.svg b/static/images/es.svg old mode 100644 new mode 100755 diff --git a/static/images/fr.svg b/static/images/fr.svg old mode 100644 new mode 100755 diff --git a/static/images/hr.svg b/static/images/hr.svg old mode 100644 new mode 100755 diff --git a/static/images/jbo.svg b/static/images/jbo.svg old mode 100644 new mode 100755 diff --git a/static/images/pl.svg b/static/images/pl.svg old mode 100644 new mode 100755 diff --git a/static/images/ru.svg b/static/images/ru.svg old mode 100644 new mode 100755 diff --git a/static/js/barcode.js b/static/js/barcode.js old mode 100644 new mode 100755 diff --git a/static/js/crementing.js b/static/js/crementing.js old mode 100644 new mode 100755 diff --git a/templates/avatars.hamlet b/templates/avatars.hamlet old mode 100644 new mode 100755 diff --git a/templates/buy.hamlet b/templates/buy.hamlet old mode 100644 new mode 100755 diff --git a/templates/buyCash.hamlet b/templates/buyCash.hamlet old mode 100644 new mode 100755 diff --git a/templates/cashCheck.hamlet b/templates/cashCheck.hamlet old mode 100644 new mode 100755 diff --git a/templates/copyright.hamlet b/templates/copyright.hamlet old mode 100644 new mode 100755 diff --git a/templates/default-layout-wrapper.hamlet b/templates/default-layout-wrapper.hamlet old mode 100644 new mode 100755 diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet old mode 100644 new mode 100755 index 67821a3..f6f2bf7 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -30,5 +30,7 @@ _{MsgSummary} _{MsgAvatars} + + _{MsgSuppliers}
^{pageBody copyrightWidget} diff --git a/templates/home.hamlet b/templates/home.hamlet old mode 100644 new mode 100755 diff --git a/templates/homepage.hamlet b/templates/homepage.hamlet old mode 100644 new mode 100755 diff --git a/templates/homepage.julius b/templates/homepage.julius old mode 100644 new mode 100755 diff --git a/templates/homepage.lucius b/templates/homepage.lucius old mode 100644 new mode 100755 diff --git a/templates/journal.hamlet b/templates/journal.hamlet old mode 100644 new mode 100755 diff --git a/templates/journalPage.hamlet b/templates/journalPage.hamlet old mode 100644 new mode 100755 diff --git a/templates/modify.hamlet b/templates/modify.hamlet old mode 100644 new mode 100755 diff --git a/templates/modifyAvatar.hamlet b/templates/modifyAvatar.hamlet old mode 100644 new mode 100755 diff --git a/templates/modifySupplier.hamlet b/templates/modifySupplier.hamlet new file mode 100755 index 0000000..728359e --- /dev/null +++ b/templates/modifySupplier.hamlet @@ -0,0 +1,8 @@ +$doctype 5 + +

_{MsgEditSupplier} + +
+ ^{modifySupplierWidget} +
+ diff --git a/templates/modifyUser.hamlet b/templates/modifyUser.hamlet old mode 100644 new mode 100755 diff --git a/templates/newArticle.hamlet b/templates/newArticle.hamlet old mode 100644 new mode 100755 diff --git a/templates/newAvatar.hamlet b/templates/newAvatar.hamlet old mode 100644 new mode 100755 diff --git a/templates/newSupplier.hamlet b/templates/newSupplier.hamlet new file mode 100755 index 0000000..b589961 --- /dev/null +++ b/templates/newSupplier.hamlet @@ -0,0 +1,8 @@ +$doctype 5 + +

_{MsgNewSupplier} + + + ^{newSupplierWidget} +
+ diff --git a/templates/newUser.hamlet b/templates/newUser.hamlet old mode 100644 new mode 100755 diff --git a/templates/payout.hamlet b/templates/payout.hamlet old mode 100644 new mode 100755 diff --git a/templates/reactivate.hamlet b/templates/reactivate.hamlet old mode 100644 new mode 100755 diff --git a/templates/recharge.hamlet b/templates/recharge.hamlet old mode 100644 new mode 100755 diff --git a/templates/restock.hamlet b/templates/restock.hamlet old mode 100644 new mode 100755 index 07c7e03..d4c03ea --- a/templates/restock.hamlet +++ b/templates/restock.hamlet @@ -16,3 +16,6 @@ $forall (Entity bId bev) <- beverages

_{MsgAddItem} + + + diff --git a/templates/select.hamlet b/templates/select.hamlet old mode 100644 new mode 100755 diff --git a/templates/selectCash.hamlet b/templates/selectCash.hamlet old mode 100644 new mode 100755 diff --git a/templates/summary.hamlet b/templates/summary.hamlet old mode 100644 new mode 100755 diff --git a/templates/supplier.hamlet b/templates/supplier.hamlet new file mode 100755 index 0000000..e1d4210 --- /dev/null +++ b/templates/supplier.hamlet @@ -0,0 +1,14 @@ +$doctype 5 + +

+ +

_{MsgCreateSupplier} + +$forall (Entity sId sup) <- sups +

+ $if supplierAvatar sup /= Nothing + +

#{supplierIdent sup} + $else + +

#{supplierIdent sup} diff --git a/templates/supplierActions.hamlet b/templates/supplierActions.hamlet new file mode 100755 index 0000000..5b5a352 --- /dev/null +++ b/templates/supplierActions.hamlet @@ -0,0 +1,13 @@ + +

#{supplierIdent sup} + +