WIP on "all the feeds"
This commit is contained in:
parent
2589d388f1
commit
1cd7b06add
@ -20,6 +20,20 @@ type CommentIdConverter () =
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> CommentId) reader.Value
|
||||
|
||||
type CustomFeedSourceConverter () =
|
||||
inherit JsonConverter<CustomFeedSource> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : CustomFeedSource, _ : JsonSerializer) =
|
||||
writer.WriteValue (CustomFeedSource.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) =
|
||||
(string >> CustomFeedSource.parse) reader.Value
|
||||
|
||||
type ExplicitRatingConverter () =
|
||||
inherit JsonConverter<ExplicitRating> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : ExplicitRating, _ : JsonSerializer) =
|
||||
writer.WriteValue (ExplicitRating.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : ExplicitRating, _ : bool, _ : JsonSerializer) =
|
||||
(string >> ExplicitRating.parse) reader.Value
|
||||
|
||||
type MarkupTextConverter () =
|
||||
inherit JsonConverter<MarkupText> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : MarkupText, _ : JsonSerializer) =
|
||||
@ -75,15 +89,17 @@ open Microsoft.FSharpLu.Json
|
||||
let all () : JsonConverter seq =
|
||||
seq {
|
||||
// Our converters
|
||||
CategoryIdConverter ()
|
||||
CommentIdConverter ()
|
||||
MarkupTextConverter ()
|
||||
PermalinkConverter ()
|
||||
PageIdConverter ()
|
||||
PostIdConverter ()
|
||||
TagMapIdConverter ()
|
||||
WebLogIdConverter ()
|
||||
WebLogUserIdConverter ()
|
||||
CategoryIdConverter ()
|
||||
CommentIdConverter ()
|
||||
CustomFeedSourceConverter ()
|
||||
ExplicitRatingConverter ()
|
||||
MarkupTextConverter ()
|
||||
PermalinkConverter ()
|
||||
PageIdConverter ()
|
||||
PostIdConverter ()
|
||||
TagMapIdConverter ()
|
||||
WebLogIdConverter ()
|
||||
WebLogUserIdConverter ()
|
||||
// Handles DUs with no associated data, as well as option fields
|
||||
CompactUnionJsonConverter ()
|
||||
}
|
||||
|
||||
@ -77,7 +77,7 @@ module Startup =
|
||||
log.LogInformation $"Creating index {table}.permalink..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"]) :> obj)
|
||||
indexCreate "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"].Downcase ()) :> obj)
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Prior permalinks are searched when a post or page permalink do not match the current URL
|
||||
@ -85,7 +85,7 @@ module Startup =
|
||||
log.LogInformation $"Creating index {table}.priorPermalinks..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "priorPermalinks" [ Multi ]
|
||||
indexCreate "priorPermalinks" (fun row -> row["priorPermalinks"].Downcase () :> obj) [ Multi ]
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Post needs indexes by category and tag (used for counting and retrieving posts)
|
||||
|
||||
@ -272,12 +272,15 @@ type WebLog =
|
||||
|
||||
/// The time zone in which dates/times should be displayed
|
||||
timeZone : string
|
||||
|
||||
/// The RSS options for this web log
|
||||
rss : RssOptions
|
||||
}
|
||||
|
||||
/// Functions to support web logs
|
||||
module WebLog =
|
||||
|
||||
/// An empty set of web logs
|
||||
/// An empty web log
|
||||
let empty =
|
||||
{ id = WebLogId.empty
|
||||
name = ""
|
||||
@ -287,6 +290,7 @@ module WebLog =
|
||||
themePath = "default"
|
||||
urlBase = ""
|
||||
timeZone = ""
|
||||
rss = RssOptions.empty
|
||||
}
|
||||
|
||||
/// Get the host (including scheme) and extra path from the URL base
|
||||
|
||||
@ -187,6 +187,133 @@ module PostId =
|
||||
let create () = PostId (newId ())
|
||||
|
||||
|
||||
/// The source for a custom feed
|
||||
type CustomFeedSource =
|
||||
/// A feed based on a particular category
|
||||
| Category of CategoryId
|
||||
/// A feed based on a particular tag
|
||||
| Tag of string
|
||||
|
||||
/// Functions to support feed sources
|
||||
module CustomFeedSource =
|
||||
/// Create a string version of a feed source
|
||||
let toString : CustomFeedSource -> string =
|
||||
function
|
||||
| Category (CategoryId catId) -> $"category:{catId}"
|
||||
| Tag tag -> $"tag:{tag}"
|
||||
|
||||
/// Parse a feed source from its string version
|
||||
let parse : string -> CustomFeedSource =
|
||||
let value (it : string) = it.Split(":").[1]
|
||||
function
|
||||
| source when source.StartsWith "category:" -> (value >> CategoryId >> Category) source
|
||||
| source when source.StartsWith "tag:" -> (value >> Tag) source
|
||||
| source -> invalidArg "feedSource" $"{source} is not a valid feed source"
|
||||
|
||||
|
||||
/// Valid values for the iTunes explicit rating
|
||||
type ExplicitRating =
|
||||
| Yes
|
||||
| No
|
||||
| Clean
|
||||
|
||||
/// Functions to support iTunes explicit ratings
|
||||
module ExplicitRating =
|
||||
/// Convert an explicit rating to a string
|
||||
let toString : ExplicitRating -> string =
|
||||
function
|
||||
| Yes -> "yes"
|
||||
| No -> "no"
|
||||
| Clean -> "clean"
|
||||
|
||||
/// Parse a string into an explicit rating
|
||||
let parse : string -> ExplicitRating =
|
||||
function
|
||||
| "yes" -> Yes
|
||||
| "no" -> No
|
||||
| "clean" -> Clean
|
||||
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
|
||||
|
||||
|
||||
/// Options for a feed that describes a podcast
|
||||
type PodcastOptions =
|
||||
{ /// The title of the podcast
|
||||
title : string
|
||||
|
||||
/// A subtitle for the podcast
|
||||
subtitle : string option
|
||||
|
||||
/// The number of items in the podcast feed
|
||||
itemsInFeed : int
|
||||
|
||||
/// A summary of the podcast (iTunes field)
|
||||
summary : string
|
||||
|
||||
/// The display name of the podcast author (iTunes field)
|
||||
displayedAuthor : string
|
||||
|
||||
/// The e-mail address of the user who registered the podcast at iTunes
|
||||
email : string
|
||||
|
||||
/// The category from iTunes under which this podcast is categorized
|
||||
iTunesCategory : string
|
||||
|
||||
/// A further refinement of the categorization of this podcast (iTunes field / values)
|
||||
iTunesSubcategory : string
|
||||
|
||||
/// The explictness rating (iTunes field)
|
||||
explicit : ExplicitRating
|
||||
}
|
||||
|
||||
|
||||
/// A custom feed
|
||||
type CustomFeed =
|
||||
{ /// The source for the custom feed
|
||||
source : CustomFeedSource
|
||||
|
||||
/// The path for the custom feed
|
||||
path : Permalink
|
||||
|
||||
/// Podcast options, if the feed defines a podcast
|
||||
podcast : PodcastOptions option
|
||||
}
|
||||
|
||||
|
||||
/// Really Simple Syndication (RSS) options for this web log
|
||||
type RssOptions =
|
||||
{ /// Whether the site feed of posts is enabled
|
||||
feedEnabled : bool
|
||||
|
||||
/// The name of the file generated for the site feed
|
||||
feedName : string
|
||||
|
||||
/// Override the "posts per page" setting for the site feed
|
||||
itemsInFeed : int option
|
||||
|
||||
/// Whether feeds are enabled for all categories
|
||||
categoryEnabled : bool
|
||||
|
||||
/// Whether feeds are enabled for all tags
|
||||
tagEnabled : bool
|
||||
|
||||
/// Custom feeds for this web log
|
||||
customFeeds: CustomFeed list
|
||||
}
|
||||
|
||||
/// Functions to support RSS options
|
||||
module RssOptions =
|
||||
|
||||
/// An empty set of RSS options
|
||||
let empty =
|
||||
{ feedEnabled = true
|
||||
feedName = "feed.xml"
|
||||
itemsInFeed = None
|
||||
categoryEnabled = true
|
||||
tagEnabled = true
|
||||
customFeeds = []
|
||||
}
|
||||
|
||||
|
||||
/// An identifier for a tag mapping
|
||||
type TagMapId = TagMapId of string
|
||||
|
||||
|
||||
@ -195,84 +195,119 @@ let home : HttpHandler = fun next ctx -> task {
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// Functions to support generating RSS feeds
|
||||
module Feed =
|
||||
|
||||
open System.IO
|
||||
open System.ServiceModel.Syndication
|
||||
open System.Text.RegularExpressions
|
||||
open System.Xml
|
||||
|
||||
open System.IO
|
||||
open System.ServiceModel.Syndication
|
||||
open System.Text.RegularExpressions
|
||||
open System.Xml
|
||||
/// The type of feed to generate
|
||||
type FeedType =
|
||||
| Standard
|
||||
| Category of CategoryId
|
||||
| Tag of string
|
||||
| Custom of CustomFeed
|
||||
|
||||
/// Derive the type of RSS feed requested
|
||||
let deriveFeedType ctx webLog feedPath : (FeedType * int) option =
|
||||
let name = $"/{webLog.rss.feedName}"
|
||||
let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage
|
||||
// Standard feed
|
||||
match webLog.rss.feedEnabled && feedPath = name with
|
||||
| true -> Some (Standard, postCount)
|
||||
| false ->
|
||||
// Category feed
|
||||
match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = feedPath.Replace (name, "")) with
|
||||
| Some cat -> Some (Category (CategoryId cat.id), postCount)
|
||||
| None ->
|
||||
// Tag feed
|
||||
match feedPath.StartsWith "/tag/" with
|
||||
| true -> Some (Tag (feedPath.Replace("/tag/", "").Replace(name, "")), postCount)
|
||||
| false ->
|
||||
// Custom feed
|
||||
match webLog.rss.customFeeds
|
||||
|> List.tryFind (fun it -> (Permalink.toString it.path).EndsWith feedPath) with
|
||||
| Some feed ->
|
||||
Some (Custom feed,
|
||||
feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount)
|
||||
| None ->
|
||||
// No feed
|
||||
None
|
||||
|
||||
// GET {any-prescribed-feed}
|
||||
let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
|
||||
// TODO: stopped here; use feed type and count in the below function
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
let! posts = Data.Post.findPageOfPublishedPosts webLog.id 1 postCount conn
|
||||
let! authors = getAuthors webLog posts conn
|
||||
let! tagMaps = getTagMappings webLog posts conn
|
||||
let cats = CategoryCache.get ctx
|
||||
|
||||
let toItem (post : Post) =
|
||||
let plainText =
|
||||
Regex.Replace (post.text, "<(.|\n)*?>", "")
|
||||
|> function
|
||||
| txt when txt.Length < 255 -> txt
|
||||
| txt -> $"{txt.Substring (0, 252)}..."
|
||||
let item = SyndicationItem (
|
||||
Id = WebLog.absoluteUrl webLog post.permalink,
|
||||
Title = TextSyndicationContent.CreateHtmlContent post.title,
|
||||
PublishDate = DateTimeOffset post.publishedOn.Value,
|
||||
LastUpdatedTime = DateTimeOffset post.updatedOn,
|
||||
Content = TextSyndicationContent.CreatePlaintextContent plainText)
|
||||
item.AddPermalink (Uri item.Id)
|
||||
|
||||
let encoded =
|
||||
post.text.Replace("src=\"/", $"src=\"{webLog.urlBase}/").Replace ("href=\"/", $"href=\"{webLog.urlBase}/")
|
||||
item.ElementExtensions.Add ("encoded", "http://purl.org/rss/1.0/modules/content/", encoded)
|
||||
item.Authors.Add (SyndicationPerson (
|
||||
Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString 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))
|
||||
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)"))
|
||||
]
|
||||
|> List.concat
|
||||
|> List.iter item.Categories.Add
|
||||
item
|
||||
|
||||
|
||||
let feed = SyndicationFeed ()
|
||||
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.Links.Add (SyndicationLink (Uri $"{webLog.urlBase}/feed.xml", "self", "", "application/rss+xml", 0L))
|
||||
feed.AttributeExtensions.Add
|
||||
(XmlQualifiedName ("content", "http://www.w3.org/2000/xmlns/"), "http://purl.org/rss/1.0/modules/content/")
|
||||
feed.ElementExtensions.Add ("link", "", webLog.urlBase)
|
||||
|
||||
use mem = new MemoryStream ()
|
||||
use xml = XmlWriter.Create mem
|
||||
feed.SaveAsRss20 xml
|
||||
xml.Close ()
|
||||
|
||||
let _ = mem.Seek (0L, SeekOrigin.Begin)
|
||||
let rdr = new StreamReader(mem)
|
||||
let! output = rdr.ReadToEndAsync ()
|
||||
|
||||
return! ( setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
|
||||
}
|
||||
|
||||
// GET /feed.xml
|
||||
// (Routing handled by catch-all handler for future configurability)
|
||||
let generateFeed : HttpHandler = fun next ctx -> backgroundTask {
|
||||
let webLog = ctx.WebLog
|
||||
let conn = ctx.Conn
|
||||
// TODO: hard-coded number of items
|
||||
let! posts = Data.Post.findPageOfPublishedPosts webLog.id 1 10 conn
|
||||
let! authors = getAuthors webLog posts conn
|
||||
let! tagMaps = getTagMappings webLog posts conn
|
||||
let cats = CategoryCache.get ctx
|
||||
|
||||
let toItem (post : Post) =
|
||||
let plainText =
|
||||
Regex.Replace (post.text, "<(.|\n)*?>", "")
|
||||
|> function
|
||||
| txt when txt.Length < 255 -> txt
|
||||
| txt -> $"{txt.Substring (0, 252)}..."
|
||||
let item = SyndicationItem (
|
||||
Id = WebLog.absoluteUrl webLog post.permalink,
|
||||
Title = TextSyndicationContent.CreateHtmlContent post.title,
|
||||
PublishDate = DateTimeOffset post.publishedOn.Value,
|
||||
LastUpdatedTime = DateTimeOffset post.updatedOn,
|
||||
Content = TextSyndicationContent.CreatePlaintextContent plainText)
|
||||
item.AddPermalink (Uri item.Id)
|
||||
|
||||
let encoded =
|
||||
post.text.Replace("src=\"/", $"src=\"{webLog.urlBase}/").Replace ("href=\"/", $"href=\"{webLog.urlBase}/")
|
||||
item.ElementExtensions.Add ("encoded", "http://purl.org/rss/1.0/modules/content/", encoded)
|
||||
item.Authors.Add (SyndicationPerson (
|
||||
Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString 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))
|
||||
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)"))
|
||||
]
|
||||
|> List.concat
|
||||
|> List.iter item.Categories.Add
|
||||
item
|
||||
|
||||
|
||||
let feed = SyndicationFeed ()
|
||||
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.Links.Add (SyndicationLink (Uri $"{webLog.urlBase}/feed.xml", "self", "", "application/rss+xml", 0L))
|
||||
feed.AttributeExtensions.Add
|
||||
(XmlQualifiedName ("content", "http://www.w3.org/2000/xmlns/"), "http://purl.org/rss/1.0/modules/content/")
|
||||
feed.ElementExtensions.Add ("link", "", webLog.urlBase)
|
||||
|
||||
use mem = new MemoryStream ()
|
||||
use xml = XmlWriter.Create mem
|
||||
feed.SaveAsRss20 xml
|
||||
xml.Close ()
|
||||
|
||||
let _ = mem.Seek (0L, SeekOrigin.Begin)
|
||||
let rdr = new StreamReader(mem)
|
||||
let! output = rdr.ReadToEndAsync ()
|
||||
|
||||
return! ( setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
|
||||
}
|
||||
|
||||
/// Sequence where the first returned value is the proper handler for the link
|
||||
let private deriveAction (ctx : HttpContext) : HttpHandler seq =
|
||||
@ -281,7 +316,7 @@ let private deriveAction (ctx : HttpContext) : HttpHandler seq =
|
||||
let textLink =
|
||||
let _, extra = WebLog.hostAndPath webLog
|
||||
let url = string ctx.Request.Path
|
||||
if extra = "" then url else url.Substring extra.Length
|
||||
(if extra = "" then url else url.Substring extra.Length).ToLowerInvariant ()
|
||||
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
|
||||
seq {
|
||||
debug "Post" ctx (fun () -> $"Considering URL {textLink}")
|
||||
@ -303,8 +338,9 @@ let private deriveAction (ctx : HttpContext) : HttpHandler seq =
|
||||
|> themedView (defaultArg page.template "single-page") next ctx
|
||||
| None -> ()
|
||||
// RSS feed
|
||||
// TODO: configure this via web log
|
||||
if textLink = "/feed.xml" then yield generateFeed
|
||||
match Feed.deriveFeedType ctx webLog textLink with
|
||||
| Some (feedType, postCount) -> yield Feed.generate feedType postCount
|
||||
| None -> ()
|
||||
// Post differing only by trailing slash
|
||||
let altLink = Permalink (if textLink.EndsWith "/" then textLink[..textLink.Length - 2] else $"{textLink}/")
|
||||
match Data.Post.findByPermalink altLink webLog.id conn |> await with
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
"hostname": "data02.bitbadger.solutions",
|
||||
"database": "myWebLog_dev"
|
||||
},
|
||||
"Generator": "myWebLog 2.0-alpha14",
|
||||
"Generator": "myWebLog 2.0-alpha15",
|
||||
"Logging": {
|
||||
"LogLevel": {
|
||||
"MyWebLog.Handlers": "Debug"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user