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)