88 lines
3.2 KiB
Haskell
88 lines
3.2 KiB
Haskell
module Import
|
|
( module Import
|
|
) where
|
|
|
|
import Foundation as Import
|
|
import Import.NoFoundation as Import
|
|
import Yesod.Form.Bootstrap3 as Import
|
|
import Text.Printf
|
|
import Data.List (unfoldr)
|
|
import Text.Hamlet
|
|
|
|
{- CONVINIENCE FUNCTIONS -}
|
|
|
|
loginOrDo :: ((Key User, User) -> Handler Html) -> Handler Html
|
|
loginOrDo cont = do
|
|
maid <- maybeAuthId
|
|
muid <- case maid of
|
|
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 "%02u" 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)
|
|
|
|
loginLayout :: ToWidget App a =>
|
|
User
|
|
-> a
|
|
-> HandlerT
|
|
App IO Html
|
|
loginLayout user widget = do
|
|
master <- getYesod
|
|
mmsg <- getMessage
|
|
|
|
-- We break up the default layout into two components:
|
|
-- default-layout is the contents of the body tag, and
|
|
-- default-layout-wrapper is the entire page. Since the final
|
|
-- value passed to hamletToRepHtml cannot be a widget, this allows
|
|
-- you to use normal widget features in default-layout.
|
|
|
|
pc <- widgetToPageContent $ do
|
|
addStylesheet $ StaticR css_bootstrap_css
|
|
addStylesheet $ StaticR css_neat_css
|
|
addScript $ StaticR js_jquery_js
|
|
addScript $ StaticR js_bootstrap_js
|
|
addScript $ StaticR js_neat_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"
|
|
|
|
transRealProfit :: Transaction -> Maybe Int64
|
|
transRealProfit t = if transactionTransIsSell t then
|
|
(\a b c -> a - b - c) <$> transactionProfit t <*> transactionFee t <*> transactionTax t
|
|
else
|
|
negate <$> ((+) <$> transactionFee t <*> transactionTax t)
|
|
|
|
profitPercent :: Int64 -> Transaction -> String
|
|
profitPercent p t = printf "%.2f" $ (100*(fromIntegral p) / (fromIntegral (transactionQuantity t * transactionPriceCents t)) :: Double)
|