added order-loading. Fixes #3

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

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|
              <h1>Welcome back, #{userName user}.
              <p>Current Balance: #{prettyISK $ userBalanceCents user} ISK.
-             <p>Current Stock Worth: ...
+             <p>Current Stock Worth: #{prettyISK $ userStockCents user} ISK.
-             <p>Current total Worth: ...
+             <p>Current Escrow Worth: #{prettyISK $ userEscrowCents user} ISK.
-             <p>Profit in the last 7 days: ...
+             <p>Current total Worth: #{prettyISK $ totalworth} ISK.
              |]
 
 

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|
              <div .panel .panel-default>
                <div .panel-heading>Current Stock:
@@ -102,6 +102,14 @@ getStockR = loginOrDo (\(uid,user) -> do
                      <td .numeric>#{prettyISK taxed}
                      <td .numeric>#{prettyISK wrth}
                      <td>#{sn}
+                 <tr .total>
+                   <th .text-center>Total
+                   <td>
+                   <td .numeric>
+                   <td .numeric>
+                   <td .numeric>
+                   <td .numeric>#{prettyISK total}
+                   <td>
              |]
             )
 
@@ -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'

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
+

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|
              <div .panel .panel-default>
                <div .panel-heading>Transactions in the last #{hrs} hours:
@@ -162,6 +171,20 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
                          #{pp}
                        $nothing
                          &nbsp;
+                 $with (ProfitSum b s p bf tt) <- profitssum
+                   <tr .total>
+                     <th .text-center>Total
+                     <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
+                         &nbsp;
              |]
              )
 
@@ -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')

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

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)

static/css/neat.css

@@ -35,3 +35,7 @@
   text-align: right;
   font-family: monospace;
 }
+
+tr.total {
+  border-top: 2px solid grey;
+}

templates/login-layout-wrapper.hamlet

@@ -53,7 +53,7 @@ $newline never
                   <li role="separator" class="divider">
                   <li><a href="@SettingsR">Settings</a-->
               <li><a href="@{SettingsR}">Settings</a>
-              <li><a href="#">#{prettyISK $ userBalanceCents user} ISK</a>
+              <li><a href="#">#{prettyISK $ foldl' (+) 0 [userBalanceCents user, userEscrowCents user, userStockCents user]} ISK</a>
             <ul class="nav navbar-nav navbar-right">
               <li><a href="@{UpdateR}">Update</a>
               <li><a href="@{AuthR LogoutR}">Logout</a>