yammat/Handler/Statistics.hs

128 lines
4.7 KiB
Haskell
Raw Normal View History

2016-03-23 03:15:49 +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/>.
module Handler.Statistics where
import Import
2017-01-21 17:02:29 +00:00
import Handler.Common
2016-03-23 03:15:49 +00:00
import Data.List hiding (length)
2017-01-21 19:38:38 +00:00
import Data.Maybe (fromMaybe)
2017-01-21 17:02:29 +00:00
import Data.Time.Calendar (addDays)
2016-03-23 03:15:49 +00:00
getStatisticsR :: Handler RepJson
getStatisticsR = do
2017-01-21 17:02:29 +00:00
today <- liftIO $ utctDay <$> getCurrentTime
2016-03-23 03:15:49 +00:00
users <- runDB $ selectList [] [Asc UserId]
2017-01-21 17:02:29 +00:00
positiveBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u >= 0
2016-03-23 03:15:49 +00:00
then acc + (fromIntegral $ userBalance u) / 100
else acc
) 0 users
negativeBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u < 0
then acc + (fromIntegral $ userBalance u) / 100
else acc
) 0 users
2017-01-21 17:02:29 +00:00
aUsers <- runDB $ selectList [UserTimestamp >=. addDays (-30) today] [Asc UserId]
aPositiveBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u >= 0
then acc + (fromIntegral $ userBalance u) / 100
else acc
) 0 aUsers
aNegativeBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u < 0
then acc + (fromIntegral $ userBalance u) / 100
else acc
) 0 aUsers
dUsers <- runDB $ selectList [UserTimestamp <. addDays (-30) today] [Asc UserId]
dPositiveBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u >= 0
then acc + (fromIntegral $ userBalance u) / 100
else acc
) 0 dUsers
dNegativeBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u < 0
then acc + (fromIntegral $ userBalance u) / 100
else acc
) 0 dUsers
totalBalance <- (/100) . fromIntegral <$> getCashierBalance
2016-03-23 03:15:49 +00:00
goodUsers <- runDB $ selectList [UserBalance >=. 0] []
noobAngels <- runDB $ selectList [UserBalance >=. 0, UserBalance <=. 1000] []
noobDevils <- runDB $ selectList [UserBalance <=. 0, UserBalance >=. -1000] []
archangels <- runDB $ selectList [UserBalance >. 5000] []
archdevils <- runDB $ selectList [UserBalance <. -5000] []
bevs <- runDB $ selectList [] [Asc BeverageId]
2017-01-21 20:43:55 +00:00
-- let totalLossPrime = foldl (\acc (Entity _ bev) -> let primePrice = (fromIntegral $ fromMaybe 0 (beveragePricePerCrate bev)) / (fromIntegral $ fromMaybe 1 (beveragePerCrate bev)) in acc + (((fromIntegral $ abs $ beverageCorrectedAmount bev) * primePrice) / 100)) 0 bevs
2016-03-23 03:15:49 +00:00
totalLossRetail <- return $ foldl (\acc (Entity _ bev) ->
2017-01-21 20:43:55 +00:00
acc + ((fromIntegral $ abs $ beverageCorrectedAmount bev) * (fromIntegral $ beveragePrice bev) / 100)
2016-03-23 03:15:49 +00:00
) 0 bevs
return $ repJson $ toJSON $ Statistics
(length users)
2017-01-21 17:02:29 +00:00
(length aUsers)
(length dUsers)
2016-03-23 03:15:49 +00:00
positiveBalance
negativeBalance
2017-01-21 17:02:29 +00:00
totalBalance
2016-03-23 03:15:49 +00:00
(length goodUsers)
(length users - length goodUsers)
(length noobAngels)
(length noobDevils)
(length archangels)
(length archdevils)
2017-01-21 17:02:29 +00:00
aPositiveBalance
aNegativeBalance
dPositiveBalance
dNegativeBalance
2017-01-21 20:43:55 +00:00
-- totalLossPrime
2016-03-23 03:15:49 +00:00
totalLossRetail
data Statistics = Statistics
{ totalUsers :: Int
2017-01-21 17:02:29 +00:00
, activeUsers :: Int
, deadUsers :: Int
2016-03-23 03:15:49 +00:00
, positiveBalance :: Double
, negativeBalance :: Double
2017-01-21 17:02:29 +00:00
, totalBalance :: Double
2016-03-23 03:15:49 +00:00
, goodUsers :: Int
, evilUsers :: Int
, noobAngels :: Int
, noobDevils :: Int
, archangels :: Int
, archdevils :: Int
2017-01-21 17:02:29 +00:00
, activeUsersPositiveBalance :: Double
, activeUsersNegativeBalance :: Double
, deadUsersPositiveBalance :: Double
, deadUsersNegativeBalance :: Double
2017-01-21 20:43:55 +00:00
-- , totalLossPrime :: Double
2016-03-23 03:15:49 +00:00
, totalLossRetail :: Double
}
instance ToJSON Statistics where
2017-01-21 20:43:55 +00:00
toJSON (Statistics tu au du pb nb tb gu eu na nd aa ad aupb aunb dupb dunb tlr) =
2016-03-23 03:15:49 +00:00
object
[ "total_users" .= tu
2017-01-21 17:02:29 +00:00
, "active_users" .= au
, "inactive_users" .= du
2016-03-23 03:15:49 +00:00
, "positive_balance" .= pb
, "negative_balance" .= nb
2017-01-21 17:02:29 +00:00
, "total_balance" .= tb
2016-03-23 03:15:49 +00:00
, "good_users" .= gu
, "evil_users" .= eu
, "noob_angels" .= na
, "noob_devils" .= nd
, "archangels" .= aa
, "archdevils" .= ad
2017-01-21 17:02:29 +00:00
, "active_users_positive_balance" .= aupb
, "active_users_negative_balance" .= aunb
, "inactive_users_positive_balance" .= dupb
, "inactive_users_negative_balance" .= dunb
2017-01-21 20:43:55 +00:00
-- , "total_loss_prime_price" .= tlp
2016-03-23 03:15:49 +00:00
, "total_loss_retail_price" .= tlr
]