yammat/Handler/Summary.hs

136 lines
4 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
, bevStoreAlertAmount :: Int
2015-04-24 10:28:45 +00:00
, bevStoreMl :: Int
2015-04-16 00:12:03 +00:00
}
instance ToJSON BevStore where
2015-04-24 10:28:45 +00:00
toJSON (BevStore ident price amount alertAmount ml) =
2015-04-11 17:44:13 +00:00
object
[ "name" .= ident
, "price" .= price
, "amount" .= amount
, "alertAt" .= alertAmount
2015-04-24 10:28:45 +00:00
, "ml" .= ml
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"
<*> o .: "alertAt"
2015-04-24 10:28:45 +00:00
<*> o .: "ml"
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)
(beverageAlertAmount bev)
2015-04-24 10:28:45 +00:00
(beverageMl bev)
2015-04-16 00:12:03 +00:00
) bevs
2015-04-11 17:44:13 +00:00
getUploadInventoryJsonR :: Handler Html
getUploadInventoryJsonR = do
(uploadJsonWidget, enctype) <- generateFormPost 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
((res, _), _) <- runFormPost uploadJsonForm
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-04-23 01:32:53 +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
uploadJsonForm :: Form FileInfo
uploadJsonForm = renderDivs
$ areq fileField (fieldSettingsLabel MsgSelectFile) Nothing
2015-04-16 00:12:03 +00:00
insOrUpd :: BevStore -> Handler ()
2015-04-11 17:44:13 +00:00
insOrUpd bev = do
2015-04-16 00:12:03 +00:00
meb <- runDB $ getBy $ UniqueBeverage $ bevStoreIdent bev
2015-04-11 17:44:13 +00:00
case meb of
2015-09-14 22:49:13 +00:00
Just eb ->
2015-04-11 17:44:13 +00:00
runDB $ update (entityKey eb)
2015-04-16 00:12:03 +00:00
[ BeveragePrice =. bevStorePrice bev
, BeverageAmount =. bevStoreAmount bev
, BeverageAlertAmount =. bevStoreAlertAmount bev
2015-04-24 10:28:45 +00:00
, BeverageMl =. bevStoreMl bev
2015-04-11 17:44:13 +00:00
]
2015-09-14 22:49:13 +00:00
Nothing ->
2015-04-16 00:12:03 +00:00
runDB $ insert_ $ Beverage
(bevStoreIdent bev)
(bevStorePrice bev)
(bevStoreAmount bev)
(bevStoreAlertAmount bev)
2015-05-19 03:37:22 +00:00
0
2015-04-24 10:28:45 +00:00
(bevStoreMl bev)
2015-04-16 00:12:03 +00:00
Nothing