a bit templating
This commit is contained in:
parent
617e225624
commit
9ad4be6ba4
@ -35,6 +35,7 @@ import Handler.Home
|
|||||||
import Handler.Wallet
|
import Handler.Wallet
|
||||||
import Handler.Settings
|
import Handler.Settings
|
||||||
import Handler.Update
|
import Handler.Update
|
||||||
|
import Handler.Stock
|
||||||
|
|
||||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||||
|
6
Handler/Stock.hs
Normal file
6
Handler/Stock.hs
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
module Handler.Stock where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
|
||||||
|
getStockR :: Handler Html
|
||||||
|
getStockR = error "Not yet implemented: getStockR"
|
@ -8,7 +8,6 @@ import qualified Eve.Api.Types as T
|
|||||||
import qualified Eve.Api.Char.Standings as ST
|
import qualified Eve.Api.Char.Standings as ST
|
||||||
import qualified Eve.Api.Char.Skills as SK
|
import qualified Eve.Api.Char.Skills as SK
|
||||||
import Database.Persist.Sql
|
import Database.Persist.Sql
|
||||||
import qualified Debug.Trace as Debug
|
|
||||||
|
|
||||||
accountingId :: Int64
|
accountingId :: Int64
|
||||||
accountingId = 16622
|
accountingId = 16622
|
||||||
@ -97,11 +96,7 @@ updateProfits dat = updateProfits' [] dat
|
|||||||
t' = t {transactionInStock = transactionInStock t + m}
|
t' = t {transactionInStock = transactionInStock t + m}
|
||||||
ct' = ct {transactionInStock = transactionInStock ct - m}
|
ct' = ct {transactionInStock = transactionInStock ct - m}
|
||||||
prof' = (transactionPriceCents t - transactionPriceCents ct) * m
|
prof' = (transactionPriceCents t - transactionPriceCents ct) * m
|
||||||
(t'',ct'') = if prof' > 0 then
|
(t'',ct'') = updateProfits'' (Entity et (t' { transactionProfit = maybe (Just prof') (\a -> Just (a + prof')) (transactionProfit t')})) ts
|
||||||
Debug.trace ("Item "++show (transactionTypeId t)++" has profit "++show prof'++" ("++show (transactionPriceCents t)++" - "++show (transactionPriceCents ct)++")*"++show m)
|
|
||||||
$ updateProfits'' (Entity et (t' { transactionProfit = maybe (Just prof') (\a -> Just (a + prof')) (transactionProfit t')})) ts
|
|
||||||
else
|
|
||||||
updateProfits'' (Entity et (t' { transactionProfit = maybe (Just prof') (\a -> Just (a + prof')) (transactionProfit t')})) ts
|
|
||||||
in
|
in
|
||||||
(t'' ,(Entity cet ct'):ct'')
|
(t'' ,(Entity cet ct'):ct'')
|
||||||
else
|
else
|
||||||
|
@ -15,13 +15,25 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
|
|||||||
<a href=@{WalletDetailsR 168 days}>show last 7 days
|
<a href=@{WalletDetailsR 168 days}>show last 7 days
|
||||||
<h1>Transactions in the last #{hrs} hours
|
<h1>Transactions in the last #{hrs} hours
|
||||||
<table>
|
<table>
|
||||||
|
<tr>
|
||||||
|
<th>Time
|
||||||
|
<th>Price
|
||||||
|
<th>Name
|
||||||
|
<th>Profit
|
||||||
$forall Entity _ t <- trans
|
$forall Entity _ t <- trans
|
||||||
<tr>
|
<tr>
|
||||||
<td>#{show $ transactionDateTime t}
|
<td>#{show $ transactionDateTime t}
|
||||||
<td>#{transactionPriceCents t}
|
<td>#{transactionPriceCents t}
|
||||||
<td>#{transactionClientName t}
|
<td>#{transactionClientName t}
|
||||||
|
<td>
|
||||||
|
$maybe profit <- transRealProfit t
|
||||||
|
#{profit}
|
||||||
|
$nothing
|
||||||
|
-
|
||||||
|
|
||||||
<h1>Statistices for the last #{days} days
|
<h1>Statistices for the last #{days} days
|
||||||
|]
|
|]
|
||||||
)
|
)
|
||||||
|
|
||||||
|
transRealProfit :: Transaction -> Maybe Int64
|
||||||
|
transRealProfit t = (\a b c -> a - b - c) <$> transactionProfit t <*> transactionFee t <*> transactionTax t
|
||||||
|
@ -10,3 +10,4 @@
|
|||||||
-- /register RegisterR GET POST
|
-- /register RegisterR GET POST
|
||||||
/settings SettingsR GET POST
|
/settings SettingsR GET POST
|
||||||
/update UpdateR GET
|
/update UpdateR GET
|
||||||
|
/stock StockR GET
|
||||||
|
@ -25,6 +25,7 @@ library
|
|||||||
Handler.Wallet
|
Handler.Wallet
|
||||||
Handler.Settings
|
Handler.Settings
|
||||||
Handler.Update
|
Handler.Update
|
||||||
|
Handler.Stock
|
||||||
|
|
||||||
if flag(dev) || flag(library-only)
|
if flag(dev) || flag(library-only)
|
||||||
cpp-options: -DDEVELOPMENT
|
cpp-options: -DDEVELOPMENT
|
||||||
|
10
test/Handler/StockSpec.hs
Normal file
10
test/Handler/StockSpec.hs
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
module Handler.StockSpec (spec) where
|
||||||
|
|
||||||
|
import TestImport
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = withApp $ do
|
||||||
|
|
||||||
|
describe "getStockR" $ do
|
||||||
|
error "Spec not implemented: getStockR"
|
||||||
|
|
10
test/Handler/UpdateSpec.hs
Normal file
10
test/Handler/UpdateSpec.hs
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
module Handler.UpdateSpec (spec) where
|
||||||
|
|
||||||
|
import TestImport
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = withApp $ do
|
||||||
|
|
||||||
|
describe "getUpdateR" $ do
|
||||||
|
error "Spec not implemented: getUpdateR"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user