more statistics

Foundation.hs

@@ -15,7 +15,7 @@
 --  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 module Foundation where
 
-import Import.NoFoundation
+import Import.NoFoundation hiding (tail)
 import Database.Persist.Sql (ConnectionPool, runSqlPool)
 import Text.Hamlet          (hamletFile)
 import Text.Jasmine         (minifym)

Handler/Home.hs

@@ -29,7 +29,7 @@ import Data.Time.Calendar (addDays)
 getHomeR :: Handler Html
 getHomeR = do
   beverages <- runDB $ selectList [BeverageAmount !=. 0] [Desc BeverageIdent]
-  today <- liftIO $ return . utctDay =<< getCurrentTime
+  today <- liftIO $ utctDay <$> getCurrentTime
   users <- runDB $ selectList [UserTimestamp >=. addDays (-30) today] [Asc UserIdent]
   defaultLayout $
     $(widgetFile "home")

Handler/Statistics.hs

@@ -16,13 +16,16 @@
 module Handler.Statistics where
 
 import Import
+import Handler.Common
 import Data.List hiding (length)
 import Data.Maybe (fromJust)
+import Data.Time.Calendar (addDays)
 
 getStatisticsR :: Handler RepJson
 getStatisticsR = do
+  today <- liftIO $ utctDay <$> getCurrentTime
   users <- runDB $ selectList [] [Asc UserId]
-  positiveBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u > 0
+  positiveBalance <- return $ foldl (\acc (Entity _ u) -> if userBalance u >= 0
     then acc + (fromIntegral $ userBalance u) / 100
     else acc
     ) 0 users
@@ -30,6 +33,25 @@ getStatisticsR = do
     then acc + (fromIntegral $ userBalance u) / 100
     else acc
     ) 0 users
+  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
   goodUsers <- runDB $ selectList [UserBalance >=. 0] []
   noobAngels <- runDB $ selectList [UserBalance >=. 0, UserBalance <=. 1000] []
   noobDevils <- runDB $ selectList [UserBalance <=. 0, UserBalance >=. -1000] []
@@ -37,7 +59,7 @@ getStatisticsR = do
   archdevils <- runDB $ selectList [UserBalance <. -5000] []
   bevs <- runDB $ selectList [] [Asc BeverageId]
   totalLossPrime <- return $ foldl (\acc (Entity _ bev) ->
-    let primePrice = if not (isNothing (beveragePricePerCrate bev) || isNothing (beveragePerCrate bev)) then (fromIntegral $ fromJust (beveragePricePerCrate bev)) / (fromIntegral $ fromJust (beveragePerCrate bev)) else 0
+    let primePrice = if not (isNothing (beveragePricePerCrate bev) && not (isNothing (beveragePerCrate bev))) then (fromIntegral $ fromJust (beveragePricePerCrate bev)) / (fromIntegral $ fromJust (beveragePerCrate bev)) else 0.0
     in acc + (((fromIntegral $ beverageCorrectedAmount bev) * primePrice) / 100)
     ) 0 bevs
   totalLossRetail <- return $ foldl (\acc (Entity _ bev) ->
@@ -45,43 +67,64 @@ getStatisticsR = do
     ) 0 bevs
   return $ repJson $ toJSON $ Statistics
     (length users)
+    (length aUsers)
+    (length dUsers)
     positiveBalance
     negativeBalance
+    totalBalance
     (length goodUsers)
     (length users - length goodUsers)
     (length noobAngels)
     (length noobDevils)
     (length archangels)
     (length archdevils)
+    aPositiveBalance
+    aNegativeBalance
+    dPositiveBalance
+    dNegativeBalance
     totalLossPrime
     totalLossRetail
 
 data Statistics = Statistics
   { totalUsers :: Int
+  , activeUsers :: Int
+  , deadUsers :: Int
   , positiveBalance :: Double
   , negativeBalance :: Double
+  , totalBalance :: Double
   , goodUsers :: Int
   , evilUsers :: Int
   , noobAngels :: Int
   , noobDevils :: Int
   , archangels :: Int
   , archdevils :: Int
+  , activeUsersPositiveBalance :: Double
+  , activeUsersNegativeBalance :: Double
+  , deadUsersPositiveBalance :: Double
+  , deadUsersNegativeBalance :: Double
   , totalLossPrime :: Double
   , totalLossRetail :: Double
   }
 
 instance ToJSON Statistics where
