nek0/yammat
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

more statistics

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Foundation.hs
View file

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

2
Handler/Home.hs
View file

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

49
Handler/Statistics.hs
View file

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

63
README.md
View file

@ -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
with:
A working Haskell capable environment. For that you will need `ghc` and
`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 `stack`, let it make itself comfortable in your system with
After you installed `cabal-install`, 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.
Everything else should be done automagically.
First create a sandbox in the project directory with:
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.
Copy or link the executable `yammat` from `.stack-work/dist/<arch>/Cabal-<version>/build/eidolon/`,
where `<arch>` is your systems architecture and `<version>` the version of your `cabal` library,
to your desired run location alongside with the folders `static` and `config` and their contenst.
The Folders should be copied, or you will get problems with your git pulls.
Create a directory outside of the project directory, where you want to actually
run the application. Copy or link the executable `yammat` from
`dist/build/yammat/` to your desired run location alongside with the folders
`static` and `config` and their contenst. The Folders should be copied, or you
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.
Most of these settings normally don't need to be altered much, except for `approot`.
Change this setting to the root address with which you want to connect to the application,
including the scheme (http or https).
Check the configuration File `config/settings.yml` and alter its content to your
liking. Most of these settings normally don't need to be altered much, except
for `approot`. Change this setting to the root address with which you want to
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.
* `currency` is your currency sign or shorthand, which will be used when displaying prices.
* `email` is the email address, which will receive notifications from yammat,
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
and grant the user all privileges on the database.
Create a Postgresql User and Database according to the settings in the settings
file and grant the user all privileges on the database.
## Lift-Off

2
Settings.hs
View file

@ -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, (.!=),
(.:?))

205
stack.yaml
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

12
yammat.cabal
View file

@ -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-postgresql >= 2.1.2 && < 2.2
, persistent-template >= 2.0 && < 2.2
, persistent >= 2.0
, persistent-postgresql >= 2.1.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