diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index bb411aa..1e802aa 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -204,26 +204,6 @@ type DisplayPage = { } -/// Information about a revision used for display -[] -type DisplayRevision = { - /// The as-of date/time for the revision - AsOf: DateTime - - /// The as-of date/time for the revision in the web log's local time zone - AsOfLocal: DateTime - - /// The format of the text of the revision - Format: string -} with - - /// Create a display revision from an actual revision - static member FromRevision (webLog: WebLog) (rev : Revision) = - { AsOf = rev.AsOf.ToDateTimeUtc() - AsOfLocal = webLog.LocalTime rev.AsOf - Format = rev.Text.SourceType } - - open System.IO /// Information about a theme used for display @@ -1180,22 +1160,22 @@ type ManageRevisionsModel = { CurrentTitle: string /// The revisions for the page or post - Revisions: DisplayRevision array + Revisions: Revision list } with /// Create a revision model from a page - static member FromPage webLog (page: Page) = + static member FromPage (page: Page) = { Id = string page.Id Entity = "page" CurrentTitle = page.Title - Revisions = page.Revisions |> List.map (DisplayRevision.FromRevision webLog) |> Array.ofList } + Revisions = page.Revisions } /// Create a revision model from a post - static member FromPost webLog (post: Post) = + static member FromPost (post: Post) = { Id = string post.Id Entity = "post" CurrentTitle = post.Title - Revisions = post.Revisions |> List.map (DisplayRevision.FromRevision webLog) |> Array.ofList } + Revisions = post.Revisions } /// View model for posts in a list diff --git a/src/MyWebLog.Tests/Domain/ViewModelsTests.fs b/src/MyWebLog.Tests/Domain/ViewModelsTests.fs index e00af60..a4bb736 100644 --- a/src/MyWebLog.Tests/Domain/ViewModelsTests.fs +++ b/src/MyWebLog.Tests/Domain/ViewModelsTests.fs @@ -179,17 +179,6 @@ let displayPageTests = testList "DisplayPage" [ ] ] -/// Unit tests for the DisplayRevision type -let displayRevisionTests = test "DisplayRevision.FromRevision succeeds" { - let model = - DisplayRevision.FromRevision - { WebLog.Empty with TimeZone = "Etc/GMT+1" } - { Text = Html "howdy"; AsOf = Noda.epoch } - Expect.equal model.AsOf (Noda.epoch.ToDateTimeUtc()) "AsOf not filled properly" - Expect.equal model.AsOfLocal ((Noda.epoch - Duration.FromHours 1).ToDateTimeUtc()) "AsOfLocal not filled properly" - Expect.equal model.Format "HTML" "Format not filled properly" -} - open System.IO /// Unit tests for the DisplayTheme type @@ -1346,7 +1335,6 @@ let all = testList "ViewModels" [ displayChapterTests displayCustomFeedTests displayPageTests - displayRevisionTests displayThemeTests displayUploadTests displayUserTests diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index 660c215..fe1c9d7 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -228,16 +228,10 @@ let register () = typeof; typeof; typeof; typeof; typeof typeof; typeof; typeof; typeof; typeof // View models - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof // Framework types typeof; typeof; typeof; typeof typeof; typeof; typeof; typeof diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index e04a9b1..d00239d 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -27,45 +27,35 @@ module Dashboard = ListedPages = listed Categories = cats TopLevelCategories = topCats } - return! adminPage "Dashboard" false (Views.Admin.dashboard model) next ctx + return! adminPage "Dashboard" false next ctx (Views.Admin.dashboard model) } // GET /admin/administration let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { - match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with - | Ok bodyTemplate -> - let! themes = ctx.Data.Theme.All() - let cachedTemplates = TemplateCache.allNames () - let! hash = - hashForPage "myWebLog Administration" - |> withAntiCsrf ctx - |> addToHash "themes" ( - themes - |> List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) - |> Array.ofList) - |> addToHash "cached_themes" ( - themes - |> Seq.ofList - |> Seq.map (fun it -> [| - string it.Id - it.Name - cachedTemplates - |> List.filter _.StartsWith(string it.Id) - |> List.length - |> string - |]) - |> Array.ofSeq) - |> addToHash "web_logs" ( - WebLogCache.all () - |> Seq.ofList - |> Seq.sortBy _.Name - |> Seq.map (fun it -> [| string it.Id; it.Name; it.UrlBase |]) - |> Array.ofSeq) - |> addViewContext ctx - return! - addToHash "theme_list" (bodyTemplate.Render hash) hash - |> adminView "admin-dashboard" next ctx - | Error message -> return! Error.server message next ctx + let! themes = ctx.Data.Theme.All() + let cachedTemplates = TemplateCache.allNames () + return! + hashForPage "myWebLog Administration" + |> withAntiCsrf ctx + |> addToHash "cached_themes" ( + themes + |> Seq.ofList + |> Seq.map (fun it -> [| + string it.Id + it.Name + cachedTemplates + |> List.filter _.StartsWith(string it.Id) + |> List.length + |> string + |]) + |> Array.ofSeq) + |> addToHash "web_logs" ( + WebLogCache.all () + |> Seq.ofList + |> Seq.sortBy _.Name + |> Seq.map (fun it -> [| string it.Id; it.Name; it.UrlBase |]) + |> Array.ofSeq) + |> adminView "admin-dashboard" next ctx } /// Redirect the user to the admin dashboard @@ -215,11 +205,11 @@ module RedirectRules = // GET /admin/settings/redirect-rules let all : HttpHandler = fun next ctx -> - adminPage "Redirect Rules" true (Views.Admin.redirectList ctx.WebLog.RedirectRules) next ctx + adminPage "Redirect Rules" true next ctx (Views.Admin.redirectList ctx.WebLog.RedirectRules) // GET /admin/settings/redirect-rules/[index] let edit idx : HttpHandler = fun next ctx -> - let titleAndModel = + let titleAndView = if idx = -1 then Some ("Add", Views.Admin.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty)) else @@ -228,8 +218,8 @@ module RedirectRules = None else Some ("Edit", (Views.Admin.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules)))) - match titleAndModel with - | Some (title, model) -> adminBarePage $"{title} Redirect Rule" true model next ctx + match titleAndView with + | Some (title, view) -> adminBarePage $"{title} Redirect Rule" true next ctx view | None -> Error.notFound next ctx /// Update the web log's redirect rules in the database, the request web log, and the web log cache @@ -294,7 +284,7 @@ module TagMapping = // GET /admin/settings/tag-mappings let all : HttpHandler = fun next ctx -> task { let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id - return! adminBarePage "Tag Mapping List" true (Views.Admin.tagMapList mappings) next ctx + return! adminBarePage "Tag Mapping List" true next ctx (Views.Admin.tagMapList mappings) } // GET /admin/settings/tag-mapping/{id}/edit @@ -306,9 +296,8 @@ module TagMapping = match! tagMap with | Some tm -> return! - adminBarePage - (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") true - (Views.Admin.tagMapEdit (EditTagMapModel.FromMapping tm)) next ctx + Views.Admin.tagMapEdit (EditTagMapModel.FromMapping tm) + |> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") true next ctx | None -> return! Error.notFound next ctx } @@ -349,17 +338,13 @@ module Theme = let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { let! themes = ctx.Data.Theme.All () return! - hashForPage "Themes" - |> withAntiCsrf ctx - |> addToHash "themes" (themes |> List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) |> Array.ofList) - |> adminBareView "theme-list-body" next ctx + Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes) + |> adminBarePage "Themes" true next ctx } // GET /admin/theme/new let add : HttpHandler = requireAccess Administrator >=> fun next ctx -> - hashForPage "Upload a Theme File" - |> withAntiCsrf ctx - |> adminBareView "theme-upload" next ctx + adminBarePage "Upload a Theme File" true next ctx Views.Admin.themeUpload /// Update the name and version for a theme based on the version.txt file, if present let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask { diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index 00f7274..e78a580 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -282,8 +282,9 @@ module Error = let notAuthorized : HttpHandler = fun next ctx -> if ctx.Request.Method = "GET" then let redirectUrl = $"user/log-on?returnUrl={WebUtility.UrlEncode ctx.Request.Path}" - if isHtmx ctx then (withHxRedirect redirectUrl >=> redirectToGet redirectUrl) next ctx - else redirectToGet redirectUrl next ctx + (next, ctx) + ||> if isHtmx ctx then withHxRedirect redirectUrl >=> withHxRetarget "body" >=> redirectToGet redirectUrl + else redirectToGet redirectUrl else if isHtmx ctx then let messages = [| @@ -370,7 +371,7 @@ let adminBareView template = bareForTheme adminTheme template /// Display a page for an admin endpoint -let adminPage pageTitle includeCsrf (content: AppViewContext -> XmlNode list) : HttpHandler = fun next ctx -> task { +let adminPage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task { let! messages = getCurrentMessages ctx let appCtx = generateViewContext pageTitle messages includeCsrf ctx let layout = if isHtmx ctx then Layout.partial else Layout.full @@ -378,7 +379,7 @@ let adminPage pageTitle includeCsrf (content: AppViewContext -> XmlNode list) : } /// Display a bare page for an admin endpoint -let adminBarePage pageTitle includeCsrf (content: AppViewContext -> XmlNode list) : HttpHandler = fun next ctx -> task { +let adminBarePage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task { let! messages = getCurrentMessages ctx let appCtx = generateViewContext pageTitle messages includeCsrf ctx return! @@ -471,13 +472,12 @@ let getCategoryIds slug ctx = |> Seq.map (fun c -> CategoryId c.Id) |> List.ofSeq -open System -open System.Globalization open NodaTime /// Parse a date/time to UTC -let parseToUtc (date: string) = - Instant.FromDateTimeUtc(DateTime.Parse(date, null, DateTimeStyles.AdjustToUniversal)) +let parseToUtc (date: string) : Instant = + let result = roundTrip.Parse date + if result.Success then result.Value else raise result.Exception open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.Logging diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 28b8074..5cf619b 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -66,10 +66,9 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with | Some pg when canEdit pg.AuthorId ctx -> return! - hashForPage "Manage Prior Permalinks" - |> withAntiCsrf ctx - |> addToHash ViewContext.Model (ManagePermalinksModel.FromPage pg) - |> adminView "permalinks" next ctx + ManagePermalinksModel.FromPage pg + |> Views.Helpers.managePermalinks + |> adminPage "Manage Prior Permalinks" true next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } @@ -95,15 +94,14 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with | Some pg when canEdit pg.AuthorId ctx -> return! - hashForPage "Manage Page Revisions" - |> withAntiCsrf ctx - |> addToHash ViewContext.Model (ManageRevisionsModel.FromPage ctx.WebLog pg) - |> adminView "revisions" next ctx + ManageRevisionsModel.FromPage pg + |> Views.Helpers.manageRevisions + |> adminPage "Manage Page Revisions" true next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } -// GET /admin/page/{id}/revisions/purge +// DELETE /admin/page/{id}/revisions let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with @@ -158,7 +156,7 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun | _, None -> return! Error.notFound next ctx } -// POST /admin/page/{id}/revision/{revision-date}/delete +// DELETE /admin/page/{id}/revision/{revision-date} let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPageRevision pgId revDate ctx with | Some pg, Some rev when canEdit pg.AuthorId ctx -> diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index 0555999..8e0cdb4 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -254,7 +254,7 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25 let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data - return! adminPage "Posts" true (Views.Post.list (hash[ViewContext.Model] :?> PostDisplay)) next ctx + return! adminPage "Posts" true next ctx (Views.Post.list (hash[ViewContext.Model] :?> PostDisplay)) } // GET /admin/post/{id}/edit @@ -305,10 +305,9 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post when canEdit post.AuthorId ctx -> return! - hashForPage "Manage Prior Permalinks" - |> withAntiCsrf ctx - |> addToHash ViewContext.Model (ManagePermalinksModel.FromPost post) - |> adminView "permalinks" next ctx + ManagePermalinksModel.FromPost post + |> Views.Helpers.managePermalinks + |> adminPage "Manage Prior Permalinks" true next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } @@ -334,15 +333,14 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx - match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post when canEdit post.AuthorId ctx -> return! - hashForPage "Manage Post Revisions" - |> withAntiCsrf ctx - |> addToHash ViewContext.Model (ManageRevisionsModel.FromPost ctx.WebLog post) - |> adminView "revisions" next ctx + ManageRevisionsModel.FromPost post + |> Views.Helpers.manageRevisions + |> adminPage "Manage Post Revisions" true next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } -// GET /admin/post/{id}/revisions/purge +// DELETE /admin/post/{id}/revisions let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with @@ -398,7 +396,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f | _, None -> return! Error.notFound next ctx } -// POST /admin/post/{id}/revision/{revision-date}/delete +// DELETE /admin/post/{id}/revision/{revision-date} let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPostRevision postId revDate ctx with | Some post, Some rev when canEdit post.AuthorId ctx -> @@ -418,7 +416,8 @@ let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx && Option.isSome post.Episode.Value.Chapters && canEdit post.AuthorId ctx -> return! - adminPage "Manage Chapters" true (Views.Post.chapters false (ManageChaptersModel.Create post)) next ctx + Views.Post.chapters false (ManageChaptersModel.Create post) + |> adminPage "Manage Chapters" true next ctx | Some _ | None -> return! Error.notFound next ctx } @@ -437,9 +436,8 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex match chapter with | Some chap -> return! - adminBarePage - (if index = -1 then "Add a Chapter" else "Edit Chapter") true - (Views.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)) next ctx + Views.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap) + |> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") true next ctx | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx } @@ -466,9 +464,8 @@ let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex do! data.Post.Update updatedPost do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" } return! - adminPage - "Manage Chapters" true - (Views.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)) next ctx + Views.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost) + |> adminPage "Manage Chapters" true next ctx with | ex -> return! Error.server ex.Message next ctx else return! Error.notFound next ctx @@ -491,9 +488,8 @@ let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun n do! data.Post.Update updatedPost do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" } return! - adminPage - "Manage Chapters" true (Views.Post.chapterList false (ManageChaptersModel.Create updatedPost)) next - ctx + Views.Post.chapterList false (ManageChaptersModel.Create updatedPost) + |> adminPage "Manage Chapters" true next ctx else return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index a4ef6f9..f0db9ca 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -176,17 +176,13 @@ let router : HttpHandler = choose [ route "/save" >=> Page.save route "/permalinks" >=> Page.savePermalinks routef "/%s/delete" Page.delete - routef "/%s/revision/%s/delete" Page.deleteRevision routef "/%s/revision/%s/restore" Page.restoreRevision - routef "/%s/revisions/purge" Page.purgeRevisions ]) subRoute "/post" (choose [ route "/save" >=> Post.save route "/permalinks" >=> Post.savePermalinks routef "/%s/chapter/%i" Post.saveChapter - routef "/%s/revision/%s/delete" Post.deleteRevision routef "/%s/revision/%s/restore" Post.restoreRevision - routef "/%s/revisions/purge" Post.purgeRevisions ]) subRoute "/settings" (requireAccess WebLogAdmin >=> choose [ route "" >=> Admin.WebLog.saveSettings @@ -214,9 +210,15 @@ let router : HttpHandler = choose [ ]) ] DELETE >=> validateCsrf >=> choose [ + subRoute "/page" (choose [ + routef "/%s/revision/%s" Page.deleteRevision + routef "/%s/revisions" Page.purgeRevisions + ]) subRoute "/post" (choose [ - routef "/%s" Post.delete - routef "/%s/chapter/%i" Post.deleteChapter + routef "/%s" Post.delete + routef "/%s/chapter/%i" Post.deleteChapter + routef "/%s/revision/%s" Post.deleteRevision + routef "/%s/revisions" Post.purgeRevisions ]) subRoute "/settings" (requireAccess WebLogAdmin >=> choose [ routef "/user/%s" User.delete diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index fbd1734..5f972ac 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -35,7 +35,7 @@ let logOn returnUrl : HttpHandler = fun next ctx -> match returnUrl with | Some _ -> returnUrl | None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None - adminPage "Log On" true (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo }) next ctx + adminPage "Log On" true next ctx (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo }) open System.Security.Claims @@ -91,12 +91,12 @@ let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?" // GET /admin/settings/users let all : HttpHandler = fun next ctx -> task { let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id - return! adminBarePage "User Administration" true (Views.User.userList users) next ctx + return! adminBarePage "User Administration" true next ctx (Views.User.userList users) } /// Show the edit user page let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx -> - adminBarePage (if model.IsNew then "Add a New User" else "Edit User") true (Views.User.edit model) next ctx + adminBarePage (if model.IsNew then "Add a New User" else "Edit User") true next ctx (Views.User.edit model) // GET /admin/settings/user/{id}/edit let edit usrId : HttpHandler = fun next ctx -> task { @@ -137,7 +137,9 @@ let delete userId : HttpHandler = fun next ctx -> task { let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with | Some user -> - return! adminPage "Edit Your Information" true (Views.User.myInfo (EditMyInfoModel.FromUser user) user) next ctx + return! + Views.User.myInfo (EditMyInfoModel.FromUser user) user + |> adminPage "Edit Your Information" true next ctx | None -> return! Error.notFound next ctx } @@ -161,9 +163,8 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { | Some user -> do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" } return! - adminPage - "Edit Your Information" true - (Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user) next ctx + Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user + |> adminPage "Edit Your Information" true next ctx | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Views/Admin.fs b/src/MyWebLog/Views/Admin.fs index 7e4aac1..f773b46 100644 --- a/src/MyWebLog/Views/Admin.fs +++ b/src/MyWebLog/Views/Admin.fs @@ -293,3 +293,91 @@ let tagMapList (model: TagMap list) app = ] ] |> List.singleton + + +/// Display a list of themes +let themeList (model: DisplayTheme list) app = + let themeCol = "col-12 col-md-6" + let slugCol = "d-none d-md-block col-md-3" + let tmplCol = "d-none d-md-block col-md-3" + div [ _id "theme_panel" ] [ + a [ _href (relUrl app "admin/theme/new"); _class "btn btn-primary btn-sm mb-3"; _hxTarget "#theme_new" ] [ + raw "Upload a New Theme" + ] + div [ _class "container g-0" ] [ + div [ _class "row mwl-table-heading" ] [ + div [ _class themeCol ] [ raw "Theme" ] + div [ _class slugCol ] [ raw "Slug" ] + div [ _class tmplCol ] [ raw "Templates" ] + ] + ] + div [ _class "row mwl-table-detail"; _id "theme_new" ] [] + form [ _method "post"; _id "themeList"; _class "container g-0"; _hxTarget "#theme_panel" + _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [ + antiCsrf app + for theme in model do + let url = relUrl app $"admin/theme/{theme.Id}" + div [ _class "row mwl-table-detail"; _id $"theme_{theme.Id}" ] [ + div [ _class $"{themeCol} no-wrap" ] [ + txt theme.Name + if theme.IsInUse then span [ _class "badge bg-primary ms-2" ] [ raw "IN USE" ] + if not theme.IsOnDisk then + span [ _class "badge bg-warning text-dark ms-2" ] [ raw "NOT ON DISK" ] + br [] + small [] [ + span [ _class "text-muted" ] [ txt $"v{theme.Version}" ] + if not (theme.IsInUse || theme.Id = "default") then + span [ _class "text-muted" ] [ raw " • " ] + a [ _href url; _hxDelete url; _class "text-danger" + _hxConfirm $"Are you sure you want to delete the theme “{theme.Name}”? This action cannot be undone." ] [ + raw "Delete" + ] + span [ _class "d-md-none text-muted" ] [ + br []; raw "Slug: "; txt theme.Id; raw $" • {theme.TemplateCount} Templates" + ] + ] + ] + div [ _class slugCol ] [ txt (string theme.Id) ] + div [ _class tmplCol ] [ txt (string theme.TemplateCount) ] + ] + ] + ] + |> List.singleton + + +/// Form to allow a theme to be uploaded +let themeUpload app = + div [ _class "col" ] [ + h5 [ _class "mt-2" ] [ raw app.PageTitle ] + form [ _action (relUrl app "admin/theme/new"); _method "post"; _class "container" + _enctype "multipart/form-data"; _hxNoBoost ] [ + antiCsrf app + div [ _class "row " ] [ + div [ _class "col-12 col-sm-6 pb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "file"; _id "file"; _name "file"; _class "form-control"; _accept ".zip" + _placeholder "Theme File"; _required ] + label [ _for "file" ] [ raw "Theme File" ] + ] + ] + div [ _class "col-12 col-sm-6 pb-3 d-flex justify-content-center align-items-center" ] [ + div [ _class "form-check form-switch pb-2" ] [ + input [ _type "checkbox"; _name "DoOverwrite"; _id "doOverwrite"; _class "form-check-input" + _value "true" ] + label [ _for "doOverwrite"; _class "form-check-label" ] [ raw "Overwrite" ] + ] + ] + ] + div [ _class "row pb-3" ] [ + div [ _class "col text-center" ] [ + button [ _type "submit"; _class "btn btn-sm btn-primary" ] [ raw "Upload Theme" ]; raw "   " + button [ _type "button"; _class "btn btn-sm btn-secondary ms-3" + _onclick "document.getElementById('theme_new').innerHTML = ''" ] [ + raw "Cancel" + ] + ] + ] + ] + ] + |> List.singleton + \ No newline at end of file diff --git a/src/MyWebLog/Views/Helpers.fs b/src/MyWebLog/Views/Helpers.fs index cd09280..ab28e95 100644 --- a/src/MyWebLog/Views/Helpers.fs +++ b/src/MyWebLog/Views/Helpers.fs @@ -232,3 +232,139 @@ module Layout = title [] [] yield! content app ] + + +// ~~ SHARED TEMPLATES BETWEEN POSTS AND PAGES +open Giraffe.Htmx.Common + +/// The round-trip instant pattern +let roundTrip = InstantPattern.CreateWithInvariantCulture "uuuu'-'MM'-'dd'T'HH':'mm':'ss'.'fffffff" + +/// Capitalize the first letter in the given string +let private capitalize (it: string) = + $"{(string it[0]).ToUpper()}{it[1..]}" + +/// Form to manage permalinks for pages or posts +let managePermalinks (model: ManagePermalinksModel) app = [ + let baseUrl = relUrl app $"admin/{model.Entity}/" + let linkDetail idx link = + div [ _id $"link_%i{idx}"; _class "row mb-3" ] [ + div [ _class "col-1 text-center align-self-center" ] [ + button [ _type "button"; _class "btn btn-sm btn-danger" + _onclick $"Admin.removePermalink({idx})" ] [ + raw "−" + ] + ] + div [ _class "col-11" ] [ + div [ _class "form-floating" ] [ + input [ _type "text"; _name "Prior"; _id $"prior_{idx}"; _class "form-control"; _placeholder "Link" + _value link ] + label [ _for $"prior_{idx}" ] [ raw "Link" ] + ] + ] + ] + h2 [ _class "my-3" ] [ raw app.PageTitle ] + article [] [ + form [ _action $"{baseUrl}permalinks"; _method "post"; _class "container" ] [ + antiCsrf app + input [ _type "hidden"; _name "Id"; _value model.Id ] + div [ _class "row" ] [ + div [ _class "col" ] [ + p [ _style "line-height:1.2rem;" ] [ + strong [] [ txt model.CurrentTitle ]; br [] + small [ _class "text-muted" ] [ + span [ _class "fst-italic" ] [ txt model.CurrentPermalink ]; br [] + a [ _href $"{baseUrl}{model.Id}/edit" ] [ + raw $"« Back to Edit {capitalize model.Entity}" + ] + ] + ] + ] + ] + div [ _class "row mb-3" ] [ + div [ _class "col" ] [ + button [ _type "button"; _class "btn btn-sm btn-secondary"; _onclick "Admin.addPermalink()" ] [ + raw "Add a Permalink" + ] + ] + ] + div [ _class "row mb-3" ] [ + div [ _class "col" ] [ + div [ _id "permalinks"; _class "container g-0" ] [ + yield! Array.mapi linkDetail model.Prior + script [] [ + raw """document.addEventListener(\"DOMContentLoaded\", """ + raw $"() => Admin.setPermalinkIndex({model.Prior.Length}))" + ] + ] + ] + ] + div [ _class "row pb-3" ] [ + div [ _class "col " ] [ + button [ _type "submit"; _class "btn btn-primary" ] [ raw "Save Changes" ] + ] + ] + ] + ] +] + +/// Form to manage revisions for pages or posts +let manageRevisions (model: ManageRevisionsModel) app = [ + let revUrlBase = relUrl app $"admin/{model.Entity}/{model.Id}/revision" + let revDetail idx (rev: Revision) = + let asOfString = roundTrip.Format rev.AsOf + let asOfId = $"""rev_{asOfString.Replace(".", "_").Replace(":", "-")}""" + div [ _id asOfId; _class "row pb-3 mwl-table-detail" ] [ + div [ _class "col-12 mb-1" ] [ + longDate app rev.AsOf; raw " at "; shortTime app rev.AsOf; raw " " + span [ _class "badge bg-secondary text-uppercase ms-2" ] [ txt (string rev.Text.SourceType) ] + if idx = 0 then span [ _class "badge bg-primary text-uppercase ms-2" ] [ raw "Current Revision" ] + br [] + if idx > 0 then + let revUrlPrefix = $"{revUrlBase}/{asOfString}" + let revRestore = $"{revUrlPrefix}/restore" + small [] [ + a [ _href $"{revUrlPrefix}/preview"; _hxTarget $"#{asOfId}_preview" ] [ raw "Preview" ] + span [ _class "text-muted" ] [ raw " • " ] + a [ _href revRestore; _hxPost revRestore ] [ raw "Restore as Current" ] + span [ _class "text-muted" ] [ raw " • " ] + a [ _href revUrlPrefix; _hxDelete revUrlPrefix; _hxTarget $"#{asOfId}" + _hxSwap HxSwap.OuterHtml; _class "text-danger" ] [ + raw "Delete" + ] + ] + ] + if idx > 0 then div [ _id $"{asOfId}_preview"; _class "col-12" ] [] + ] + + h2 [ _class "my-3" ] [ raw app.PageTitle ] + article [] [ + form [ _method "post"; _hxTarget "body"; _class "container mb-3" ] [ + antiCsrf app + input [ _type "hidden"; _name "Id"; _value model.Id ] + div [ _class "row" ] [ + div [ _class "col" ] [ + p [ _style "line-height:1.2rem;" ] [ + strong [] [ txt model.CurrentTitle ]; br [] + small [ _class "text-muted" ] [ + a [ _href (relUrl app $"admin/{model.Entity}/{model.Id}/edit") ] [ + raw $"« Back to Edit {(string model.Entity[0]).ToUpper()}{model.Entity[1..]}" + ] + ] + ] + ] + ] + if model.Revisions.Length > 1 then + div [ _class "row mb-3" ] [ + div [ _class "col" ] [ + button [ _type "button"; _class "btn btn-sm btn-danger"; _hxDelete $"{revUrlBase}s/purge" + _hxConfirm "This will remove all revisions but the current one; are you sure this is what you wish to do?" ] [ + raw "Delete All Prior Revisions" + ] + ] + ] + div [ _class "row mwl-table-heading" ] [ div [ _class "col" ] [ raw "Revision" ] ] + yield! List.mapi revDetail model.Revisions + ] + ] +] diff --git a/src/MyWebLog/Views/User.fs b/src/MyWebLog/Views/User.fs index 90c0116..98c9dc2 100644 --- a/src/MyWebLog/Views/User.fs +++ b/src/MyWebLog/Views/User.fs @@ -13,7 +13,7 @@ let edit (model: EditUserModel) app = div [ _class "col-12" ] [ h5 [ _class "my-3" ] [ txt app.PageTitle ] form [ _hxPost (relUrl app "admin/settings/user/save"); _method "post"; _class "container" - _hxTarget "#userList"; _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [ + _hxTarget "#user_panel"; _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [ antiCsrf app input [ _type "hidden"; _name "Id"; _value model.Id ] div [ _class "row" ] [ @@ -163,56 +163,77 @@ let logOn (model: LogOnModel) (app: AppViewContext) = [ /// The list of users for a web log (part of web log settings page) let userList (model: WebLogUser list) app = - let badge = "ms-2 badge bg" - div [ _id "userList" ] [ - div [ _class "container g-0" ] [ - div [ _class "row mwl-table-detail"; _id "user_new" ] [] - ] - form [ _method "post"; _class "container g-0"; _hxTarget "this" - _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [ - antiCsrf app - for user in model do - div [ _class "row mwl-table-detail"; _id $"user_{user.Id}" ] [ - div [ _class "col-12 col-md-4 col-xl-3 no-wrap" ] [ - txt user.PreferredName; raw " " - match user.AccessLevel with - | Administrator -> span [ _class $"{badge}-success" ] [ raw "ADMINISTRATOR" ] - | WebLogAdmin -> span [ _class $"{badge}-primary" ] [ raw "WEB LOG ADMIN" ] - | Editor -> span [ _class $"{badge}-secondary" ] [ raw "EDITOR" ] - | Author -> span [ _class $"{badge}-dark" ] [ raw "AUTHOR" ] - br [] - if app.IsAdministrator || (app.IsWebLogAdmin && not (user.AccessLevel = Administrator)) then - let userUrl = relUrl app $"admin/settings/user/{user.Id}" - small [] [ - a [ _href $"{userUrl}/edit"; _hxTarget $"#user_{user.Id}" - _hxSwap $"{HxSwap.InnerHtml} show:#user_{user.Id}:top" ] [ - raw "Edit" - ] - if app.UserId.Value <> user.Id then - span [ _class "text-muted" ] [ raw " • " ] - a [ _href userUrl; _hxDelete userUrl; _class "text-danger" - _hxConfirm $"Are you sure you want to delete the user “{user.PreferredName}”? This action cannot be undone. (This action will not succeed if the user has authored any posts or pages.)" ] [ - raw "Delete" - ] + let userCol = "col-12 col-md-4 col-xl-3" + let emailCol = "col-12 col-md-4 col-xl-4" + let cre8Col = "d-none d-xl-block col-xl-2" + let lastCol = "col-12 col-md-4 col-xl-3" + let badge = "ms-2 badge bg" + let userDetail (user: WebLogUser) = + div [ _class "row mwl-table-detail"; _id $"user_{user.Id}" ] [ + div [ _class $"{userCol} no-wrap" ] [ + txt user.PreferredName; raw " " + match user.AccessLevel with + | Administrator -> span [ _class $"{badge}-success" ] [ raw "ADMINISTRATOR" ] + | WebLogAdmin -> span [ _class $"{badge}-primary" ] [ raw "WEB LOG ADMIN" ] + | Editor -> span [ _class $"{badge}-secondary" ] [ raw "EDITOR" ] + | Author -> span [ _class $"{badge}-dark" ] [ raw "AUTHOR" ] + br [] + if app.IsAdministrator || (app.IsWebLogAdmin && not (user.AccessLevel = Administrator)) then + let userUrl = relUrl app $"admin/settings/user/{user.Id}" + small [] [ + a [ _href $"{userUrl}/edit"; _hxTarget $"#user_{user.Id}" + _hxSwap $"{HxSwap.InnerHtml} show:#user_{user.Id}:top" ] [ + raw "Edit" + ] + if app.UserId.Value <> user.Id then + span [ _class "text-muted" ] [ raw " • " ] + a [ _href userUrl; _hxDelete userUrl; _class "text-danger" + _hxConfirm $"Are you sure you want to delete the user “{user.PreferredName}”? This action cannot be undone. (This action will not succeed if the user has authored any posts or pages.)" ] [ + raw "Delete" ] ] - div [ _class "col-12 col-md-4 col-xl-4" ] [ - txt $"{user.FirstName} {user.LastName}"; br [] - small [ _class "text-muted" ] [ - txt user.Email - if Option.isSome user.Url then - br []; txt user.Url.Value - ] - ] - div [ _class "d-none d-xl-block col-xl-2" ] [ - if user.CreatedOn = Noda.epoch then raw "N/A" else longDate app user.CreatedOn - ] - div [ _class "col-12 col-md-4 col-xl-3" ] [ - match user.LastSeenOn with - | Some it -> longDate app it; raw " at "; shortTime app it - | None -> raw "--" - ] + ] + div [ _class emailCol ] [ + txt $"{user.FirstName} {user.LastName}"; br [] + small [ _class "text-muted" ] [ + txt user.Email + if Option.isSome user.Url then + br []; txt user.Url.Value ] + ] + div [ _class "d-none d-xl-block col-xl-2" ] [ + if user.CreatedOn = Noda.epoch then raw "N/A" else longDate app user.CreatedOn + ] + div [ _class "col-12 col-md-4 col-xl-3" ] [ + match user.LastSeenOn with + | Some it -> longDate app it; raw " at "; shortTime app it + | None -> raw "--" + ] + ] + div [ _id "user_panel" ] [ + a [ _href (relUrl app "admin/settings/user/new/edit"); _class "btn btn-primary btn-sm mb-3" + _hxTarget "#user_new" ] [ + raw "Add a New User" + ] + div [ _class "container g-0" ] [ + div [ _class "row mwl-table-heading" ] [ + div [ _class userCol ] [ + raw "User"; span [ _class "d-md-none" ] [ raw "; Full Name / E-mail; Last Log On" ] + ] + div [ _class $"{emailCol} d-none d-md-inline-block" ] [ raw "Full Name / E-mail" ] + div [ _class cre8Col ] [ raw "Created" ] + div [ _class $"{lastCol} d-none d-md-block" ] [ raw "Last Log On" ] + ] + ] + div [ _id "userList" ] [ + div [ _class "container g-0" ] [ + div [ _class "row mwl-table-detail"; _id "user_new" ] [] + ] + form [ _method "post"; _class "container g-0"; _hxTarget "#user_panel" + _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [ + antiCsrf app + yield! List.map userDetail model + ] ] ] |> List.singleton diff --git a/src/admin-theme/_theme-list-columns.liquid b/src/admin-theme/_theme-list-columns.liquid deleted file mode 100644 index 18b9282..0000000 --- a/src/admin-theme/_theme-list-columns.liquid +++ /dev/null @@ -1,3 +0,0 @@ -{%- assign theme_col = "col-12 col-md-6" -%} -{%- assign slug_col = "d-none d-md-block col-md-3" -%} -{%- assign tmpl_col = "d-none d-md-block col-md-3" -%} diff --git a/src/admin-theme/_user-list-columns.liquid b/src/admin-theme/_user-list-columns.liquid deleted file mode 100644 index 74b6626..0000000 --- a/src/admin-theme/_user-list-columns.liquid +++ /dev/null @@ -1,4 +0,0 @@ -{%- assign user_col = "col-12 col-md-4 col-xl-3" -%} -{%- assign email_col = "col-12 col-md-4 col-xl-4" -%} -{%- assign cre8_col = "d-none d-xl-block col-xl-2" -%} -{%- assign last_col = "col-12 col-md-4 col-xl-3" -%} diff --git a/src/admin-theme/admin-dashboard.liquid b/src/admin-theme/admin-dashboard.liquid index baed2f7..4d8ac30 100644 --- a/src/admin-theme/admin-dashboard.liquid +++ b/src/admin-theme/admin-dashboard.liquid @@ -2,19 +2,7 @@
Themes - - Upload a New Theme - -
- {% include_template "_theme-list-columns" %} -
-
Theme
-
Slug
-
Templates
-
-
-
- {{ theme_list }} +
{%- assign cache_base_url = "admin/cache/" -%} diff --git a/src/admin-theme/permalinks.liquid b/src/admin-theme/permalinks.liquid deleted file mode 100644 index 2d4a168..0000000 --- a/src/admin-theme/permalinks.liquid +++ /dev/null @@ -1,59 +0,0 @@ -

