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

V2 #1

Merged
danieljsummers merged 102 commits from v2 into main 2022-06-23 00:35:12 +00:00
Conversation 0 Commits 102 Files Changed 125 +336 -180
6 changed files with 336 additions and 180 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit fbacacfb5b - Show all commits

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

@ -524,8 +524,7 @@ module Post =
}
/// Find posts to be displayed on a category list page
let findPageOfCategorizedPosts (webLogId : WebLogId) (catIds : CategoryId list) (pageNbr : int64) postsPerPage =
let pg = int pageNbr
let findPageOfCategorizedPosts (webLogId : WebLogId) (catIds : CategoryId list) pageNbr postsPerPage =
rethink<Post list> {
withTable Table.Post
getAll (objList catIds) "categoryIds"
@ -534,7 +533,7 @@ module Post =
without [ "priorPermalinks"; "revisions" ]
distinct
orderByDescending "publishedOn"
skip ((pg - 1) * postsPerPage)
skip ((pageNbr - 1) * postsPerPage)
limit (postsPerPage + 1)
result; withRetryDefault
}

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

@ -255,6 +255,9 @@ type PodcastOptions =
/// The e-mail address of the user who registered the podcast at iTunes
email : string
/// The link to the image for the podcast
imageUrl : Permalink
/// The category from iTunes under which this podcast is categorized
iTunesCategory : string
@ -263,6 +266,9 @@ type PodcastOptions =
/// The explictness rating (iTunes field)
explicit : ExplicitRating
/// The default media type for files in this podcast
defaultMediaType : string option
}

257
src/MyWebLog/Handlers/Feed.fs Normal file
View File