-  toJSON (Statistics tu pb nb gu eu na nd aa ad tlp tlr) =
+  toJSON (Statistics tu au du pb nb tb gu eu na nd aa ad aupb aunb dupb dunb tlp tlr) =
     object
       [ "total_users" .= tu
+      , "active_users" .= au
+      , "inactive_users" .= du
       , "positive_balance" .= pb
       , "negative_balance" .= nb
+      , "total_balance" .= tb
       , "good_users" .= gu
       , "evil_users" .= eu
       , "noob_angels" .= na
       , "noob_devils" .= nd
       , "archangels" .= aa
       , "archdevils" .= ad
+      , "active_users_positive_balance" .= aupb
+      , "active_users_negative_balance" .= aunb
+      , "inactive_users_positive_balance" .= dupb
+      , "inactive_users_negative_balance" .= dunb
       , "total_loss_prime_price" .= tlp
       , "total_loss_retail_price" .= tlr
       ]

README.md

@@ -12,26 +12,25 @@ This project aims to be an implementation for a trust based POS for hackerspaces
 
 #### Environment dependencies
 
-A working Haskell capable environment. For that you will need `haskell-stack`, which can be installed
+A working Haskell capable environment. For that you will need `ghc` and
-with:
+`cabal-install`, which can be installed with:
 
 ```bash
-sudo apt-get install haskell-stack
+sudo apt-get install ghc cabal-install
 ```
 
-In case you can't find this package in your repositories, get `stack` from [stackage][stackage].
+After you installed `cabal-install`, let it make itself comfortable in your system with
-
-After you installed `stack`, let it make itself comfortable in your system with
 
 ```bash
-stack setup
+cabal update && cabal install cabal-install
 ```
 
 This might, depending on your system setup, take some time. Brew yourself some tea.
 
 #### Build dependencies
 
-Now that your Haskell environment is set up, you need to install the dependencies for building and running yammat, which are:
+Now that your Haskell environment is set up, you need to install the 
+dependencies for building and running yammat, which are:
 
 * alex
 * happy
@@ -43,37 +42,49 @@ Install all of them through your package management system.
 
 ### Building
 
-To build this project enter `stack build` into your command line.
+First create a sandbox in the project directory with:
-Everything else should be done automagically.
 
-This will take a long time, so go on a quest to find some cookies to go with the tea.
+```bash
+cabal sandbox init && cabal install --only-dependencies
+```
+
+This will take a long time, so go on a quest to find some cookies to go with
+the tea.
+
+To build this project enter `cabal build` into your command line.
+
+Enjoy your cookies and tea while you watch your yammat being built.
 
 ## Deployment
 
-Create a directory outside of the project directory, where you want to actually run the application.
+Create a directory outside of the project directory, where you want to actually
-Copy or link the executable `yammat` from `.stack-work/dist/<arch>/Cabal-<version>/build/eidolon/`,
+run the application. Copy or link the executable `yammat` from
-where `<arch>` is your systems architecture and `<version>` the version of your `cabal` library,
+`dist/build/yammat/` to your desired run location alongside with the folders
-to your desired run location alongside with the folders `static` and `config` and their contenst.
+`static` and `config` and their contenst. The Folders should be copied, or you
-The Folders should be copied, or you will get problems with your git pulls.
+may get problems with your git pulls.
 
 ## Configuration
 
 Let's leave the project directory and enter your desired run location.
-Check the configuration File `config/settings.yml` and alter its content to your liking.
+Check the configuration File `config/settings.yml` and alter its content to your
-Most of these settings normally don't need to be altered much, except for `approot`.
+liking. Most of these settings normally don't need to be altered much, except
-Change this setting to the root address with which you want to connect to the application,
+for `approot`. Change this setting to the root address with which you want to
-including the scheme (http or https).
+connect to the application, including the scheme (http or https).
 Additionally edit the settings `email`, `currency` and `cash_charge`.
 
-* `email` is the email address, which will receive notifications from yammat, should the stock run low.  
+* `email` is the email address, which will receive notifications from yammat,
-* `currency` is your currency sign or shorthand, which will be used when displaying prices.
+should the stock run low.  
+* `currency` is your currency sign or shorthand, which will be used when
+displaying prices.
 * `cash_charge` is the extra you want to charge your users, who pay cash.
-	* *Note:* The value of this setting is in hundredths of your currency denomination.
+	* *Note:* The value of this setting is in hundredths of your currency
+	denomination.
 
-`cash_charge` is effectively a "guest tax". Setting it to `0` is perfectly fine, if you don't want that.
+`cash_charge` is effectively a "guest tax". Setting it to `0` is perfectly fine,
+if you don't want that.
 
-Create a Postgresql User and Database according to the settings in the settings file
+Create a Postgresql User and Database according to the settings in the settings
-and grant the user all privileges on the database.
+file and grant the user all privileges on the database.
 
 ## Lift-Off
 

Settings.hs

