diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index 3b29deb..cb43451 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -3,6 +3,7 @@ module MyWebLog.DotLiquidBespoke open System open System.IO +open System.Web open DotLiquid open MyWebLog.ViewModels @@ -22,11 +23,13 @@ let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> st | Some link -> linkFunc (webLog ctx) (Permalink link) | None -> $"alert('unknown item type {item.GetType().Name}')" + /// A filter to generate an absolute link type AbsoluteLinkFilter () = static member AbsoluteLink (ctx : Context, item : obj) = permalink ctx item WebLog.absoluteUrl + /// A filter to generate a link with posts categorized under the given category type CategoryLinkFilter () = static member CategoryLink (ctx : Context, catObj : obj) = @@ -50,6 +53,7 @@ type EditPageLinkFilter () = |> function | Some pageId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/page/{pageId}/edit") | None -> $"alert('unknown page object type {pageObj.GetType().Name}')" + /// A filter to generate a link that will edit a post type EditPostLinkFilter () = @@ -62,6 +66,7 @@ type EditPostLinkFilter () = |> function | Some postId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/post/{postId}/edit") | None -> $"alert('unknown post object type {postObj.GetType().Name}')" + /// A filter to generate nav links, highlighting the active link (exact match) type NavLinkFilter () = @@ -78,11 +83,62 @@ type NavLinkFilter () = } |> Seq.fold (+) "" + +/// Create various items in the page header based on the state of the page being generated +type PageHeadTag () = + inherit Tag () + + override this.Render (context : Context, result : TextWriter) = + let webLog = webLog context + // spacer + let s = " " + let getBool name = + context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean |> Option.defaultValue false + + result.WriteLine $"""""" + + // Theme assets + let has fileName = File.Exists (Path.Combine ("wwwroot", "themes", webLog.themePath, fileName)) + if has "style.css" then + result.WriteLine $"""{s}""" + if has "favicon.ico" then + result.WriteLine $"""{s}""" + + // RSS feeds and canonical URLs + let feedLink title url = + let escTitle = HttpUtility.HtmlAttributeEncode title + let relUrl = WebLog.relativeUrl webLog (Permalink url) + $"""{s}""" + + if webLog.rss.feedEnabled && getBool "is_home" then + result.WriteLine (feedLink webLog.name webLog.rss.feedName) + result.WriteLine $"""{s}""" + + if webLog.rss.categoryEnabled && getBool "is_category_home" then + let slug = context.Environments[0].["slug"] :?> string + result.WriteLine (feedLink webLog.name $"category/{slug}/{webLog.rss.feedName}") + + if webLog.rss.tagEnabled && getBool "is_tag_home" then + let slug = context.Environments[0].["slug"] :?> string + result.WriteLine (feedLink webLog.name $"tag/{slug}/{webLog.rss.feedName}") + + if getBool "is_post" then + let post = context.Environments[0].["model"] :?> PostDisplay + let url = WebLog.absoluteUrl webLog (Permalink post.posts[0].permalink) + result.WriteLine $"""{s}""" + + if getBool "is_page" then + let page = context.Environments[0].["page"] :?> DisplayPage + let url = WebLog.absoluteUrl webLog (Permalink page.permalink) + result.WriteLine $"""{s}""" + + /// A filter to generate a relative link type RelativeLinkFilter () = static member RelativeLink (ctx : Context, item : obj) = permalink ctx item WebLog.relativeUrl + /// A filter to generate a link with posts tagged with the given tag type TagLinkFilter () = static member TagLink (ctx : Context, tag : string) = @@ -92,6 +148,7 @@ type TagLinkFilter () = | Some tagMap -> tagMap.urlValue | None -> tag.Replace (" ", "+") |> function tagUrl -> WebLog.relativeUrl (webLog ctx) (Permalink $"tag/{tagUrl}/") + /// Create links for a user to log on or off, and a dashboard link if they are logged off type UserLinksTag () = diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index 68ab950..cfc5b35 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -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)) diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index b9a428d..98d6984 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -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 diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index ca502e1..10e99ee 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -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 $""" (Page {pageNbr})""" - 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 $""" (Page {pageNbr})""" + 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 $""" (Page {pageNbr})""" - hash.Add ("page_title", $"Posts Tagged “{tag}”{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 $""" (Page {pageNbr})""" + hash.Add ("page_title", $"Posts Tagged “{tag}”{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 / diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 42f3be8..589c4c4 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -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 diff --git a/src/MyWebLog/MyWebLog.fsproj b/src/MyWebLog/MyWebLog.fsproj index ab6d573..09c7773 100644 --- a/src/MyWebLog/MyWebLog.fsproj +++ b/src/MyWebLog/MyWebLog.fsproj @@ -12,8 +12,8 @@ - + diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 189931e..645c9b0 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -215,6 +215,7 @@ let main args = ] |> List.iter Template.RegisterFilter + Template.RegisterTag "page_head" Template.RegisterTag "user_links" [ // Domain types diff --git a/src/MyWebLog/themes/bit-badger/layout.liquid b/src/MyWebLog/themes/bit-badger/layout.liquid index d75e4fc..5cf46a6 100644 --- a/src/MyWebLog/themes/bit-badger/layout.liquid +++ b/src/MyWebLog/themes/bit-badger/layout.liquid @@ -3,11 +3,9 @@ - {{ page_title }} » Bit Badger Solutions - - + {% page_head -%}
diff --git a/src/MyWebLog/themes/daniel-j-summers/layout.liquid b/src/MyWebLog/themes/daniel-j-summers/layout.liquid index f3b5cdc..0cb08c2 100644 --- a/src/MyWebLog/themes/daniel-j-summers/layout.liquid +++ b/src/MyWebLog/themes/daniel-j-summers/layout.liquid @@ -4,25 +4,19 @@ - - {%- if is_home %} + {%- if is_home -%} {{ web_log.name }}{% if web_log.subtitle %} | {{ web_log.subtitle.value }}{% endif %} - {%- else %} + {%- else -%} {{ page_title | strip_html }}{% if page_title and page_title != "" %} » {% endif %}{{ web_log.name }} - {%- endif %} + {%- endif -%} - - {%- if is_home %} - - - {%- endif %} + {% page_head -%}