@ -0,0 +1,257 @@
/// Functions to support generating RSS feeds
module MyWebLog.Handlers.Feed
open System
open System.IO
open System.ServiceModel.Syndication
open System.Text.RegularExpressions
open System.Xml
open Giraffe
open Microsoft.AspNetCore.Http
open MyWebLog
open MyWebLog.ViewModels
/// The type of feed to generate
type FeedType =
| StandardFeed
| CategoryFeed of CategoryId
| TagFeed of string
| Custom of CustomFeed
/// Derive the type of RSS feed requested
let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
let webLog = ctx.WebLog
let name = $"/{webLog.rss.feedName}"
let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage
// Standard feed
match webLog.rss.feedEnabled && feedPath = name with
| true -> Some (StandardFeed, postCount)
| false ->
// Category feed
match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = feedPath.Replace (name, "")) with
| Some cat -> Some (CategoryFeed (CategoryId cat.id), postCount)
| None ->
// Tag feed
match feedPath.StartsWith "/tag/" with
| true -> Some (TagFeed (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
/// Determine the function to retrieve posts for the given feed
let private getFeedPosts (webLog : WebLog) feedType =
match feedType with
| StandardFeed -> Data.Post.findPageOfPublishedPosts webLog.id 1
| CategoryFeed catId -> Data.Post.findPageOfCategorizedPosts webLog.id [ catId ] 1
| TagFeed tag -> Data.Post.findPageOfTaggedPosts webLog.id tag 1
| Custom feed ->
match feed.source with
| Category catId -> Data.Post.findPageOfCategorizedPosts webLog.id [ catId ] 1
| Tag tag -> Data.Post.findPageOfTaggedPosts webLog.id tag 1
/// Strip HTML from a string
let private stripHtml text = Regex.Replace (text, "<(.|\n)*?>", "")
/// Create a feed item from the given post
let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
(post : Post) =
let plainText =
match stripHtml post.text with
| 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
/// Add episode information to a podcast feed item
let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : SyndicationItem) =
let podcast = Option.get feed.podcast
let meta name = post.metadata |> List.tryFind (fun it -> it.name = name)
let value (item : MetaItem) = item.value
let epMediaUrl =
match (meta >> Option.get >> value) "media" with
| link when link.StartsWith "http" -> link
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType =
match meta "mediaType", podcast.defaultMediaType with
| Some epType, _ -> Some epType.value
| None, Some defType -> Some defType
| _ -> None
let epImageUrl =
match defaultArg ((meta >> Option.map value) "image") (Permalink.toString podcast.imageUrl) with
| link when link.StartsWith "http" -> link
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epExplicit =
try
(meta >> Option.map (value >> ExplicitRating.parse)) "explicit"
|> Option.defaultValue podcast.explicit
|> ExplicitRating.toString
with :? ArgumentException -> ExplicitRating.toString podcast.explicit
let encXml = XmlDocument ()
let encElt = encXml.CreateElement "enclosure"
encElt.SetAttribute ("url", epMediaUrl)
meta "length" |> Option.iter (fun it -> encElt.SetAttribute ("length", it.value))
epMediaType |> Option.iter (fun typ -> encElt.SetAttribute ("type", typ))
item.ElementExtensions.Add ("enclosure", "", encXml)
item.ElementExtensions.Add ("creator", "dc", podcast.displayedAuthor)
item.ElementExtensions.Add ("author", "itunes", podcast.displayedAuthor)
meta "subtitle" |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", "itunes", it.value))
item.ElementExtensions.Add ("summary", "itunes", stripHtml post.text)
item.ElementExtensions.Add ("image", "itunes", epImageUrl)
item.ElementExtensions.Add ("explicit", "itunes", epExplicit)
meta "duration" |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", "itunes", it.value))
if post.metadata |> List.exists (fun it -> it.name = "chapter") then
try
let chapXml = XmlDocument ()
let chapsElt = chapXml.CreateElement ("psc", "chapters", "")
chapsElt.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.sortBy fst
|> List.iter (fun chap ->
let chapElt = chapXml.CreateElement ("psc", "chapter", "")
chapElt.SetAttribute ("start", (fst chap).ToString "hh:mm:ss")
chapElt.SetAttribute ("title", snd chap)
chapsElt.AppendChild chapElt |> ignore)
chapXml.AppendChild chapsElt |> ignore
item.ElementExtensions.Add ("chapters", "psc", chapXml)
with _ -> ()
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)
/// Add items to the top of the feed required for podcasts
let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
let addChild (doc : XmlDocument) name prefix value =
let child = doc.CreateElement (name, prefix, "") |> doc.AppendChild
child.Value <- value
doc
let podcast = Option.get feed.podcast
let feedUrl = WebLog.absoluteUrl webLog feed.path
let imageUrl =
match podcast.imageUrl with
| Permalink link when link.StartsWith "http" -> link
| Permalink _ -> WebLog.absoluteUrl webLog podcast.imageUrl
let categoryXml = XmlDocument ()
let catElt = categoryXml.CreateElement ("itunes", "category", "")
catElt.SetAttribute ("text", podcast.iTunesCategory)
let subCat = categoryXml.CreateElement ("itunes", "category", "")
subCat.SetAttribute ("text", podcast.iTunesSubcategory)
catElt.AppendChild subCat |> ignore
categoryXml.AppendChild catElt |> ignore
[ "dc", "http://purl.org/dc/elements/1.1/"
"itunes", "http://www.itunes.com/dtds/podcast-1.0.dtd"
"psc", "http://podlove.org/simple-chapters/"
"rawvoice", "http://www.rawvoice.com/rawvoiceRssModule/"
]
|> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
rssFeed.ElementExtensions.Add
("image", "",
[ "title", podcast.title
"url", imageUrl
"link", feedUrl
]
|> List.fold (fun doc (name, value) -> addChild doc name "" value) (XmlDocument ()))
// TODO: is copyright required?
rssFeed.ElementExtensions.Add ("summary", "itunes", podcast.summary)
rssFeed.ElementExtensions.Add ("author", "itunes", podcast.displayedAuthor)
podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", "itunes", sub))
rssFeed.ElementExtensions.Add
("owner", "itunes",
[ "name", podcast.displayedAuthor
"email", podcast.email
]
|> List.fold (fun doc (name, value) -> addChild doc name "itunes" value) (XmlDocument ()))
rssFeed.ElementExtensions.Add ("image", "itunes", imageUrl)
rssFeed.ElementExtensions.Add ("category", "itunes", categoryXml)
rssFeed.ElementExtensions.Add ("explicit", "itunes", ExplicitRating.toString podcast.explicit)
rssFeed.ElementExtensions.Add ("subscribe", "rawvoice", feedUrl)
// GET {any-prescribed-feed}
let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
let webLog = ctx.WebLog
let conn = ctx.Conn
let! posts = getFeedPosts webLog feedType postCount conn
let! authors = Post.getAuthors webLog posts conn
let! tagMaps = Post.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 toItem post =
let item = toFeedItem webLog authors cats tagMaps post
match podcast with
| Some feed when post.metadata |> List.exists (fun it -> it.name = "media") ->
addEpisode webLog feed post item
| _ -> 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)
podcast |> Option.iter (addPodcast webLog feed)
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
}

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

