added quick statistics output

Application.hs

@@ -56,6 +56,7 @@ import Handler.Transfer
 import Handler.Supplier
 import Handler.SupplierActions
 import Handler.Demand
+import Handler.Statistics
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

Handler/Statistics.hs

@@ -0,0 +1,86 @@
+--  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
+import Data.List hiding (length)
+
+getStatisticsR :: Handler RepJson
+getStatisticsR = do
+  users <- runDB $ selectList [] [Asc UserId]
+  positiveBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u > 0
+    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
+  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]
+  totalLossPrime <- return $ foldl (\acc (Entity _ bev) ->
+    let primePrice = (fromIntegral $ fromMaybe 0 (beveragePricePerCrate bev)) / (fromIntegral $ fromMaybe 1 (beveragePerCrate bev))
+    in acc + (((fromIntegral $ beverageCorrectedAmount bev) * primePrice) / 100)
+    ) 0 bevs
+  totalLossRetail <- return $ foldl (\acc (Entity _ bev) ->
+    acc + ((fromIntegral $ beverageCorrectedAmount bev) * (fromIntegral $ beveragePrice bev) / 100)
+    ) 0 bevs
+  return $ repJson $ toJSON $ Statistics
+    (length users)
+    positiveBalance
+    negativeBalance
+    (length goodUsers)
+    (length users - length goodUsers)
+    (length noobAngels)
+    (length noobDevils)
+    (length archangels)
+    (length archdevils)
+    totalLossPrime
+    totalLossRetail
+
+data Statistics = Statistics
+  { totalUsers :: Int
+  , positiveBalance :: Double
+  , negativeBalance :: Double
+  , goodUsers :: Int
+  , evilUsers :: Int
+  , noobAngels :: Int
+  , noobDevils :: Int
+  , archangels :: Int
+  , archdevils :: Int
+  , totalLossPrime :: Double
+  , totalLossRetail :: Double
+  }
+
+instance ToJSON Statistics where
+  toJSON (Statistics tu pb nb gu eu na nd aa ad tlp tlr) =
+    object
+      [ "total_users" .= tu
+      , "positive_balance" .= pb
+      , "negative_balance" .= nb
+      , "good_users" .= gu
+      , "evil_users" .= eu
+      , "noob_angels" .= na
+      , "noob_devils" .= nd
+      , "archangels" .= aa
+      , "archdevils" .= ad
+      , "total_loss_prime_price" .= tlp
+      , "total_loss_retail_price" .= tlr
+      ]

config/routes

@@ -44,3 +44,5 @@
 /supply/#SupplierId/digest	SupplierDigestR		GET
 /supply/#SupplierId/delete	DeleteSupplierR		GET
 /demand/#Int                    DemandR                 GET
+
+/statistics.json		StatisticsR		GET

yammat.cabal

@@ -40,6 +40,7 @@ library
                      Handler.Supplier
                      Handler.SupplierActions
                      Handler.Demand
+                     Handler.Statistics
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT -DHTTP_CLIENT