added login-layout and changed default layout to different stuff. Also included Balance

This commit is contained in:
Nicole Dresselhaus 2015-08-18 12:28:15 +02:00
parent ae16513293
commit a71c8f3b26
12 changed files with 155 additions and 41 deletions

View File

@ -152,8 +152,10 @@ instance YesodAuth App where
, userWalletTimeout = now , userWalletTimeout = now
, userStandingsTimeout = now , userStandingsTimeout = now
, userSkillTimeout = now , userSkillTimeout = now
, userBalanceTimeout = now
, userAcc = 0 , userAcc = 0
, userBr = 0 , userBr = 0
, userBalanceCents = 0
} }
Nothing -> return $ ServerError "Problems extracting Access-Token" Nothing -> return $ ServerError "Problems extracting Access-Token"
where where

View File

@ -2,39 +2,40 @@ module Handler.Home where
import Import import Import
-- This is a handler function for the GET request method on the HomeR loginOrElse :: ((Key User, User) -> Handler Html) -> Handler Html -> Handler Html
-- resource pattern. All of your resource patterns are defined in loginOrElse cont contElse = do
-- config/routes maid <- maybeAuthId
-- muid <- case maid of
-- The majority of the code you will write in Yesod lives in these handler Just uid -> fmap ((,) uid) <$> runDB (get uid)
-- functions. You can spread them across multiple files if you are so Nothing -> return Nothing
-- inclined, or create a single monolithic file. case muid of
Nothing -> contElse
Just (uid,u) -> cont (uid,u)
getHomeR :: Handler Html getHomeR :: Handler Html
getHomeR = do getHomeR = do
maid <- maybeAuthId loginOrElse getLoggedIn getNotLoggedIn
muser <- case maid of
Just uid -> runDB $ get uid
Nothing -> return $ Nothing getLoggedIn :: (Key User, User) -> Handler Html
getLoggedIn (uid, user) = do
loginLayout user $ [whamlet|
<h1>Welcome back, #{userName user}.
<p>Current Balance: #{prettyISK $ userBalanceCents user} ISK.
<p>Current Stock Worth: ...
<p>Current total Worth: ...
<p>Profit in the last 7 days: ...
|]
getNotLoggedIn :: Handler Html
getNotLoggedIn = do
defaultLayout $ do defaultLayout $ do
setTitle "NEAT" setTitle "NEAT"
[whamlet| [whamlet|
<h1> <h1>Welcome to NEAT.
$maybe u <- muser <div>Here we should present features, images and other stuff to get people hooked.
Welcome back #{userName u}
$nothing
Welcome to NEAT.
<div>
$maybe u <- maid
<p>
Data: #{show u}<br>
<a href=@{AuthR LogoutR}>Logout
<br>
<a href=@{WalletR}>Wallet
<br>
<a href=@{SettingsR}>Settings
$nothing
<p>
<a href=@{AuthR LoginR}>Login
|] |]
{- {-
(formWidget, formEnctype) <- generateFormPost sampleForm (formWidget, formEnctype) <- generateFormPost sampleForm

View File

@ -11,7 +11,7 @@ import qualified Data.Text.Lazy as T
import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.ByteString.Lazy.Char8 as B
getSettingsR :: Handler Html getSettingsR :: Handler Html
getSettingsR = loginOrDo $ (\(uid,_) -> do getSettingsR = loginOrDo $ (\(uid,user) -> do
apiKey <- runDB $ getBy $ UniqueApiUser uid apiKey <- runDB $ getBy $ UniqueApiUser uid
(formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid) (formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid)
man <- getHttpManager <$> ask man <- getHttpManager <$> ask
@ -19,12 +19,12 @@ getSettingsR = loginOrDo $ (\(uid,_) -> do
Just (Entity _ key) -> liftIO $ checkApiKey key man Just (Entity _ key) -> liftIO $ checkApiKey key man
Nothing -> return False Nothing -> return False
insertionWidget <- return Nothing :: Handler (Maybe Widget) insertionWidget <- return Nothing :: Handler (Maybe Widget)
defaultLayout $(widgetFile "settings") loginLayout user $(widgetFile "settings")
) )
postSettingsR :: Handler Html postSettingsR :: Handler Html
postSettingsR = loginOrDo $ (\(uid,_) -> do postSettingsR = loginOrDo $ (\(uid,user) -> do
apiKey <- runDB $ getBy $ UniqueApiUser uid apiKey <- runDB $ getBy $ UniqueApiUser uid
((result,formWidget),formEnctype) <- runFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid) ((result,formWidget),formEnctype) <- runFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid)
(success, msg) <- case result of (success, msg) <- case result of
@ -46,7 +46,7 @@ $if success
$else $else
<div class="alert alert-danger" role="alert">^{msg} <div class="alert alert-danger" role="alert">^{msg}
|] :: Handler (Maybe Widget) |] :: Handler (Maybe Widget)
defaultLayout $(widgetFile "settings") loginLayout user $(widgetFile "settings")
) )
checkApiKey :: Api -> Manager -> IO Bool checkApiKey :: Api -> Manager -> IO Bool

