2015-03-10 23:13:42 +00:00
|
|
|
module Handler.Home where
|
|
|
|
|
|
|
|
import Import
|
|
|
|
|
2015-08-18 10:28:15 +00:00
|
|
|
loginOrElse :: ((Key User, User) -> Handler Html) -> Handler Html -> Handler Html
|
|
|
|
loginOrElse cont contElse = do
|
|
|
|
maid <- maybeAuthId
|
|
|
|
muid <- case maid of
|
|
|
|
Just uid -> fmap ((,) uid) <$> runDB (get uid)
|
|
|
|
Nothing -> return Nothing
|
|
|
|
case muid of
|
|
|
|
Nothing -> contElse
|
|
|
|
Just (uid,u) -> cont (uid,u)
|
|
|
|
|
2015-03-10 23:13:42 +00:00
|
|
|
getHomeR :: Handler Html
|
|
|
|
getHomeR = do
|
2015-08-18 10:28:15 +00:00
|
|
|
loginOrElse getLoggedIn getNotLoggedIn
|
|
|
|
|
|
|
|
|
|
|
|
getLoggedIn :: (Key User, User) -> Handler Html
|
|
|
|
getLoggedIn (uid, user) = do
|
2015-09-06 13:53:09 +00:00
|
|
|
let totalworth = userBalanceCents user + userStockCents user + userEscrowCents user
|
2015-08-18 10:28:15 +00:00
|
|
|
loginLayout user $ [whamlet|
|
|
|
|
<h1>Welcome back, #{userName user}.
|
|
|
|
<p>Current Balance: #{prettyISK $ userBalanceCents user} ISK.
|
2015-09-06 13:53:09 +00:00
|
|
|
<p>Current Stock Worth: #{prettyISK $ userStockCents user} ISK.
|
|
|
|
<p>Current Escrow Worth: #{prettyISK $ userEscrowCents user} ISK.
|
|
|
|
<p>Current total Worth: #{prettyISK $ totalworth} ISK.
|
2015-08-18 10:28:15 +00:00
|
|
|
|]
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
getNotLoggedIn :: Handler Html
|
|
|
|
getNotLoggedIn = do
|
2015-04-26 20:18:24 +00:00
|
|
|
defaultLayout $ do
|
|
|
|
setTitle "NEAT"
|
|
|
|
[whamlet|
|
2015-08-18 10:28:15 +00:00
|
|
|
<h1>Welcome to NEAT.
|
|
|
|
<div>Here we should present features, images and other stuff to get people hooked.
|
2015-04-26 20:18:24 +00:00
|
|
|
|]
|
|
|
|
{-
|
2015-03-10 23:13:42 +00:00
|
|
|
(formWidget, formEnctype) <- generateFormPost sampleForm
|
|
|
|
let submission = Nothing :: Maybe (FileInfo, Text)
|
|
|
|
handlerName = "getHomeR" :: Text
|
|
|
|
defaultLayout $ do
|
|
|
|
aDomId <- newIdent
|
|
|
|
setTitle "Welcome To Yesod!"
|
2015-04-26 20:18:24 +00:00
|
|
|
$(widgetFile "homepage")-}
|
2015-03-10 23:13:42 +00:00
|
|
|
|
|
|
|
postHomeR :: Handler Html
|
|
|
|
postHomeR = do
|
2015-06-16 18:08:01 +00:00
|
|
|
defaultLayout $ [whamlet|
|
|
|
|
<h1>nothing to see here. Stuff coming soon (tm).
|
|
|
|
|]
|
|
|
|
{- ((result, loginWidget), loginEnctype) <- runFormPost loginForm
|
2015-06-16 15:03:34 +00:00
|
|
|
let loginfail err = defaultLayout $ do
|
2015-04-27 15:31:06 +00:00
|
|
|
setTitle "NEAT"
|
|
|
|
[whamlet|
|
|
|
|
<h1>
|
|
|
|
Welcome to NEAT.
|
|
|
|
<div>
|
2015-06-16 15:03:34 +00:00
|
|
|
<div class="alert alert-danger fade in">#{err}
|
2015-04-27 15:31:06 +00:00
|
|
|
Login
|
|
|
|
<form method=post action=@{HomeR} enctype=#{loginEnctype}>
|
|
|
|
^{loginWidget}
|
|
|
|
<button>Submit
|
|
|
|
<a href=@{RegisterR}>Register Account
|
|
|
|
|]
|
2015-08-18 10:28:15 +00:00
|
|
|
case result of
|
2015-06-16 15:03:34 +00:00
|
|
|
FormSuccess (u,pw) -> do
|
|
|
|
login <- runDB $ selectFirst [UserIdent ==. u, UserPassword ==. (Just pw)] []
|
|
|
|
case login of
|
|
|
|
Nothing -> loginfail ("wrong username or password" :: Text)
|
|
|
|
Just (Entity _ (User name _ _)) ->
|
|
|
|
defaultLayout $ do [whamlet|<h1>Hello #{name}|]
|
2015-06-16 18:08:01 +00:00
|
|
|
_ -> loginfail ("wrong username or password" :: Text)-}
|
2015-03-10 23:13:42 +00:00
|
|
|
|
2015-04-26 20:18:24 +00:00
|
|
|
|
2015-06-16 18:08:01 +00:00
|
|
|
{-loginForm :: Form (Text, Text)
|
2015-04-26 20:18:24 +00:00
|
|
|
loginForm = renderBootstrap3 BootstrapBasicForm $ (,)
|
|
|
|
<$> areq textField ((withAutofocus . withPlaceholder "Username") (bfs ("Username" :: Text))) Nothing
|
2015-06-16 18:08:01 +00:00
|
|
|
<*> areq passwordField (bfs ("Password" :: Text)) Nothing-}
|