added supplier management

This commit is contained in:
nek0 2015-10-11 20:07:12 +02:00
parent 8db774ccd6
commit 165ba6318e
100 changed files with 416 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.Avatar
import Handler.Barcode import Handler.Barcode
import Handler.Transfer import Handler.Transfer
import Handler.Supplier
import Handler.SupplierActions
-- This line actually creates our YesodDispatch instance. It is the second half -- 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 -- 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 import Text.Printf
prependZero :: Text -> Text prependZero :: Text -> Text
prependZero t0 prependZero t0
| T.null t1 = t1 | T.null t1 = t1
@ -135,6 +136,7 @@ instance Yesod App where
$(widgetFile "default-layout") $(widgetFile "default-layout")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- The page to be redirected to when authentication is required. -- The page to be redirected to when authentication is required.
-- authRoute _ = Just $ AuthR LoginR -- authRoute _ = Just $ AuthR LoginR

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

@ -141,7 +141,8 @@ getAvatarDeleteR aId = do
Just _ -> do Just _ -> do
c <- runDB $ selectList [UserAvatar ==. Just aId] [] c <- runDB $ selectList [UserAvatar ==. Just aId] []
d <- runDB $ selectList [BeverageAvatar ==. 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 then do
runDB $ delete aId runDB $ delete aId
setMessageI MsgAvatarDeleted setMessageI MsgAvatarDeleted

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

@ -53,6 +53,18 @@ getSelectCashBarcodeR = do
Nothing -> Nothing ->
redirect SelectCashR 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 :: Handler (Maybe (Either UserId BeverageId))
handleSelectParam = do handleSelectParam = do
c <- lookupGetParam "barcode" 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) , BeverageCorrectedAmount +=. (modBevAmount nBev - beverageAmount bev)
, BeverageMl =. modBevMl nBev , BeverageMl =. modBevMl nBev
, BeverageAvatar =. modBevAvatar 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) handleBarcodes (Right bId) (fromMaybe [] $ modBevBarcodes nBev)
setMessageI MsgEditSuccess setMessageI MsgEditSuccess
@ -68,9 +73,14 @@ data ModBev = ModBev
, modBevPrice :: Int , modBevPrice :: Int
, modBevAmount :: Int , modBevAmount :: Int
, modBevAlertAmount :: Int , modBevAlertAmount :: Int
, modBevMaxAmount :: Int
, modBevMl :: Int , modBevMl :: Int
, modBevPC :: Maybe Int
, modBevPricePC :: Maybe Int
, modBevAvatar :: Maybe AvatarId , modBevAvatar :: Maybe AvatarId
, modBevBarcodes :: Maybe [Text] , modBevBarcodes :: Maybe [Text]
, modBevSupp :: Maybe SupplierId
, modBevArtNr :: Maybe Text
} }
modifyForm :: Beverage -> [Text] -> Form ModBev modifyForm :: Beverage -> [Text] -> Form ModBev
@ -79,13 +89,17 @@ modifyForm bev bs = renderDivs $ ModBev
<*> areq currencyField (fieldSettingsLabel MsgPrice) (Just $ beveragePrice bev) <*> areq currencyField (fieldSettingsLabel MsgPrice) (Just $ beveragePrice bev)
<*> areq amountField (fieldSettingsLabel MsgCurrentStock) (Just $ beverageAmount bev) <*> areq amountField (fieldSettingsLabel MsgCurrentStock) (Just $ beverageAmount bev)
<*> areq amountField (fieldSettingsLabel MsgAnnouncedStock) (Just $ beverageAlertAmount bev) <*> areq amountField (fieldSettingsLabel MsgAnnouncedStock) (Just $ beverageAlertAmount bev)
<*> areq amountField (fieldSettingsLabel MsgMaxAmount) (Just $ beverageMaxAmount bev)
<*> areq volumeField (fieldSettingsLabel MsgVolume) (Just $ beverageMl 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 (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ beverageAvatar bev)
<*> aopt barcodeField (fieldSettingsLabel MsgBarcodeField) (Just $ Just bs) <*> aopt barcodeField (fieldSettingsLabel MsgBarcodeField) (Just $ Just bs)
<*> aopt (selectField sups) (fieldSettingsLabel MsgSelectSupplier) (Just $ beverageSupplier bev)
<*> aopt textField (fieldSettingsLabel MsgArtNr) Nothing
where where
avatars = do avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent
ents <- runDB $ selectList [] [Asc AvatarIdent] sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent
optionsPairs $ map (\ent -> (avatarIdent $ entityVal ent, entityKey ent)) ents
getDeleteBeverageR :: BeverageId -> Handler Html getDeleteBeverageR :: BeverageId -> Handler Html
getDeleteBeverageR bId = do 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 redirect HomeR
newArticleForm :: Form Beverage 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 textField (fieldSettingsLabel MsgName) Nothing
<*> areq currencyField (fieldSettingsLabel MsgPrice) (Just 100) <*> areq currencyField (fieldSettingsLabel MsgPrice) (Just 100)
<*> areq amountField (fieldSettingsLabel MsgAmount) (Just 0) <*> areq amountField (fieldSettingsLabel MsgAmount) (Just 0)
<*> areq amountField (fieldSettingsLabel MsgAmountWarning) (Just 0) <*> areq amountField (fieldSettingsLabel MsgAmountWarning) (Just 0)
<*> areq amountField (fieldSettingsLabel MsgMaxAmount) (Just 200)
<*> aopt amountField (fieldSettingsLabel MsgAmountPerCrate) (Just $ Just 20)
<*> pure 0 <*> pure 0
<*> areq volumeField (fieldSettingsLabel MsgVolume) (Just 500) <*> areq volumeField (fieldSettingsLabel MsgVolume) (Just 500)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing
<*> aopt (selectField sups) (fieldSettingsLabel MsgSelectSupplier) Nothing
<*> aopt textField (fieldSettingsLabel MsgArtNr) Nothing
<*> aopt currencyField (fieldSettingsLabel MsgPricePerCrate) Nothing
where where
avatars = do avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent
ents <- runDB $ selectList [] [Asc AvatarIdent] sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent
optionsPairs $ map (\ent -> (avatarIdent $ entityVal ent, entityKey ent)) ents

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

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

@ -47,18 +47,26 @@ data BevStore = BevStore
{ bevStoreIdent :: Text { bevStoreIdent :: Text
, bevStorePrice :: Int , bevStorePrice :: Int
, bevStoreAmount :: Int , bevStoreAmount :: Int
, bevStoreMaxAmount :: Int
, bevStorePerCrate :: Maybe Int
, bevStoreAlertAmount :: Int , bevStoreAlertAmount :: Int
, bevStoreMl :: Int , bevStoreMl :: Int
, bevStoreArtNr :: Maybe Text
, bevStorePricePerCrate :: Maybe Int
} }
instance ToJSON BevStore where instance ToJSON BevStore where
toJSON (BevStore ident price amount alertAmount ml) = toJSON (BevStore ident price amount alertAmount maxAmount perCrate ml artNr ppc) =
object object
[ "name" .= ident [ "name" .= ident
, "price" .= price , "price" .= price
, "amount" .= amount , "amount" .= amount
, "alertAt" .= alertAmount , "alertAt" .= alertAmount
, "max" .= maxAmount
, "perCrate" .= perCrate
, "ml" .= ml , "ml" .= ml
, "artNr" .= artNr
, "pricePerCrate" .= ppc
] ]
instance FromJSON BevStore where instance FromJSON BevStore where
@ -66,8 +74,12 @@ instance FromJSON BevStore where
<$> o .: "name" <$> o .: "name"
<*> o .: "price" <*> o .: "price"
<*> o .: "amount" <*> o .: "amount"
<*> o .: "max"
<*> o .:? "perCrate"
<*> o .: "alertAt" <*> o .: "alertAt"
<*> o .: "ml" <*> o .: "ml"
<*> o .:? "artNr"
<*> o .:? "pricePerCrate"
-- For errors -- For errors
parseJSON _ = mzero parseJSON _ = mzero
@ -80,8 +92,12 @@ getInventoryJsonR = do
(beverageIdent bev) (beverageIdent bev)
(beveragePrice bev) (beveragePrice bev)
(beverageAmount bev) (beverageAmount bev)
(beverageMaxAmount bev)
(beveragePerCrate bev)
(beverageAlertAmount bev) (beverageAlertAmount bev)
(beverageMl bev) (beverageMl bev)
(beverageArtNr bev)
(beveragePricePerCrate bev)
) bevs ) bevs
getUploadInventoryJsonR :: Handler Html getUploadInventoryJsonR :: Handler Html
@ -99,7 +115,7 @@ postUploadInventoryJsonR = do
then do then do
source <- runResourceT $ fileSource file $$ sinkLbs source <- runResourceT $ fileSource file $$ sinkLbs
let bevs = fromMaybe [] (decode source :: Maybe [BevStore]) let bevs = fromMaybe [] (decode source :: Maybe [BevStore])
I.mapM_ insOrUpd bevs _ <- I.mapM insOrUpd bevs
setMessageI MsgRestoreSuccess setMessageI MsgRestoreSuccess
redirect HomeR redirect HomeR
else do else do
@ -113,19 +129,9 @@ uploadJsonForm :: Form FileInfo
uploadJsonForm = renderDivs uploadJsonForm = renderDivs
$ areq fileField (fieldSettingsLabel MsgSelectFile) Nothing $ areq fileField (fieldSettingsLabel MsgSelectFile) Nothing
insOrUpd :: BevStore -> Handler () insOrUpd :: BevStore -> Handler (Entity Beverage)
insOrUpd bev = do insOrUpd bev = do
meb <- runDB $ getBy $ UniqueBeverage $ bevStoreIdent bev nbev <- return $ Beverage
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) (bevStoreIdent bev)
(bevStorePrice bev) (bevStorePrice bev)
(bevStoreAmount bev) (bevStoreAmount bev)
@ -133,3 +139,19 @@ insOrUpd bev = do
0 0
(bevStoreMl bev) (bevStoreMl bev)
Nothing 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
]

97
Handler/Supplier.hs Executable file
View file

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

108
Handler/SupplierActions.hs Executable file
View file

@ -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
<body>
#{supplierIdent sup}<br>
#{unTextarea $ supplierAddress sup}<br>
#{supplierTel sup}<br>
#{supplierEmail sup}<br>
<hr>
<b>
_{MsgCustomerId}: #{supplierCustomerId sup}
<table>
<thead>
<tr>
<th>_{MsgArtNr}
<th>_{MsgName}
<th>_{MsgVolume}
<th>_{MsgCrateCount}
<th>_{MsgPricePerCrate}
<th>_{MsgTotalValue}
$forall dig <- digests
$if bdCrates dig > 0
<tr>
<td>#{fromMaybe "" $ beverageArtNr $ bdBev dig}
<td>#{beverageIdent $ bdBev dig}
<td>#{formatIntVolume $ beverageMl $ bdBev dig}
<td>#{T.pack $ show $ bdCrates dig}
<td>#{formatIntCurrency $ fromMaybe 0 $ beveragePricePerCrate $ bdBev dig} #{appCurrency $ appSettings master}
<td>#{formatIntCurrency $ bdTotal dig} #{appCurrency $ appSettings master}
<td colspan="5">_{MsgBuyValue}
<td>#{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
<html>
<head>
<meta charset="UTF-8">
^{pageHead cont}
<body>
^{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

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 avatar AvatarId Maybe
UniqueUser ident UniqueUser ident
deriving Typeable Show deriving Typeable Show
Beverage Beverage
ident Text ident Text
price Int price Int
@ -14,26 +15,36 @@ Beverage
correctedAmount Int default=0 correctedAmount Int default=0
ml Int default=500 ml Int default=500
avatar AvatarId Maybe avatar AvatarId Maybe
supplier SupplierId Maybe
maxAmount Int default=0
perCrate Int Maybe
artNr Text Maybe
pricePerCrate Int Maybe
UniqueBeverage ident UniqueBeverage ident
deriving Typeable Show deriving Typeable Show
Transaction Transaction
description Text description Text
amount Int amount Int
time UTCTime time UTCTime
deriving Typeable Show deriving Typeable Show
Cashier Cashier
balance Int balance Int
created UTCTime default=now() created UTCTime default=now()
deriving Typeable Show deriving Typeable Show
CashCheck CashCheck
balance Int balance Int
time UTCTime time UTCTime
deriving Typeable Show deriving Typeable Show
Avatar Avatar
ident Text ident Text
data ByteString data ByteString
hash ByteString default='fill_me!' hash ByteString default='fill_me!'
deriving Typeable Show deriving Typeable Show
Barcode Barcode
code Text code Text
isUser Bool isUser Bool
@ -42,4 +53,14 @@ Barcode
UniqueBarcode code UniqueBarcode code
deriving Show 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) -- 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 /barcode HomeBarcodeR GET
/user/#UserId/barcode SelectBarcodeR GET /user/#UserId/barcode SelectBarcodeR GET
!/user/cash/barcode SelectCashBarcodeR GET !/user/cash/barcode SelectCashBarcodeR GET
/restock/barcode RestockBarcodeR GET
/user/#UserId/transfer TransferSelectR GET /user/#UserId/transfer TransferSelectR GET
/user/#UserId/to/#UserId TransferR GET POST /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 TransferError: Fehler beim Transfer
PreviousPage: vorherige Seite PreviousPage: vorherige Seite
NextPage: nächste 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} <a href=@{SummaryR}>_{MsgSummary}
<span> <span>
<a href=@{AvatarR}>_{MsgAvatars} <a href=@{AvatarR}>_{MsgAvatars}
<span>
<a href=@{SupplierR}>_{MsgSuppliers}
<div .right> <div .right>
^{pageBody copyrightWidget} ^{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

View file

@ -0,0 +1,8 @@
$doctype 5
<h3>_{MsgEditSupplier}
<form method=post enctype=#{enctype}>
^{modifySupplierWidget}
<div>
<input type=submit value="_{MsgSubmit}">

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

8
templates/newSupplier.hamlet Executable file
View file

@ -0,0 +1,8 @@
$doctype 5
<h3>_{MsgNewSupplier}
<form method=post enctype=#{enctype}>
^{newSupplierWidget}
<div>
<input type=submit value="_{MsgSubmit}">

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}> <a href=@{NewArticleR}>
<p> <p>
_{MsgAddItem} _{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

14
templates/supplier.hamlet Executable file
View file

@ -0,0 +1,14 @@
$doctype 5
<article .article #func>
<a href=@{NewSupplierR}>
<p>_{MsgCreateSupplier}
$forall (Entity sId sup) <- sups
<article .article>
$if supplierAvatar sup /= Nothing
<a href=@{SupplierActionsR sId} style="background-image: url(@{GetAvatarR $ fromJust $ supplierAvatar sup})" .avatar>
<p>#{supplierIdent sup}
$else
<a href=@{SupplierActionsR sId}>
<p>#{supplierIdent sup}

View file

@ -0,0 +1,13 @@
<h3>#{supplierIdent sup}
<ul>
<li>
<a href=@{SupplierDigestR sId}>
_{MsgCreateSupplierDigest}
<li>
<a href=@{ModifySupplierR sId}>
_{MsgEditSupplier}
<li>
<a href=@{DeleteSupplierR sId}>
_{MsgDeleteSupplier}

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