diff --git a/Handler/Stock.hs b/Handler/Stock.hs index 399f148..5cb099b 100644 --- a/Handler/Stock.hs +++ b/Handler/Stock.hs @@ -1,21 +1,111 @@ +{-# LANGUAGE ScopedTypeVariables #-} + module Handler.Stock where 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 = 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| -

Current Stock - - -
Item name - Quantity - Buy Price - $forall Entity _ t <- items +
+
Current Stock: + - +
#{transactionTypeName t} - #{transactionInStock t} - #{transactionPriceCents t} + Bought + Item name + Quantity + Buy price + Required sell + Total + Station name + $forall DisCols tid sid sn tn is wrth avg' dt taxed <- items' +
#{showDateTime dt} + #{tn} + #{is} + #{prettyISK avg'} + #{prettyISK taxed} + #{prettyISK wrth} + #{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 diff --git a/Handler/Wallet.hs b/Handler/Wallet.hs index c046119..c0490db 100644 --- a/Handler/Wallet.hs +++ b/Handler/Wallet.hs @@ -112,7 +112,7 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do #{prettyISK $ profit} $else - + #{prettyISK $ profit} #{profitPercent profit t}% diff --git a/Import.hs b/Import.hs index e1047dd..06a5b77 100644 --- a/Import.hs +++ b/Import.hs @@ -29,7 +29,7 @@ prettyISK isk = signIsk++pretty++","++ printf "%02u" cents [] -> "0" 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 (hours, minutes') = divMod t 3600 (minutes, seconds) = divMod minutes' 60