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

WIP on module/member conversion

Browse Source 
Data types complete
This commit is contained in:
Daniel J. Summers
2023-12-16 14:05:45 -05:00
parent d8ce59a6cd
commit c3d615d10a
26 changed files with 481 additions and 521 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/MyWebLog/Caches.fs
View File

@@ -53,7 +53,7 @@ module Extensions =
/// Does the current user have the requested level of access?
member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map (fun it -> it.HasAccess level)) false
defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false
open System.Collections.Concurrent
@@ -93,13 +93,13 @@ module WebLogCache =
_redirectCache[webLog.Id] <-
webLog.RedirectRules
|> List.map (fun it ->
let relUrl = Permalink >> WebLog.relativeUrl webLog
let relUrl = Permalink >> webLog.RelativeUrl
let urlTo = if it.To.Contains "://" then it.To else relUrl it.To
if it.IsRegex then
let pattern = if it.From.StartsWith "^" then $"^{relUrl (it.From.Substring 1)}" else it.From
RegEx (new Regex (pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo)
let pattern = if it.From.StartsWith "^" then $"^{relUrl it.From[1..]}" else it.From
RegEx(Regex(pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo)
else
Text (relUrl it.From, urlTo))
Text(relUrl it.From, urlTo))
/// Get all cached web logs
let all () =

76
src/MyWebLog/DotLiquidBespoke.fs
View File

@@ -21,7 +21,7 @@ let assetExists fileName (webLog : WebLog) =
ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
/// Obtain the link from known types
let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) =
let permalink (item: obj) (linkFunc: Permalink -> string) =
match item with
| :? String as link -> Some link
| :? DisplayPage as page -> Some page.Permalink
@@ -29,64 +29,64 @@ let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> st
| :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string
| _ -> None
|> function
| Some link -> linkFunc ctx.WebLog (Permalink link)
| Some link -> linkFunc (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
type AbsoluteLinkFilter() =
static member AbsoluteLink(ctx: Context, item: obj) =
permalink item ctx.WebLog.AbsoluteUrl
/// A filter to generate a link with posts categorized under the given category
type CategoryLinkFilter () =
static member CategoryLink (ctx : Context, catObj : obj) =
type CategoryLinkFilter() =
static member CategoryLink(ctx: Context, catObj: obj) =
match catObj with
| :? DisplayCategory as cat -> Some cat.Slug
| :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
| _ -> None
|> function
| Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/")
| Some slug -> ctx.WebLog.RelativeUrl(Permalink $"category/{slug}/")
| None -> $"alert('unknown category object type {catObj.GetType().Name}')"
/// A filter to generate a link that will edit a page
type EditPageLinkFilter () =
static member EditPageLink (ctx : Context, pageObj : obj) =
type EditPageLinkFilter() =
static member EditPageLink(ctx: Context, pageObj: obj) =
match pageObj with
| :? DisplayPage as page -> Some page.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
| Some pageId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/page/{pageId}/edit")
| Some pageId -> ctx.WebLog.RelativeUrl(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 () =
static member EditPostLink (ctx : Context, postObj : obj) =
type EditPostLinkFilter() =
static member EditPostLink(ctx: Context, postObj: obj) =
match postObj with
| :? PostListItem as post -> Some post.Id
| :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string
| :? String as theId -> Some theId
| _ -> None
|> function
| Some postId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/post/{postId}/edit")
| Some postId -> ctx.WebLog.RelativeUrl(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 () =
static member NavLink (ctx : Context, url : string, text : string) =
let _, path = WebLog.hostAndPath ctx.WebLog
let path = if path = "" then path else $"{path.Substring 1}/"
type NavLinkFilter() =
static member NavLink(ctx: Context, url: string, text: string) =
let extraPath = ctx.WebLog.ExtraPath
let path = if extraPath = "" then "" else $"{extraPath[1..]}/"
seq {
"<li class=\"nav-item\"><a class=\"nav-link"
if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active"
"\" href=\""
WebLog.relativeUrl ctx.WebLog (Permalink url)
ctx.WebLog.RelativeUrl(Permalink url)
"\">"
text
"</a></li>"
@@ -97,7 +97,7 @@ type NavLinkFilter () =
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter() =
static member ThemeAsset(ctx: Context, asset: string) =
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ctx.WebLog.ThemeId}/{asset}")
ctx.WebLog.RelativeUrl(Permalink $"themes/{ctx.WebLog.ThemeId}/{asset}")
/// Create various items in the page header based on the state of the page being generated
@@ -122,12 +122,12 @@ type PageHeadTag() =
// RSS feeds and canonical URLs
let feedLink title url =
let escTitle = HttpUtility.HtmlAttributeEncode title
let relUrl = WebLog.relativeUrl webLog (Permalink url)
let relUrl = webLog.RelativeUrl(Permalink url)
$"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if webLog.Rss.IsFeedEnabled && getBool "is_home" then
result.WriteLine(feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.Empty}">"""
result.WriteLine $"""{s}<link rel="canonical" href="{webLog.AbsoluteUrl Permalink.Empty}">"""
if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string
@@ -139,12 +139,12 @@ type PageHeadTag() =
if getBool "is_post" then
let post = context.Environments[0].["model"] :?> PostDisplay
let url = WebLog.absoluteUrl webLog (Permalink post.Posts[0].Permalink)
let url = webLog.AbsoluteUrl (Permalink post.Posts[0].Permalink)
result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
if getBool "is_page" then
let page = context.Environments[0].["page"] :?> DisplayPage
let url = WebLog.absoluteUrl webLog (Permalink page.Permalink)
let url = webLog.AbsoluteUrl (Permalink page.Permalink)
result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
@@ -167,26 +167,26 @@ type PageFootTag () =
/// A filter to generate a relative link
type RelativeLinkFilter () =
static member RelativeLink (ctx : Context, item : obj) =
permalink ctx item WebLog.relativeUrl
permalink item ctx.WebLog.RelativeUrl
/// A filter to generate a link with posts tagged with the given tag
type TagLinkFilter () =
static member TagLink (ctx : Context, tag : string) =
type TagLinkFilter() =
static member TagLink(ctx: Context, tag: string) =
ctx.Environments[0].["tag_mappings"] :?> TagMap list
|> List.tryFind (fun it -> it.Tag = tag)
|> function
| Some tagMap -> tagMap.UrlValue
| None -> tag.Replace (" ", "+")
|> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/")
| None -> tag.Replace(" ", "+")
|> function tagUrl -> ctx.WebLog.RelativeUrl(Permalink $"tag/{tagUrl}/")
/// Create links for a user to log on or off, and a dashboard link if they are logged off
type UserLinksTag () =
inherit Tag ()
type UserLinksTag() =
inherit Tag()
override this.Render (context : Context, result : TextWriter) =
let link it = WebLog.relativeUrl context.WebLog (Permalink it)
override this.Render(context: Context, result: TextWriter) =
let link it = context.WebLog.RelativeUrl(Permalink it)
seq {
"""<ul class="navbar-nav flex-grow-1 justify-content-end">"""
match Convert.ToBoolean context.Environments[0].["is_logged_on"] with
@@ -201,8 +201,8 @@ type UserLinksTag () =
/// A filter to retrieve the value of a meta item from a list
// (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
type ValueFilter () =
static member Value (_ : Context, items : MetaItem list, name : string) =
type ValueFilter() =
static member Value(_: Context, items: MetaItem list, name: string) =
match items |> List.tryFind (fun it -> it.Name = name) with
| Some item -> item.Value
| None -> $"-- {name} not found --"

10
src/MyWebLog/Handlers/Admin.fs
View File

@@ -156,7 +156,7 @@ module Category =
let edit catId : HttpHandler = fun next ctx -> task {
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with Id = CategoryId "new" })
| "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" })
| _ ->
match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with
| Some cat -> return Some ("Edit Category", cat)
@@ -177,7 +177,7 @@ module Category =
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category =
if model.IsNew then someTask { Category.empty with Id = CategoryId.Create(); WebLogId = ctx.WebLog.Id }
if model.IsNew then someTask { Category.Empty with Id = CategoryId.Create(); WebLogId = ctx.WebLog.Id }
else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
match! category with
| Some cat ->
@@ -333,7 +333,7 @@ module TagMapping =
let edit tagMapId : HttpHandler = fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then someTask { TagMap.empty with Id = TagMapId "new" }
if isNew then someTask { TagMap.Empty with Id = TagMapId "new" }
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with
| Some tm ->
@@ -350,7 +350,7 @@ module TagMapping =
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel>()
let tagMap =
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.Create(); WebLogId = ctx.WebLog.Id }
if model.IsNew then someTask { TagMap.Empty with Id = TagMapId.Create(); WebLogId = ctx.WebLog.Id }
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with
| Some tm ->
@@ -455,7 +455,7 @@ module Theme =
let! isNew, theme = backgroundTask {
match! data.Theme.FindById themeId with
| Some t -> return false, t
| None -> return true, { Theme.empty with Id = themeId }
| None -> return true, { Theme.Empty with Id = themeId }
}
use zip = new ZipArchive (file, ZipArchiveMode.Read)
let! theme = updateNameAndVersion theme zip

