added supplier management

This commit is contained in:
nek0 2015-10-11 20:07:12 +02:00
parent 8db774ccd6
commit 82470c1942
94 changed files with 168 additions and 53 deletions

View file

@ -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))))

3
.ghci
View file

@ -1,3 +0,0 @@
:set -i.:config:dist/build/autogen
:set -DDEVELOPMENT
:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable

0
.gitignore vendored Normal file → Executable file
View file

2
Application.hs Normal file → Executable file
View file

@ -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

2
Foundation.hs Normal file → Executable file
View file

@ -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

3
Handler/Avatar.hs Normal file → Executable file
View file

@ -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

12
Handler/Barcode.hs Normal file → Executable file
View file

@ -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"

0
Handler/Buy.hs Normal file → Executable file
View file

0
Handler/CashCheck.hs Normal file → Executable file
View file

0
Handler/Common.hs Normal file → Executable file
View file

0
Handler/Home.hs Normal file → Executable file
View file

0
Handler/Journal.hs Normal file → Executable file
View file

20
Handler/Modify.hs Normal file → Executable file
View file

@ -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

0
Handler/NewUser.hs Normal file → Executable file
View file

0
Handler/Payout.hs Normal file → Executable file
View file

12
Handler/Restock.hs Normal file → Executable file
View file

@ -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

0
Handler/Select.hs Normal file → Executable file
View file

64
Handler/Summary.hs Normal file → Executable file
View file

@ -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
]

0
Handler/Transfer.hs Normal file → Executable file
View file

0
Import.hs Normal file → Executable file
View file

0
Import/NoFoundation.hs Normal file → Executable file
View file

0
LICENSE.md Normal file → Executable file
View file

0
Migration/0.0.0-0.0.1/Migration.hs Normal file → Executable file
View file

0
Model.hs Normal file → Executable file
View file

0
README.md Normal file → Executable file
View file

0
Settings.hs Normal file → Executable file
View file

0
Settings/StaticFiles.hs Normal file → Executable file
View file

0
app/DevelMain.hs Normal file → Executable file
View file

0
app/devel.hs Normal file → Executable file
View file

0
app/main.hs Normal file → Executable file
View file

0
config/favicon.ico Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

0
config/keter.yml Normal file → Executable file
View file

21
config/models Normal file → Executable file
View file

@ -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)

0
config/robots.txt Normal file → Executable file
View file

7
config/routes Normal file → Executable file
View file

@ -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

0
config/settings.yml Normal file → Executable file
View file

0
config/test-settings.yml Normal file → Executable file
View file

0
messages/cz.msg Normal file → Executable file
View file

24
messages/de.msg Normal file → Executable file
View file

@ -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

0
messages/en.msg Normal file → Executable file
View file

0
messages/fr.msg Normal file → Executable file
View file

0
messages/pl.msg Normal file → Executable file
View file

0
static/css/bootstrap.css vendored Normal file → Executable file
View file

0
static/css/main.css Normal file → Executable file
View file

0
static/fonts/glyphicons-halflings-regular.eot Normal file → Executable file
View file

0
static/fonts/glyphicons-halflings-regular.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 62 KiB

After

Width:  |  Height:  |  Size: 62 KiB

0
static/fonts/glyphicons-halflings-regular.ttf Normal file → Executable file
View file

0
static/fonts/glyphicons-halflings-regular.woff Normal file → Executable file
View file

0
static/images/cz.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 2.3 KiB

After

Width:  |  Height:  |  Size: 2.3 KiB

0
static/images/de.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

0
static/images/en.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

0
static/images/es.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 2 KiB

After

Width:  |  Height:  |  Size: 2 KiB

0
static/images/fr.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

0
static/images/hr.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 102 KiB

After

Width:  |  Height:  |  Size: 102 KiB

0
static/images/jbo.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 385 B

After

Width:  |  Height:  |  Size: 385 B

0
static/images/pl.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 2 KiB

After

Width:  |  Height:  |  Size: 2 KiB

0
static/images/ru.svg Normal file → Executable file
View file

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

0
static/js/barcode.js Normal file → Executable file
View file

0
static/js/crementing.js Normal file → Executable file
View file

0
templates/avatars.hamlet Normal file → Executable file
View file

0
templates/buy.hamlet Normal file → Executable file
View file

0
templates/buyCash.hamlet Normal file → Executable file
View file

0
templates/cashCheck.hamlet Normal file → Executable file
View file

0
templates/copyright.hamlet Normal file → Executable file
View file

0
templates/default-layout-wrapper.hamlet Normal file → Executable file
View file

