yammat/Handler/Summary.hs

160 lines
4.8 KiB
Haskell
Raw Normal View History

2015-08-09 19:16:33 +00:00
-- yammat - Yet Another MateMAT
-- Copyright (C) 2015 Amedeo Molnár
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
2015-04-04 04:46:33 +00:00
module Handler.Summary where
2015-04-23 01:32:53 +00:00
import Import as I
2015-04-10 00:53:55 +00:00
import qualified Data.List as L
2015-04-11 17:44:13 +00:00
import Data.Aeson
import Data.Conduit.Binary
2015-04-24 10:28:45 +00:00
import Handler.Common
2015-04-04 04:46:33 +00:00
getSummaryR :: Handler Html
getSummaryR = do
2015-04-04 06:18:15 +00:00
master <- getYesod
2015-04-04 04:46:33 +00:00
bevs <- runDB $ selectList [] [Asc BeverageIdent]
2015-09-14 22:49:13 +00:00
defaultLayout $
2015-04-04 04:46:33 +00:00
$(widgetFile "summary")
2015-04-10 00:53:55 +00:00
getSummaryJsonR :: Handler RepJson
getSummaryJsonR = do
master <- getYesod
bevs <- runDB $ selectList [] [Asc BeverageIdent]
return $
repJson $ array $
map (\(Entity _ bev) ->
object [ "name" .= beverageIdent bev
, "value" .= beverageAmount bev
2015-09-14 22:49:13 +00:00
, "volume" .= (fromIntegral (beverageMl bev) / 1000 :: Double)
, "price" .= (fromIntegral (beveragePrice bev) / 100 :: Double)
2015-04-10 00:53:55 +00:00
, "currency" .= appCurrency (appSettings master)
]
) bevs
2015-04-11 17:44:13 +00:00
2015-04-16 00:12:03 +00:00
data BevStore = BevStore
{ bevStoreIdent :: Text
, bevStorePrice :: Int
, bevStoreAmount :: Int
2015-10-11 18:07:12 +00:00
, bevStoreMaxAmount :: Int
, bevStorePerCrate :: Maybe Int
2015-04-16 00:12:03 +00:00
, bevStoreAlertAmount :: Int
2015-04-24 10:28:45 +00:00
, bevStoreMl :: Int
2015-10-11 18:07:12 +00:00
, bevStoreArtNr :: Maybe Text
, bevStorePricePerCrate :: Maybe Int
2015-04-16 00:12:03 +00:00
}
instance ToJSON BevStore where
2015-10-12 15:19:51 +00:00
toJSON (BevStore ident price amount maxAmount perCrate alertAmount ml artNr ppc) =
2015-04-11 17:44:13 +00:00
object
[ "name" .= ident
, "price" .= price
, "amount" .= amount
, "alertAt" .= alertAmount
2015-10-11 18:07:12 +00:00
, "max" .= maxAmount
, "perCrate" .= perCrate
2015-04-24 10:28:45 +00:00
, "ml" .= ml
2015-10-11 18:07:12 +00:00
, "artNr" .= artNr
, "pricePerCrate" .= ppc
2015-04-11 17:44:13 +00:00
]
2015-04-16 00:12:03 +00:00
instance FromJSON BevStore where
parseJSON (Object o) = BevStore
2015-04-11 17:44:13 +00:00
<$> o .: "name"
<*> o .: "price"
<*> o .: "amount"
2015-10-11 18:07:12 +00:00
<*> o .: "max"
<*> o .:? "perCrate"
2015-04-11 17:44:13 +00:00
<*> o .: "alertAt"
2015-04-24 10:28:45 +00:00
<*> o .: "ml"
2015-10-11 18:07:12 +00:00
<*> o .:? "artNr"
<*> o .:? "pricePerCrate"
2015-04-11 17:44:13 +00:00
-- For errors
parseJSON _ = mzero
getInventoryJsonR :: Handler RepJson
getInventoryJsonR = do
bevs <- runDB $ selectList [] [Asc BeverageIdent]
return $
repJson $ array $
2015-04-16 00:12:03 +00:00
map (\(Entity _ bev) -> toJSON $ BevStore
(beverageIdent bev)
(beveragePrice bev)
(beverageAmount bev)
2015-10-11 18:07:12 +00:00
(beverageMaxAmount bev)
(beveragePerCrate bev)
2015-04-16 00:12:03 +00:00
(beverageAlertAmount bev)
2015-04-24 10:28:45 +00:00
(beverageMl bev)
2015-10-11 18:07:12 +00:00
(beverageArtNr bev)
(beveragePricePerCrate bev)
2015-04-16 00:12:03 +00:00
) bevs
2015-04-11 17:44:13 +00:00
getUploadInventoryJsonR :: Handler Html
getUploadInventoryJsonR = do
2015-10-22 21:57:27 +00:00
(uploadJsonWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm uploadJsonForm
2015-09-14 22:49:13 +00:00
defaultLayout $
2015-04-11 17:44:13 +00:00
$(widgetFile "uploadJson")
postUploadInventoryJsonR :: Handler Html
postUploadInventoryJsonR = do
2015-10-22 21:57:27 +00:00
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm uploadJsonForm
2015-04-11 17:44:13 +00:00
case res of
2015-09-14 22:49:13 +00:00
FormSuccess file ->
if fileContentType file == "application/json"
then do
2015-04-11 17:44:13 +00:00
source <- runResourceT $ fileSource file $$ sinkLbs
2015-09-14 22:49:13 +00:00
let bevs = fromMaybe [] (decode source :: Maybe [BevStore])
2015-10-11 18:07:12 +00:00
_ <- I.mapM insOrUpd bevs
2015-04-11 17:44:13 +00:00
setMessageI MsgRestoreSuccess
2015-09-14 22:49:13 +00:00
redirect HomeR
else do
2015-04-11 17:44:13 +00:00
setMessageI MsgNotJson
2015-09-14 22:49:13 +00:00
redirect UploadInventoryJsonR
2015-04-11 17:44:13 +00:00
_ -> do
setMessageI MsgErrorOccured
2015-09-14 22:49:13 +00:00
redirect UploadInventoryJsonR
2015-04-11 17:44:13 +00:00
2015-10-22 21:57:27 +00:00
uploadJsonForm :: AForm Handler FileInfo
uploadJsonForm = areq fileField (bfs MsgSelectFile) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
2015-04-11 17:44:13 +00:00
2015-10-11 18:07:12 +00:00
insOrUpd :: BevStore -> Handler (Entity Beverage)
2015-04-11 17:44:13 +00:00
insOrUpd bev = do
2015-10-11 18:07:12 +00:00
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
]