Stats now work correctly

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|
+             <div .panel .panel-default>
+               <div .panel-heading>Statistices for the last #{days} days:
+               <div .btn-group .btn-group-justified role="group">
+                 $forall days' <- profitIntervals
+                   $if days == days'
+                     <a href="@{ProfitItemsDetailsR days'}" .btn .active role="button">#{days'} days
+                   $else
+                     <a href="@{ProfitItemsDetailsR days'}" .btn role="button">#{days'} days
+               <table .table .table-condensed .small>
+                 <tr>
+                   <th .text-center>Item
+                   <th .text-center>ISK Profit
+                   <th .text-center>ISK Broker Fee
+                   <th .text-center>ISK Transaction Tax
+                   <th .text-center>Real Profit
+                   <th .text-center>Avg Time
+                   <th .text-center># Items
+                   <th .text-center>Real Profit/Day
+                   <th .text-center>%
+                   <th .text-center>%/Day
+                 $forall (Profit tn tid quant pc f t a sc) <- items
+                   <tr>
+                     <td>#{tn}
+                     <td .numeric>#{prettyISK pc}
+                     <td .numeric>#{prettyISK f}
+                     <td .numeric>#{prettyISK t}
+                     <td .numeric>#{transRealProfit' pc f t}
+                     <td .numeric>#{showSecsToSell a}
+                     <td .numeric>#{quant}
+                     <td .numeric>#{prettyISK $ profitPerDay pc f t a}
+                     <td .numeric>#{profitPercent pc f t sc}
+                     <td .numeric>#{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)

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

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"

config/routes

@@ -12,3 +12,4 @@
 /update UpdateR GET
 /stock StockR GET
 /analysis/items ProfitItemsR GET
+/analysis/items/#Int64 ProfitItemsDetailsR GET

templates/login-layout-wrapper.hamlet

@@ -42,18 +42,18 @@ $newline never
               <li><a href="@{HomeR}">Home</a>
               <li><a href="@{WalletR}">Transactions</a>
               <li><a href="@{StockR}">Stock</a>
-              <li><a href="@{SettingsR}">Settings</a>
+              <li class="dropdown">
-              <li><a href="#">#{prettyISK $ userBalanceCents user} ISK</a>
+                <a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Analysis <span class="caret"></span>
-              <!--li class="dropdown">
-                <a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Dropdown <span class="caret"></span>
                 <ul class="dropdown-menu">
-                  <li><a href="#">Action</a>
+                  <li><a href="@{ProfitItemsR}">Profitable Items</a>
-                  <li><a href="#">Another action</a>
+                  <!--li><a href="#">Another action</a>
                   <li><a href="#">Something else here</a>
                   <li role="separator" class="divider">
                   <li><a href="#">Separated link</a>
                   <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>
             <ul class="nav navbar-nav navbar-right">
               <li><a href="@{UpdateR}">Update</a>
               <li><a href="@{AuthR LogoutR}">Logout</a>