From 9afd341acac6c7ba12d988592f75c926278f91c2 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Thu, 3 Mar 2016 08:35:29 +0000
Subject: [PATCH] Replace some Esqueleto with much simpler Persistent queries

---
 src/Vervis/Handler/Person.hs  | 18 ++++++--------
 src/Vervis/Handler/Project.hs | 29 ++++++++++-------------
 templates/person.hamlet       | 18 ++++++--------
 templates/project.hamlet      | 44 ++++++++++++++++++-----------------
 4 files changed, 49 insertions(+), 60 deletions(-)

diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs
index b4820dd..116bf21 100644
--- a/src/Vervis/Handler/Person.hs
+++ b/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")
diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs
index 6f92769..18c110f 100644
--- a/src/Vervis/Handler/Project.hs
+++ b/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")
diff --git a/templates/person.hamlet b/templates/person.hamlet
index 1e74c27..0990edb 100644
--- a/templates/person.hamlet
+++ b/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>.
diff --git a/templates/project.hamlet b/templates/project.hamlet
index 1f17e6b..efb48c4 100644
--- a/templates/project.hamlet
+++ b/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>.