fixed Stock
This commit is contained in:
Stefan Dresselhaus
112
Handler/Stock.hs
112
Handler/Stock.hs
@@ -1,21 +1,111 @@
|
|||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
module Handler.Stock where
|
module Handler.Stock where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
--import Database.Esqueleto as E
|
||||||
|
import Database.Persist.Sql (rawSql,RawSql(..))
|
||||||
|
|
||||||
|
|
||||||
|
data Stock = Stock
|
||||||
|
{ typeId :: Int64
|
||||||
|
, stationId :: Int64
|
||||||
|
, stationName :: Text
|
||||||
|
, typeName :: Text
|
||||||
|
, inStock :: Rational
|
||||||
|
, worth :: Rational
|
||||||
|
, datetime :: UTCTime
|
||||||
|
, tax :: Double
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
data DisCols = DisCols
|
||||||
|
{ dTypeId :: Int64
|
||||||
|
, dStationId :: Int64
|
||||||
|
, dStationName :: Text
|
||||||
|
, dTypeName :: Text
|
||||||
|
, dInStock :: Int64
|
||||||
|
, dWorth :: Int64
|
||||||
|
, dAvgWorth :: Int64
|
||||||
|
, dDateTime :: UTCTime
|
||||||
|
, dResell :: Int64
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
|
||||||
|
instance RawSql Stock where
|
||||||
|
rawSqlCols _ _ = (8,[])
|
||||||
|
rawSqlColCountReason _ = "typeId, stationId, stationName, typeName, inStock, worth, date, tax"
|
||||||
|
rawSqlProcessRow [PersistInt64 t, PersistInt64 s, PersistText sn, PersistText tn,
|
||||||
|
PersistRational is, PersistRational w, PersistUTCTime time, PersistDouble tax] =
|
||||||
|
Right (Stock t s sn tn is w time tax)
|
||||||
|
rawSqlProcessRow a = Left ("Wrong kinds of Arguments:" <> (pack $ show a))
|
||||||
|
|
||||||
getStockR :: Handler Html
|
getStockR :: Handler Html
|
||||||
getStockR = loginOrDo (\(uid,user) -> do
|
getStockR = loginOrDo (\(uid,user) -> do
|
||||||
items <- runDB $ selectList [TransactionUser ==. uid, TransactionInStock >. 0] [Asc TransactionTypeName]
|
--items <- runDB $ selectList [TransactionUser ==. uid, TransactionInStock >. 0] [Asc TransactionTypeName]
|
||||||
|
--persist cannot do groupBy
|
||||||
|
{-(items :: [(E.Value Text,
|
||||||
|
E.Value Text,
|
||||||
|
E.Value (Maybe Rational),
|
||||||
|
E.Value (Maybe Rational))]) <-
|
||||||
|
runDB $ select $ from $ \trans -> do
|
||||||
|
where_ (trans ^. TransactionInStock E.>. (val 0))
|
||||||
|
E.groupBy $ trans ^. TransactionTypeId
|
||||||
|
E.groupBy $ trans ^. TransactionTypeName
|
||||||
|
E.groupBy $ trans ^. TransactionStationName
|
||||||
|
orderBy [asc (trans ^. TransactionTypeName)]
|
||||||
|
return (trans ^. TransactionTypeName
|
||||||
|
,trans ^. TransactionStationName
|
||||||
|
,sum_ $ trans ^. TransactionInStock
|
||||||
|
,avg_ $ (trans ^. TransactionPriceCents) *. (trans ^. TransactionInStock))-}
|
||||||
|
--esqueleto does not work because we reference tables outside of the model, so we come back to raw SQL:
|
||||||
|
let sql = "select t.type_id, t.station_id, t.station_name, t.type_name, \
|
||||||
|
sum(t.in_stock) as in_stock, \
|
||||||
|
sum(t.in_stock*t.price_cents) as worth, \
|
||||||
|
to_timestamp(avg(extract(epoch from t.date_time at time zone 'utc'))) at time zone 'utc' as date_time, \
|
||||||
|
(0.01-(0.001*ch.acc))+2*(0.0100-0.0005*ch.br)/exp(0.1000*COALESCE(\
|
||||||
|
(select faction_standing from faction_standings where faction_id=c.\"factionID\" and \"user\"=t.\"user\")\
|
||||||
|
,0)+0.0400*COALESCE(\
|
||||||
|
(select corp_standing from corp_standings where corp_id=c.\"corporationID\" and \"user\"=t.\"user\")\
|
||||||
|
,0))+1 as tax \
|
||||||
|
\
|
||||||
|
from transaction t \
|
||||||
|
join \"staStations\" s on (t.station_id = s.\"stationID\") \
|
||||||
|
join \"crpNPCCorporations\" c on (s.\"corporationID\" = c.\"corporationID\") \
|
||||||
|
join \"user\" ch on (t.\"user\"=ch.id) \
|
||||||
|
\
|
||||||
|
where t.\"user\" = ? \
|
||||||
|
and t.in_stock > 0 and not trans_is_sell \
|
||||||
|
\
|
||||||
|
group by t.type_id, t.station_id, t.type_name, t.station_name,\
|
||||||
|
ch.acc, ch.br, c.\"factionID\", t.\"user\", c.\"corporationID\" \
|
||||||
|
order by t.type_name asc"
|
||||||
|
(items :: [Stock]) <- runDB $ rawSql sql [toPersistValue uid]
|
||||||
|
let items' = convertStock <$> items
|
||||||
defaultLayout $ [whamlet|
|
defaultLayout $ [whamlet|
|
||||||
<h1>Current Stock
|
<div .panel .panel-default>
|
||||||
<table .table>
|
<div .panel-heading>Current Stock:
|
||||||
<tr>
|
<table .table .table-condensed .small .table-bordered>
|
||||||
<th>Item name
|
|
||||||
<th>Quantity
|
|
||||||
<th>Buy Price
|
|
||||||
$forall Entity _ t <- items
|
|
||||||
<tr>
|
<tr>
|
||||||
<td>#{transactionTypeName t}
|
<th .text-center>Bought
|
||||||
<td>#{transactionInStock t}
|
<th .text-center>Item name
|
||||||
<td>#{transactionPriceCents t}
|
<th .text-center>Quantity
|
||||||
|
<th .text-center>Buy price
|
||||||
|
<th .text-center>Required sell
|
||||||
|
<th .text-center>Total
|
||||||
|
<th .text-center>Station name
|
||||||
|
$forall DisCols tid sid sn tn is wrth avg' dt taxed <- items'
|
||||||
|
<tr>
|
||||||
|
<td>#{showDateTime dt}
|
||||||
|
<td>#{tn}
|
||||||
|
<td .numeric>#{is}
|
||||||
|
<td .numeric>#{prettyISK avg'}
|
||||||
|
<td .numeric>#{prettyISK taxed}
|
||||||
|
<td .numeric>#{prettyISK wrth}
|
||||||
|
<td>#{sn}
|
||||||
|]
|
|]
|
||||||
)
|
)
|
||||||
|
|
||||||
|
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
|
||||||
|
|||||||
@@ -112,7 +112,7 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
|
|||||||
<td .numeric .buyfee>
|
<td .numeric .buyfee>
|
||||||
#{prettyISK $ profit}
|
#{prettyISK $ profit}
|
||||||
$else
|
$else
|
||||||
<td ..numeric>
|
<td .numeric>
|
||||||
#{prettyISK $ profit}
|
#{prettyISK $ profit}
|
||||||
<td .numeric>
|
<td .numeric>
|
||||||
#{profitPercent profit t}%
|
#{profitPercent profit t}%
|
||||||
|
|||||||
@@ -29,7 +29,7 @@ prettyISK isk = signIsk++pretty++","++ printf "%02u" cents
|
|||||||
[] -> "0"
|
[] -> "0"
|
||||||
|
|
||||||
showTime :: Int64 -> String
|
showTime :: Int64 -> String
|
||||||
showTime t = printf "%2u" hours ++ ":" ++ printf "%02u" minutes ++ ":" ++ printf "%02u" seconds
|
showTime t = printf "%02u" hours ++ ":" ++ printf "%02u" minutes ++ ":" ++ printf "%02u" seconds
|
||||||
where
|
where
|
||||||
(hours, minutes') = divMod t 3600
|
(hours, minutes') = divMod t 3600
|
||||||
(minutes, seconds) = divMod minutes' 60
|
(minutes, seconds) = divMod minutes' 60
|
||||||
|
|||||||
Reference in New Issue
Block a user