neat/Handler/Home.hs

82 lines
3.1 KiB
Haskell
Raw Normal View History

2015-03-10 23:13:42 +00:00
module Handler.Home where
import Import
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
2015-04-26 20:18:24 +00:00
withSmallInput, withPlaceholder, bfs,
withAutofocus)
2015-03-10 23:13:42 +00:00
-- This is a handler function for the GET request method on the HomeR
-- resource pattern. All of your resource patterns are defined in
-- config/routes
--
-- The majority of the code you will write in Yesod lives in these handler
-- functions. You can spread them across multiple files if you are so
-- inclined, or create a single monolithic file.
getHomeR :: Handler Html
getHomeR = do
2015-04-27 15:31:06 +00:00
maid <- maybeAuthId
2015-04-26 20:18:24 +00:00
(loginWidget, loginEnctype) <- generateFormPost loginForm
defaultLayout $ do
setTitle "NEAT"
[whamlet|
<h1>
Welcome to NEAT.
<div>
2015-04-27 15:31:06 +00:00
Current Auth-ID: #{show maid}.
$maybe u <- maid
<p>
Data: #{show u}<br>
<a href=@{AuthR LogoutR}>Logout
$nothing
Login
<a href=@{AuthR LoginR}>Login-Page
<form method=post action=@{HomeR} enctype=#{loginEnctype}>
^{loginWidget}
<button>Submit
<a href=@{RegisterR}>Register Account
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-04-27 15:31:06 +00:00
((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-06-16 15:03:34 +00:00
case result of
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}|]
_ -> loginfail ("wrong username or password" :: Text)
2015-04-27 15:31:06 +00:00
2015-03-10 23:13:42 +00:00
sampleForm :: Form (FileInfo, Text)
sampleForm = renderBootstrap3 BootstrapBasicForm $ (,)
<$> fileAFormReq "Choose a file"
<*> areq textField (withSmallInput "What's on the file?") Nothing
2015-04-26 20:18:24 +00:00
loginForm :: Form (Text, Text)
loginForm = renderBootstrap3 BootstrapBasicForm $ (,)
<$> areq textField ((withAutofocus . withPlaceholder "Username") (bfs ("Username" :: Text))) Nothing
<*> areq passwordField (bfs ("Password" :: Text)) Nothing