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

WIP on module/member conversion

Browse Source
This commit is contained in:
Daniel J. Summers
2023-12-15 22:46:12 -05:00
parent 7071d606f1
commit 5fe2077974
24 changed files with 548 additions and 565 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
src/MyWebLog/DotLiquidBespoke.fs
View File

@@ -101,10 +101,10 @@ type ThemeAssetFilter () =
/// Create various items in the page header based on the state of the page being generated
type PageHeadTag () =
inherit Tag ()
type PageHeadTag() =
inherit Tag()
override this.Render (context : Context, result : TextWriter) =
override this.Render(context: Context, result: TextWriter) =
let webLog = context.WebLog
// spacer
let s = " "
@@ -115,9 +115,9 @@ type PageHeadTag () =
// Theme assets
if assetExists "style.css" webLog then
result.WriteLine $"""{s}<link rel="stylesheet" href="{ThemeAssetFilter.ThemeAsset (context, "style.css")}">"""
result.WriteLine $"""{s}<link rel="stylesheet" href="{ThemeAssetFilter.ThemeAsset(context, "style.css")}">"""
if assetExists "favicon.ico" webLog then
result.WriteLine $"""{s}<link rel="icon" href="{ThemeAssetFilter.ThemeAsset (context, "favicon.ico")}">"""
result.WriteLine $"""{s}<link rel="icon" href="{ThemeAssetFilter.ThemeAsset(context, "favicon.ico")}">"""
// RSS feeds and canonical URLs
let feedLink title url =
@@ -126,16 +126,16 @@ type PageHeadTag () =
$"""{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(feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.Empty}">"""
if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
result.WriteLine(feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
if webLog.Rss.IsTagEnabled && getBool "is_tag_home" then
let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
result.WriteLine(feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
if getBool "is_post" then
let post = context.Environments[0].["model"] :?> PostDisplay

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

@@ -233,7 +233,7 @@ module RedirectRules =
if idx = -1 then
return!
hashForPage "Add Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.empty)
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.Empty)
|> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx
else
@@ -260,7 +260,7 @@ module RedirectRules =
let! model = ctx.BindFormAsync<EditRedirectRuleModel> ()
let isNew = idx = -1
let rules = ctx.WebLog.RedirectRules
let rule = model.UpdateRule (if isNew then RedirectRule.empty else List.item idx rules)
let rule = model.UpdateRule (if isNew then RedirectRule.Empty else List.item idx rules)
let newRules =
match isNew with
| true when model.InsertAtTop -> List.insertAt 0 rule rules
@@ -545,7 +545,7 @@ module WebLog =
match! TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data with
| Ok tagMapTemplate ->
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
let! themes = data.Theme.All()
let! users = data.WebLogUser.FindByWebLog ctx.WebLog.Id
let! hash =
hashForPage "Web Log Settings"
@@ -553,10 +553,10 @@ module WebLog =
|> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
KeyValuePair.Create("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
|> List.sortBy _.Title.ToLower()
|> List.map (fun p -> KeyValuePair.Create(p.Id.Value, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (

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

@@ -37,13 +37,12 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
| 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 it.Path.Value) 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
@@ -142,7 +141,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (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 epImageUrl = defaultArg episode.ImageUrl podcast.ImageUrl.Value |> toAbsolute webLog
let epExplicit = (defaultArg episode.Explicit podcast.Explicit).Value
let xmlDoc = XmlDocument()
@@ -310,8 +309,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
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))
podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, med.Value))
/// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx =
@@ -370,7 +368,7 @@ 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.Value}] \"{stripHtml post.Title}\" has no media"
item
| _ -> item
@@ -437,14 +435,14 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash "medium_values" [|
KeyValuePair.Create ("", "&ndash; Unspecified &ndash;")
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")
KeyValuePair.Create("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create(Podcast.Value, "Podcast")
KeyValuePair.Create(Music.Value, "Music")
KeyValuePair.Create(Video.Value, "Video")
KeyValuePair.Create(Film.Value, "Film")
KeyValuePair.Create(Audiobook.Value, "Audiobook")
KeyValuePair.Create(Newsletter.Value, "Newsletter")
KeyValuePair.Create(Blog.Value, "Blog")
|]
|> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx

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

@@ -133,7 +133,7 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
rev.Text.AsHtml() |> addBaseToRelativeUrls extra
"</div>"
]
|> String.concat ""
@@ -174,13 +174,13 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
// POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let! model = ctx.BindFormAsync<EditPageModel>()
let data = ctx.Data
let now = Noda.now ()
let tryPage =
if model.IsNew then
{ Page.empty with
Id = PageId.create ()
Id = PageId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
@@ -193,7 +193,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{PageId.toString page.Id}/edit" next ctx
return! redirectToGet $"admin/page/{page.Id.Value}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@@ -39,7 +39,7 @@ open MyWebLog.Data
open MyWebLog.ViewModels
/// Convert a list of posts into items ready to be displayed
let preparePostList webLog posts listType (url : string) pageNbr perPage (data : IData) = task {
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)
@@ -58,7 +58,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
| _ -> Task.FromResult (None, None)
let newerLink =
match listType, pageNbr with
| SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| SinglePost, _ -> newerPost |> Option.map _.Permalink.Value
| _, 1 -> None
| PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}"
@@ -70,7 +70,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
| AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink =
match listType, List.length posts > perPage with
| SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| SinglePost, _ -> olderPost |> Option.map _.Permalink.Value
| _, false -> None
| PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}"
@@ -81,9 +81,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
Authors = authors
Subtitle = None
NewerLink = newerLink
NewerName = newerPost |> Option.map (fun p -> p.Title)
NewerName = newerPost |> Option.map _.Title
OlderLink = olderLink
OlderName = olderPost |> Option.map (fun p -> p.Title)
OlderName = olderPost |> Option.map _.Title
}
return
makeHash {||}
@@ -333,7 +333,7 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
rev.Text.AsHtml() |> addBaseToRelativeUrls extra
"</div>"
]
|> String.concat ""
@@ -374,12 +374,12 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
// POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let! model = ctx.BindFormAsync<EditPostModel>()
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.empty with
Id = PostId.create ()
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
} |> someTask
@@ -410,7 +410,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{PostId.toString post.Id}/edit" next ctx
return! redirectToGet $"admin/post/{post.Id.Value}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@@ -11,20 +11,20 @@ module CatchAll =
open MyWebLog.ViewModels
/// Sequence where the first returned value is the proper handler for the link
let private deriveAction (ctx : HttpContext) : HttpHandler seq =
let private deriveAction (ctx: HttpContext): HttpHandler seq =
let webLog = ctx.WebLog
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 ()
(if extra = "" then url else url.Substring 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)
let permalink = Permalink (textLink.Substring 1)
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.Empty)
let permalink = Permalink textLink[1..]
// Current post
match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post ->
@@ -80,7 +80,7 @@ module CatchAll =
}
// GET {all-of-the-above}
let route : HttpHandler = fun next ctx ->
let route: HttpHandler = fun next ctx ->
match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx

