From 0055a4160bc6c3a70d0339a240966b066f8a49de Mon Sep 17 00:00:00 2001
From: Danielle McLean <dani@00dani.me>
Date: Wed, 11 Oct 2017 13:16:47 +1100
Subject: [PATCH] Use an Esqueleto query to efficiently fetch and render the
 user profiles on h-cards, rather than several queries and lots of fussing
 around

---
 src/Site.hs                 | 21 ---------------------
 src/Widget/Card.hs          | 27 +++++++++++++--------------
 templates/mf2/h-card.hamlet |  4 ++--
 3 files changed, 15 insertions(+), 37 deletions(-)
 delete mode 100644 src/Site.hs

diff --git a/src/Site.hs b/src/Site.hs
deleted file mode 100644
index 0eb03fa..0000000
--- a/src/Site.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module Site ( fetch ) where
-
-import Foundation ( Handler )
-import Model
-import Util ( compileMustache, entityToTuple )
-
-import Text.Mustache ( Template )
-import Yesod ( Key, runDB, selectList, (<-.) )
-
-import qualified Data.Map as M
-import qualified Data.Text as T
-
-compileTemplates :: M.Map (Key Site) Site -> M.Map (Key Site) (Site, Template)
-compileTemplates = fmap $ \site -> (site, compile site)
-    where compile site = T.unpack (siteIcon site) `compileMustache` siteTemplate site
-
-fetch :: [Key Site] -> Handler (M.Map (Key Site) (Site, Template))
-fetch = fmap compileTemplates . fetchSites
-
-fetchSites :: [SiteId] -> Handler (M.Map (Key Site) Site)
-fetchSites siteIds = runDB $ M.fromList . map entityToTuple <$> selectList [SiteId <-. siteIds] []
diff --git a/src/Widget/Card.hs b/src/Widget/Card.hs
index 4e64b1b..05d7844 100644
--- a/src/Widget/Card.hs
+++ b/src/Widget/Card.hs
@@ -5,31 +5,30 @@ module Widget.Card ( hCard ) where
 
 import Import
 
-import qualified Site
+import Database.Esqueleto ( (^.) )
+import qualified Database.Esqueleto as E
+
+import Text.Mustache ( substitute )
+import Util ( compileMustache )
 
-import Data.Maybe (fromJust)
-import Text.Mustache ( Template, substitute )
-import qualified Data.Map as M
 import qualified Data.Text as T
 
-arrangeProfiles :: [Profile] -> M.Map (Key Site) (Site, Template) -> [((Site, Template), Profile)]
-arrangeProfiles profiles sites = sortBy icon $ zip profileSites profiles
-    where findSite = fromJust . flip M.lookup sites . profileSiteId
-          profileSites = findSite <$> profiles
-          icon = comparing $ siteName . fst . fst
-
 prettyPgp :: PgpKey -> Text
 prettyPgp = T.unwords . T.chunksOf 4 . pgpKeyFingerprint
 
 routeFromPgp :: PgpKey -> Route App
 routeFromPgp PgpKey { pgpKeyFingerprint = f } = staticR ["pgp", T.takeEnd 8 f ++ ".asc"]
 
+profileUrl :: Site -> Profile -> Text
+profileUrl site = substitute $ T.unpack (siteName site) `compileMustache` siteTemplate site
+
 hCard :: Entity User -> Widget
 hCard (Entity userId user) = do
     mcurrentRoute <- getCurrentRoute
-    userProfiles <- handlerToWidget $ do
-        profiles <- runDB $ map entityVal <$> selectList [ProfileUserId ==. userId] []
-        sites <- Site.fetch $ profileSiteId <$> profiles
-        return . arrangeProfiles profiles $ sites
+    userProfiles <- handlerToWidget . runDB . E.select . E.from $ \(profile `E.InnerJoin` site) -> do
+        E.on $ profile ^. ProfileSiteId E.==. site ^. SiteId
+        E.where_ $ profile ^. ProfileUserId E.==. E.val userId
+        E.orderBy [E.asc $ site ^. SiteName]
+        return (site, profile)
     pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
     $(widgetFile "mf2/h-card")
diff --git a/templates/mf2/h-card.hamlet b/templates/mf2/h-card.hamlet
index 316d20b..c0ffd1d 100644
--- a/templates/mf2/h-card.hamlet
+++ b/templates/mf2/h-card.hamlet
@@ -18,9 +18,9 @@
         <a .u-email itemprop="email" rel="me" href="mailto:#{userEmail user}">
           <i .fa.fa-envelope>
           #{userEmail user}
-      $forall ((site, template), profile) <- userProfiles
+      $forall (Entity _ site, Entity _ profile) <- userProfiles
         <li>
-          <a .u-url itemprop="sameAs" rel="me" href="#{substitute template profile}">
+          <a .u-url itemprop="sameAs" rel="me" href="#{profileUrl site profile}">
             <i .#{siteIcon site}>
             $maybe name <- profileDisplayName profile
               #{name}