more statistics

This commit is contained in:
nek0 2017-01-21 18:02:29 +01:00
parent a39db41d8e
commit 1a20a2b846
7 changed files with 92 additions and 243 deletions

View file

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

View file

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

View file

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

View file

@ -12,26 +12,25 @@ This project aims to be an implementation for a trust based POS for hackerspaces
#### Environment dependencies #### 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 ```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 ```bash
stack setup cabal update && cabal install cabal-install
``` ```
This might, depending on your system setup, take some time. Brew yourself some tea. This might, depending on your system setup, take some time. Brew yourself some tea.
#### Build dependencies #### 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 * alex
* happy * happy
@ -43,37 +42,49 @@ Install all of them through your package management system.
### Building ### 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 ## 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 ## Configuration
Let's leave the project directory and enter your desired run location. 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`. 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. * `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 ## Lift-Off

View file

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

View file

@ -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

View file

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