Replace some Esqueleto with much simpler Persistent queries

src/Vervis/Handler/Person.hs

@@ -87,14 +87,10 @@ getPersonNewR = do
 
 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")
+    person <- runDB $ do
+        Entity sid _s <- getBy404 $ UniqueSharerIdent ident
+        Entity _pid p <- getBy404 $ UniquePersonIdent sid
+        return p
+    defaultLayout $ do
+        setTitle $ text $ "Vervis > People > " <> ident
+        $(widgetFile "person")

src/Vervis/Handler/Project.hs

@@ -72,20 +72,15 @@ getProjectNewR ident = do
 
 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")
+    project <- runDB $ do
+        Entity sid _s <- getBy404 $ UniqueSharerIdent user
+        Entity _pid p <- getBy404 $ UniqueProject proj sid
+        return p
+    defaultLayout $ do
+        setTitle $ text $ mconcat
+            [ "Vervis > People > "
+            , user
+            , " > Project > "
+            , proj
+            ]
+        $(widgetFile "project")

templates/person.hamlet

@@ -14,15 +14,11 @@ $# <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>
+<h2>About
+<p>
+  This is the user page for <b>#{ident}</b>
 
-  <h2>Projects
-  <p>
-    See
-    <a href=@{ProjectsR ident}>projects</a>.
-
-$nothing
-  <p>Internal error: More than one user with the same identifier!
+<h2>Projects
+<p>
+  See
+  <a href=@{ProjectsR ident}>projects</a>.

templates/project.hamlet

@@ -14,26 +14,28 @@ $# <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>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)
+<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!
+<h2>Repos
+
+<p>
+  See
+  <a href=@{ReposR user proj}>repos</a>.