/// Handlers to manipulate posts module MyWebLog.Handlers.Post open System open System.Collections.Generic open MyWebLog /// Parse a slug and page number from an "everything else" URL let private parseSlugAndPage webLog (slugAndPage : string seq) = let fullPath = slugAndPage |> Seq.head let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head let slugs, isFeed = let feedName = $"/{webLog.rss.feedName}" let notBlank = Array.filter (fun it -> it <> "") if ( (webLog.rss.categoryEnabled && fullPath.StartsWith "/category/") || (webLog.rss.tagEnabled && fullPath.StartsWith "/tag/" )) && slugPath.EndsWith feedName then notBlank (slugPath.Replace(feedName, "").Split "/"), true else notBlank (slugPath.Split "/"), false let pageIdx = Array.IndexOf (slugs, "page") let pageNbr = match pageIdx with | -1 -> Some 1 | idx when idx + 2 = slugs.Length -> Some (int slugs[pageIdx + 1]) | _ -> None let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs pageNbr, String.Join ("/", slugParts), isFeed /// The type of post list being prepared type ListType = | AdminList | CategoryList | PostList | SinglePost | TagList open System.Threading.Tasks open DotLiquid 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 ctx (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 postItems = posts |> Seq.ofList |> Seq.truncate perPage |> Seq.map (PostListItem.fromPost webLog) |> Array.ofSeq let! olderPost, newerPost = match listType with | SinglePost -> let post = List.head posts let dateTime = defaultArg post.publishedOn post.updatedOn data.Post.findSurroundingPosts webLog.id dateTime | _ -> Task.FromResult (None, None) let newerLink = match listType, pageNbr with | SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.permalink) | _, 1 -> None | PostList, 2 when webLog.defaultPage = "posts" -> Some "" | PostList, _ -> relUrl $"page/{pageNbr - 1}" | CategoryList, 2 -> relUrl $"category/{url}/" | CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}" | TagList, 2 -> relUrl $"tag/{url}/" | TagList, _ -> relUrl $"tag/{url}/page/{pageNbr - 1}" | AdminList, 2 -> relUrl "admin/posts" | 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) | _, false -> None | PostList, true -> relUrl $"page/{pageNbr + 1}" | CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}" | TagList, true -> relUrl $"tag/{url}/page/{pageNbr + 1}" | AdminList, true -> relUrl $"admin/posts/page/{pageNbr + 1}" let model = { posts = postItems authors = authors subtitle = None newerLink = newerLink newerName = newerPost |> Option.map (fun p -> p.title) olderLink = olderLink olderName = olderPost |> Option.map (fun p -> p.title) } return Hash.FromAnonymousObject {| model = model categories = CategoryCache.get ctx tag_mappings = tagMappings is_post = match listType with SinglePost -> true | _ -> false |} } open Giraffe // GET /page/{pageNbr} let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let data = ctx.Data let! posts = data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage let! hash = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx data let title = match pageNbr, webLog.defaultPage with | 1, "posts" -> None | _, "posts" -> Some $"Page {pageNbr}" | _, _ -> Some $"Page {pageNbr} « Posts" match title with Some ttl -> hash.Add ("page_title", ttl) | None -> () if pageNbr = 1 && webLog.defaultPage = "posts" then hash.Add ("is_home", true) return! themedView "index" next ctx hash } // GET /page/{pageNbr}/ let redirectToPageOfPosts (pageNbr : int) : HttpHandler = fun next ctx -> redirectTo true (WebLog.relativeUrl ctx.WebLog (Permalink $"page/{pageNbr}")) next ctx // GET /category/{slug}/ // GET /category/{slug}/page/{pageNbr} let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let data = ctx.Data match parseSlugAndPage webLog slugAndPage with | Some pageNbr, slug, isFeed -> match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = slug) with | Some cat when isFeed -> return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.id), $"category/{slug}/{webLog.rss.feedName}")) (defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx | Some cat -> // Category pages include posts in subcategories match! data.Post.findPageOfCategorizedPosts webLog.id (getCategoryIds slug ctx) pageNbr webLog.postsPerPage with | posts when List.length posts > 0 -> let! hash = preparePostList webLog posts CategoryList cat.slug pageNbr webLog.postsPerPage ctx data let pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}") hash.Add ("subtitle", defaultArg cat.description "") hash.Add ("is_category", true) hash.Add ("is_category_home", (pageNbr = 1)) hash.Add ("slug", slug) return! themedView "index" next ctx hash | _ -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx | None, _, _ -> return! Error.notFound next ctx } open System.Web // GET /tag/{tag}/ // GET /tag/{tag}/page/{pageNbr} let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let data = ctx.Data match parseSlugAndPage webLog slugAndPage with | Some pageNbr, rawTag, isFeed -> let urlTag = HttpUtility.UrlDecode rawTag let! tag = backgroundTask { match! data.TagMap.findByUrlValue urlTag webLog.id with | Some m -> return m.tag | None -> return urlTag } if isFeed then return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.rss.feedName}")) (defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx else match! data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage with | posts when List.length posts > 0 -> let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx data let pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" hash.Add ("page_title", $"Posts Tagged “{tag}”{pgTitle}") hash.Add ("is_tag", true) hash.Add ("is_tag_home", (pageNbr = 1)) hash.Add ("slug", rawTag) return! themedView "index" next ctx hash // Other systems use hyphens for spaces; redirect if this is an old tag link | _ -> let spacedTag = tag.Replace ("-", " ") match! data.Post.findPageOfTaggedPosts webLog.id spacedTag pageNbr 1 with | posts when List.length posts > 0 -> let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}" return! redirectTo true (WebLog.relativeUrl webLog (Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}""")) next ctx | _ -> return! Error.notFound next ctx | None, _, _ -> return! Error.notFound next ctx } // GET / let home : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog match webLog.defaultPage with | "posts" -> return! pageOfPosts 1 next ctx | pageId -> match! ctx.Data.Page.findById (PageId pageId) webLog.id with | Some page -> return! Hash.FromAnonymousObject {| page = DisplayPage.fromPage webLog page categories = CategoryCache.get ctx page_title = page.title is_home = true |} |> themedView (defaultArg page.template "single-page") next ctx | None -> return! Error.notFound next ctx } // GET /admin/posts // GET /admin/posts/page/{pageNbr} let all pageNbr : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let data = ctx.Data let! posts = data.Post.findPageOfPosts webLog.id pageNbr 25 let! hash = preparePostList webLog posts AdminList "" pageNbr 25 ctx data hash.Add ("page_title", "Posts") hash.Add ("csrf", csrfToken ctx) return! viewForTheme "admin" "post-list" next ctx hash } // GET /admin/post/{id}/edit let edit postId : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let data = ctx.Data let! result = task { match postId with | "new" -> return Some ("Write a New Post", { Post.empty with id = PostId "new" }) | _ -> match! data.Post.findFullById (PostId postId) webLog.id with | Some post -> return Some ("Edit Post", post) | None -> return None } match result with | Some (title, post) -> let! cats = data.Category.findAllForView webLog.id let! templates = templatesForTheme ctx "post" let model = EditPostModel.fromPost webLog post return! Hash.FromAnonymousObject {| csrf = csrfToken ctx model = model metadata = Array.zip model.metaNames model.metaValues |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) page_title = title templates = templates categories = cats explicit_values = [| KeyValuePair.Create ("", "– Default –") KeyValuePair.Create (ExplicitRating.toString Yes, "Yes") KeyValuePair.Create (ExplicitRating.toString No, "No") KeyValuePair.Create (ExplicitRating.toString Clean, "Clean") |] |} |> viewForTheme "admin" "post-edit" next ctx | None -> return! Error.notFound next ctx } // GET /admin/post/{id}/permalinks let editPermalinks postId : HttpHandler = fun next ctx -> task { match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with | Some post -> return! Hash.FromAnonymousObject {| csrf = csrfToken ctx model = ManagePermalinksModel.fromPost post page_title = $"Manage Prior Permalinks" |} |> viewForTheme "admin" "permalinks" next ctx | None -> return! Error.notFound next ctx } // POST /admin/post/permalinks let savePermalinks : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let! model = ctx.BindFormAsync () let links = model.prior |> Array.map Permalink |> List.ofArray match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with | true -> do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" } return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{model.id}/permalinks")) next ctx | false -> return! Error.notFound next ctx } // POST /admin/post/{id}/delete let delete postId : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog match! ctx.Data.Post.delete (PostId postId) webLog.id with | true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" } | false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" } return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx } #nowarn "3511" // POST /admin/post/save let save : HttpHandler = fun next ctx -> task { let! model = ctx.BindFormAsync () let webLog = ctx.WebLog let data = ctx.Data let now = DateTime.UtcNow let! pst = task { match model.postId with | "new" -> return Some { Post.empty with id = PostId.create () webLogId = webLog.id authorId = userId ctx } | postId -> return! data.Post.findFullById (PostId postId) webLog.id } match pst with | Some post -> let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" } // Detect a permalink change, and add the prior one to the prior list let post = match Permalink.toString post.permalink with | "" -> post | link when link = model.permalink -> post | _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks } let post = model.updatePost post revision now let post = match model.setPublished with | true -> let dt = WebLog.utcTime webLog model.pubOverride.Value match model.setUpdated with | true -> { post with publishedOn = Some dt updatedOn = dt revisions = [ { (List.head post.revisions) with asOf = dt } ] } | false -> { post with publishedOn = Some dt } | false -> post do! (if model.postId = "new" then data.Post.add else data.Post.update) post // If the post was published or its categories changed, refresh the category cache if model.doPublish || not (pst.Value.categoryIds |> List.append post.categoryIds |> List.distinct |> List.length = List.length pst.Value.categoryIds) then do! CategoryCache.update ctx do! addMessage ctx { UserMessage.success with message = "Post saved successfully" } return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{PostId.toString post.id}/edit")) next ctx | None -> return! Error.notFound next ctx }