yammat/Handler/Summary.hs

95 lines
2.7 KiB
Haskell
Raw Normal View History

2015-04-04 04:46:33 +00:00
module Handler.Summary where
import Import
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-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-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
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