73
src/MyWebLog/Handlers/Feed.fs
View File

@@ -86,13 +86,13 @@ 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 array) (tagMaps: TagMap list)
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,
Id = webLog.AbsoluteUrl post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset(),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
@@ -115,30 +115,31 @@ let private toFeedItem webLog (authors: MetaItem list) (cats: DisplayCategory ar
[ post.CategoryIds
|> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.Id = string catId)
SyndicationCategory(cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
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 (string podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = string (defaultArg episode.Explicit podcast.Explicit)
@@ -234,22 +235,22 @@ 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
@@ -260,12 +261,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 =
@@ -275,19 +276,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
@@ -298,7 +299,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
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.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)
@@ -353,7 +354,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
@@ -371,36 +372,36 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
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

2
src/MyWebLog/Handlers/Helpers.fs
View File

@@ -234,7 +234,7 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler =
/// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun _ ctx -> task {
do! commitSession ctx
return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn ctx
return! redirectTo false (ctx.WebLog.RelativeUrl(Permalink url)) earlyReturn ctx
}

7
src/MyWebLog/Handlers/Page.fs
View File

@@ -28,7 +28,7 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.empty with Id = PageId "new"; AuthorId = ctx.UserId })
| "new" -> return Some ("Add a New Page", { Page.Empty with Id = PageId "new"; AuthorId = ctx.UserId })
| _ ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some page -> return Some ("Edit Page", page)
@@ -129,11 +129,10 @@ let private findPageRevision pgId revDate (ctx : HttpContext) = task {
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
rev.Text.AsHtml() |> addBaseToRelativeUrls extra
rev.Text.AsHtml() |> addBaseToRelativeUrls ctx.WebLog.ExtraPath
"</div>"
]
|> String.concat ""
@@ -179,7 +178,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.empty with
{ Page.Empty with
Id = PageId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId

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

@@ -42,7 +42,7 @@ open MyWebLog.ViewModels
let preparePostList webLog posts listType (url: string) pageNbr perPage (data: IData) = task {
let! authors = getAuthors webLog posts data
let! tagMappings = getTagMappings webLog posts data
let relUrl it = Some <| WebLog.relativeUrl webLog (Permalink it)
let relUrl it = Some <| webLog.RelativeUrl(Permalink it)
let postItems =
posts
|> Seq.ofList
@@ -115,7 +115,7 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
// GET /page/{pageNbr}/
let redirectToPageOfPosts (pageNbr : int) : HttpHandler = fun next ctx ->
redirectTo true (WebLog.relativeUrl ctx.WebLog (Permalink $"page/{pageNbr}")) next ctx
redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
// GET /category/{slug}/
// GET /category/{slug}/page/{pageNbr}
@@ -184,7 +184,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
return!
redirectTo true
(WebLog.relativeUrl webLog (Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
(webLog.RelativeUrl(Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
next ctx
| _ -> return! Error.notFound next ctx
| None, _, _ -> return! Error.notFound next ctx
@@ -223,7 +223,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
match postId with
| "new" -> return Some ("Write a New Post", { Post.empty with Id = PostId "new" })
| "new" -> return Some ("Write a New Post", { Post.Empty with Id = PostId "new" })
| _ ->
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post)
@@ -329,11 +329,10 @@ let private findPostRevision postId revDate (ctx : HttpContext) = task {
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
let _, extra = WebLog.hostAndPath ctx.WebLog
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
rev.Text.AsHtml() |> addBaseToRelativeUrls extra
rev.Text.AsHtml() |> addBaseToRelativeUrls ctx.WebLog.ExtraPath
"</div>"
]
|> String.concat ""
@@ -378,7 +377,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.empty with
{ Post.Empty with
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId

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

@@ -16,14 +16,14 @@ module CatchAll =
let data = ctx.Data
let debug = debug "Routes.CatchAll" ctx
let textLink =
let _, extra = WebLog.hostAndPath webLog
let url = string ctx.Request.Path
(if extra = "" then url else url.Substring extra.Length).ToLowerInvariant()
let extra = webLog.ExtraPath
let url = string ctx.Request.Path
(if extra = "" then url else url[..extra.Length]).ToLowerInvariant()
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
seq {
debug (fun () -> $"Considering URL {textLink}")
// Home page directory without the directory slash
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.Empty)
if textLink = "" then yield redirectTo true (webLog.RelativeUrl Permalink.Empty)
let permalink = Permalink textLink[1..]
// Current post
match data.Post.FindByPermalink permalink webLog.Id |> await with
@@ -56,25 +56,25 @@ module CatchAll =
match data.Post.FindByPermalink altLink webLog.Id |> await with
| Some post ->
debug (fun () -> "Found post by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog post.Permalink)
yield redirectTo true (webLog.RelativeUrl post.Permalink)
| None -> ()
// Page differing only by trailing slash
match data.Page.FindByPermalink altLink webLog.Id |> await with
| Some page ->
debug (fun () -> "Found page by trailing-slash-agnostic permalink")
yield redirectTo true (WebLog.relativeUrl webLog page.Permalink)
yield redirectTo true (webLog.RelativeUrl page.Permalink)
| None -> ()
// Prior post
match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link ->
debug (fun () -> "Found post by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link)
yield redirectTo true (webLog.RelativeUrl link)
| None -> ()
// Prior page
match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
| Some link ->
debug (fun () -> "Found page by prior permalink")
yield redirectTo true (WebLog.relativeUrl webLog link)
yield redirectTo true (webLog.RelativeUrl link)
| None -> ()
debug (fun () -> "No content found")
}
@@ -239,7 +239,7 @@ let routerWithPath extraPath : HttpHandler =
/// Handler to apply Giraffe routing with a possible sub-route
let handleRoute : HttpHandler = fun next ctx ->
let _, extraPath = WebLog.hostAndPath ctx.WebLog
let extraPath = ctx.WebLog.ExtraPath
(if extraPath = "" then router else routerWithPath extraPath) next ctx

2
src/MyWebLog/Handlers/Upload.fs
View File

@@ -146,7 +146,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant())
let now = Noda.now ()
let localNow = WebLog.localTime ctx.WebLog now
let localNow = ctx.WebLog.LocalTime now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel>()

16
src/MyWebLog/Handlers/User.fs
View File

@@ -122,7 +122,7 @@ let edit usrId : HttpHandler = fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
let tryUser =
if isNew then someTask { WebLogUser.empty with Id = userId }
if isNew then someTask { WebLogUser.Empty with Id = userId }
else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
match! tryUser with
| Some user -> return! showEdit (EditUserModel.fromUser user) next ctx
@@ -141,13 +141,13 @@ let delete userId : HttpHandler = fun next ctx -> task {
| Ok _ ->
do! addMessage ctx
{ UserMessage.success with
Message = $"User {WebLogUser.displayName user} deleted successfully"
Message = $"User {user.DisplayName} deleted successfully"
}
return! all next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.error with
Message = $"User {WebLogUser.displayName user} was not deleted"
Message = $"User {user.DisplayName} was not deleted"
Detail = Some msg
}
return! all next ctx
@@ -155,15 +155,13 @@ let delete userId : HttpHandler = fun next ctx -> task {
}
/// Display the user "my info" page, with information possibly filled in
let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandler = fun next ctx ->
let private showMyInfo (model: EditMyInfoModel) (user: WebLogUser) : HttpHandler = fun next ctx ->
hashForPage "Edit Your Information"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_level" (string user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> addToHash "created_on" (ctx.WebLog.LocalTime user.CreatedOn)
|> addToHash "last_seen_on" (ctx.WebLog.LocalTime (defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx
@@ -207,7 +205,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
{ WebLogUser.Empty with
Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now ()

6
src/MyWebLog/Maintenance.fs
View File

@@ -32,7 +32,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
let accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin
do! data.WebLog.Add
{ WebLog.empty with
{ WebLog.Empty with
Id = webLogId
Name = args[2]
Slug = slug
@@ -44,7 +44,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the admin user
let now = Noda.now ()
let user =
{ WebLogUser.empty with
{ WebLogUser.Empty with
Id = userId
WebLogId = webLogId
Email = args[3]
@@ -58,7 +58,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the default home page
do! data.Page.Add
{ Page.empty with
{ Page.Empty with
Id = homePageId
WebLogId = webLogId
AuthorId = userId