@@ -20,7 +20,7 @@
 -- declared in the Foundation.hs file.
 module Settings where
 
-import ClassyPrelude.Yesod
+import ClassyPrelude.Yesod hiding (throw)
 import Control.Exception          (throw)
 import Data.Aeson                 (Result (..), fromJSON, withObject, (.!=),
                                    (.:?))

stack.yaml

@@ -1,205 +0,0 @@
-flags:
-  time-locale-compat:
-    old-locale: false
-extra-package-dbs: []
-packages:
-- '.'
-extra-deps:
-- HDBC-2.4.0.1
-- HDBC-postgresql-2.3.2.3
-- HUnit-1.3.1.1
-- JuicyPixels-3.2.7
-- JuicyPixels-scale-dct-0.1.1.0
-- QuickCheck-2.8.2
-- ReadArgs-1.2.2
-- StateVar-1.1.0.3
-- adjunctions-4.3
-- aeson-0.10.0.0
-- aeson-extra-0.2.3.0
-- ansi-terminal-0.6.2.3
-- ansi-wl-pprint-0.6.7.3
-- appar-0.1.4
-- asn1-encoding-0.9.3
-- asn1-parse-0.9.4
-- asn1-types-0.3.2
-- async-2.1.0
-- attoparsec-0.13.0.1
-- authenticate-1.3.3
-- auto-update-0.1.3
-- base-compat-0.9.0
-- base-orphans-0.5.0
-- base16-bytestring-0.1.1.6
-- base64-bytestring-1.0.0.1
-- basic-prelude-0.5.0
-- bifunctors-5.2.1
-- blaze-builder-0.4.0.1
-- blaze-html-0.8.1.1
-- blaze-markup-0.7.0.3
-- blaze-textual-0.2.1.0
-- byteable-0.1.1
-- byteorder-1.0.4
-- bytestring-builder-0.10.6.0.0
-- carray-0.1.6.3
-- case-insensitive-1.2.0.5
-- cereal-0.5.1.0
-- chunked-data-0.2.0
-- cipher-aes-0.2.11
-- classy-prelude-0.12.5
-- classy-prelude-conduit-0.12.5
-- classy-prelude-yesod-0.12.5
-- clientsession-0.9.1.1
-- comonad-5
-- conduit-1.2.6.1
-- conduit-combinators-1.0.3
-- conduit-extra-1.1.9.2
-- connection-0.2.5
-- contravariant-1.4
-- convertible-1.1.1.0
-- cookie-0.4.1.6
-- cprng-aes-0.6.1
-- crypto-api-0.13.2
-- crypto-cipher-types-0.0.9
-- crypto-random-0.0.9
-- cryptohash-0.11.6
-- cryptohash-conduit-0.1.1
-- cryptonite-0.10
-- css-text-0.1.2.1
-- data-default-0.5.3
-- data-default-class-0.0.1
-- data-default-instances-base-0.0.1
-- data-default-instances-containers-0.0.1
-- data-default-instances-dlist-0.0.1
-- data-default-instances-old-locale-0.0.1
-- distributive-0.5.0.2
-- dlist-0.7.1.2
-- dlist-instances-0.1
-- easy-file-0.2.1
-- email-validate-2.2.0
-- enclosed-exceptions-1.0.1.1
-- entropy-0.3.7
-- exceptions-0.8.2.1
-- fast-logger-2.4.1
-- fft-0.1.8.3
-- file-embed-0.0.9.1
-- free-4.12.4
-- hashable-1.2.4.0
-- hjsmin-0.1.5.1
-- hourglass-0.2.9
-- hspec-2.2.2
-- hspec-core-2.2.2
-- hspec-discover-2.2.2
-- hspec-expectations-0.7.2
-- html-conduit-1.2.1
-- http-client-0.4.27
-- http-client-tls-0.2.2
-- http-conduit-2.1.8
-- http-date-0.0.6.1
-- http-types-0.9
-- iproute-1.7.0
-- ix-shapable-0.1.0
-- kan-extensions-5.0.1
-- keys-3.11
-- language-javascript-0.5.14.2
-- lifted-base-0.2.3.6
-- memory-0.11
-- mime-mail-0.4.11
-- mime-types-0.1.0.6
-- mmorph-1.0.5
-- monad-control-1.0.0.5
-- monad-logger-0.3.17
-- monad-loops-0.4.3
-- mono-traversable-0.10.1
-- mtl-2.2.1
-- mutable-containers-0.3.2
-- mwc-random-0.13.3.2
-- mysql-0.1.1.8
-- mysql-simple-0.2.2.5
-- network-2.6.2.1
-- network-info-0.2.0.8
-- network-uri-2.6.0.3
-- nonce-1.0.2
-- old-locale-1.0.0.7
-- old-time-1.1.0.3
-- optparse-applicative-0.12.1.0
-- parsec-3.1.9
-- path-pieces-0.2.1
-- pcre-light-0.4.0.4
-- pem-0.2.2
-- persistent-2.1.6
-- persistent-mysql-2.1.3.1
-- persistent-postgresql-2.1.6
-- persistent-template-2.1.3.7
-- pointed-5
-- postgresql-libpq-0.9.1.1
-- postgresql-simple-0.4.10.0
-- prelude-extras-0.4.0.3
-- primitive-0.6.1.0
-- profunctors-5.2
-- quickcheck-io-0.1.2
-- random-1.1
-- resource-pool-0.2.3.2
-- resourcet-1.1.7.1
-- safe-0.3.9
-- scientific-0.3.4.4
-- securemem-0.1.9
-- semigroupoids-5.0.1
-- semigroups-0.18.1
-- setenv-0.1.1.3
-- shakespeare-2.0.7
-- silently-1.2.5
-- simple-sendfile-0.2.21
-- skein-1.0.9.4
-- socks-0.5.4
-- split-0.2.3
-- stm-2.4.4.1
-- stm-chans-3.0.0.4
-- storable-complex-0.2.2
-- streaming-commons-0.1.15
-- stringsearch-0.3.6.6
-- syb-0.6
-- system-fileio-0.3.16.3
-- system-filepath-0.4.13.4
-- tagged-0.8.3
-- tagsoup-0.13.8
-- tagstream-conduit-0.5.5.3
-- text-1.2.2.0
-- tf-random-0.5
-- time-locale-compat-0.1.1.1
-- tls-1.3.4
-- transformers-base-0.4.4
-- transformers-compat-0.5.1.4
-- unix-compat-0.4.1.4
-- unix-time-0.3.6
-- unordered-containers-0.2.6.0
-- utf8-string-1.0.1.1
-- uuid-1.3.11
-- uuid-types-1.0.2
-- vault-0.3.0.5
-- vector-0.11.0.0
-- vector-algorithms-0.7.0.1
-- vector-instances-3.3.1
-- void-0.7.1
-- wai-3.0.3.0
-- wai-app-static-3.0.1.1
-- wai-extra-3.0.14
-- wai-logger-2.2.5
-- warp-3.0.13.1
-- word8-0.1.2
-- x509-1.6.3
-- x509-store-1.6.1
-- x509-system-1.6.3
-- x509-validation-1.6.3
-- xml-conduit-1.3.3
-- xml-types-0.3.6
-- xss-sanitize-0.3.5.6
-- yaml-0.8.15.3
-- yesod-1.4.2
-- yesod-auth-1.4.12
-- yesod-core-1.4.19
-- yesod-form-1.4.6
-- yesod-newsfeed-1.5
-- yesod-persistent-1.4.0.3
-- yesod-static-1.4.0.4
-- yesod-test-1.4.4
-- zlib-0.6.1.1
-resolver: ghc-7.10.3