14
src/MyWebLog/Maintenance.fs
View File

@@ -23,12 +23,12 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the web log
let webLogId = WebLogId.create ()
let userId = WebLogUserId.create ()
let homePageId = PageId.create ()
let homePageId = PageId.Create()
let slug = Handlers.Upload.makeSlug args[2]
// If this is the first web log being created, the user will be an installation admin; otherwise, they will be an
// admin just over their web log
let! webLogs = data.WebLog.All ()
let! webLogs = data.WebLog.All()
let accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin
do! data.WebLog.Add
@@ -37,7 +37,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
Name = args[2]
Slug = slug
UrlBase = args[1]
DefaultPage = PageId.toString homePageId
DefaultPage = homePageId.Value
TimeZone = timeZone
}
@@ -110,8 +110,8 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.PriorPermalinks)
printfn $"{Permalink.toString old} -> {Permalink.toString current}"
| None -> eprintfn $"Cannot find current post for {Permalink.toString current}"
printfn $"{old.Value} -> {current.Value}"
| None -> eprintfn $"Cannot find current post for {current.Value}"
printfn "Done!"
| None -> eprintfn $"No web log found at {urlBase}"
}
@@ -336,8 +336,8 @@ module Backup =
let newWebLogId = WebLogId.create ()
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create ()) |> dict
let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.Create ()) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.Create ()) |> dict
let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict
let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict
return