Use an Esqueleto query to efficiently fetch and render the user profiles on h-cards, rather than several queries and lots of fussing around

This commit is contained in:
Danielle McLean 2017-10-11 13:16:47 +11:00
parent f3b12ded69
commit 0055a4160b
Signed by: 00dani
GPG key ID: 5A5D2D1AFF12EEC5
3 changed files with 15 additions and 37 deletions

View file

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