Stats now work correctly
This commit is contained in:
parent
7de15e9bac
commit
09612c9364
@ -1,6 +1,108 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Handler.ProfitItems where
|
||||
|
||||
import Import
|
||||
import Database.Persist.Sql (rawSql,RawSql(..))
|
||||
import Text.Printf
|
||||
|
||||
|
||||
data Profit = Profit
|
||||
{ typeName :: Text
|
||||
, typeId :: Int64
|
||||
, quantity :: Int64
|
||||
, profitcents :: Int64
|
||||
, fee :: Int64
|
||||
, tax :: Int64
|
||||
, avg :: Int64
|
||||
, sellcents :: Int64
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
-- profitcents may be NULL (therfore also avg). Test for that. Rest ist never NULL, due to update-routine
|
||||
instance RawSql Profit where
|
||||
rawSqlCols _ _ = (8,[])
|
||||
rawSqlColCountReason _ = "typeName, typeId, quantity, profit, fee, tax, avg, sell"
|
||||
rawSqlProcessRow [PersistText t, PersistInt64 i, PersistRational q,
|
||||
PersistRational pc, PersistRational bf, PersistRational tt,
|
||||
PersistRational a, PersistRational s] = Right (Profit t i (c q) (c pc) (c bf) (c tt) (c a) (c s))
|
||||
where c = floor
|
||||
rawSqlProcessRow [PersistText t, PersistInt64 i, PersistRational q,
|
||||
PersistNull, PersistRational bf, PersistRational tt,
|
||||
PersistNull, PersistRational s] = Right (Profit t i (c q) 0 (c bf) (c tt) 0 (c s))
|
||||
where c = floor
|
||||
rawSqlProcessRow a = Left ("Wrong kinds of Arguments:" <> (pack $ show a))
|
||||
|
||||
profitIntervals :: [Int64]
|
||||
profitIntervals = [1,2,7,14,31]
|
||||
|
||||
getProfitItemsR :: Handler Html
|
||||
getProfitItemsR = error "Not yet implemented: getProfitItemsR"
|
||||
getProfitItemsR = getProfitItemsDetailsR 7
|
||||
|
||||
|
||||
getProfitItemsDetailsR :: Int64 -> Handler Html
|
||||
getProfitItemsDetailsR days = loginOrDo (\(uid,user) -> do
|
||||
let sql = "select type_name, type_id, sum(quantity) as quantity, sum(profit) as profitcents,\
|
||||
sum(fee) as brokerfee, sum(tax) as transactiontax,\
|
||||
sum(seconds_to_sell)/(sum(CASE WHEN trans_is_sell THEN 1 ELSE 0 END)+0.01) as avg,\
|
||||
sum(CASE WHEN trans_is_sell THEN quantity*price_cents ELSE 0 END) as sell\
|
||||
from transaction\
|
||||
where\
|
||||
\"user\"=? and\
|
||||
extract(day from now()-date(date_time) at time zone 'utc') < ?\
|
||||
and not problematic\
|
||||
group by type_id, type_name\
|
||||
order by (coalesce(sum(profit),0)-sum(fee)-sum(tax)) desc"
|
||||
(items :: [Profit]) <- runDB $ rawSql sql [toPersistValue uid, toPersistValue days]
|
||||
loginLayout user $ [whamlet|
|
||||
<div .panel .panel-default>
|
||||
<div .panel-heading>Statistices for the last #{days} days:
|
||||
<div .btn-group .btn-group-justified role="group">
|
||||
$forall days' <- profitIntervals
|
||||
$if days == days'
|
||||
<a href="@{ProfitItemsDetailsR days'}" .btn .active role="button">#{days'} days
|
||||
$else
|
||||
<a href="@{ProfitItemsDetailsR days'}" .btn role="button">#{days'} days
|
||||
<table .table .table-condensed .small>
|
||||
<tr>
|
||||
<th .text-center>Item
|
||||
<th .text-center>ISK Profit
|
||||
<th .text-center>ISK Broker Fee
|
||||
<th .text-center>ISK Transaction Tax
|
||||
<th .text-center>Real Profit
|
||||
<th .text-center>Avg Time
|
||||
<th .text-center># Items
|
||||
<th .text-center>Real Profit/Day
|
||||
<th .text-center>%
|
||||
<th .text-center>%/Day
|
||||
$forall (Profit tn tid quant pc f t a sc) <- items
|
||||
<tr>
|
||||
<td>#{tn}
|
||||
<td .numeric>#{prettyISK pc}
|
||||
<td .numeric>#{prettyISK f}
|
||||
<td .numeric>#{prettyISK t}
|
||||
<td .numeric>#{transRealProfit' pc f t}
|
||||
<td .numeric>#{showSecsToSell a}
|
||||
<td .numeric>#{quant}
|
||||
<td .numeric>#{prettyISK $ profitPerDay pc f t a}
|
||||
<td .numeric>#{profitPercent pc f t sc}
|
||||
<td .numeric>#{profitPercentDay pc f t sc a}
|
||||
|]
|
||||
)
|
||||
|
||||
|
||||
transRealProfit' :: Int64 -> Int64 -> Int64 -> String
|
||||
transRealProfit' p bf tt = prettyISK (p-bf-tt)
|
||||
|
||||
profitPerDay :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
|
||||
profitPerDay _ _ _ 0 = 0
|
||||
profitPerDay p f t a = ((p-f-t) * 86400) `div` a
|
||||
|
||||
profitPercent :: Int64 -> Int64 -> Int64 -> Int64 -> String
|
||||
profitPercent _ _ _ 0 = printf "%.2f" $ (0 :: Double)
|
||||
profitPercent p f t s = printf "%.2f" $ (100*(fromIntegral (p-f-t)) / (fromIntegral s) :: Double)
|
||||
|
||||
profitPercentDay :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> String
|
||||
profitPercentDay _ _ _ 0 _ = printf "%.2f" $ (0 :: Double)
|
||||
profitPercentDay _ _ _ _ 0 = printf "%.2f" $ (0 :: Double)
|
||||
profitPercentDay p f t s a = printf "%.2f" $ (100*(fromIntegral (profitPerDay p f t a)) / (fromIntegral s) :: Double)
|
||||
|
||||
@ -180,14 +180,3 @@ profitPercent' p bf tt s = if s == 0 then Nothing
|
||||
|
||||
profitPercent :: Int64 -> Transaction -> String
|
||||
profitPercent p t = printf "%.2f" $ (100*(fromIntegral p) / (fromIntegral (transactionQuantity t * transactionPriceCents t)) :: Double)
|
||||
|
||||
|
||||
showSecsToSell :: Int64 -> String
|
||||
showSecsToSell t
|
||||
| t > 4*7*86400 = pp (fromIntegral t / (7*86400) :: Double) ++ "w"
|
||||
| t > 86400 = pp (fromIntegral t / 86400 :: Double) ++ "d"
|
||||
| t > 3600 = pp (fromIntegral t / 3600 :: Double) ++ "h"
|
||||
| t > 60 = pp (fromIntegral t / 60 :: Double) ++ "m"
|
||||
| otherwise = pp (fromIntegral t :: Double) ++ "s"
|
||||
where
|
||||
pp x = printf "%.2f" x
|
||||
|
||||
12
Import.hs
12
Import.hs
@ -61,3 +61,15 @@ loginLayout user widget = do
|
||||
addScript $ StaticR js_bootstrap_js
|
||||
$(widgetFile "default-layout")
|
||||
withUrlRenderer $(hamletFile "templates/login-layout-wrapper.hamlet")
|
||||
|
||||
|
||||
showSecsToSell :: Int64 -> String
|
||||
showSecsToSell t
|
||||
| t > 4*7*86400 = pp (fromIntegral t / (7*86400) :: Double) ++ "w"
|
||||
| t > 86400 = pp (fromIntegral t / 86400 :: Double) ++ "d"
|
||||
| t > 3600 = pp (fromIntegral t / 3600 :: Double) ++ "h"
|
||||
| t > 60 = pp (fromIntegral t / 60 :: Double) ++ "m"
|
||||
| t == 0 = "-"
|
||||
| otherwise = pp (fromIntegral t :: Double) ++ "s"
|
||||
where
|
||||
pp = printf "%.2f"
|
||||
|
||||
@ -12,3 +12,4 @@
|
||||
/update UpdateR GET
|
||||
/stock StockR GET
|
||||
/analysis/items ProfitItemsR GET
|
||||
/analysis/items/#Int64 ProfitItemsDetailsR GET
|
||||
|
||||
@ -42,18 +42,18 @@ $newline never
|
||||
<li><a href="@{HomeR}">Home</a>
|
||||
<li><a href="@{WalletR}">Transactions</a>
|
||||
<li><a href="@{StockR}">Stock</a>
|
||||
<li><a href="@{SettingsR}">Settings</a>
|
||||
<li><a href="#">#{prettyISK $ userBalanceCents user} ISK</a>
|
||||
<!--li class="dropdown">
|
||||
<a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Dropdown <span class="caret"></span>
|
||||
<li class="dropdown">
|
||||
<a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Analysis <span class="caret"></span>
|
||||
<ul class="dropdown-menu">
|
||||
<li><a href="#">Action</a>
|
||||
<li><a href="#">Another action</a>
|
||||
<li><a href="@{ProfitItemsR}">Profitable Items</a>
|
||||
<!--li><a href="#">Another action</a>
|
||||
<li><a href="#">Something else here</a>
|
||||
<li role="separator" class="divider">
|
||||
<li><a href="#">Separated link</a>
|
||||
<li role="separator" class="divider">
|
||||
<li><a href="@SettingsR">Settings</a-->
|
||||
<li><a href="@{SettingsR}">Settings</a>
|
||||
<li><a href="#">#{prettyISK $ userBalanceCents user} ISK</a>
|
||||
<ul class="nav navbar-nav navbar-right">
|
||||
<li><a href="@{UpdateR}">Update</a>
|
||||
<li><a href="@{AuthR LogoutR}">Logout</a>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user