a bit templating

This commit is contained in:
Nicole Dresselhaus 2015-08-07 02:26:16 +02:00
parent 617e225624
commit 9ad4be6ba4
8 changed files with 42 additions and 6 deletions

View File

@ -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
View File

@ -0,0 +1,6 @@
module Handler.Stock where
import Import
getStockR :: Handler Html
getStockR = error "Not yet implemented: getStockR"

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
View 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"

View 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"