diff --git a/Handler/Update.hs b/Handler/Update.hs
index c05fa85..26933a6 100644
--- a/Handler/Update.hs
+++ b/Handler/Update.hs
@@ -76,8 +76,10 @@ getUpdateR = loginOrDo (\(uid,user) -> do
runDB $ rawExecute sql [toPersistValue uid]
-- calculate profits
runDB $ do
- trans <- updateProfits <$> selectList [TransactionUser ==. uid, TransactionInStock !=. 0] [Asc TransactionDateTime]
+ trans <- updateProfits <$> selectList [TransactionUser ==. uid, TransactionInStock !=. 0, TransactionProblematic ==. False] [Asc TransactionDateTime]
mapM_ (\(Entity eid t) -> replace eid t) trans
+ let updateProblemSql = "update transaction t set problematic=true where t.trans_is_sell and t.in_stock < 0"
+ runDB $ rawExecute updateProblemSql []
redirect WalletR
)
@@ -131,7 +133,7 @@ migrateTransaction :: UserId -> WT.Transaction -> Transaction
migrateTransaction u (WT.Transaction dt tid q tn ti pc ci cn si sn tt tf jti) =
Transaction u dt tid q (if tis tt then -q else q) tn ti
(fromIntegral pc) ci cn si sn (tis tt) (tfc tf) jti
- Nothing Nothing Nothing Nothing False
+ Nothing Nothing Nothing Nothing False False
where
tis :: WT.TransactionType -> Bool
tis WT.Sell = True
diff --git a/Handler/Wallet.hs b/Handler/Wallet.hs
index c36b8f1..c046119 100644
--- a/Handler/Wallet.hs
+++ b/Handler/Wallet.hs
@@ -5,7 +5,6 @@ module Handler.Wallet where
import Import
-import Data.List (unfoldr)
import Data.Time.Clock
import Text.Printf
import Database.Persist.Sql
@@ -89,7 +88,7 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
$forall Entity _ t <- trans
|
- #{show $ utctDay $ transactionDateTime $ t} #{showTime $ round $ utctDayTime $ transactionDateTime $ t}
+ | #{showDateTime $ transactionDateTime $ t}
$if transactionTransForCorp t
| C
$else
@@ -182,21 +181,6 @@ 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)
-prettyISK :: Int64 -> String
-prettyISK isk = signIsk++pretty++","++ printf "%02u" cents
- where
- signIsk = if isk >= 0 then "" else "-"
- (isk',cents) = divMod (abs isk) 100
- thousands = unfoldr (\b -> if b == 0 then Nothing else Just (b `mod` 1000, b `div` 1000)) isk'
- pretty = case reverse thousands of
- (ht:t) -> intercalate "." $ [show ht] ++ (printf "%03u" <$> t)
- [] -> "0"
-
-showTime :: Int64 -> String
-showTime t = printf "%2u" hours ++ ":" ++ printf "%02u" minutes ++ ":" ++ printf "%02u" seconds
- where
- (hours, minutes') = divMod t 3600
- (minutes, seconds) = divMod minutes' 60
showSecsToSell :: Int64 -> String
showSecsToSell t
diff --git a/Import.hs b/Import.hs
index ea0a6c8..e1047dd 100644
--- a/Import.hs
+++ b/Import.hs
@@ -5,13 +5,35 @@ module Import
import Foundation as Import
import Import.NoFoundation as Import
import Yesod.Form.Bootstrap3 as Import
+import Text.Printf
+import Data.List (unfoldr)
loginOrDo :: ((Key User, User) -> Handler Html) -> Handler Html
loginOrDo cont = do
maid <- maybeAuthId
muid <- case maid of
- Just uid -> fmap ((,) uid) <$> (runDB $ get uid)
+ Just uid -> fmap ((,) uid) <$> runDB (get uid)
Nothing -> return Nothing
case muid of
Nothing -> redirect (AuthR LoginR)
Just (uid,u) -> cont (uid,u)
+
+prettyISK :: Int64 -> String
+prettyISK isk = signIsk++pretty++","++ printf "%02u" cents
+ where
+ signIsk = if isk >= 0 then "" else "-"
+ (isk',cents) = divMod (abs isk) 100
+ thousands = unfoldr (\b -> if b == 0 then Nothing else Just (b `mod` 1000, b `div` 1000)) isk'
+ pretty = case reverse thousands of
+ (ht:t) -> intercalate "." $ show ht : (printf "%03u" <$> t)
+ [] -> "0"
+
+showTime :: Int64 -> String
+showTime t = printf "%2u" hours ++ ":" ++ printf "%02u" minutes ++ ":" ++ printf "%02u" seconds
+ where
+ (hours, minutes') = divMod t 3600
+ (minutes, seconds) = divMod minutes' 60
+
+showDateTime :: UTCTime -> String
+showDateTime t = (show . utctDay $ t) ++ " " ++
+ (showTime . round . utctDayTime $ t)
diff --git a/config/models b/config/models
index e7dba38..5faf53c 100644
--- a/config/models
+++ b/config/models
@@ -47,6 +47,7 @@ Transaction
fee Int64 Maybe -- broker-fee for putting order up
secondsToSell Int64 Maybe --avg time this item needed to sell
noTax Bool -- True if no taxes should be calculated
+ problematic Bool
CorpStandings
user UserId
|