forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Add people and person pages

Browse source
This commit is contained in:
fr33domlover 2016-02-17 16:43:23 +00:00
parent 7ede602d1d
commit a6525d7549
10 changed files with 165 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
config/routes
View file

@ -12,10 +12,25 @@
-- with this software. If not, see
-- <http://creativecommons.org/publicdomain/zero/1.0/>.
/static StaticR Static appStatic
/auth AuthR Auth getAuth
-- ----------------------------------------------------------------------------
-- Yesod misc
-- ----------------------------------------------------------------------------
/static StaticR Static appStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
-- ----------------------------------------------------------------------------
-- User signup and login
-- ----------------------------------------------------------------------------
/auth AuthR Auth getAuth
-- ----------------------------------------------------------------------------
-- Everything else...
-- ----------------------------------------------------------------------------
/ HomeR GET
/p PeopleR GET
/p/#Text PersonR GET

1
src/Application.hs
View file

@ -51,6 +51,7 @@ import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
-- Don't forget to add new modules to your cabal file!
import Handler.Common
import Handler.Home
import Handler.Person
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the

1
src/Foundation.hs
View file

@ -88,6 +88,7 @@ instance Yesod App where
defaultLayout widget = do
master <- getYesod
mmsg <- getMessage
mperson <- maybeAuth
-- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and

1
src/Handler/Home.hs
View file

@ -52,7 +52,6 @@ getHomeR = do
dt <- lastChange path
ago <- timeAgo dt
return (sharer, project, repo, ago)
mp <- maybeAuth
defaultLayout $ do
setTitle "Welcome to Vervis!"
$(widgetFile "homepage")

52
src/Handler/Person.hs Normal file
View file

@ -0,0 +1,52 @@
{- 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/>.
-}
module Handler.Person
( getPeopleR
, getPersonR
)
where
import Import hiding ((==.))
--import Prelude
import Text.Blaze (text)
import Database.Esqueleto
--import Model
--import Yesod.Core (Handler)
getPeopleR :: Handler Html
getPeopleR = do
people <- runDB $ select $ from $ \ (sharer, person) -> do
where_ $ sharer ^. SharerId ==. person ^. PersonIdent
orderBy [asc $ sharer ^. SharerIdent]
return $ sharer ^. SharerIdent
defaultLayout $ do
setTitle "Vervis > People"
$(widgetFile "people")
getPersonR :: Text -> Handler Html
getPersonR ident = do
people <- runDB $ select $ from $ \ (sharer, person) -> do
where_ $
sharer ^. SharerIdent ==. val ident &&.
sharer ^. SharerId ==. person ^. PersonIdent
return person
case people of
[] -> notFound
p:ps -> defaultLayout $ do
let mperson = if null ps then Just p else Nothing
setTitle $ text $ "Vervis > People > " <> ident
$(widgetFile "person")

23
templates/default-layout.hamlet
View file

@ -1,3 +1,26 @@
$# 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/>.
$maybe Entity _pid person <- mperson
<p>
You are logged in as #{personLogin person}.
<a href=@{AuthR LogoutR}>Log out.
$nothing
<p>
You are not logged in.
<a href=@{AuthR LoginR}>Log in.
$maybe msg <- mmsg
<div #message>#{msg}
^{widget}

33
templates/homepage.hamlet
View file

@ -1,18 +1,25 @@
$# 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
<p>
Vervis is hopefully going to be, eventually, a decentralized project hosting
platform. At the time of writing (2016-02-14), it is a simple scaffolded
Yesod web application which displays a table of Git repositories.
platform. It's still in early development, but hopefully making progress
fast.
$maybe Entity _pid person <- mp
<p>
You are logged in as #{personLogin person}.
<a href=@{AuthR LogoutR}>Log out.
$nothing
<p>
You are not logged in.
<a href=@{AuthR LoginR}>Log in.
<h2>Repos
<table>
$forall (sharer, proj, repo, ago) <- rows
@ -21,3 +28,9 @@ $nothing
<td>#{proj}
<td>#{repo}
<td>#{ago}
<h2>People
<p>
See
<a href=@{PeopleR}>people</a>.

23
templates/people.hamlet Normal file
View file

@ -0,0 +1,23 @@
$# 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
<p>
These are the people registered in this Vervis instance.
<ul>
$forall Value ident <- people
<li>
<a href=@{PersonR ident}>#{ident}

23
templates/person.hamlet Normal file
View file

@ -0,0 +1,23 @@
$# 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 > #{ident}
$maybe Entity _pid _person <- mperson
<p>
This is the user page for <b>#{ident}</b>. Nothing exciting here yet.
$nothing
<p>
No such registered user in this Vervis instance.

2
vervis.cabal
View file

@ -44,6 +44,7 @@ library
Settings.StaticFiles
Handler.Common
Handler.Home
Handler.Person
-- other-modules:
default-extensions: TemplateHaskell
QuasiQuotes
@ -72,6 +73,7 @@ library
-- , unordered-containers >=0.2.5
build-depends: aeson >= 0.6 && < 0.11
, base >= 4 && < 5
, blaze-markup
, bytestring >= 0.9 && < 0.11
, case-insensitive
, classy-prelude >= 0.10.2