inventory backup

Handler/Summary.hs

@@ -2,7 +2,8 @@ module Handler.Summary where
 
 import Import
 import qualified Data.List as L
-import Handler.Common
+import Data.Aeson
+import Data.Conduit.Binary
 
 getSummaryR :: Handler Html
 getSummaryR = do
@@ -20,7 +21,74 @@ getSummaryJsonR = do
     map (\(Entity _ bev) ->
           object [ "name" .= beverageIdent bev
                  , "value" .= beverageAmount bev
-                 , "price" .= beveragePrice bev
+                 , "price" .= ((fromIntegral (beveragePrice bev)) / 100 :: Double)
                  , "currency" .= appCurrency (appSettings master)
                  ]
         ) bevs
+
+instance ToJSON Beverage where
+  toJSON (Beverage ident price amount alertAmount) =
+    object
+      [ "name" .= ident
+      , "price" .= price
+      , "amount" .= amount
+      , "alertAt" .= alertAmount
+      ]
+
+instance FromJSON Beverage where
+  parseJSON (Object o) = Beverage
+    <$> o .: "name"
+    <*> o .: "price"
+    <*> o .: "amount"
+    <*> o .: "alertAt"
+  -- For errors
+  parseJSON _ = mzero
+
+getInventoryJsonR :: Handler RepJson
+getInventoryJsonR = do
+  bevs <- runDB $ selectList [] [Asc BeverageIdent]
+  return $
+    repJson $ array $
+      map (\(Entity _ bev) -> toJSON bev) bevs
+
+getUploadInventoryJsonR :: Handler Html
+getUploadInventoryJsonR = do
+  (uploadJsonWidget, enctype) <- generateFormPost uploadJsonForm
+  defaultLayout $ do
+    $(widgetFile "uploadJson")
+
+postUploadInventoryJsonR :: Handler Html
+postUploadInventoryJsonR = do
+  ((res, _), _) <- runFormPost uploadJsonForm
+  case res of
+    FormSuccess file -> do
+      case fileContentType file == "application/json" of
+        True -> do
+          source <- runResourceT $ fileSource file $$ sinkLbs
+          bevs <- return $ fromMaybe [] $ (decode source :: Maybe [Beverage])
+          _ <- return $ map insOrUpd bevs
+          setMessageI MsgRestoreSuccess
+          redirect $ HomeR
+        False -> do
+          setMessageI MsgNotJson
+          redirect $ UploadInventoryJsonR
+    _ -> do
+      setMessageI MsgErrorOccured
+      redirect $ UploadInventoryJsonR
+
+uploadJsonForm :: Form FileInfo
+uploadJsonForm = renderDivs
+  $ areq fileField (fieldSettingsLabel MsgSelectFile) Nothing
+
+insOrUpd :: Beverage -> Handler ()
+insOrUpd bev = do
+  meb <- runDB $ getBy $ UniqueBeverage $ beverageIdent bev
+  case meb of
+    Just eb -> do
+      runDB $ update (entityKey eb)
+        [ BeveragePrice =. beveragePrice bev
+        , BeverageAmount =. beverageAmount bev
+        , BeverageAlertAmount =. beverageAlertAmount bev
+        ]
+    Nothing -> do
+      runDB $ insert_ bev

config/routes

@@ -23,3 +23,5 @@
 /modify/#BeverageId		ModifyR			GET POST
 /delete/#BeverageId		DeleteBeverageR		GET
 /cashcheck			CashCheckR		GET POST
+/backup				UploadInventoryJsonR	GET POST
+/backup/inventory.json		InventoryJsonR		GET

messages/cz.msg

@@ -74,3 +74,9 @@ NoItems: Žadné zboží
 StockUp name@Text: Přidat #{name}
 Fillup: Naplnit
 CashCheckOf date@String: Kontrola kasy od #{date}
+NotJson: Toto nejsou JSON data
+Upload: Nahrát zálohu
+SelectFile: Vyber soubor
+RestoreSuccess: Databáze znovu nahrána!
+InventoryBackup: Stahnout zálohu
+RestoreFromBackup: Nahrát záĺohu

messages/de.msg

@@ -74,3 +74,9 @@ NoItems: keine Getränke vorhanden
 StockUp name@Text: Bestand von #{name} auffüllen
 Fillup: Auffüllen
 CashCheckOf date@String: Kassensturz vom #{date}
+NotJson: Dies sind keine JSON daten
+Upload: Sicherung hochladen
+SelectFile: Datei auswählen
+RestoreSuccess: Datenbankwiederherstellung erfolgreich!
+InventoryBackup: Inventarsicherung herunterladen
+RestoreFromBackup: Inventar wiederherstellen

messages/en.msg

@@ -74,3 +74,9 @@ NoItems: No items
 StockUp name@Text: Stock up #{name}
 Fillup: Fill up
 CashCheckOf date@String: Cash check of #{date}
+NotJson: These are not JSON data
+Upload: Upload backup
+SelectFile: Select file
+RestoreSuccess: Database restored successfully!
+InventoryBackup: Backup inventory
+RestoreFromBackup: Restore from backup

messages/pl.msg

@@ -74,3 +74,9 @@ NoItems: Napoje dostępne żadne
 StockUp name@Text: składało się z #{name} wypełnić
 Fillup: wypełnić
 CashCheckOf date@String: Fundusze spaść z #{date}
+NotJson: These are not JSON data
+Upload: Upload backup
+SelectFile: Select file
+RestoreSuccess: Database restored successfully!
+InventoryBackup: Backup inventory
+RestoreFromBackup: Restore from backup

templates/summary.hamlet

@@ -20,3 +20,11 @@ $if not $ L.null bevs
         <td><a href=@{ModifyR bId}>bearbeiten
 $else
   <p>_{MsgNoItems}
+
+<ul>
+  <li>
+    <a href=@{InventoryJsonR}>
+      _{MsgInventoryBackup}
+  <li>
+    <a href=@{UploadInventoryJsonR}>
+      _{MsgRestoreFromBackup}

templates/uploadJson.hamlet

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

yammat.cabal

@@ -95,6 +95,7 @@ library
                  , wai
                  , blaze-builder                 < 0.4.0.0
                  , split
+                 , conduit-extra
 
 executable         yammat
     if flag(library-only)