Version 2.1 (#41)
- Add full chapter support (#6) - Add built-in redirect functionality (#39) - Support building Docker containers for release (#38) - Support canonical domain configuration (#37) - Add unit tests for domain/models and integration tests for all three data stores - Convert SQLite storage to use JSON documents, similar to PostgreSQL - Convert admin templates to Giraffe View Engine (from Liquid) - Add .NET 8 support
This commit was merged in pull request #41.
This commit is contained in:
GitHub
+152
-151
@@ -2,7 +2,6 @@
|
||||
module MyWebLog.Handlers.Feed
|
||||
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
open System.IO
|
||||
open System.Net
|
||||
open System.ServiceModel.Syndication
|
||||
@@ -23,7 +22,7 @@ type FeedType =
|
||||
| Custom of CustomFeed * string
|
||||
|
||||
/// Derive the type of RSS feed requested
|
||||
let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
|
||||
let deriveFeedType (ctx: HttpContext) feedPath : (FeedType * int) option =
|
||||
let webLog = ctx.WebLog
|
||||
let debug = debug "Feed" ctx
|
||||
let name = $"/{webLog.Rss.FeedName}"
|
||||
@@ -33,23 +32,22 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
|
||||
match webLog.Rss.IsFeedEnabled && feedPath = name with
|
||||
| true ->
|
||||
debug (fun () -> "Found standard feed")
|
||||
Some (StandardFeed feedPath, postCount)
|
||||
Some(StandardFeed feedPath, postCount)
|
||||
| false ->
|
||||
// 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
|
||||
|> List.tryFind (fun it -> feedPath.EndsWith(string 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)
|
||||
Some(Custom(feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount)
|
||||
| None ->
|
||||
debug (fun () -> $"No matching feed found")
|
||||
debug (fun () -> "No matching feed found")
|
||||
None
|
||||
|
||||
/// Determine the function to retrieve posts for the given feed
|
||||
let private getFeedPosts ctx feedType =
|
||||
let childIds catId =
|
||||
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = CategoryId.toString catId)
|
||||
let childIds (catId: CategoryId) =
|
||||
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = string catId)
|
||||
getCategoryIds cat.Slug ctx
|
||||
let data = ctx.Data
|
||||
match feedType with
|
||||
@@ -62,7 +60,7 @@ let private getFeedPosts ctx feedType =
|
||||
| Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
|
||||
|
||||
/// Strip HTML from a string
|
||||
let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "")
|
||||
let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace(text, "<(.|\n)*?>", "")
|
||||
|
||||
/// XML namespaces for building RSS feeds
|
||||
[<RequireQualifiedAccess>]
|
||||
@@ -87,108 +85,113 @@ module private Namespace =
|
||||
let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
|
||||
|
||||
/// Create a feed item from the given post
|
||||
let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
|
||||
(post : Post) =
|
||||
let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list)
|
||||
(post: Post) =
|
||||
let plainText =
|
||||
let endingP = post.Text.IndexOf "</p>"
|
||||
stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
|
||||
let item = SyndicationItem (
|
||||
Id = WebLog.absoluteUrl webLog post.Permalink,
|
||||
let item = SyndicationItem(
|
||||
Id = webLog.AbsoluteUrl post.Permalink,
|
||||
Title = TextSyndicationContent.CreateHtmlContent post.Title,
|
||||
PublishDate = post.PublishedOn.Value.ToDateTimeOffset (),
|
||||
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
|
||||
PublishDate = post.PublishedOn.Value.ToDateTimeOffset(),
|
||||
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
|
||||
Content = TextSyndicationContent.CreatePlaintextContent plainText)
|
||||
item.AddPermalink (Uri item.Id)
|
||||
|
||||
let xmlDoc = XmlDocument ()
|
||||
let xmlDoc = XmlDocument()
|
||||
|
||||
let encoded =
|
||||
let txt =
|
||||
post.Text
|
||||
.Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
|
||||
.Replace ("href=\"/", $"href=\"{webLog.UrlBase}/")
|
||||
let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content)
|
||||
let _ = it.AppendChild (xmlDoc.CreateCDataSection txt)
|
||||
.Replace("href=\"/", $"href=\"{webLog.UrlBase}/")
|
||||
let it = xmlDoc.CreateElement("content", "encoded", Namespace.content)
|
||||
let _ = it.AppendChild(xmlDoc.CreateCDataSection txt)
|
||||
it
|
||||
item.ElementExtensions.Add encoded
|
||||
|
||||
item.Authors.Add (SyndicationPerson (
|
||||
Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
|
||||
item.Authors.Add(SyndicationPerson(Name = (authors |> List.find (fun a -> a.Name = string post.AuthorId)).Value))
|
||||
[ post.CategoryIds
|
||||
|> List.map (fun catId ->
|
||||
let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId)
|
||||
SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
|
||||
let cat = cats |> Array.find (fun c -> c.Id = string catId)
|
||||
SyndicationCategory(cat.Name, webLog.AbsoluteUrl(Permalink $"category/{cat.Slug}/"), cat.Name))
|
||||
post.Tags
|
||||
|> List.map (fun tag ->
|
||||
let urlTag =
|
||||
match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
|
||||
| Some tm -> tm.UrlValue
|
||||
| None -> tag.Replace (" ", "+")
|
||||
SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
|
||||
SyndicationCategory(tag, webLog.AbsoluteUrl(Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
|
||||
]
|
||||
|> List.concat
|
||||
|> List.iter item.Categories.Add
|
||||
item
|
||||
|
||||
/// Convert non-absolute URLs to an absolute URL for this web log
|
||||
let toAbsolute webLog (link : string) =
|
||||
if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
|
||||
let toAbsolute (webLog: WebLog) (link: string) =
|
||||
if link.StartsWith "http" then link else webLog.AbsoluteUrl(Permalink link)
|
||||
|
||||
/// Add episode information to a podcast feed item
|
||||
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
|
||||
let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Episode) (post: Post)
|
||||
(item: SyndicationItem) =
|
||||
let epMediaUrl =
|
||||
match episode.Media with
|
||||
| link when link.StartsWith "http" -> link
|
||||
| link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
|
||||
| link -> WebLog.absoluteUrl webLog (Permalink link)
|
||||
| link -> webLog.AbsoluteUrl(Permalink link)
|
||||
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
|
||||
let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog
|
||||
let epExplicit = defaultArg episode.Explicit podcast.Explicit |> ExplicitRating.toString
|
||||
let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog
|
||||
let epExplicit = string (defaultArg episode.Explicit podcast.Explicit)
|
||||
|
||||
let xmlDoc = XmlDocument ()
|
||||
let xmlDoc = XmlDocument()
|
||||
let enclosure =
|
||||
let it = xmlDoc.CreateElement "enclosure"
|
||||
it.SetAttribute ("url", epMediaUrl)
|
||||
it.SetAttribute ("length", string episode.Length)
|
||||
epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
|
||||
it.SetAttribute("url", epMediaUrl)
|
||||
it.SetAttribute("length", string episode.Length)
|
||||
epMediaType |> Option.iter (fun typ -> it.SetAttribute("type", typ))
|
||||
it
|
||||
let image =
|
||||
let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes)
|
||||
it.SetAttribute ("href", epImageUrl)
|
||||
let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
|
||||
it.SetAttribute("href", epImageUrl)
|
||||
it
|
||||
|
||||
item.ElementExtensions.Add enclosure
|
||||
item.ElementExtensions.Add image
|
||||
item.ElementExtensions.Add ("creator", Namespace.dc, podcast.DisplayedAuthor)
|
||||
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
|
||||
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
|
||||
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
|
||||
Episode.formatDuration episode
|
||||
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
|
||||
item.ElementExtensions.Add("creator", Namespace.dc, podcast.DisplayedAuthor)
|
||||
item.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
|
||||
item.ElementExtensions.Add("explicit", Namespace.iTunes, epExplicit)
|
||||
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add("subtitle", Namespace.iTunes, it))
|
||||
episode.FormatDuration() |> Option.iter (fun it -> item.ElementExtensions.Add("duration", Namespace.iTunes, it))
|
||||
|
||||
match episode.ChapterFile with
|
||||
| Some chapters ->
|
||||
let url = toAbsolute webLog chapters
|
||||
let typ =
|
||||
match episode.ChapterType with
|
||||
| Some mime -> Some mime
|
||||
| None when chapters.EndsWith ".json" -> Some "application/json+chapters"
|
||||
| None -> None
|
||||
let elt = xmlDoc.CreateElement ("podcast", "chapters", Namespace.podcast)
|
||||
elt.SetAttribute ("url", url)
|
||||
typ |> Option.iter (fun it -> elt.SetAttribute ("type", it))
|
||||
let chapterUrl, chapterMimeType =
|
||||
match episode.Chapters, episode.ChapterFile with
|
||||
| Some _, _ ->
|
||||
Some $"{webLog.AbsoluteUrl post.Permalink}?chapters", Some JSON_CHAPTERS
|
||||
| None, Some chapters ->
|
||||
let typ =
|
||||
match episode.ChapterType with
|
||||
| Some mime -> Some mime
|
||||
| None when chapters.EndsWith ".json" -> Some JSON_CHAPTERS
|
||||
| None -> None
|
||||
Some (toAbsolute webLog chapters), typ
|
||||
| None, None -> None, None
|
||||
|
||||
match chapterUrl with
|
||||
| Some url ->
|
||||
let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast)
|
||||
elt.SetAttribute("url", url)
|
||||
chapterMimeType |> Option.iter (fun it -> elt.SetAttribute("type", it))
|
||||
item.ElementExtensions.Add elt
|
||||
| None -> ()
|
||||
|
||||
match episode.TranscriptUrl with
|
||||
| Some transcript ->
|
||||
let url = toAbsolute webLog transcript
|
||||
let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
|
||||
elt.SetAttribute ("url", url)
|
||||
elt.SetAttribute ("type", Option.get episode.TranscriptType)
|
||||
episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it))
|
||||
if defaultArg episode.TranscriptCaptions false then
|
||||
elt.SetAttribute ("rel", "captions")
|
||||
let elt = xmlDoc.CreateElement("podcast", "transcript", Namespace.podcast)
|
||||
elt.SetAttribute("url", url)
|
||||
elt.SetAttribute("type", Option.get episode.TranscriptType)
|
||||
episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute("language", it))
|
||||
if defaultArg episode.TranscriptCaptions false then elt.SetAttribute("rel", "captions")
|
||||
item.ElementExtensions.Add elt
|
||||
| None -> ()
|
||||
|
||||
@@ -196,38 +199,37 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
|
||||
| Some season ->
|
||||
match episode.SeasonDescription with
|
||||
| Some desc ->
|
||||
let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast)
|
||||
elt.SetAttribute ("name", desc)
|
||||
let elt = xmlDoc.CreateElement("podcast", "season", Namespace.podcast)
|
||||
elt.SetAttribute("name", desc)
|
||||
elt.InnerText <- string season
|
||||
item.ElementExtensions.Add elt
|
||||
| None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season)
|
||||
| None -> item.ElementExtensions.Add("season", Namespace.podcast, string season)
|
||||
| None -> ()
|
||||
|
||||
match episode.EpisodeNumber with
|
||||
| Some epNumber ->
|
||||
match episode.EpisodeDescription with
|
||||
| Some desc ->
|
||||
let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast)
|
||||
elt.SetAttribute ("name", desc)
|
||||
let elt = xmlDoc.CreateElement("podcast", "episode", Namespace.podcast)
|
||||
elt.SetAttribute("name", desc)
|
||||
elt.InnerText <- string epNumber
|
||||
item.ElementExtensions.Add elt
|
||||
| None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber)
|
||||
| None -> item.ElementExtensions.Add("episode", Namespace.podcast, string epNumber)
|
||||
| None -> ()
|
||||
|
||||
if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then
|
||||
try
|
||||
let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc)
|
||||
chapters.SetAttribute ("version", "1.2")
|
||||
let chapters = xmlDoc.CreateElement("psc", "chapters", Namespace.psc)
|
||||
chapters.SetAttribute("version", "1.2")
|
||||
|
||||
post.Metadata
|
||||
|> List.filter (fun it -> it.Name = "chapter")
|
||||
|> List.map (fun it ->
|
||||
TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1))
|
||||
|> List.map (fun it -> TimeSpan.Parse(it.Value.Split(" ")[0]), it.Value[it.Value.IndexOf(" ") + 1..])
|
||||
|> List.sortBy fst
|
||||
|> List.iter (fun chap ->
|
||||
let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc)
|
||||
chapter.SetAttribute ("start", (fst chap).ToString "hh:mm:ss")
|
||||
chapter.SetAttribute ("title", snd chap)
|
||||
let chapter = xmlDoc.CreateElement("psc", "chapter", Namespace.psc)
|
||||
chapter.SetAttribute("start", (fst chap).ToString "hh:mm:ss")
|
||||
chapter.SetAttribute("title", snd chap)
|
||||
chapters.AppendChild chapter |> ignore)
|
||||
|
||||
item.ElementExtensions.Add chapters
|
||||
@@ -235,26 +237,26 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
|
||||
item
|
||||
|
||||
/// Add a namespace to the feed
|
||||
let private addNamespace (feed : SyndicationFeed) alias nsUrl =
|
||||
feed.AttributeExtensions.Add (XmlQualifiedName (alias, "http://www.w3.org/2000/xmlns/"), nsUrl)
|
||||
let private addNamespace (feed: SyndicationFeed) alias nsUrl =
|
||||
feed.AttributeExtensions.Add(XmlQualifiedName(alias, "http://www.w3.org/2000/xmlns/"), nsUrl)
|
||||
|
||||
/// Add items to the top of the feed required for podcasts
|
||||
let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
|
||||
let addChild (doc : XmlDocument) ns prefix name value (elt : XmlElement) =
|
||||
let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: CustomFeed) =
|
||||
let addChild (doc: XmlDocument) ns prefix name value (elt: XmlElement) =
|
||||
let child =
|
||||
if ns = "" then doc.CreateElement name else doc.CreateElement (prefix, name, ns)
|
||||
if ns = "" then doc.CreateElement name else doc.CreateElement(prefix, name, ns)
|
||||
|> elt.AppendChild
|
||||
child.InnerText <- value
|
||||
elt
|
||||
|
||||
let podcast = Option.get feed.Podcast
|
||||
let feedUrl = WebLog.absoluteUrl webLog feed.Path
|
||||
let feedUrl = webLog.AbsoluteUrl feed.Path
|
||||
let imageUrl =
|
||||
match podcast.ImageUrl with
|
||||
| Permalink link when link.StartsWith "http" -> link
|
||||
| Permalink _ -> WebLog.absoluteUrl webLog podcast.ImageUrl
|
||||
| Permalink _ -> webLog.AbsoluteUrl podcast.ImageUrl
|
||||
|
||||
let xmlDoc = XmlDocument ()
|
||||
let xmlDoc = XmlDocument()
|
||||
|
||||
[ "dc", Namespace.dc
|
||||
"itunes", Namespace.iTunes
|
||||
@@ -265,12 +267,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
|
||||
|> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
|
||||
|
||||
let categorization =
|
||||
let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
|
||||
it.SetAttribute ("text", podcast.AppleCategory)
|
||||
let it = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
|
||||
it.SetAttribute("text", podcast.AppleCategory)
|
||||
podcast.AppleSubcategory
|
||||
|> Option.iter (fun subCat ->
|
||||
let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
|
||||
subCatElt.SetAttribute ("text", subCat)
|
||||
let subCatElt = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
|
||||
subCatElt.SetAttribute("text", subCat)
|
||||
it.AppendChild subCatElt |> ignore)
|
||||
it
|
||||
let image =
|
||||
@@ -280,19 +282,19 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
|
||||
]
|
||||
|> List.fold (fun elt (name, value) -> addChild xmlDoc "" "" name value elt) (xmlDoc.CreateElement "image")
|
||||
let iTunesImage =
|
||||
let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes)
|
||||
it.SetAttribute ("href", imageUrl)
|
||||
let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
|
||||
it.SetAttribute("href", imageUrl)
|
||||
it
|
||||
let owner =
|
||||
[ "name", podcast.DisplayedAuthor
|
||||
"email", podcast.Email
|
||||
]
|
||||
|> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
|
||||
(xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes))
|
||||
(xmlDoc.CreateElement("itunes", "owner", Namespace.iTunes))
|
||||
let rawVoice =
|
||||
let it = xmlDoc.CreateElement ("rawvoice", "subscribe", Namespace.rawVoice)
|
||||
it.SetAttribute ("feed", feedUrl)
|
||||
it.SetAttribute ("itunes", "")
|
||||
let it = xmlDoc.CreateElement("rawvoice", "subscribe", Namespace.rawVoice)
|
||||
it.SetAttribute("feed", feedUrl)
|
||||
it.SetAttribute("itunes", "")
|
||||
it
|
||||
|
||||
rssFeed.ElementExtensions.Add image
|
||||
@@ -300,25 +302,24 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
|
||||
rssFeed.ElementExtensions.Add categorization
|
||||
rssFeed.ElementExtensions.Add iTunesImage
|
||||
rssFeed.ElementExtensions.Add rawVoice
|
||||
rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.Summary)
|
||||
rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
|
||||
rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.Explicit)
|
||||
podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
|
||||
rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary)
|
||||
rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
|
||||
rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, string podcast.Explicit)
|
||||
podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add("subtitle", Namespace.iTunes, sub))
|
||||
podcast.FundingUrl
|
||||
|> Option.iter (fun url ->
|
||||
let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast)
|
||||
funding.SetAttribute ("url", toAbsolute webLog url)
|
||||
let funding = xmlDoc.CreateElement("podcast", "funding", Namespace.podcast)
|
||||
funding.SetAttribute("url", toAbsolute webLog url)
|
||||
funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast"
|
||||
rssFeed.ElementExtensions.Add funding)
|
||||
podcast.PodcastGuid
|
||||
|> Option.iter (fun guid ->
|
||||
rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
|
||||
podcast.Medium
|
||||
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
|
||||
rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
|
||||
podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, string med))
|
||||
|
||||
/// Get the feed's self reference and non-feed link
|
||||
let private selfAndLink webLog feedType ctx =
|
||||
let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.Rss.FeedName}", ""))
|
||||
let withoutFeed (it: string) = Permalink(it.Replace($"/{webLog.Rss.FeedName}", ""))
|
||||
match feedType with
|
||||
| StandardFeed path
|
||||
| CategoryFeed (_, path)
|
||||
@@ -330,8 +331,8 @@ let private selfAndLink webLog feedType ctx =
|
||||
| Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/"""
|
||||
|
||||
/// 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))
|
||||
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
|
||||
@@ -359,7 +360,7 @@ let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCat
|
||||
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 createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgroundTask {
|
||||
let webLog = ctx.WebLog
|
||||
let data = ctx.Data
|
||||
let! authors = getAuthors webLog posts data
|
||||
@@ -373,40 +374,40 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
|
||||
match podcast, post.Episode with
|
||||
| Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
|
||||
| Some _, _ ->
|
||||
warn "Feed" ctx $"[{webLog.Name} {Permalink.toString self}] \"{stripHtml post.Title}\" has no media"
|
||||
warn "Feed" ctx $"[{webLog.Name} {self}] \"{stripHtml post.Title}\" has no media"
|
||||
item
|
||||
| _ -> item
|
||||
|
||||
let feed = SyndicationFeed ()
|
||||
let feed = SyndicationFeed()
|
||||
addNamespace feed "content" Namespace.content
|
||||
setTitleAndDescription feedType webLog cats feed
|
||||
|
||||
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset ()
|
||||
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset()
|
||||
feed.Generator <- ctx.Generator
|
||||
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
|
||||
feed.Language <- "en"
|
||||
feed.Id <- WebLog.absoluteUrl webLog link
|
||||
feed.Id <- webLog.AbsoluteUrl 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))
|
||||
feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link)
|
||||
feed.Links.Add(SyndicationLink(Uri(webLog.AbsoluteUrl self), "self", "", "application/rss+xml", 0L))
|
||||
feed.ElementExtensions.Add("link", "", webLog.AbsoluteUrl link)
|
||||
|
||||
podcast |> Option.iter (addPodcast webLog feed)
|
||||
|
||||
use mem = new MemoryStream ()
|
||||
use mem = new MemoryStream()
|
||||
use xml = XmlWriter.Create mem
|
||||
feed.SaveAsRss20 xml
|
||||
xml.Close ()
|
||||
xml.Close()
|
||||
|
||||
let _ = mem.Seek (0L, SeekOrigin.Begin)
|
||||
let _ = mem.Seek(0L, SeekOrigin.Begin)
|
||||
let rdr = new StreamReader(mem)
|
||||
let! output = rdr.ReadToEndAsync ()
|
||||
let! output = rdr.ReadToEndAsync()
|
||||
|
||||
return! (setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
|
||||
}
|
||||
|
||||
// GET {any-prescribed-feed}
|
||||
let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
|
||||
let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
|
||||
match! getFeedPosts ctx feedType postCount with
|
||||
| posts when List.length posts > 0 -> return! createFeed feedType posts next ctx
|
||||
| _ -> return! Error.notFound next ctx
|
||||
@@ -417,13 +418,13 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
|
||||
// POST /admin/settings/rss
|
||||
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
|
||||
let data = ctx.Data
|
||||
let! model = ctx.BindFormAsync<EditRssModel> ()
|
||||
let! model = ctx.BindFormAsync<EditRssModel>()
|
||||
match! data.WebLog.FindById ctx.WebLog.Id with
|
||||
| Some webLog ->
|
||||
let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
|
||||
do! data.WebLog.UpdateRssOptions webLog
|
||||
WebLogCache.set webLog
|
||||
do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" }
|
||||
do! addMessage ctx { UserMessage.Success with Message = "RSS settings updated successfully" }
|
||||
return! redirectToGet "admin/settings#rss-settings" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@@ -432,24 +433,27 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
|
||||
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
|
||||
let customFeed =
|
||||
match feedId with
|
||||
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" }
|
||||
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
|
||||
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
|
||||
match customFeed with
|
||||
| Some f ->
|
||||
hashForPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
|
||||
|> withAntiCsrf ctx
|
||||
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|
||||
|> addToHash "medium_values" [|
|
||||
KeyValuePair.Create ("", "– Unspecified –")
|
||||
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
|
||||
KeyValuePair.Create (PodcastMedium.toString Music, "Music")
|
||||
KeyValuePair.Create (PodcastMedium.toString Video, "Video")
|
||||
KeyValuePair.Create (PodcastMedium.toString Film, "Film")
|
||||
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
|
||||
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
|
||||
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|
||||
|]
|
||||
|> adminView "custom-feed-edit" next ctx
|
||||
let ratings = [
|
||||
{ Name = string Yes; Value = "Yes" }
|
||||
{ Name = string No; Value = "No" }
|
||||
{ Name = string Clean; Value = "Clean" }
|
||||
]
|
||||
let mediums = [
|
||||
{ Name = ""; Value = "– Unspecified –" }
|
||||
{ Name = string Podcast; Value = "Podcast" }
|
||||
{ Name = string Music; Value = "Music" }
|
||||
{ Name = string Video; Value = "Video" }
|
||||
{ Name = string Film; Value = "Film" }
|
||||
{ Name = string Audiobook; Value = "Audiobook" }
|
||||
{ Name = string Newsletter; Value = "Newsletter" }
|
||||
{ Name = string Blog; Value = "Blog" }
|
||||
]
|
||||
Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
|
||||
|> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" true next ctx
|
||||
| None -> Error.notFound next ctx
|
||||
|
||||
// POST /admin/settings/rss/save
|
||||
@@ -457,45 +461,42 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
|
||||
let data = ctx.Data
|
||||
match! data.WebLog.FindById ctx.WebLog.Id with
|
||||
| Some webLog ->
|
||||
let! model = ctx.BindFormAsync<EditCustomFeedModel> ()
|
||||
let! model = ctx.BindFormAsync<EditCustomFeedModel>()
|
||||
let theFeed =
|
||||
match model.Id with
|
||||
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () }
|
||||
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id)
|
||||
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() }
|
||||
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
|
||||
match theFeed with
|
||||
| Some feed ->
|
||||
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
|
||||
let webLog = { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
|
||||
let webLog = { webLog with Rss.CustomFeeds = feeds }
|
||||
do! data.WebLog.UpdateRssOptions webLog
|
||||
WebLogCache.set webLog
|
||||
do! addMessage ctx {
|
||||
UserMessage.success with
|
||||
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
|
||||
}
|
||||
return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.Id}/edit" next ctx
|
||||
do! addMessage ctx
|
||||
{ UserMessage.Success with
|
||||
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" }
|
||||
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// POST /admin/settings/rss/{id}/delete
|
||||
// DELETE /admin/settings/rss/{id}
|
||||
let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
|
||||
let data = ctx.Data
|
||||
match! data.WebLog.FindById ctx.WebLog.Id with
|
||||
| Some webLog ->
|
||||
let customId = CustomFeedId feedId
|
||||
if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
|
||||
let webLog = {
|
||||
webLog with
|
||||
Rss = {
|
||||
webLog.Rss with
|
||||
CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId)
|
||||
}
|
||||
}
|
||||
let webLog =
|
||||
{ webLog with
|
||||
Rss =
|
||||
{ webLog.Rss with
|
||||
CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) } }
|
||||
do! data.WebLog.UpdateRssOptions webLog
|
||||
WebLogCache.set webLog
|
||||
do! addMessage ctx { UserMessage.success with Message = "Custom feed deleted successfully" }
|
||||
do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" }
|
||||
else
|
||||
do! addMessage ctx { UserMessage.warning with Message = "Custom feed not found; no action taken" }
|
||||
do! addMessage ctx { UserMessage.Warning with Message = "Custom feed not found; no action taken" }
|
||||
return! redirectToGet "admin/settings#rss-settings" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user