From 1a20a2b846393104f347ae76da370ce85b71530c Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 21 Jan 2017 18:02:29 +0100 Subject: [PATCH] more statistics --- Foundation.hs | 2 +- Handler/Home.hs | 2 +- Handler/Statistics.hs | 49 +++++++++- README.md | 63 +++++++------ Settings.hs | 2 +- stack.yaml | 205 ------------------------------------------ yammat.cabal | 12 +-- 7 files changed, 92 insertions(+), 243 deletions(-) delete mode 100644 stack.yaml diff --git a/Foundation.hs b/Foundation.hs index f56228e..00756a7 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see . 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) diff --git a/Handler/Home.hs b/Handler/Home.hs index 04653f5..4ab1576 100644 --- a/Handler/Home.hs +++ b/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") diff --git a/Handler/Statistics.hs b/Handler/Statistics.hs index 270dadc..85e7322 100644 --- a/Handler/Statistics.hs +++ b/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 ] diff --git a/README.md b/README.md index 3c693f3..17d4a83 100644 --- a/README.md +++ b/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 -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//Cabal-/build/eidolon/`, -where `` is your systems architecture and `` 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 diff --git a/Settings.hs b/Settings.hs index 1995bbf..1fc9077 100644 --- a/Settings.hs +++ b/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, (.!=), (.:?)) diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 index 679bf97..0000000 --- a/stack.yaml +++ /dev/null @@ -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 diff --git a/yammat.cabal b/yammat.cabal index 376408c..b47e349 100644 --- a/yammat.cabal +++ b/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-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