Drezil/neat
1
0
Fork 0
Code Issues 5 Pull Requests Projects Releases Wiki Activity

added order-loading. Fixes #3

Browse Source
This commit is contained in:
Stefan Dresselhaus
2015-09-06 15:53:09 +02:00
parent 09612c9364
commit a8df1abfa1
9 changed files with 99 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
Foundation.hs
View File

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

7
Handler/Home.hs
View File

@@ -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 total Worth: ...
<p>Profit in the last 7 days: ...
<p>Current Stock Worth: #{prettyISK $ userStockCents user} ISK.
<p>Current Escrow Worth: #{prettyISK $ userEscrowCents user} ISK.
<p>Current total Worth: #{prettyISK $ totalworth} ISK.
|]

14
Handler/Stock.hs
View File

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

26
Handler/Update.hs
View File

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

26
Handler/Wallet.hs
View File

@@ -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')

2
Import.hs
View File

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

20
config/models
View File

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

4
static/css/neat.css
View File

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

2
templates/login-layout-wrapper.hamlet
View File

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