{-# 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|
Transactions in the last #{hrs} hours:
$forall (hrs',cap) <- buttonIntervals $if hrs == hrs' #{cap} $else #{cap}
Time P/C B/S Item ## ISK/Item ISK total ISK profit % Time Client Station ? $forall Entity _ t <- trans
#{showDateTime $ transactionDateTime $ t} $if transactionTransForCorp t C $else P $if transactionTransIsSell t S $else B #{transactionTypeName t} #{transactionQuantity t} #{prettyISK $ transactionPriceCents t} #{prettyISK $ transactionQuantity t * transactionPriceCents t} $maybe profit <- transRealProfit t $if (&&) (transactionTransIsSell t) (profit > 0) #{prettyISK $ profit} $elseif (&&) (transactionTransIsSell t) (profit < 0) #{prettyISK $ profit} $elseif not (transactionTransIsSell t) #{prettyISK $ profit} $else #{prettyISK $ profit} #{profitPercent profit t}% $nothing - $maybe secs <- transactionSecondsToSell t #{showSecsToSell secs} $nothing   #{transactionClientName t} #{transactionStationName t}
Statistices for the last #{days} days:
$forall days' <- profitIntervals $if days == days' #{days'} days $else #{days'} days
Date ISK Buy ISK Sell ISK Profit ISK Broker Fee ISK Transaction Tax Real Profit % $forall (Profit t b s p bf tt) <- profits
#{show t} #{prettyISK b} #{prettyISK s} #{prettyISK p} #{prettyISK bf} #{prettyISK tt} #{transRealProfit' p bf tt} $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