Add project pages

This commit is contained in:
fr33domlover 2016-02-17 21:53:53 +00:00
parent a6525d7549
commit 5287a47372
9 changed files with 153 additions and 10 deletions

View file

@ -16,21 +16,23 @@
-- Yesod misc
-- ----------------------------------------------------------------------------
/static StaticR Static appStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/static StaticR Static appStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
-- ----------------------------------------------------------------------------
-- User signup and login
-- ----------------------------------------------------------------------------
/auth AuthR Auth getAuth
/auth AuthR Auth getAuth
-- ----------------------------------------------------------------------------
-- Everything else...
-- ----------------------------------------------------------------------------
/ HomeR GET
/ HomeR GET
/p PeopleR GET
/p/#Text PersonR GET
/u PeopleR GET
/u/#Text PersonR GET
/u/#Text/p ProjectsR GET
/u/#Text/p/#Text ProjectR GET

View file

@ -52,6 +52,7 @@ import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
import Handler.Common
import Handler.Home
import Handler.Person
import Handler.Project
-- 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

View file

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

60
src/Handler/Project.hs Normal file
View file

@ -0,0 +1,60 @@
{- 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.Project
( getProjectsR
, getProjectR
)
where
import Import hiding ((==.))
--import Prelude
import Text.Blaze (text)
import Database.Esqueleto
--import Model
--import Yesod.Core (Handler)
getProjectsR :: Text -> Handler Html
getProjectsR ident = do
projects <- runDB $ select $ from $ \ (sharer, project) -> do
where_ $
sharer ^. SharerIdent ==. val ident &&.
sharer ^. SharerId ==. project ^. ProjectSharer
orderBy [asc $ project ^. ProjectIdent]
return $ project ^. ProjectIdent
defaultLayout $ do
setTitle $ text $ "Vervis > People > " <> ident <> " > Projects"
$(widgetFile "projects")
getProjectR :: Text -> Text -> Handler Html
getProjectR user proj = do
projects <- runDB $ select $ from $ \ (sharer, project) -> do
where_ $
sharer ^. SharerIdent ==. val user &&.
project ^. ProjectIdent ==. val proj &&.
sharer ^. SharerId ==. project ^. ProjectSharer
return project
case projects of
[] -> notFound
p:ps -> defaultLayout $ do
let mproject = if null ps then Just p else Nothing
setTitle $ text $ mconcat
[ "Vervis > People > "
, user
, " > Project > "
, proj
]
$(widgetFile "project")

View file

@ -19,6 +19,18 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
platform. It's still in early development, but hopefully making progress
fast.
<h2>Intended Content
<p>
This page, the homepage, is currently planned to be an intro or global
overview page when not logged in, and be a user-specific overview page when
browsing to it while logged in.
$maybe _ <- mp
<p>You're logged in, i.e. you should see a personal overview.
$nothing
<p>You aren't logged in, i.e. you should see a global overview/intro.
<h2>Repos
<table>

View file

@ -15,9 +15,14 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<h1>Vervis > People > #{ident}
$maybe Entity _pid _person <- mperson
<h2>About
<p>
This is the user page for <b>#{ident}</b>. Nothing exciting here yet.
This is the user page for <b>#{ident}</b>
<h2>Projects
<p>
See
<a href=@{ProjectsR ident}>projects</a>.
$nothing
<p>
No such registered user in this Vervis instance.
<p>Internal error: More than one user with the same identifier!

39
templates/project.hamlet Normal file
View file

@ -0,0 +1,39 @@
$# 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 > #{user} > Projects > #{proj}
$maybe Entity _pid project <- mproject
<h2>About
<p>This is the project page for <b>#{proj}</b>, shared by <b>#{user}</b>.
<h2>Details
<table>
<tr>
<td>Human-friendly name
<td>
$maybe name <- projectName project
#{name}
$nothing
(none)
<tr>
<td>Description
<td>
$maybe desc <- projectDesc project
#{desc}
$nothing
(none)
$nothing
<p>Internal error: More than one project per user/proj name pair!

22
templates/projects.hamlet Normal file
View file

@ -0,0 +1,22 @@
$# 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} > Projects
<p>These are projects shared by #{ident}.
<ul>
$forall Value project <- projects
<li>
<a href=@{ProjectR ident project}>#{project}

View file

@ -45,6 +45,7 @@ library
Handler.Common
Handler.Home
Handler.Person
Handler.Project
-- other-modules:
default-extensions: TemplateHaskell
QuasiQuotes