{{ page_title }}

-
- {%- assign base_url = "admin/" | append: model.entity | append: "/" -%} -
- - -
-
-
-

- {{ model.current_title }}
- - {{ model.current_permalink }}
- - « Back to Edit {{ model.entity | capitalize }} - - -

-
-
-
- -
-
-
-
- -
-
-
-
- -
-
-
-
-
diff --git a/src/admin-theme/revisions.liquid b/src/admin-theme/revisions.liquid deleted file mode 100644 index 4a5ab75..0000000 --- a/src/admin-theme/revisions.liquid +++ /dev/null @@ -1,65 +0,0 @@ -

{{ page_title }}

-
-
- - -
-
-
-

- {{ model.current_title }}
- - - « Back to Edit {{ model.entity | capitalize }} - - -

-
- {%- assign revision_count = model.revisions | size -%} - {%- assign rev_url_base = "admin/" | append: model.entity | append: "/" | append: model.id | append: "/revision" -%} - {%- if revision_count > 1 %} -
-
- -
-
- {%- endif %} -
Revision
- {% for rev in model.revisions %} - {%- assign as_of_string = rev.as_of | date: "o" -%} - {%- assign as_of_id = "rev_" | append: as_of_string | replace: "\.", "_" | replace: ":", "-" -%} -
-
- {{ rev.as_of_local | date: "MMMM d, yyyy" }} at {{ rev.as_of_local | date: "h:mmtt" | downcase }} - {{ rev.format }} - {%- if forloop.first %} - Current Revision - {%- endif %}
- {% unless forloop.first %} - {%- assign rev_url_prefix = rev_url_base | append: "/" | append: as_of_string -%} - {%- assign rev_restore = rev_url_prefix | append: "/restore" | relative_link -%} - {%- assign rev_delete = rev_url_prefix | append: "/delete" | relative_link -%} - - - Preview - - • - Restore as Current - • - - Delete - - - {% endunless %} -
- {% unless forloop.first %}
{% endunless %} -
- {% endfor %} -
-
-
diff --git a/src/admin-theme/settings.liquid b/src/admin-theme/settings.liquid index 4f8e2d8..45d21dc 100644 --- a/src/admin-theme/settings.liquid +++ b/src/admin-theme/settings.liquid @@ -109,19 +109,6 @@
Users - {% include_template "_user-list-columns" %} - - Add a New User - -
-
-
User; Full Name / E-mail; Last Log On
- -
Created
-
Last Log On
-
-
diff --git a/src/admin-theme/theme-list-body.liquid b/src/admin-theme/theme-list-body.liquid deleted file mode 100644 index 13eb143..0000000 --- a/src/admin-theme/theme-list-body.liquid +++ /dev/null @@ -1,33 +0,0 @@ -
- - {% include_template "_theme-list-columns" %} - {% for theme in themes -%} -
-
- {{ theme.name }} - {%- if theme.is_in_use %} - IN USE - {%- endif %} - {%- unless theme.is_on_disk %} - NOT ON DISK - {%- endunless %}
- - v{{ theme.version }} - {% unless theme.is_in_use or theme.id == "default" %} - • - {%- assign theme_del_link = "admin/theme/" | append: theme.id | append: "/delete" | relative_link -%} - - Delete - - {% endunless %} - -
Slug: {{ theme.id }} • {{ theme.template_count }} Templates - - -
-
{{ theme.id }}
-
{{ theme.template_count }}
-
- {%- endfor %} -
diff --git a/src/admin-theme/theme-upload.liquid b/src/admin-theme/theme-upload.liquid deleted file mode 100644 index 73f31e8..0000000 --- a/src/admin-theme/theme-upload.liquid +++ /dev/null @@ -1,30 +0,0 @@ -
-
{{ page_title }}
-
- -
-
-
- - -
-
-
-
- - -
-
-
-
-
- - -
-
-
-