a bit templating
This commit is contained in:
		@@ -35,6 +35,7 @@ import Handler.Home
 | 
			
		||||
import Handler.Wallet
 | 
			
		||||
import Handler.Settings
 | 
			
		||||
import Handler.Update
 | 
			
		||||
import Handler.Stock
 | 
			
		||||
 | 
			
		||||
-- 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
 | 
			
		||||
 
 | 
			
		||||
							
								
								
									
										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.Skills as SK
 | 
			
		||||
import Database.Persist.Sql
 | 
			
		||||
import qualified Debug.Trace as Debug
 | 
			
		||||
 | 
			
		||||
accountingId :: Int64
 | 
			
		||||
accountingId = 16622
 | 
			
		||||
@@ -97,11 +96,7 @@ updateProfits dat = updateProfits' [] dat
 | 
			
		||||
                                     t' = t {transactionInStock = transactionInStock t + m}
 | 
			
		||||
                                     ct' = ct {transactionInStock = transactionInStock ct - m}
 | 
			
		||||
                                     prof' = (transactionPriceCents t - transactionPriceCents ct) * m
 | 
			
		||||
                                     (t'',ct'') = if prof' > 0 then
 | 
			
		||||
                                                   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
 | 
			
		||||
                                     (t'',ct'') = updateProfits'' (Entity et (t' { transactionProfit = maybe (Just prof') (\a -> Just (a + prof')) (transactionProfit t')})) ts
 | 
			
		||||
                                 in
 | 
			
		||||
                                   (t'' ,(Entity cet ct'):ct'')
 | 
			
		||||
                               else
 | 
			
		||||
 
 | 
			
		||||
@@ -15,13 +15,25 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
 | 
			
		||||
             <a href=@{WalletDetailsR 168 days}>show last 7 days
 | 
			
		||||
             <h1>Transactions in the last #{hrs} hours
 | 
			
		||||
             <table>
 | 
			
		||||
               <tr>
 | 
			
		||||
                 <th>Time
 | 
			
		||||
                 <th>Price
 | 
			
		||||
                 <th>Name
 | 
			
		||||
                 <th>Profit
 | 
			
		||||
               $forall Entity _ t <- trans
 | 
			
		||||
                 <tr>
 | 
			
		||||
                   <td>#{show $ transactionDateTime t}
 | 
			
		||||
                   <td>#{transactionPriceCents t}
 | 
			
		||||
                   <td>#{transactionClientName t}
 | 
			
		||||
                   <td>
 | 
			
		||||
                     $maybe profit <- transRealProfit t
 | 
			
		||||
                       #{profit}
 | 
			
		||||
                     $nothing
 | 
			
		||||
                       -
 | 
			
		||||
 | 
			
		||||
             <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
 | 
			
		||||
/settings SettingsR GET POST
 | 
			
		||||
/update UpdateR GET
 | 
			
		||||
/stock StockR GET
 | 
			
		||||
 
 | 
			
		||||
@@ -25,6 +25,7 @@ library
 | 
			
		||||
                     Handler.Wallet
 | 
			
		||||
                     Handler.Settings
 | 
			
		||||
                     Handler.Update
 | 
			
		||||
                     Handler.Stock
 | 
			
		||||
 | 
			
		||||
    if flag(dev) || flag(library-only)
 | 
			
		||||
        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"
 | 
			
		||||
 | 
			
		||||
		Reference in New Issue
	
	Block a user