bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

Add category/tag feeds

Browse Source 
- Add page_head tag to add feed links, canonical URLs, generator, and theme files
- Use page_head in all current themes
This commit is contained in:
Daniel J. Summers
2022-05-30 22:01:13 -04:00
parent d1d384812e
commit b971a343a4
12 changed files with 210 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
src/MyWebLog/Handlers/Feed.fs
View File

@@ -33,28 +33,16 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
debug (fun () -> "Found standard feed")
Some (StandardFeed feedPath, postCount)
| false ->
// Category feed
match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = feedPath.Replace (name, "")) with
| Some cat ->
debug (fun () -> "Found category feed")
Some (CategoryFeed (CategoryId cat.id, feedPath), postCount)
// Category and tag feeds are handled by defined routes; check for custom feed
match webLog.rss.customFeeds
|> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.path)) with
| Some feed ->
debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath),
feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount)
| None ->
// Tag feed
match feedPath.StartsWith "/tag/" with
| true ->
debug (fun () -> "Found tag feed")
Some (TagFeed (feedPath.Replace("/tag/", "").Replace(name, ""), feedPath), postCount)
| false ->
// Custom feed
match webLog.rss.customFeeds
|> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.path)) with
| Some feed ->
debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath),
feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount)
| None ->
debug (fun () -> $"No matching feed found")
None
debug (fun () -> $"No matching feed found")
None
/// Determine the function to retrieve posts for the given feed
let private getFeedPosts (webLog : WebLog) feedType =
@@ -252,12 +240,41 @@ let private selfAndLink webLog feedType =
|> function
| path -> Permalink path, Permalink (path.Replace ($"/{webLog.rss.feedName}", ""))
/// Set the title and description of the feed based on its source
let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) =
let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def))
match feedType with
| StandardFeed _ ->
feed.Title <- cleanText None webLog.name
feed.Description <- cleanText webLog.subtitle webLog.name
| CategoryFeed (CategoryId catId, _) ->
let cat = cats |> Array.find (fun it -> it.id = catId)
feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.name}" Category"""
feed.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """
| TagFeed (tag, _) ->
feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
| Custom (custom, _) ->
match custom.podcast with
| Some podcast ->
feed.Title <- cleanText None podcast.title
feed.Description <- cleanText podcast.subtitle podcast.title
| None ->
match custom.source with
| Category (CategoryId catId) ->
let cat = cats |> Array.find (fun it -> it.id = catId)
feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.name}" Category"""
feed.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """
| Tag tag ->
feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag"""
feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
/// Create a feed with a known non-zero-length list of posts
let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backgroundTask {
let webLog = ctx.WebLog
let conn = ctx.Conn
let! authors = Post.getAuthors webLog posts conn
let! tagMaps = Post.getTagMappings webLog posts conn
let! authors = getAuthors webLog posts conn
let! tagMaps = getTagMappings webLog posts conn
let cats = CategoryCache.get ctx
let podcast = match feedType with Custom (feed, _) when Option.isSome feed.podcast -> Some feed | _ -> None
let self, link = selfAndLink webLog feedType
@@ -274,14 +291,13 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
let feed = SyndicationFeed ()
addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed
feed.Title <- TextSyndicationContent webLog.name
feed.Description <- TextSyndicationContent <| defaultArg webLog.subtitle webLog.name
feed.LastUpdatedTime <- DateTimeOffset <| (List.head posts).updatedOn
feed.Generator <- generator ctx
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en"
feed.Id <- webLog.urlBase
feed.Id <- WebLog.absoluteUrl webLog link
webLog.rss.copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L))

26
src/MyWebLog/Handlers/Helpers.fs
View File

