added volume info

Handler/Common.hs

@@ -110,3 +110,6 @@ sendMail to subject body =
         , partContent = E.encodeUtf8 body
         }]]
       }
+
+formatIntVolume :: Int -> Text
+formatIntVolume x = formatFloat $ ((fromIntegral x) / 1000)

Handler/Modify.hs

@@ -28,6 +28,7 @@ postModifyR bId = do
             , BeveragePrice =. beveragePrice nBev
             , BeverageAmount =. beverageAmount nBev
             , BeverageAlertAmount =. beverageAlertAmount nBev
+            , BeverageMl =. beverageMl nBev
             , BeverageAvatar =. beverageAvatar nBev
             ]
           setMessageI MsgEditSuccess
@@ -45,6 +46,7 @@ modifyForm bev = renderDivs $ Beverage
   <*> areq currencyField (fieldSettingsLabel MsgPrice) (Just $ beveragePrice bev)
   <*> areq amountField (fieldSettingsLabel MsgCurrentStock) (Just $ beverageAmount bev)
   <*> areq amountField (fieldSettingsLabel MsgAnnouncedStock) (Just $ beverageAlertAmount bev)
+  <*> areq currencyField (fieldSettingsLabel MsgVolume) (Just $ beverageMl bev)
   <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ beverageAvatar bev)
   where
     avatars = do

Handler/Restock.hs

@@ -72,6 +72,7 @@ newArticleForm = renderDivs $ Beverage
   <*> areq currencyField (fieldSettingsLabel MsgPrice) (Just 100)
   <*> areq amountField (fieldSettingsLabel MsgAmount) (Just 0)
   <*> areq amountField (fieldSettingsLabel MsgAmountWarning) (Just 0)
+  <*> areq currencyField (fieldSettingsLabel MsgVolume) (Just 500)
   <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing
   where
     avatars = do

Handler/Summary.hs

@@ -4,6 +4,7 @@ import Import as I
 import qualified Data.List as L
 import Data.Aeson
 import Data.Conduit.Binary
+import Handler.Common
 
 getSummaryR :: Handler Html
 getSummaryR = do
@@ -21,6 +22,7 @@ getSummaryJsonR = do
     map (\(Entity _ bev) ->
           object [ "name" .= beverageIdent bev
                  , "value" .= beverageAmount bev
+                 , "volume" .= ((fromIntegral (beverageMl bev)) / 1000 :: Double)
                  , "price" .= ((fromIntegral (beveragePrice bev)) / 100 :: Double)
                  , "currency" .= appCurrency (appSettings master)
                  ]
@@ -31,15 +33,17 @@ data BevStore = BevStore
   , bevStorePrice :: Int
   , bevStoreAmount :: Int
   , bevStoreAlertAmount :: Int
+  , bevStoreMl :: Int
   }
 
 instance ToJSON BevStore where
-  toJSON (BevStore ident price amount alertAmount) =
+  toJSON (BevStore ident price amount alertAmount ml) =
     object
       [ "name" .= ident
       , "price" .= price
       , "amount" .= amount
       , "alertAt" .= alertAmount
+      , "ml" .= ml
       ]
 
 instance FromJSON BevStore where
@@ -48,6 +52,7 @@ instance FromJSON BevStore where
     <*> o .: "price"
     <*> o .: "amount"
     <*> o .: "alertAt"
+    <*> o .: "ml"
   -- For errors
   parseJSON _ = mzero
 
@@ -61,6 +66,7 @@ getInventoryJsonR = do
         (beveragePrice bev)
         (beverageAmount bev)
         (beverageAlertAmount bev)
+        (beverageMl bev)
         ) bevs
 
 getUploadInventoryJsonR :: Handler Html
@@ -101,6 +107,7 @@ insOrUpd bev = do
         [ BeveragePrice =. bevStorePrice bev
         , BeverageAmount =. bevStoreAmount bev
         , BeverageAlertAmount =. bevStoreAlertAmount bev
+        , BeverageMl =. bevStoreMl bev
         ]
     Nothing -> do
       runDB $ insert_ $ Beverage
@@ -108,4 +115,5 @@ insOrUpd bev = do
         (bevStorePrice bev)
         (bevStoreAmount bev)
         (bevStoreAlertAmount bev)
+        (bevStoreMl bev)
         Nothing

config/models

@@ -11,6 +11,7 @@ Beverage
     price Int
     amount Int
     alertAmount Int
+    ml Int default=500
     avatar AvatarId Maybe
     UniqueBeverage ident
     deriving Typeable Show

messages/cz.msg

@@ -99,3 +99,4 @@ AvatarUploadSuccessfull: Avatar úspěšně nahrán
 DeleteAvatar: Smazat avatar
 AvatarDeleted: Avatar úspěšně smazán
 AvatarInUseError: Avatar nelze smazat dokud je v užitku
+Volume: Objem v l

messages/de.msg

@@ -99,3 +99,4 @@ AvatarUploadSuccessfull: Avatar erfolgreich hochgeladen
 DeleteAvatar: Diesen Avatar löschen
 AvatarDeleted: Avatar gelöscht
 AvatarInUseError: Avatare können nicht gelöscht werden, solange sie in Benutzung sind.
+Volume: Volumen in l

messages/en.msg

@@ -99,3 +99,4 @@ AvatarUploadSuccessfull: Avatar upload successfull
 DeleteAvatar: Delete avatar
 AvatarDeleted: Avatar successfully deleted
 AvatarInUseError: You can not delete avatars that are currently in use
+Volume: Volume in l

templates/buy.hamlet

@@ -3,7 +3,11 @@ $doctype 5
 <h3>_{MsgPurchaseOf $ beverageIdent bev}
 
 <p>
-  _{MsgPricePerUnit (beveragePrice bev) (appCurrency $ appSettings master)}
+  <ul>
+    <li>
+      _{MsgPricePerUnit (beveragePrice bev) (appCurrency $ appSettings master)}
+    <li>
+      _{MsgVolume}: #{formatIntVolume (beverageMl bev)}
 
 <form method=post enctype=#{enctype}>
   ^{buyWidget}

templates/buyCash.hamlet

@@ -3,7 +3,11 @@ $doctype 5
 <h3>_{MsgPurchaseOf $ beverageIdent bev}
 
 <p>
-  _{MsgPricePerUnit (beveragePrice bev + 50) (appCurrency $ appSettings master)}
+  <ul>
+    <li>
+      _{MsgPricePerUnit (beveragePrice bev + 50) (appCurrency $ appSettings master)}
+    <li>
+      _{MsgVolume}: #{formatIntVolume (beverageMl bev)}
 
 <form method=post enctype=#{enctype}>
   ^{buyCashWidget}

templates/summary.hamlet

@@ -7,6 +7,7 @@ $if not $ L.null bevs
     <thead>
       <tr>
         <th>_{MsgName}
+        <th>_{MsgVolume}
         <th>_{MsgCurrentAmount}
         <th>_{MsgAnnouncedStock}
         <th>_{MsgValueIn $ appCurrency $ appSettings master}
@@ -14,6 +15,7 @@ $if not $ L.null bevs
     $forall (Entity bId bev) <- bevs
       <tr>
         <td>#{beverageIdent bev}
+        <td>#{formatIntVolume (beverageMl bev)}
         <td>#{beverageAmount bev}
         <td>#{beverageAlertAmount bev}
         <td>#{formatIntCurrency (beveragePrice bev)} #{appCurrency $ appSettings master}