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:
parent
f3b12ded69
commit
0055a4160b
3 changed files with 15 additions and 37 deletions
21
src/Site.hs
21
src/Site.hs
|
@ -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] []
|
|
|
@ -5,31 +5,30 @@ module Widget.Card ( hCard ) where
|
||||||
|
|
||||||
import Import
|
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
|
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 :: PgpKey -> Text
|
||||||
prettyPgp = T.unwords . T.chunksOf 4 . pgpKeyFingerprint
|
prettyPgp = T.unwords . T.chunksOf 4 . pgpKeyFingerprint
|
||||||
|
|
||||||
routeFromPgp :: PgpKey -> Route App
|
routeFromPgp :: PgpKey -> Route App
|
||||||
routeFromPgp PgpKey { pgpKeyFingerprint = f } = staticR ["pgp", T.takeEnd 8 f ++ ".asc"]
|
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 User -> Widget
|
||||||
hCard (Entity userId user) = do
|
hCard (Entity userId user) = do
|
||||||
mcurrentRoute <- getCurrentRoute
|
mcurrentRoute <- getCurrentRoute
|
||||||
userProfiles <- handlerToWidget $ do
|
userProfiles <- handlerToWidget . runDB . E.select . E.from $ \(profile `E.InnerJoin` site) -> do
|
||||||
profiles <- runDB $ map entityVal <$> selectList [ProfileUserId ==. userId] []
|
E.on $ profile ^. ProfileSiteId E.==. site ^. SiteId
|
||||||
sites <- Site.fetch $ profileSiteId <$> profiles
|
E.where_ $ profile ^. ProfileUserId E.==. E.val userId
|
||||||
return . arrangeProfiles profiles $ sites
|
E.orderBy [E.asc $ site ^. SiteName]
|
||||||
|
return (site, profile)
|
||||||
pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
|
pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
|
||||||
$(widgetFile "mf2/h-card")
|
$(widgetFile "mf2/h-card")
|
||||||
|
|
|
@ -18,9 +18,9 @@
|
||||||
<a .u-email itemprop="email" rel="me" href="mailto:#{userEmail user}">
|
<a .u-email itemprop="email" rel="me" href="mailto:#{userEmail user}">
|
||||||
<i .fa.fa-envelope>
|
<i .fa.fa-envelope>
|
||||||
#{userEmail user}
|
#{userEmail user}
|
||||||
$forall ((site, template), profile) <- userProfiles
|
$forall (Entity _ site, Entity _ profile) <- userProfiles
|
||||||
<li>
|
<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}>
|
<i .#{siteIcon site}>
|
||||||
$maybe name <- profileDisplayName profile
|
$maybe name <- profileDisplayName profile
|
||||||
#{name}
|
#{name}
|
||||||
|
|
Loading…
Reference in a new issue