@@ -160,6 +160,32 @@ let templatesForTheme (ctx : HttpContext) (typ : string) =
}
|> Array.ofSeq
/// Get all authors for a list of posts as metadata items
let getAuthors (webLog : WebLog) (posts : Post list) conn =
posts
|> List.map (fun p -> p.authorId)
|> List.distinct
|> Data.WebLogUser.findNames webLog.id conn
/// Get all tag mappings for a list of posts as metadata items
let getTagMappings (webLog : WebLog) (posts : Post list) =
posts
|> List.map (fun p -> p.tags)
|> List.concat
|> List.distinct
|> fun tags -> Data.TagMap.findMappingForTags tags webLog.id
/// Get all category IDs for the given slug (includes owned subcategories)
let getCategoryIds slug ctx =
let allCats = CategoryCache.get ctx
let cat = allCats |> Array.find (fun cat -> cat.slug = slug)
// Category pages include posts in subcategories
allCats
|> Seq.ofArray
|> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames)
|> Seq.map (fun c -> CategoryId c.id)
|> List.ofSeq
open Microsoft.Extensions.Logging
/// Log level for debugging

128
src/MyWebLog/Handlers/Post.fs
View File

@@ -2,10 +2,21 @@
module MyWebLog.Handlers.Post
open System
open MyWebLog
/// Parse a slug and page number from an "everything else" URL
let private parseSlugAndPage (slugAndPage : string seq) =
let slugs = (slugAndPage |> Seq.skip 1 |> Seq.head).Split "/" |> Array.filter (fun it -> it <> "")
let private parseSlugAndPage webLog (slugAndPage : string seq) =
let fullPath = slugAndPage |> Seq.head
let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head
let slugs, isFeed =
let feedName = $"/{webLog.rss.feedName}"
let notBlank = Array.filter (fun it -> it <> "")
if ( (webLog.rss.categoryEnabled && fullPath.StartsWith "/category/")
|| (webLog.rss.tagEnabled && fullPath.StartsWith "/tag/" ))
&& slugPath.EndsWith feedName then
notBlank (slugPath.Replace(feedName, "").Split "/"), true
else
notBlank (slugPath.Split "/"), false
let pageIdx = Array.IndexOf (slugs, "page")
let pageNbr =
match pageIdx with
@@ -13,7 +24,7 @@ let private parseSlugAndPage (slugAndPage : string seq) =
| idx when idx + 2 = slugs.Length -> Some (int slugs[pageIdx + 1])
| _ -> None
let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs
pageNbr, String.Join ("/", slugParts)
pageNbr, String.Join ("/", slugParts), isFeed
/// The type of post list being prepared
type ListType =
@@ -23,23 +34,6 @@ type ListType =
| SinglePost
| TagList
open MyWebLog
/// Get all authors for a list of posts as metadata items
let getAuthors (webLog : WebLog) (posts : Post list) conn =
posts
|> List.map (fun p -> p.authorId)
|> List.distinct
|> Data.WebLogUser.findNames webLog.id conn
/// Get all tag mappings for a list of posts as metadata items
let getTagMappings (webLog : WebLog) (posts : Post list) =
posts
|> List.map (fun p -> p.tags)
|> List.concat
|> List.distinct
|> fun tags -> Data.TagMap.findMappingForTags tags webLog.id
open System.Threading.Tasks
open DotLiquid
open MyWebLog.ViewModels
@@ -91,7 +85,12 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx con
olderLink = olderLink
olderName = olderPost |> Option.map (fun p -> p.title)
}
return Hash.FromAnonymousObject {| model = model; categories = CategoryCache.get ctx; tag_mappings = tagMappings |}
return Hash.FromAnonymousObject {|
model = model
categories = CategoryCache.get ctx
tag_mappings = tagMappings
is_post = match listType with SinglePost -> true | _ -> false
|}
}
open Giraffe
@@ -117,27 +116,30 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let conn = ctx.Conn
match parseSlugAndPage slugAndPage with
| Some pageNbr, slug ->
match parseSlugAndPage webLog slugAndPage with
| Some pageNbr, slug, isFeed ->
let allCats = CategoryCache.get ctx
let cat = allCats |> Array.find (fun cat -> cat.slug = slug)
// Category pages include posts in subcategories
let catIds =
allCats
|> Seq.ofArray
|> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames)
|> Seq.map (fun c -> CategoryId c.id)
|> List.ofSeq
match! Data.Post.findPageOfCategorizedPosts webLog.id catIds pageNbr webLog.postsPerPage conn with
| posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts CategoryList cat.slug pageNbr webLog.postsPerPage ctx conn
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}")
hash.Add ("subtitle", cat.description.Value)
hash.Add ("is_category", true)
return! themedView "index" next ctx hash
| _ -> return! Error.notFound next ctx
| None, _ -> return! Error.notFound next ctx
if isFeed then
return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.id), $"category/{slug}/{webLog.rss.feedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx
else
let allCats = CategoryCache.get ctx
let cat = allCats |> Array.find (fun cat -> cat.slug = slug)
// Category pages include posts in subcategories
match! Data.Post.findPageOfCategorizedPosts webLog.id (getCategoryIds slug ctx) pageNbr webLog.postsPerPage
conn with
| posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts CategoryList cat.slug pageNbr webLog.postsPerPage ctx conn
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}")
hash.Add ("subtitle", defaultArg cat.description "")
hash.Add ("is_category", true)
hash.Add ("is_category_home", (pageNbr = 1))
hash.Add ("slug", slug)
return! themedView "index" next ctx hash
| _ -> return! Error.notFound next ctx
| None, _, _ -> return! Error.notFound next ctx
}
open System.Web
@@ -147,33 +149,39 @@ open System.Web
let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let conn = ctx.Conn
match parseSlugAndPage slugAndPage with
| Some pageNbr, rawTag ->
match parseSlugAndPage webLog slugAndPage with
| Some pageNbr, rawTag, isFeed ->
let urlTag = HttpUtility.UrlDecode rawTag
let! tag = backgroundTask {
match! Data.TagMap.findByUrlValue urlTag webLog.id conn with
| Some m -> return m.tag
| None -> return urlTag
}
match! Data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage conn with
| posts when List.length posts > 0 ->
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx conn
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}")
hash.Add ("is_tag", true)
return! themedView "index" next ctx hash
// Other systems use hyphens for spaces; redirect if this is an old tag link
| _ ->
let spacedTag = tag.Replace ("-", " ")
match! Data.Post.findPageOfTaggedPosts webLog.id spacedTag pageNbr 1 conn with
if isFeed then
return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.rss.feedName}"))
(defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx
else
match! Data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage conn with
| posts when List.length posts > 0 ->
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return!
redirectTo true
(WebLog.relativeUrl webLog (Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
next ctx
| _ -> return! Error.notFound next ctx
| None, _ -> return! Error.notFound next ctx
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx conn
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}")
hash.Add ("is_tag", true)
hash.Add ("is_tag_home", (pageNbr = 1))
hash.Add ("slug", rawTag)
return! themedView "index" next ctx hash
// Other systems use hyphens for spaces; redirect if this is an old tag link
| _ ->
let spacedTag = tag.Replace ("-", " ")
match! Data.Post.findPageOfTaggedPosts webLog.id spacedTag pageNbr 1 conn with
| posts when List.length posts > 0 ->
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return!
redirectTo true
(WebLog.relativeUrl webLog (Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
next ctx
| _ -> return! Error.notFound next ctx
| None, _, _ -> return! Error.notFound next ctx
}
// GET /

6
src/MyWebLog/Handlers/Routes.fs
View File

@@ -39,7 +39,11 @@ module CatchAll =
| Some page ->
debug (fun () -> $"Found page by permalink")
yield fun next ctx ->
Hash.FromAnonymousObject {| page = DisplayPage.fromPage webLog page; page_title = page.title |}
Hash.FromAnonymousObject {|
page = DisplayPage.fromPage webLog page
page_title = page.title
is_page = true
|}
|> themedView (defaultArg page.template "single-page") next ctx
| None -> ()
// RSS feed