diff --git a/Foundation.hs b/Foundation.hs index d9d41bc..3d151e7 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -153,9 +153,12 @@ instance YesodAuth App where , userStandingsTimeout = now , userSkillTimeout = now , userBalanceTimeout = now + , userOrderTimeout = now , userAcc = 0 , userBr = 0 , userBalanceCents = 0 + , userStockCents = 0 + , userEscrowCents = 0 } Nothing -> return $ ServerError "Problems extracting Access-Token" where diff --git a/Handler/Home.hs b/Handler/Home.hs index 797bb9a..5194939 100644 --- a/Handler/Home.hs +++ b/Handler/Home.hs @@ -19,12 +19,13 @@ getHomeR = do getLoggedIn :: (Key User, User) -> Handler Html getLoggedIn (uid, user) = do + let totalworth = userBalanceCents user + userStockCents user + userEscrowCents user loginLayout user $ [whamlet|

Welcome back, #{userName user}.

Current Balance: #{prettyISK $ userBalanceCents user} ISK. -

Current Stock Worth: ... -

Current total Worth: ... -

Profit in the last 7 days: ... +

Current Stock Worth: #{prettyISK $ userStockCents user} ISK. +

Current Escrow Worth: #{prettyISK $ userEscrowCents user} ISK. +

Current total Worth: #{prettyISK $ totalworth} ISK. |] diff --git a/Handler/Stock.hs b/Handler/Stock.hs index e41a2d1..11b5c12 100644 --- a/Handler/Stock.hs +++ b/Handler/Stock.hs @@ -30,7 +30,6 @@ data DisCols = DisCols , dResell :: Int64 } deriving (Show, Eq) - instance RawSql Stock where rawSqlCols _ _ = (8,[]) rawSqlColCountReason _ = "typeId, stationId, stationName, typeName, inStock, worth, date, tax" @@ -81,6 +80,7 @@ getStockR = loginOrDo (\(uid,user) -> do order by t.type_name asc" (items :: [Stock]) <- runDB $ rawSql sql [toPersistValue uid] let items' = convertStock <$> items + let total = foldl' sumTotal 0 items' loginLayout user $ [whamlet|

Current Stock: @@ -102,6 +102,14 @@ getStockR = loginOrDo (\(uid,user) -> do #{prettyISK taxed} #{prettyISK wrth} #{sn} + + Total + + + + + #{prettyISK total} + |] ) @@ -109,3 +117,7 @@ convertStock :: Stock -> DisCols convertStock (Stock tid sid sn tn is wrth dt tax) = DisCols tid sid sn tn (floor is) (floor wrth) avgItem dt (floor $ (fromIntegral avgItem) * tax) where avgItem = floor $ wrth / is + + +sumTotal :: Int64 -> DisCols -> Int64 +sumTotal t (DisCols _ _ _ _ _ t' _ _ _) = t + t' diff --git a/Handler/Update.hs b/Handler/Update.hs index fd4af6c..7579b82 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 qualified Eve.Api.Char.AccountBalance as BA +import qualified Eve.Api.Char.MarketOrders as MO import Database.Persist.Sql import Data.Time.Clock import Control.Lens.Operators @@ -91,6 +92,26 @@ getUpdateR = loginOrDo (\(uid,user) -> do update uid [UserBalanceCents =. fromIntegral (balance' ^. BA.centbalance)] update uid [UserBalanceTimeout =. time'] _ -> return () + --update stock-worth (cache) + let stocksql = "update \"user\" set \ + stock_cents = (select sum(in_stock*price_cents) from transaction where \"user\"=\"user\".id and price_cents > 0 and in_stock > 0 and not trans_is_sell)\ + where id=?" + runDB $ rawExecute stocksql [toPersistValue uid] + --get current Orders + when (userOrderTimeout user < now) $ + do + orders <- liftIO $ MO.getMarketOrders man apidata + case orders of + T.QueryResult time' orders' -> runDB $ do + deleteWhere [OrderUser ==. uid] + insertMany_ (migrateOrders uid <$> orders') + update uid [UserOrderTimeout =. time'] + --update escrow-worth (cache) + let ordersql = "update \"user\" set \ + escrow_cents = COALESCE((select sum(escrow_cents) from \"order\" where \"user\"=\"user\".id),0) \ + where id=?" + rawExecute ordersql [toPersistValue uid] + _ -> return () redirect WalletR ) @@ -152,3 +173,8 @@ migrateTransaction u (WT.Transaction dt tid q tn ti pc ci cn si sn tt tf jti) = tfc :: WT.TransactionFor -> Bool tfc WT.Corporation = True tfc WT.Personal = False + +migrateOrders :: UserId -> MO.Order -> Import.Order +migrateOrders uid (MO.Order oid cid sid ve vr mv os tid r ak dur esc pric bid iss) = + Import.Order uid oid cid sid ve vr mv (fromIntegral . fromEnum $ os) tid (fromIntegral . fromEnum $ r) (fromIntegral ak) (fromIntegral dur) (fromInteger esc) (fromInteger pric) (bid == MO.Sell) iss + diff --git a/Handler/Wallet.hs b/Handler/Wallet.hs index c52b816..7ea1c68 100644 --- a/Handler/Wallet.hs +++ b/Handler/Wallet.hs @@ -18,6 +18,14 @@ data Profit = Profit , tt :: Int64 } deriving (Show, Eq) +data ProfitSum = ProfitSum + { psbuy :: Int64 + , pssell :: Int64 + , psprofit :: Int64 + , psbf :: Int64 + , pstt :: Int64 + } deriving (Show, Eq) + instance RawSql Profit where rawSqlCols _ _ = (6,[]) rawSqlColCountReason _ = "date, buy, sell, profit, bf, tt" @@ -61,6 +69,7 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do 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] + let profitssum = foldl' addProfit (ProfitSum 0 0 0 0 0) profits loginLayout user $ [whamlet|
Transactions in the last #{hrs} hours: @@ -162,6 +171,20 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do #{pp} $nothing   + $with (ProfitSum b s p bf tt) <- profitssum + + Total + #{prettyISK b} + #{prettyISK s} + #{prettyISK p} + #{prettyISK bf} + #{prettyISK tt} + #{transRealProfit' p bf tt} + + $maybe pp <- profitPercent' p bf tt s + #{pp} + $nothing +   |] ) @@ -180,3 +203,6 @@ 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) + +addProfit :: ProfitSum -> Profit -> ProfitSum +addProfit (ProfitSum b' s' p' bf' tt') (Profit _ b s p bf tt) = ProfitSum (b+b') (s+s') (p+p') (bf+bf') (tt+tt') diff --git a/Import.hs b/Import.hs index 5ef039c..b71baae 100644 --- a/Import.hs +++ b/Import.hs @@ -9,6 +9,8 @@ import Text.Printf import Data.List (unfoldr) import Text.Hamlet +{- CONVINIENCE FUNCTIONS -} + loginOrDo :: ((Key User, User) -> Handler Html) -> Handler Html loginOrDo cont = do maid <- maybeAuthId diff --git a/config/models b/config/models index 6adae2f..cb6af06 100644 --- a/config/models +++ b/config/models @@ -10,9 +10,12 @@ User standingsTimeout UTCTime balanceTimeout UTCTime skillTimeout UTCTime + orderTimeout UTCTime br Int -- Broker-Relations-Skill acc Int -- Accounting-Skill balanceCents Int64 + stockCents Int64 + escrowCents Int64 UniqueUser ident deriving Typeable @@ -63,5 +66,22 @@ FactionStandings factionName Text factionStanding Double +Order + user UserId + orderId Int64 + charId Int64 + stationId Int64 + volEntered Int64 + volRemaining Int64 + minVolume Int64 + orderState Int32 --no custom field as this forces string-comparisons. Use toEnum/fromEnum to get an Int + typeId Int64 + range Int32 --same as orderState + accountKey Int32 + duration Int32 + escrowCents Int64 + priceCents Int64 + isSell Bool + issued UTCTime -- By default this file is used in Model.hs (which is imported by Foundation.hs) diff --git a/static/css/neat.css b/static/css/neat.css index f611d54..07bd08c 100644 --- a/static/css/neat.css +++ b/static/css/neat.css @@ -35,3 +35,7 @@ text-align: right; font-family: monospace; } + +tr.total { + border-top: 2px solid grey; +} diff --git a/templates/login-layout-wrapper.hamlet b/templates/login-layout-wrapper.hamlet index c11d26f..f95d94b 100644 --- a/templates/login-layout-wrapper.hamlet +++ b/templates/login-layout-wrapper.hamlet @@ -53,7 +53,7 @@ $newline never
  • Settings
  • Settings -
  • #{prettyISK $ userBalanceCents user} ISK +
  • #{prettyISK $ foldl' (+) 0 [userBalanceCents user, userEscrowCents user, userStockCents user]} ISK