diff --git a/Handler/Stock.hs b/Handler/Stock.hs index fae2dee..399f148 100644 --- a/Handler/Stock.hs +++ b/Handler/Stock.hs @@ -7,7 +7,7 @@ getStockR = loginOrDo (\(uid,user) -> do items <- runDB $ selectList [TransactionUser ==. uid, TransactionInStock >. 0] [Asc TransactionTypeName] defaultLayout $ [whamlet|

Current Stock - +
Item name Quantity diff --git a/Handler/Update.hs b/Handler/Update.hs index 471d2fe..c05fa85 100644 --- a/Handler/Update.hs +++ b/Handler/Update.hs @@ -8,6 +8,7 @@ import qualified Eve.Api.Types as T import qualified Eve.Api.Char.Standings as ST import qualified Eve.Api.Char.Skills as SK import Database.Persist.Sql +import Data.Time.Clock accountingId :: Int64 accountingId = 16622 @@ -93,10 +94,15 @@ updateProfits dat = updateProfits' [] dat && transactionInStock ct > 0 && transactionInStock t < 0 then let m = min (transactionInStock t * (-1)) (transactionInStock ct) - t' = t {transactionInStock = transactionInStock t + m} + t' = t { transactionInStock = transactionInStock t + m + , transactionProfit = maybe (Just prof') (\a -> Just (a + prof')) (transactionProfit t) + , transactionSecondsToSell = maybe (Just secs) (\a -> Just ((a*done + secs * m)`div`(done+m))) (transactionSecondsToSell t) + } ct' = ct {transactionInStock = transactionInStock ct - m} prof' = (transactionPriceCents t - transactionPriceCents ct) * m - (t'',ct'') = updateProfits'' (Entity et (t' { transactionProfit = maybe (Just prof') (\a -> Just (a + prof')) (transactionProfit t')})) ts + secs = round $ diffUTCTime (transactionDateTime t) (transactionDateTime ct) + done = (transactionQuantity t + transactionInStock t) + (t'',ct'') = updateProfits'' (Entity et t') ts in (t'' ,(Entity cet ct'):ct'') else diff --git a/Handler/Wallet.hs b/Handler/Wallet.hs index 60e7281..4ddd3aa 100644 --- a/Handler/Wallet.hs +++ b/Handler/Wallet.hs @@ -2,7 +2,9 @@ module Handler.Wallet where import Import +import Data.List (unfoldr) import Data.Time.Clock +import Text.Printf getWalletR :: Handler Html getWalletR = getWalletDetailsR 6 7 @@ -14,22 +16,55 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do defaultLayout $ [whamlet| show last 7 days

Transactions in the last #{hrs} hours - +
-
Time - Price - Name - Profit + P/C + B/S + Item + Quantity + ISK/Item + ISK total + ISK profit + % + Time + Client + Station + ? + $forall Entity _ t <- trans
#{show $ transactionDateTime t} - #{transactionPriceCents t} - #{transactionClientName t} - - $maybe profit <- transRealProfit t - #{profit} - $nothing + #{show $ utctDay $ transactionDateTime $ t} #{show $ utctDayTime $ 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 + + #{prettyISK $ profit} + + #{profitPercent profit t} + $nothing + - + + + $maybe secs <- transactionSecondsToSell t + #{secs} + $nothing +   + #{transactionClientName t} + #{transactionStationName t} + +

Statistices for the last #{days} days |] @@ -37,3 +72,16 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do transRealProfit :: Transaction -> Maybe Int64 transRealProfit t = (\a b c -> a - b - c) <$> transactionProfit t <*> transactionFee t <*> transactionTax t + +profitPercent :: Int64 -> Transaction -> String +profitPercent p t = printf "%.2f" $ (100*(fromIntegral p) / (fromIntegral (transactionQuantity t * transactionPriceCents t)) :: Double) + +prettyISK :: Int64 -> String +prettyISK isk = pretty++","++ printf "%02u" cents + where + (isk',cents) = divMod isk 100 + thousands = unfoldr (\b -> if b == 0 then Nothing else Just (b `mod` 1000, b `div` 1000)) isk' + (ht:t) = reverse thousands + pretty = intercalate "." $ [show ht] ++ (printf "%03u" <$> t) + +