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]
defaultLayout $ do
$(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-04-24 10:28:45 +00:00
, "volume" .= ((fromIntegral (beverageMl bev)) / 1000 :: Double)
2015-04-11 17:44:13 +00:00
, "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
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
2015-04-16 00:12:03 +00:00
bevs <- return $ 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
redirect $ HomeR
False -> do
setMessageI MsgNotJson
redirect $ UploadInventoryJsonR
_ -> do
setMessageI MsgErrorOccured
redirect $ UploadInventoryJsonR
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
Just eb -> do
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
]
Nothing -> do
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