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
| |