194 lines
8.6 KiB
Haskell
194 lines
8.6 KiB
Haskell
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Handler.Wallet where
|
|
|
|
import Import
|
|
|
|
import Data.Time.Clock
|
|
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 = [ (2,"2 hours")
|
|
, (6,"6 hours")
|
|
, (12,"12 hours")
|
|
, (24,"1 day")
|
|
, (48,"2 days")
|
|
, (7*24,"7 days")
|
|
, (31*24,"31 days")
|
|
]
|
|
|
|
profitIntervals :: [Int64]
|
|
profitIntervals = [7,14,31]
|
|
|
|
getWalletR :: Handler Html
|
|
getWalletR = getWalletDetailsR 6 7
|
|
|
|
getWalletDetailsR :: Int64 -> Int64 -> Handler Html
|
|
getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
|
|
now <- liftIO getCurrentTime
|
|
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|
|
|
<div .panel .panel-default>
|
|
<div .panel-heading>Transactions in the last #{hrs} hours:
|
|
<div .btn-group .btn-group-justified role="group">
|
|
$forall (hrs',cap) <- buttonIntervals
|
|
$if hrs == hrs'
|
|
<a href="@{WalletDetailsR hrs' days}" .btn .active role="button">#{cap}
|
|
$else
|
|
<a href="@{WalletDetailsR hrs' days}" .btn role="button">#{cap}
|
|
<table .table .table-condensed .small>
|
|
<tr>
|
|
<th .text-center>Time
|
|
<th .text-center>P/C
|
|
<th .text-center>B/S
|
|
<th .text-center>Item
|
|
<th .text-center>##
|
|
<th .text-center>ISK/Item
|
|
<th .text-center>ISK total
|
|
<th .text-center>ISK profit
|
|
<th .text-center>%
|
|
<th .text-center>Time
|
|
<th .text-center>Client
|
|
<th .text-center>Station
|
|
<th .text-center>?
|
|
<th .text-center>
|
|
$forall Entity _ t <- trans
|
|
<tr>
|
|
<td>#{showDateTime $ transactionDateTime $ t}
|
|
$if transactionTransForCorp t
|
|
<td .corpTransaction .text-center>C
|
|
$else
|
|
<td .personalTransaction .text-center>P
|
|
$if transactionTransIsSell t
|
|
<td .sellTransaction .text-center>S
|
|
$else
|
|
<td .buyTransaction .text-center>B
|
|
<td>#{transactionTypeName t}
|
|
<td .numeric>#{transactionQuantity t}
|
|
<td .numeric>#{prettyISK $ transactionPriceCents t}
|
|
<td .numeric>#{prettyISK $ transactionQuantity t * transactionPriceCents t}
|
|
$maybe profit <- transRealProfit t
|
|
$if (&&) (transactionTransIsSell t) (profit > 0)
|
|
<td .numeric .profit>
|
|
#{prettyISK $ profit}
|
|
$elseif (&&) (transactionTransIsSell t) (profit < 0)
|
|
<td .numeric .loss>
|
|
#{prettyISK $ profit}
|
|
$elseif not (transactionTransIsSell t)
|
|
<td .numeric .buyfee>
|
|
#{prettyISK $ profit}
|
|
$else
|
|
<td .numeric>
|
|
#{prettyISK $ profit}
|
|
<td .numeric>
|
|
#{profitPercent profit t}%
|
|
$nothing
|
|
<td>
|
|
-
|
|
<td>
|
|
<td .duration>
|
|
$maybe secs <- transactionSecondsToSell t
|
|
#{showSecsToSell secs}
|
|
$nothing
|
|
|
|
<td>#{transactionClientName t}
|
|
<td>#{transactionStationName t}
|
|
<td>
|
|
<td>
|
|
|
|
<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="@{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>
|
|
<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
|
|
|
|
|]
|
|
)
|
|
|
|
transRealProfit :: Transaction -> Maybe Int64
|
|
transRealProfit t = if transactionTransIsSell t then
|
|
(\a b c -> a - b - c) <$> transactionProfit t <*> transactionFee t <*> transactionTax t
|
|
else
|
|
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 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
|