Add project pages

config/routes

@@ -32,5 +32,7 @@
 
 /                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

src/Application.hs

@@ -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

src/Handler/Home.hs

@@ -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")

src/Handler/Project.hs

@@ -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")

templates/homepage.hamlet

@@ -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>

templates/person.hamlet

@@ -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!

templates/project.hamlet

@@ -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!

templates/projects.hamlet

@@ -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}

vervis.cabal

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