Simplify site title handling, automatically suffix site title to all pages
This commit is contained in:
parent
4088735c69
commit
1b8a07a5f6
8 changed files with 17 additions and 13 deletions
|
@ -47,6 +47,7 @@ dependencies:
|
||||||
- case-insensitive
|
- case-insensitive
|
||||||
- wai
|
- wai
|
||||||
|
|
||||||
|
- blaze-markup >=0.8 && <0.9
|
||||||
- conduit-combinators >= 1.1 && < 1.2
|
- conduit-combinators >= 1.1 && < 1.2
|
||||||
- friendly-time >=0.4 && < 0.5
|
- friendly-time >=0.4 && < 0.5
|
||||||
- libravatar >=0.4 && <0.5
|
- libravatar >=0.4 && <0.5
|
||||||
|
|
|
@ -24,6 +24,7 @@ import Package
|
||||||
import Entry.Kind ( EntryKind, pluralise )
|
import Entry.Kind ( EntryKind, pluralise )
|
||||||
|
|
||||||
import Data.Aeson ( encode, object )
|
import Data.Aeson ( encode, object )
|
||||||
|
import qualified Text.Blaze.Internal as B
|
||||||
import qualified Data.Text.Lazy.Encoding as E
|
import qualified Data.Text.Lazy.Encoding as E
|
||||||
|
|
||||||
-- | The foundation datatype for your application. This can be a good place to
|
-- | The foundation datatype for your application. This can be a good place to
|
||||||
|
@ -113,6 +114,7 @@ instance Yesod App where
|
||||||
-- you to use normal widget features in default-layout.
|
-- you to use normal widget features in default-layout.
|
||||||
|
|
||||||
pc <- widgetToPageContent $(widgetFile "default-layout")
|
pc <- widgetToPageContent $(widgetFile "default-layout")
|
||||||
|
let hasPageTitle = not . B.null . pageTitle $ pc
|
||||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||||
|
|
||||||
-- The page to be redirected to when authentication is required.
|
-- The page to be redirected to when authentication is required.
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
module Handler.Entries where
|
module Handler.Entries where
|
||||||
|
|
||||||
|
@ -6,6 +7,7 @@ import Import
|
||||||
|
|
||||||
import Web.Slug ( Slug )
|
import Web.Slug ( Slug )
|
||||||
import Yesod.AtomFeed ( atomLink )
|
import Yesod.AtomFeed ( atomLink )
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import qualified Entry.Kind as K
|
import qualified Entry.Kind as K
|
||||||
import Widget.Entry ( entryR, hEntry )
|
import Widget.Entry ( entryR, hEntry )
|
||||||
|
@ -14,9 +16,10 @@ import Widget.Feed ( hFeed )
|
||||||
getEntriesR :: K.EntryKind -> Handler Html
|
getEntriesR :: K.EntryKind -> Handler Html
|
||||||
getEntriesR kind = do
|
getEntriesR kind = do
|
||||||
entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
|
entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
|
||||||
|
title <- asks $ siteTitle . appSettings
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle . toHtml . K.pluralise $ kind
|
setTitle . toHtml . K.pluralise $ kind
|
||||||
FeedKindR kind `atomLink` K.pluralise kind
|
atomLink (FeedKindR kind) $ T.concat [K.pluralise kind, " ~ ", title]
|
||||||
$(widgetFile "entries")
|
$(widgetFile "entries")
|
||||||
|
|
||||||
checkMatching :: K.EntryKind -> Slug -> Entry -> Bool
|
checkMatching :: K.EntryKind -> Slug -> Entry -> Bool
|
||||||
|
|
|
@ -32,7 +32,7 @@ toFeed entries@(latestEntry:_) = (toFeed [])
|
||||||
, feedUpdated = entryUpdated $ entityVal latestEntry
|
, feedUpdated = entryUpdated $ entityVal latestEntry
|
||||||
}
|
}
|
||||||
toFeed [] = Feed
|
toFeed [] = Feed
|
||||||
{ feedTitle = fromMaybe "" . appTitle $ compileTimeAppSettings
|
{ feedTitle = siteTitle compileTimeAppSettings
|
||||||
, feedLinkSelf = FeedR
|
, feedLinkSelf = FeedR
|
||||||
, feedLinkHome = HomeR
|
, feedLinkHome = HomeR
|
||||||
, feedAuthor = ""
|
, feedAuthor = ""
|
||||||
|
|
|
@ -15,14 +15,10 @@ import Widget.Feed ( hFeed )
|
||||||
getHomeR :: Handler Html
|
getHomeR :: Handler Html
|
||||||
getHomeR = do
|
getHomeR = do
|
||||||
userE@(Entity userId user) <- runDB . getBy404 $ UniqueUser "dani"
|
userE@(Entity userId user) <- runDB . getBy404 $ UniqueUser "dani"
|
||||||
maybeTitle <- asks $ appTitle . appSettings
|
title <- asks $ siteTitle . appSettings
|
||||||
entries <- runDB $ selectList [EntryAuthorId ==. userId] [Desc EntryPublished]
|
entries <- runDB $ selectList [EntryAuthorId ==. userId] [Desc EntryPublished]
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
case maybeTitle of
|
atomLink FeedR title
|
||||||
Just title -> do
|
|
||||||
setTitle $ toHtml title
|
|
||||||
atomLink FeedR title
|
|
||||||
Nothing -> return ()
|
|
||||||
toWidgetHead
|
toWidgetHead
|
||||||
[hamlet|
|
[hamlet|
|
||||||
<meta name="author" content=#{userFullName user}>
|
<meta name="author" content=#{userFullName user}>
|
||||||
|
|
|
@ -62,7 +62,7 @@ data AppSettings = AppSettings
|
||||||
-- Example app-specific configuration values.
|
-- Example app-specific configuration values.
|
||||||
, appAnalytics :: Maybe Text
|
, appAnalytics :: Maybe Text
|
||||||
-- ^ Google Analytics code
|
-- ^ Google Analytics code
|
||||||
, appTitle :: Maybe Text
|
, siteTitle :: Text
|
||||||
-- ^ Site-wide title.
|
-- ^ Site-wide title.
|
||||||
|
|
||||||
, appAuthDummyLogin :: Bool
|
, appAuthDummyLogin :: Bool
|
||||||
|
@ -93,7 +93,7 @@ instance FromJSON AppSettings where
|
||||||
appSkipCombining <- o .:? "skip-combining" .!= defaultDev
|
appSkipCombining <- o .:? "skip-combining" .!= defaultDev
|
||||||
|
|
||||||
appAnalytics <- o .:? "analytics"
|
appAnalytics <- o .:? "analytics"
|
||||||
appTitle <- o .:? "title"
|
siteTitle <- o .: "title"
|
||||||
|
|
||||||
-- This code enables MySQL's strict mode, without which MySQL will truncate data.
|
-- This code enables MySQL's strict mode, without which MySQL will truncate data.
|
||||||
-- See https://github.com/yesodweb/persistent/wiki/Database-Configuration#strict-mode for details
|
-- See https://github.com/yesodweb/persistent/wiki/Database-Configuration#strict-mode for details
|
||||||
|
|
|
@ -5,7 +5,10 @@ $doctype 5
|
||||||
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
|
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
|
||||||
<meta name="generator" content="#{packageName package} #{packageVersion package}">
|
<meta name="generator" content="#{packageName package} #{packageVersion package}">
|
||||||
|
|
||||||
<title>#{pageTitle pc}
|
<title>
|
||||||
|
$if hasPageTitle
|
||||||
|
#{pageTitle pc} ~ #
|
||||||
|
#{siteTitle $ appSettings master}
|
||||||
$maybe route <- mcurrentRoute
|
$maybe route <- mcurrentRoute
|
||||||
<link rel="canonical" href=@{route}>
|
<link rel="canonical" href=@{route}>
|
||||||
<link rel="sitemap" href=@{SitemapR}>
|
<link rel="sitemap" href=@{SitemapR}>
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
<header>
|
<header>
|
||||||
<nav .navbar .navbar-expand-lg .navbar-dark.bg-dark>
|
<nav .navbar .navbar-expand-lg .navbar-dark.bg-dark>
|
||||||
$maybe title <- appTitle $ appSettings master
|
<a .navbar-brand rel="home" href=@{HomeR}>#{siteTitle $ appSettings master}
|
||||||
<a .navbar-brand rel="home" href=@{HomeR}>#{title}
|
|
||||||
<button type="button" .navbar-toggler data-toggle="collapse" data-target="#navbar" aria-expanded="false" aria-controls="navbar" aria-label="Toggle navigation">
|
<button type="button" .navbar-toggler data-toggle="collapse" data-target="#navbar" aria-expanded="false" aria-controls="navbar" aria-label="Toggle navigation">
|
||||||
<span .navbar-toggler-icon>
|
<span .navbar-toggler-icon>
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue