Add people and person pages

config/routes

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

src/Application.hs

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

src/Foundation.hs

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

src/Handler/Home.hs

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

src/Handler/Person.hs

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

templates/default-layout.hamlet

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

templates/homepage.hamlet

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

templates/people.hamlet

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

templates/person.hamlet

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

vervis.cabal

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