00dani/lebd
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Support for Open Graph on the homepage - again it's gross but consuming sites understand it

Browse source
This commit is contained in:
Danielle McLean 2017-10-14 16:51:01 +11:00
parent 44288b419c
commit 47fe00a8b8
Signed by: 00dani
GPG key ID: 5A5D2D1AFF12EEC5
5 changed files with 23 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/Foundation.hs
View file

@ -118,7 +118,9 @@ instance Yesod App where
-- you to use normal widget features in default-layout.
pc <- widgetToPageContent $(widgetFile "default-layout")
let hasPageTitle = not . B.null . pageTitle $ pc
let globalTitle = toHtml . siteTitle . appSettings $ master
hasPageTitle = not . B.null $ pageTitle pc
fullTitle = if hasPageTitle then mconcat [pageTitle pc, " ~ ", globalTitle] else globalTitle
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- The page to be redirected to when authentication is required.

9
src/Handler/Home.hs
View file

@ -15,14 +15,9 @@ import Widget.Feed ( hFeed )
getHomeR :: Handler Html
getHomeR = do
settings <- asks appSettings
userE@(Entity userId user) <- runDB . getBy404 . UniqueUser . siteUsername $ settings
user <- runDB . getBy404 . UniqueUser . siteUsername $ settings
let title = siteTitle settings
entries <- runDB $ selectList [EntryAuthorId ==. userId] [Desc EntryPublished]
entries <- runDB $ selectList [EntryAuthorId ==. entityKey user] [Desc EntryPublished]
defaultLayout $ do
atomLink FeedR title
toWidgetHead
[hamlet|
<meta name="author" content=#{userFullName user}>
<link rel="author" href=@{HomeR}>
|]
$(widgetFile "home")

14
src/Widget/Card.hs
View file

@ -25,6 +25,7 @@ profileUrl site = substitute $ T.unpack (siteName site) `compileMustache` siteTe
hCard :: Entity User -> Widget
hCard (Entity userId user) = do
let (firstName:lastName) = T.words $ userFullName user
mcurrentRoute <- getCurrentRoute
userProfiles <- handlerToWidget . runDB . E.select . E.from $ \(profile `E.InnerJoin` site) -> do
E.on $ profile ^. ProfileSiteId E.==. site ^. SiteId
@ -32,8 +33,21 @@ hCard (Entity userId user) = do
E.orderBy [E.asc $ site ^. SiteName]
return (site, profile)
pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
let maybeFb = find (\(Entity _ site, _) -> "Facebook" == siteName site) userProfiles
toWidgetHead [hamlet|
<meta name="author" content=#{userFullName user}>
<link rel="author" href=@{HomeR}>
<meta property="og:type" content="profile">
<meta property="og:description" content=#{userNote user}>
<meta property="og:image" content=@{staticR ["img", userAvatar user]}>
<meta property="profile:first_name" content=#{firstName}>
<meta property="profile:last_name" content=#{T.unwords lastName}>
<meta property="profile:username" content=#{userUsername user}>
$maybe (_, Entity _ fb) <- maybeFb
<meta property="fb:profile_id" content=#{profileUsername fb}>
$forall key <- pgpKeys
<link rel="pgpkey" type="application/pgp-keys" href=@{routeFromPgp key}>
|]
$(widgetFile "mf2/h-card")