yammat.cabal

@@ -1,5 +1,5 @@
 name:              yammat
-version:           0.0.4
+version:           0.0.5
 cabal-version:     >= 1.8
 build-type:        Simple
 license:           AGPL-3
@@ -76,20 +76,20 @@ library
                  , classy-prelude-yesod          >= 0.10.2
                  , bytestring                    >= 0.9        && < 0.11
                  , text                          >= 0.11       && < 2.0
-                 , persistent                    >= 2.0        && < 2.2
+                 , persistent                    >= 2.0
-                 , persistent-postgresql         >= 2.1.2      && < 2.2
+                 , persistent-postgresql         >= 2.1.2
-                 , persistent-template           >= 2.0        && < 2.2
+                 , persistent-template           >= 2.0
                  , template-haskell
                  , shakespeare                   >= 2.0        && < 2.1
                  , hjsmin                        >= 0.1        && < 0.2
                  , monad-control                 >= 0.3        && < 1.1
                  , wai-extra                     >= 3.0        && < 3.1
                  , yaml                          >= 0.8        && < 0.9
-                 , http-conduit                  >= 2.1        && < 2.2
+                 , http-conduit                  >= 2.1
                  , directory                     >= 1.1        && < 1.3
                  , warp                          >= 3.0        && < 4
                  , data-default
-                 , aeson                         >= 0.6        && < 0.11
+                 , aeson                         >= 0.6
                  , conduit                       >= 1.0        && < 2.0
                  , monad-logger                  >= 0.3        && < 0.4
                  , fast-logger                   >= 2.2        && < 2.5