added profit for last x days on wallet
This commit is contained in:
parent
fc3432b834
commit
a503172e79
@ -1,3 +1,6 @@
|
|||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Handler.Wallet where
|
module Handler.Wallet where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
@ -5,6 +8,23 @@ import Import
|
|||||||
import Data.List (unfoldr)
|
import Data.List (unfoldr)
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
|
import Database.Persist.Sql
|
||||||
|
|
||||||
|
data Profit = Profit
|
||||||
|
{ date :: Day
|
||||||
|
, buy :: Int64
|
||||||
|
, sell :: Int64
|
||||||
|
, profit :: Int64
|
||||||
|
, bf :: Int64
|
||||||
|
, tt :: Int64
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
instance RawSql Profit where
|
||||||
|
rawSqlCols _ _ = (6,[])
|
||||||
|
rawSqlColCountReason _ = "date, buy, sell, profit, bf, tt"
|
||||||
|
rawSqlProcessRow [PersistDay t, PersistInt64 b, PersistInt64 s,
|
||||||
|
PersistInt64 p, PersistInt64 bf, PersistInt64 tt] = Right (Profit t b s p bf tt)
|
||||||
|
rawSqlProcessRow a = Left ("Wrong kinds of Arguments:" <> (pack $ show a))
|
||||||
|
|
||||||
buttonIntervals :: [(Int64,String)]
|
buttonIntervals :: [(Int64,String)]
|
||||||
buttonIntervals = [ (2,"2 hours")
|
buttonIntervals = [ (2,"2 hours")
|
||||||
@ -16,6 +36,9 @@ buttonIntervals = [ (2,"2 hours")
|
|||||||
, (31*24,"31 days")
|
, (31*24,"31 days")
|
||||||
]
|
]
|
||||||
|
|
||||||
|
profitIntervals :: [Int64]
|
||||||
|
profitIntervals = [7,14,31]
|
||||||
|
|
||||||
getWalletR :: Handler Html
|
getWalletR :: Handler Html
|
||||||
getWalletR = getWalletDetailsR 6 7
|
getWalletR = getWalletDetailsR 6 7
|
||||||
|
|
||||||
@ -23,6 +46,22 @@ getWalletDetailsR :: Int64 -> Int64 -> Handler Html
|
|||||||
getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
|
getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
trans <- runDB $ selectList [TransactionDateTime >. (addUTCTime ((fromIntegral $ -(hrs*3600)) :: NominalDiffTime) now)] [Desc TransactionDateTime]
|
trans <- runDB $ selectList [TransactionDateTime >. (addUTCTime ((fromIntegral $ -(hrs*3600)) :: NominalDiffTime) now)] [Desc TransactionDateTime]
|
||||||
|
let profitquery = "select \
|
||||||
|
min(date(date_time at time zone 'utc')) as date,\
|
||||||
|
sum(CASE WHEN NOT trans_is_sell THEN quantity*price_cents ELSE 0 END) :: bigint as buy,\
|
||||||
|
sum(CASE WHEN trans_is_sell THEN quantity*price_cents ELSE 0 END) :: bigint as sell,\
|
||||||
|
sum(COALESCE(profit,0)) :: bigint as profit,\
|
||||||
|
sum(fee) :: bigint as brokerfee,\
|
||||||
|
sum(tax) :: bigint as transactiontax \
|
||||||
|
from transaction \
|
||||||
|
where \
|
||||||
|
\"user\"=? \
|
||||||
|
and extract(day from (now() at time zone 'utc')-date(date_time at time zone 'utc')) < ? \
|
||||||
|
group by \
|
||||||
|
extract(day from (now() at time zone 'utc')-date(date_time at time zone 'utc')) \
|
||||||
|
order by \
|
||||||
|
extract(day from (now() at time zone 'utc')-date(date_time at time zone 'utc')) asc"
|
||||||
|
(profits :: [Profit]) <- runDB $ rawSql profitquery [toPersistValue uid, toPersistValue days]
|
||||||
defaultLayout $ [whamlet|
|
defaultLayout $ [whamlet|
|
||||||
<div .panel .panel-default>
|
<div .panel .panel-default>
|
||||||
<div .panel-heading>Transactions in the last #{hrs} hours:
|
<div .panel-heading>Transactions in the last #{hrs} hours:
|
||||||
@ -94,9 +133,36 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
|
|||||||
|
|
||||||
<div .panel .panel-default>
|
<div .panel .panel-default>
|
||||||
<div .panel-heading>Statistices for the last #{days} days:
|
<div .panel-heading>Statistices for the last #{days} days:
|
||||||
<table .table .table-striped .table-condensed .small>
|
<div .btn-group .btn-group-justified role="group">
|
||||||
|
$forall days' <- profitIntervals
|
||||||
|
$if days == days'
|
||||||
|
<a href="@{WalletDetailsR hrs days'}" .btn .active role="button">#{days'} days
|
||||||
|
$else
|
||||||
|
<a href="@{WalletDetailsR hrs days'}" .btn role="button">#{days'} days
|
||||||
|
<table .table .table-condensed .small>
|
||||||
<tr>
|
<tr>
|
||||||
<th .text-center>TODO
|
<th .text-center>Date
|
||||||
|
<th .text-center>ISK Buy
|
||||||
|
<th .text-center>ISK Sell
|
||||||
|
<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>%
|
||||||
|
$forall (Profit t b s p bf tt) <- profits
|
||||||
|
<tr>
|
||||||
|
<td>#{show t}
|
||||||
|
<td .numeric>#{prettyISK b}
|
||||||
|
<td .numeric>#{prettyISK s}
|
||||||
|
<td .numeric>#{prettyISK p}
|
||||||
|
<td .numeric>#{prettyISK bf}
|
||||||
|
<td .numeric>#{prettyISK tt}
|
||||||
|
<td .numeric>#{transRealProfit' p bf tt}
|
||||||
|
<td .numeric>
|
||||||
|
$maybe pp <- profitPercent' p bf tt s
|
||||||
|
#{pp}
|
||||||
|
$nothing
|
||||||
|
|
||||||
|]
|
|]
|
||||||
)
|
)
|
||||||
|
|
||||||
@ -106,17 +172,25 @@ transRealProfit t = if transactionTransIsSell t then
|
|||||||
else
|
else
|
||||||
negate <$> ((+) <$> transactionFee t <*> transactionTax t)
|
negate <$> ((+) <$> transactionFee t <*> transactionTax t)
|
||||||
|
|
||||||
|
transRealProfit' :: Int64 -> Int64 -> Int64 -> String
|
||||||
|
transRealProfit' p bf tt = prettyISK (p-bf-tt)
|
||||||
|
|
||||||
|
profitPercent' :: Int64 -> Int64 -> Int64 -> Int64 -> Maybe String
|
||||||
|
profitPercent' p bf tt s = if s == 0 then Nothing
|
||||||
|
else Just . printf "%.2f" $ 100*(fromIntegral (p - bf - tt) / fromIntegral s :: Double)
|
||||||
|
|
||||||
profitPercent :: Int64 -> Transaction -> String
|
profitPercent :: Int64 -> Transaction -> String
|
||||||
profitPercent p t = printf "%.2f" $ (100*(fromIntegral p) / (fromIntegral (transactionQuantity t * transactionPriceCents t)) :: Double)
|
profitPercent p t = printf "%.2f" $ (100*(fromIntegral p) / (fromIntegral (transactionQuantity t * transactionPriceCents t)) :: Double)
|
||||||
|
|
||||||
prettyISK :: Int64 -> String
|
prettyISK :: Int64 -> String
|
||||||
prettyISK isk = signIsk++pretty++","++ printf "%02u" cents
|
prettyISK isk = signIsk++pretty++","++ printf "%02u" cents
|
||||||
where
|
where
|
||||||
signIsk = if isk > 0 then "" else "-"
|
signIsk = if isk >= 0 then "" else "-"
|
||||||
(isk',cents) = divMod (abs isk) 100
|
(isk',cents) = divMod (abs isk) 100
|
||||||
thousands = unfoldr (\b -> if b == 0 then Nothing else Just (b `mod` 1000, b `div` 1000)) isk'
|
thousands = unfoldr (\b -> if b == 0 then Nothing else Just (b `mod` 1000, b `div` 1000)) isk'
|
||||||
(ht:t) = reverse thousands
|
pretty = case reverse thousands of
|
||||||
pretty = intercalate "." $ [show ht] ++ (printf "%03u" <$> t)
|
(ht:t) -> intercalate "." $ [show ht] ++ (printf "%03u" <$> t)
|
||||||
|
[] -> "0"
|
||||||
|
|
||||||
showTime :: Int64 -> String
|
showTime :: Int64 -> String
|
||||||
showTime t = printf "%2u" hours ++ ":" ++ printf "%02u" minutes ++ ":" ++ printf "%02u" seconds
|
showTime t = printf "%2u" hours ++ ":" ++ printf "%02u" minutes ++ ":" ++ printf "%02u" seconds
|
||||||
|
Loading…
Reference in New Issue
Block a user