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
+    person <- runDB $ do
-        where_ $
+        Entity sid _s <- getBy404 $ UniqueSharerIdent ident
-            sharer ^. SharerIdent ==. val ident &&.
+        Entity _pid p <- getBy404 $ UniquePersonIdent sid
-            sharer ^. SharerId ==. person ^. PersonIdent
+        return p
-        return person
+    defaultLayout $ do
-    case people of
+        setTitle $ text $ "Vervis > People > " <> ident
-        []   -> notFound
+        $(widgetFile "person")
-        p:ps -> defaultLayout $ do
-            let mperson = if null ps then Just p else Nothing
-            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
+    project <- runDB $ do
-        where_ $
+        Entity sid _s <- getBy404 $ UniqueSharerIdent user
-            sharer ^. SharerIdent ==. val user &&.
+        Entity _pid p <- getBy404 $ UniqueProject proj sid
-            project ^. ProjectIdent ==. val proj &&.
+        return p
-            sharer ^. SharerId ==. project ^. ProjectSharer
+    defaultLayout $ do
-        return project
+        setTitle $ text $ mconcat
-    case projects of
+            [ "Vervis > People > "
-        []   -> notFound
+            , user
-        p:ps -> defaultLayout $ do
+            , " > Project > "
-            let mproject = if null ps then Just p else Nothing
+            , proj
-            setTitle $ text $ mconcat
+            ]
-                [ "Vervis > People > "
+        $(widgetFile "project")
-                , 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
-  <h2>About
+<p>
-  <p>
+  This is the user page for <b>#{ident}</b>
-    This is the user page for <b>#{ident}</b>
 
-  <h2>Projects
+<h2>Projects
-  <p>
+<p>
-    See
+  See
-    <a href=@{ProjectsR ident}>projects</a>.
+  <a href=@{ProjectsR ident}>projects</a>.
-
-$nothing
-  <p>Internal error: More than one user with the same identifier!

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