diff --git a/Handler/ProfitItems.hs b/Handler/ProfitItems.hs index 8f8a43c..ab431d4 100644 --- a/Handler/ProfitItems.hs +++ b/Handler/ProfitItems.hs @@ -1,6 +1,108 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveGeneric #-} + module Handler.ProfitItems where import Import +import Database.Persist.Sql (rawSql,RawSql(..)) +import Text.Printf + + +data Profit = Profit + { typeName :: Text + , typeId :: Int64 + , quantity :: Int64 + , profitcents :: Int64 + , fee :: Int64 + , tax :: Int64 + , avg :: Int64 + , sellcents :: Int64 + } deriving (Show, Eq, Generic) + +-- profitcents may be NULL (therfore also avg). Test for that. Rest ist never NULL, due to update-routine +instance RawSql Profit where + rawSqlCols _ _ = (8,[]) + rawSqlColCountReason _ = "typeName, typeId, quantity, profit, fee, tax, avg, sell" + rawSqlProcessRow [PersistText t, PersistInt64 i, PersistRational q, + PersistRational pc, PersistRational bf, PersistRational tt, + PersistRational a, PersistRational s] = Right (Profit t i (c q) (c pc) (c bf) (c tt) (c a) (c s)) + where c = floor + rawSqlProcessRow [PersistText t, PersistInt64 i, PersistRational q, + PersistNull, PersistRational bf, PersistRational tt, + PersistNull, PersistRational s] = Right (Profit t i (c q) 0 (c bf) (c tt) 0 (c s)) + where c = floor + rawSqlProcessRow a = Left ("Wrong kinds of Arguments:" <> (pack $ show a)) + +profitIntervals :: [Int64] +profitIntervals = [1,2,7,14,31] getProfitItemsR :: Handler Html -getProfitItemsR = error "Not yet implemented: getProfitItemsR" +getProfitItemsR = getProfitItemsDetailsR 7 + + +getProfitItemsDetailsR :: Int64 -> Handler Html +getProfitItemsDetailsR days = loginOrDo (\(uid,user) -> do + let sql = "select type_name, type_id, sum(quantity) as quantity, sum(profit) as profitcents,\ + sum(fee) as brokerfee, sum(tax) as transactiontax,\ + sum(seconds_to_sell)/(sum(CASE WHEN trans_is_sell THEN 1 ELSE 0 END)+0.01) as avg,\ + sum(CASE WHEN trans_is_sell THEN quantity*price_cents ELSE 0 END) as sell\ + from transaction\ + where\ + \"user\"=? and\ + extract(day from now()-date(date_time) at time zone 'utc') < ?\ + and not problematic\ + group by type_id, type_name\ + order by (coalesce(sum(profit),0)-sum(fee)-sum(tax)) desc" + (items :: [Profit]) <- runDB $ rawSql sql [toPersistValue uid, toPersistValue days] + loginLayout user $ [whamlet| +
+
Statistices for the last #{days} days: +
+ $forall days' <- profitIntervals + $if days == days' + #{days'} days + $else + #{days'} days + + + +
Item + ISK Profit + ISK Broker Fee + ISK Transaction Tax + Real Profit + Avg Time + # Items + Real Profit/Day + % + %/Day + $forall (Profit tn tid quant pc f t a sc) <- items +
#{tn} + #{prettyISK pc} + #{prettyISK f} + #{prettyISK t} + #{transRealProfit' pc f t} + #{showSecsToSell a} + #{quant} + #{prettyISK $ profitPerDay pc f t a} + #{profitPercent pc f t sc} + #{profitPercentDay pc f t sc a} + |] + ) + + +transRealProfit' :: Int64 -> Int64 -> Int64 -> String +transRealProfit' p bf tt = prettyISK (p-bf-tt) + +profitPerDay :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 +profitPerDay _ _ _ 0 = 0 +profitPerDay p f t a = ((p-f-t) * 86400) `div` a + +profitPercent :: Int64 -> Int64 -> Int64 -> Int64 -> String +profitPercent _ _ _ 0 = printf "%.2f" $ (0 :: Double) +profitPercent p f t s = printf "%.2f" $ (100*(fromIntegral (p-f-t)) / (fromIntegral s) :: Double) + +profitPercentDay :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> String +profitPercentDay _ _ _ 0 _ = printf "%.2f" $ (0 :: Double) +profitPercentDay _ _ _ _ 0 = printf "%.2f" $ (0 :: Double) +profitPercentDay p f t s a = printf "%.2f" $ (100*(fromIntegral (profitPerDay p f t a)) / (fromIntegral s) :: Double) diff --git a/Handler/Wallet.hs b/Handler/Wallet.hs index f4da436..c52b816 100644 --- a/Handler/Wallet.hs +++ b/Handler/Wallet.hs @@ -180,14 +180,3 @@ 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) - - -showSecsToSell :: Int64 -> String -showSecsToSell t - | t > 4*7*86400 = pp (fromIntegral t / (7*86400) :: Double) ++ "w" - | t > 86400 = pp (fromIntegral t / 86400 :: Double) ++ "d" - | t > 3600 = pp (fromIntegral t / 3600 :: Double) ++ "h" - | t > 60 = pp (fromIntegral t / 60 :: Double) ++ "m" - | otherwise = pp (fromIntegral t :: Double) ++ "s" - where - pp x = printf "%.2f" x diff --git a/Import.hs b/Import.hs index 2c1858c..5ef039c 100644 --- a/Import.hs +++ b/Import.hs @@ -61,3 +61,15 @@ loginLayout user widget = do addScript $ StaticR js_bootstrap_js $(widgetFile "default-layout") withUrlRenderer $(hamletFile "templates/login-layout-wrapper.hamlet") + + +showSecsToSell :: Int64 -> String +showSecsToSell t + | t > 4*7*86400 = pp (fromIntegral t / (7*86400) :: Double) ++ "w" + | t > 86400 = pp (fromIntegral t / 86400 :: Double) ++ "d" + | t > 3600 = pp (fromIntegral t / 3600 :: Double) ++ "h" + | t > 60 = pp (fromIntegral t / 60 :: Double) ++ "m" + | t == 0 = "-" + | otherwise = pp (fromIntegral t :: Double) ++ "s" + where + pp = printf "%.2f" diff --git a/config/routes b/config/routes index bdcadf9..f5c4fd9 100644 --- a/config/routes +++ b/config/routes @@ -12,3 +12,4 @@ /update UpdateR GET /stock StockR GET /analysis/items ProfitItemsR GET +/analysis/items/#Int64 ProfitItemsDetailsR GET diff --git a/templates/login-layout-wrapper.hamlet b/templates/login-layout-wrapper.hamlet index ad71797..c11d26f 100644 --- a/templates/login-layout-wrapper.hamlet +++ b/templates/login-layout-wrapper.hamlet @@ -42,18 +42,18 @@ $newline never
  • Home
  • Transactions
  • Stock -
  • Settings -
  • #{prettyISK $ userBalanceCents user} ISK - +
  • Settings +
  • #{prettyISK $ userBalanceCents user} ISK