@ -2,7 +2,6 @@
module MyWebLog.Handlers.Post
open System
open Microsoft.AspNetCore.Http
/// Parse a slug and page number from an "everything else" URL
let private parseSlugAndPage (slugAndPage : string seq) =
@ -27,14 +26,14 @@ type ListType =
open MyWebLog
/// Get all authors for a list of posts as metadata items
let private getAuthors (webLog : WebLog) (posts : Post list) conn =
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 private getTagMappings (webLog : WebLog) (posts : Post list) =
let getTagMappings (webLog : WebLog) (posts : Post list) =
posts
|> List.map (fun p -> p.tags)
|> List.concat
@ -46,7 +45,7 @@ open DotLiquid
open MyWebLog.ViewModels
/// Convert a list of posts into items ready to be displayed
let private preparePostList webLog posts listType (url : string) pageNbr perPage ctx conn = task {
let preparePostList webLog posts listType (url : string) pageNbr perPage ctx conn = task {
let! authors = getAuthors webLog posts conn
let! tagMappings = getTagMappings webLog posts conn
let relUrl it = Some <| WebLog.relativeUrl webLog (Permalink it)
@ -195,178 +194,6 @@ 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
/// 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
}
/// Sequence where the first returned value is the proper handler for the link
let private deriveAction (ctx : HttpContext) : HttpHandler seq =
let webLog = ctx.WebLog
let conn = ctx.Conn
let textLink =
let _, extra = WebLog.hostAndPath webLog
let url = string ctx.Request.Path
(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}")
// Home page directory without the directory slash
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
let permalink = Permalink (textLink.Substring 1)
// Current post
match Data.Post.findByPermalink permalink webLog.id conn |> await with
| Some post ->
let model = preparePostList webLog [ post ] SinglePost "" 1 1 ctx conn |> await
model.Add ("page_title", post.title)
yield fun next ctx -> themedView "single-post" next ctx model
| None -> ()
// Current page
match Data.Page.findByPermalink permalink webLog.id conn |> await with
| Some page ->
yield fun next ctx ->
Hash.FromAnonymousObject {| page = DisplayPage.fromPage webLog page; page_title = page.title |}
|> themedView (defaultArg page.template "single-page") next ctx
| None -> ()
// RSS feed
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
| Some post -> yield redirectTo true (WebLog.relativeUrl webLog post.permalink)
| None -> ()
// Page differing only by trailing slash
match Data.Page.findByPermalink altLink webLog.id conn |> await with
| Some page -> yield redirectTo true (WebLog.relativeUrl webLog page.permalink)
| None -> ()
// Prior post
match Data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with
| Some link -> yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> ()
// Prior page
match Data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with
| Some link -> yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> ()
}
// GET {all-of-the-above}
let catchAll : HttpHandler = fun next ctx -> task {
match deriveAction ctx |> Seq.tryHead with
| Some handler -> return! handler next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = fun next ctx -> task {

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

@ -4,6 +4,72 @@ module MyWebLog.Handlers.Routes
open Giraffe
open MyWebLog
/// Module to resolve routes that do not match any other known route (web blog content)
module CatchAll =
open DotLiquid
open Microsoft.AspNetCore.Http
open MyWebLog.ViewModels
/// Sequence where the first returned value is the proper handler for the link
let private deriveAction (ctx : HttpContext) : HttpHandler seq =
let webLog = ctx.WebLog
let conn = ctx.Conn
let textLink =
let _, extra = WebLog.hostAndPath webLog
let url = string ctx.Request.Path
(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}")
// Home page directory without the directory slash
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
let permalink = Permalink (textLink.Substring 1)
// Current post
match Data.Post.findByPermalink permalink webLog.id conn |> await with
| Some post ->
let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx conn |> await
model.Add ("page_title", post.title)
yield fun next ctx -> themedView "single-post" next ctx model
| None -> ()
// Current page
match Data.Page.findByPermalink permalink webLog.id conn |> await with
| Some page ->
yield fun next ctx ->
Hash.FromAnonymousObject {| page = DisplayPage.fromPage webLog page; page_title = page.title |}
|> themedView (defaultArg page.template "single-page") next ctx
| None -> ()
// RSS feed
match Feed.deriveFeedType ctx 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
| Some post -> yield redirectTo true (WebLog.relativeUrl webLog post.permalink)
| None -> ()
// Page differing only by trailing slash
match Data.Page.findByPermalink altLink webLog.id conn |> await with
| Some page -> yield redirectTo true (WebLog.relativeUrl webLog page.permalink)
| None -> ()
// Prior post
match Data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with
| Some link -> yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> ()
// Prior page
match Data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with
| Some link -> yield redirectTo true (WebLog.relativeUrl webLog link)
| None -> ()
}
// GET {all-of-the-above}
let route : HttpHandler = fun next ctx -> task {
match deriveAction ctx |> Seq.tryHead with
| Some handler -> return! handler next ctx
| None -> return! Error.notFound next ctx
}
/// The primary myWebLog router
let router : HttpHandler = choose [
GET >=> choose [
route "/" >=> Post.home
@ -69,7 +135,7 @@ let router : HttpHandler = choose [
route "/log-on" >=> User.doLogOn
]
])
GET >=> Post.catchAll
GET >=> CatchAll.route
Error.notFound
]

1
src/MyWebLog/MyWebLog.fsproj
View File

@ -13,6 +13,7 @@
<Compile Include="Handlers\Helpers.fs" />
<Compile Include="Handlers\Admin.fs" />
<Compile Include="Handlers\Post.fs" />
<Compile Include="Handlers\Feed.fs" />
<Compile Include="Handlers\User.fs" />
<Compile Include="Handlers\Routes.fs" />
<Compile Include="DotLiquidBespoke.fs" />