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

WIP on "all the feeds"

Browse Source
This commit is contained in:
Daniel J. Summers 2022-05-27 14:34:21 -04:00
parent 2589d388f1
commit 1cd7b06add
6 changed files with 275 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/MyWebLog.Data/Converters.fs
View File

@ -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) =
@ -77,6 +91,8 @@ let all () : JsonConverter seq =
// Our converters
CategoryIdConverter ()
CommentIdConverter ()
CustomFeedSourceConverter ()
ExplicitRatingConverter ()
MarkupTextConverter ()
PermalinkConverter ()
PageIdConverter ()

4
src/MyWebLog.Data/Data.fs
View File

@ -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)

6
src/MyWebLog.Domain/DataTypes.fs
View File

@ -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

127
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -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

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

@ -195,19 +195,53 @@ 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
// GET /feed.xml
// (Routing handled by catch-all handler for future configurability)
let generateFeed : HttpHandler = fun next ctx -> backgroundTask {
/// 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
// TODO: hard-coded number of items
let! posts = Data.Post.findPageOfPublishedPosts webLog.id 1 10 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
@ -274,6 +308,7 @@ let generateFeed : HttpHandler = fun next ctx -> backgroundTask {
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 =
let webLog = ctx.WebLog
@ -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

2
src/MyWebLog/appsettings.json
View File

@ -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"