mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 17:24:53 +09:00
Add user registration form view, still no-op
This commit is contained in:
parent
ee7a353904
commit
c0a86c3f5b
3 changed files with 70 additions and 9 deletions
|
@ -16,23 +16,32 @@
|
||||||
-- Yesod misc
|
-- Yesod misc
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
|
|
||||||
/static StaticR Static appStatic
|
/static StaticR Static appStatic
|
||||||
/favicon.ico FaviconR GET
|
/favicon.ico FaviconR GET
|
||||||
/robots.txt RobotsR GET
|
/robots.txt RobotsR GET
|
||||||
|
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
-- User signup and login
|
-- User signup and login
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
|
|
||||||
/auth AuthR Auth getAuth
|
/auth AuthR Auth getAuth
|
||||||
|
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
-- Everything else...
|
-- Everything else...
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
|
|
||||||
/ HomeR GET
|
/ HomeR GET
|
||||||
|
|
||||||
/u PeopleR GET
|
/u PeopleR GET -- POST
|
||||||
/u/#Text PersonR GET
|
/u/!new PersonNewR GET
|
||||||
/u/#Text/p ProjectsR GET
|
/u/#Text PersonR GET
|
||||||
/u/#Text/p/#Text ProjectR GET
|
|
||||||
|
/u/#Text/p ProjectsR GET
|
||||||
|
/u/#Text/p/#Text ProjectR GET
|
||||||
|
|
||||||
|
-- /u/#Text/p/#Text/r ReposR GET
|
||||||
|
-- /u/#Text/p/#Text/r/#Text RepoR GET
|
||||||
|
-- /u/#Text/p/#Text/t TicketsR GET
|
||||||
|
-- /u/#Text/p/#Text/t/#TicketId TicketR GET
|
||||||
|
-- /u/#Text/p/#Text/w WikiR GET
|
||||||
|
-- /u/#Text/p/#Text/w/+Texts WikiPageR GET
|
||||||
|
|
|
@ -15,6 +15,7 @@
|
||||||
|
|
||||||
module Handler.Person
|
module Handler.Person
|
||||||
( getPeopleR
|
( getPeopleR
|
||||||
|
, getPersonNewR
|
||||||
, getPersonR
|
, getPersonR
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -27,6 +28,21 @@ import Database.Esqueleto
|
||||||
--import Model
|
--import Model
|
||||||
--import Yesod.Core (Handler)
|
--import Yesod.Core (Handler)
|
||||||
|
|
||||||
|
data PersonNew = PersonNew
|
||||||
|
{ uLogin :: Text
|
||||||
|
, uPass :: Text
|
||||||
|
, uPass' :: Text
|
||||||
|
, uEmail :: Maybe Text
|
||||||
|
}
|
||||||
|
|
||||||
|
formPersonNew :: Form PersonNew
|
||||||
|
formPersonNew = renderDivs $ PersonNew
|
||||||
|
<$> areq textField "Username" Nothing
|
||||||
|
<*> areq passwordField "Password" Nothing
|
||||||
|
<*> areq passwordField "Repeat password" Nothing
|
||||||
|
<*> aopt emailField "E-mail" Nothing
|
||||||
|
|
||||||
|
-- | Get list of users
|
||||||
getPeopleR :: Handler Html
|
getPeopleR :: Handler Html
|
||||||
getPeopleR = do
|
getPeopleR = do
|
||||||
people <- runDB $ select $ from $ \ (sharer, person) -> do
|
people <- runDB $ select $ from $ \ (sharer, person) -> do
|
||||||
|
@ -37,6 +53,21 @@ getPeopleR = do
|
||||||
setTitle "Vervis > People"
|
setTitle "Vervis > People"
|
||||||
$(widgetFile "people")
|
$(widgetFile "people")
|
||||||
|
|
||||||
|
-- | Create new user
|
||||||
|
--postPeopleR :: Handler Html
|
||||||
|
--postPeopleR =
|
||||||
|
|
||||||
|
getPersonNewR :: Handler Html
|
||||||
|
getPersonNewR = do
|
||||||
|
mpid <- maybeAuthId
|
||||||
|
if isJust mpid
|
||||||
|
then redirect HomeR
|
||||||
|
else do
|
||||||
|
((_result, widget), enctype) <- runFormPost formPersonNew
|
||||||
|
defaultLayout $ do
|
||||||
|
setTitle "Vervis > People > New"
|
||||||
|
$(widgetFile "person-new")
|
||||||
|
|
||||||
getPersonR :: Text -> Handler Html
|
getPersonR :: Text -> Handler Html
|
||||||
getPersonR ident = do
|
getPersonR ident = do
|
||||||
people <- runDB $ select $ from $ \ (sharer, person) -> do
|
people <- runDB $ select $ from $ \ (sharer, person) -> do
|
||||||
|
|
21
templates/person-new.hamlet
Normal file
21
templates/person-new.hamlet
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
$# This file is part of Vervis.
|
||||||
|
$#
|
||||||
|
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
|
$#
|
||||||
|
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
|
$#
|
||||||
|
$# The author(s) have dedicated all copyright and related and neighboring
|
||||||
|
$# rights to this software to the public domain worldwide. This software is
|
||||||
|
$# distributed without any warranty.
|
||||||
|
$#
|
||||||
|
$# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
|
$# with this software. If not, see
|
||||||
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
|
<h1>Vervis > People > New
|
||||||
|
|
||||||
|
Enter your details and click on "Submit" to create a new user account.
|
||||||
|
|
||||||
|
<form method=POST action=@{PeopleR} enctype=#{enctype}>
|
||||||
|
^{widget}
|
||||||
|
<input type=submit>
|
Loading…
Reference in a new issue