2
templates/default-layout.hamlet Normal file → Executable file
View file

@ -30,5 +30,7 @@
<a href=@{SummaryR}>_{MsgSummary}
<span>
<a href=@{AvatarR}>_{MsgAvatars}
<span>
<a href=@{SupplierR}>_{MsgSuppliers}
<div .right>
^{pageBody copyrightWidget}

0
templates/home.hamlet Normal file → Executable file
View file

0
templates/homepage.hamlet Normal file → Executable file
View file

0
templates/homepage.julius Normal file → Executable file
View file

0
templates/homepage.lucius Normal file → Executable file
View file

0
templates/journal.hamlet Normal file → Executable file
View file

0
templates/journalPage.hamlet Normal file → Executable file
View file

0
templates/modify.hamlet Normal file → Executable file
View file

0
templates/modifyAvatar.hamlet Normal file → Executable file
View file

0
templates/modifyUser.hamlet Normal file → Executable file
View file

0
templates/newArticle.hamlet Normal file → Executable file
View file

0
templates/newAvatar.hamlet Normal file → Executable file
View file

0
templates/newUser.hamlet Normal file → Executable file
View file

0
templates/payout.hamlet Normal file → Executable file
View file

0
templates/reactivate.hamlet Normal file → Executable file
View file

0
templates/recharge.hamlet Normal file → Executable file
View file

3
templates/restock.hamlet Normal file → Executable file
View file

@ -16,3 +16,6 @@ $forall (Entity bId bev) <- beverages
<a href=@{NewArticleR}>
<p>
_{MsgAddItem}
<form action=@{RestockBarcodeR} method=GET>
<input type=hidden #barcodeInput name=barcode>

0
templates/select.hamlet Normal file → Executable file
View file

0
templates/selectCash.hamlet Normal file → Executable file
View file

0
templates/summary.hamlet Normal file → Executable file
View file

0
templates/transfer.hamlet Normal file → Executable file
View file

0
templates/transferSelect.hamlet Normal file → Executable file
View file

0
templates/uploadJson.hamlet Normal file → Executable file
View file

0
templates/upstock.hamlet Normal file → Executable file
View file

0
test/Handler/CommonSpec.hs Normal file → Executable file
View file

0
test/Handler/HomeSpec.hs Normal file → Executable file
View file

0
test/Spec.hs Normal file → Executable file
View file

0
test/TestImport.hs Normal file → Executable file
View file

42
yammat.cabal Normal file → Executable file
View file

@ -1,5 +1,5 @@
name: yammat
version: 0.0.1
version: 0.0.2
cabal-version: >= 1.8
build-type: Simple
license: AGPL-3
@ -37,9 +37,11 @@ library
Handler.Avatar
Handler.Barcode
Handler.Transfer
Handler.Supplier
Handler.SupplierActions
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT
cpp-options: -DDEVELOPMENT -DHTTP_CLIENT
ghc-options: -Wall -fwarn-tabs -O0
else
ghc-options: -Wall -fwarn-tabs -O2
@ -78,14 +80,14 @@ library
, template-haskell
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4
, monad-control >= 0.3 && < 1.1
, wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3
, warp >= 3.0 && < 3.1
, data-default
, aeson >= 0.6 && < 0.9
, aeson >= 0.6 && < 0.11
, conduit >= 1.0 && < 2.0
, monad-logger >= 0.3 && < 0.4
, fast-logger >= 2.2 && < 2.3
@ -100,16 +102,22 @@ library
, mime-mail
, blaze-markup
, wai
, blaze-builder < 0.4.0.0
, blaze-builder
, split
, conduit-extra
, imagemagick
, cryptohash
, base64-bytestring
-- for Migrations
, HDBC
, HDBC-postgresql
, bytestring
, cryptohash
, base64-bytestring
executable yammat
if flag(library-only)
Buildable: True
Buildable: False
main-is: main.hs
hs-source-dirs: app
@ -117,17 +125,17 @@ executable yammat
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
executable Migrate1
main-is: Migration.hs
hs-source-dirs: Migration/0.0.0-0.0.1
ghc-options: -Wall
build-depends: base
, HDBC
, HDBC-postgresql
, bytestring
, cryptohash
, base64-bytestring
-- executable Migrate1
--
-- main-is: Migration.hs
-- hs-source-dirs: Migration/0.0.0-0.0.1
-- ghc-options: -Wall
-- build-depends: base
-- , HDBC
-- , HDBC-postgresql
-- , bytestring
-- , cryptohash
-- , base64-bytestring
test-suite test
type: exitcode-stdio-1.0