WIP on module/member conversion
Data types complete
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
|
||||
@@ -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>()
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
Reference in New Issue
Block a user