View File

@ -81,7 +81,7 @@ getStockR = loginOrDo (\(uid,user) -> do
order by t.type_name asc" order by t.type_name asc"
(items :: [Stock]) <- runDB $ rawSql sql [toPersistValue uid] (items :: [Stock]) <- runDB $ rawSql sql [toPersistValue uid]
let items' = convertStock <$> items let items' = convertStock <$> items
defaultLayout $ [whamlet| loginLayout user $ [whamlet|
<div .panel .panel-default> <div .panel .panel-default>
<div .panel-heading>Current Stock: <div .panel-heading>Current Stock:
<table .table .table-condensed .small .table-bordered> <table .table .table-condensed .small .table-bordered>

View File

@ -7,8 +7,10 @@ import qualified Eve.Api.Char.WalletTransactions as WT
import qualified Eve.Api.Types as T 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 qualified Eve.Api.Char.AccountBalance as BA
import Database.Persist.Sql import Database.Persist.Sql
import Data.Time.Clock import Data.Time.Clock
import Control.Lens.Operators
accountingId :: Int64 accountingId :: Int64
accountingId = 16622 accountingId = 16622
@ -80,6 +82,15 @@ getUpdateR = loginOrDo (\(uid,user) -> do
mapM_ (\(Entity eid t) -> replace eid t) trans 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" let updateProblemSql = "update transaction t set problematic=true where t.trans_is_sell and t.in_stock < 0"
runDB $ rawExecute updateProblemSql [] runDB $ rawExecute updateProblemSql []
--update Balance
when (userBalanceTimeout user < now) $
do
balance <- liftIO $ BA.getAccountBalance man apidata
case balance of
T.QueryResult time' balance' -> runDB $ do
update uid [UserBalanceCents =. fromIntegral (balance' ^. BA.centbalance)]
update uid [UserBalanceTimeout =. time']
_ -> return ()
redirect WalletR redirect WalletR
) )

View File

@ -61,7 +61,7 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
order by \ order by \
extract(day from (now() at time zone 'utc')-date(date_time at time zone 'utc')) asc" extract(day from (now() at time zone 'utc')-date(date_time at time zone 'utc')) asc"
(profits :: [Profit]) <- runDB $ rawSql profitquery [toPersistValue uid, toPersistValue days] (profits :: [Profit]) <- runDB $ rawSql profitquery [toPersistValue uid, toPersistValue days]
defaultLayout $ [whamlet| loginLayout user $ [whamlet|
<div .panel .panel-default> <div .panel .panel-default>
<div .panel-heading>Transactions in the last #{hrs} hours: <div .panel-heading>Transactions in the last #{hrs} hours:
<div .btn-group .btn-group-justified role="group"> <div .btn-group .btn-group-justified role="group">

View File

@ -7,6 +7,7 @@ import Import.NoFoundation as Import
import Yesod.Form.Bootstrap3 as Import import Yesod.Form.Bootstrap3 as Import
import Text.Printf import Text.Printf
import Data.List (unfoldr) import Data.List (unfoldr)
import Text.Hamlet
loginOrDo :: ((Key User, User) -> Handler Html) -> Handler Html loginOrDo :: ((Key User, User) -> Handler Html) -> Handler Html
loginOrDo cont = do loginOrDo cont = do
@ -37,3 +38,26 @@ showTime t = printf "%02u" hours ++ ":" ++ printf "%02u" minutes ++ ":" ++ print
showDateTime :: UTCTime -> String showDateTime :: UTCTime -> String
showDateTime t = (show . utctDay $ t) ++ " " ++ showDateTime t = (show . utctDay $ t) ++ " " ++
(showTime . round . utctDayTime $ 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
$(widgetFile "default-layout")
withUrlRenderer $(hamletFile "templates/login-layout-wrapper.hamlet")

View File

@ -8,9 +8,11 @@ User
accessToken Text accessToken Text
walletTimeout UTCTime walletTimeout UTCTime
standingsTimeout UTCTime standingsTimeout UTCTime
balanceTimeout UTCTime
skillTimeout UTCTime skillTimeout UTCTime
br Int -- Broker-Relations-Skill br Int -- Broker-Relations-Skill
acc Int -- Accounting-Skill acc Int -- Accounting-Skill
balanceCents Int64
UniqueUser ident UniqueUser ident
deriving Typeable deriving Typeable

View File

@ -25,6 +25,6 @@ database:
database: "_env:PGDATABASE:neat" database: "_env:PGDATABASE:neat"
poolsize: "_env:PGPOOLSIZE:10" poolsize: "_env:PGPOOLSIZE:10"
copyright: For all services on this Page a FULL API-Key is required! This page is run by an individual person, who is not affiliated with CCP in any way (other than he plays EVE). The service is currently in development and may break at any time. There is no backup-service and the data you enter may be lost when the servers harddrive crashes. CCP can not be held responsible for any malfunction of this page. copyright: For all services on this Page an API-Key with access to Wallet, Transaction and more is required! This page is run by an individual person, who is not affiliated with CCP in any way (other than he plays EVE). The service is currently in development and may break at any time. There is no backup-service and the data you enter may be lost when the servers harddrive crashes. CCP can not be held responsible for any malfunction of this page.
This page may improve your trading-ability, but we can't be made responsible for anything. Your PC may malfunction, explode or a llama may appear in your room - don't sue us for that. This page may improve your trading-ability, but we can't be made responsible for anything. Your PC may malfunction, explode or a llama may appear in your room - don't sue us for that.
#analytics: UA-YOURCODE #analytics: UA-YOURCODE

View File

@ -91,6 +91,7 @@ library
, xml-lens , xml-lens
, xml-conduit , xml-conduit
, eve-api , eve-api
, lens
executable neat executable neat

View File

@ -40,9 +40,7 @@ $newline never
<div class="collapse navbar-collapse" id="bs-example-navbar-collapse-1"> <div class="collapse navbar-collapse" id="bs-example-navbar-collapse-1">
<ul class="nav navbar-nav"> <ul class="nav navbar-nav">
<li><a href="@{HomeR}">Home</a> <li><a href="@{HomeR}">Home</a>
<li><a href="@{WalletR}">Transactions</a> <li><a href="#">Features</a>
<li><a href="@{StockR}">Stock</a>
<li><a href="@{SettingsR}">Settings</a>
<!--li class="dropdown"> <!--li class="dropdown">
<a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Dropdown <span class="caret"></span> <a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Dropdown <span class="caret"></span>
<ul class="dropdown-menu"> <ul class="dropdown-menu">
@ -54,8 +52,8 @@ $newline never
<li role="separator" class="divider"> <li role="separator" class="divider">
<li><a href="@SettingsR">Settings</a--> <li><a href="@SettingsR">Settings</a-->
<ul class="nav navbar-nav navbar-right"> <ul class="nav navbar-nav navbar-right">
<li><a href="@{UpdateR}">Update</a> <li><a href="@{AuthR LoginR}">Login (for now)</a>
<li><a href="@{AuthR LogoutR}">Logout</a> <li><a href="#">Fancy "Login with Eve"</a>
<div id="main" role="main"> <div id="main" role="main">
^{pageBody pc} ^{pageBody pc}
<footer class="footer"> <footer class="footer">

View File

@ -0,0 +1,75 @@
$newline never
\<!doctype html>
\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->
\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->
\<!--[if gt IE 8]><!-->
<html class="no-js" lang="en"> <!--<![endif]-->
<head>
<meta charset="UTF-8">
<title>#{pageTitle pc}
<meta name="description" content="">
<meta name="author" content="">
<meta name="viewport" content="width=device-width,initial-scale=1">
^{pageHead pc}
\<!--[if lt IE 9]>
\<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
\<![endif]-->
<script>
document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');
<body>
<div class="container">
<header>
<nav class="navbar navbar-default navbar-fixed-top">
<div class="container-fluid">
<!-- Brand and toggle get grouped for better mobile display -->
<div class="navbar-header">
<button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#bs-example-navbar-collapse-1" aria-expanded="false">
<span class="sr-only">Toggle navigation
<span class="icon-bar">
<span class="icon-bar">
<span class="icon-bar">
<a class="navbar-brand" href="@{HomeR}">NEAT
<!-- Collect the nav links, forms, and other content for toggling -->
<div class="collapse navbar-collapse" id="bs-example-navbar-collapse-1">
<ul class="nav navbar-nav">
<li><a href="@{HomeR}">Home</a>
<li><a href="@{WalletR}">Transactions</a>
<li><a href="@{StockR}">Stock</a>
<li><a href="@{SettingsR}">Settings</a>
<li><a href="#">#{prettyISK $ userBalanceCents user} ISK</a>
<!--li class="dropdown">
<a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Dropdown <span class="caret"></span>
<ul class="dropdown-menu">
<li><a href="#">Action</a>
<li><a href="#">Another action</a>
<li><a href="#">Something else here</a>
<li role="separator" class="divider">
<li><a href="#">Separated link</a>
<li role="separator" class="divider">
<li><a href="@SettingsR">Settings</a-->
<ul class="nav navbar-nav navbar-right">
<li><a href="@{UpdateR}">Update</a>
<li><a href="@{AuthR LogoutR}">Logout</a>
<div id="main" role="main">
^{pageBody pc}
<footer class="footer">
<div class="container">
#{appCopyright $ appSettings master}
$maybe analytics <- appAnalytics $ appSettings master
<script>
if(!window.location.href.match(/localhost/)){
window._gaq = [['_setAccount','#{analytics}'],['_trackPageview'],['_trackPageLoadTime']];
(function() {
\ var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
\ ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}