From 7c99da8cb56ea4da7e469bba3845fb62791c620e Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 23 Jul 2016 13:44:49 -0500 Subject: [PATCH] User logon and list fixes User logon now works; tweaked queries and display items on post, page, and category list pages --- src/myWebLog.Data/Category.fs | 9 +- src/myWebLog.Data/Page.fs | 11 +- src/myWebLog.Data/Post.fs | 39 +++--- src/myWebLog.Data/SetUp.fs | 2 +- src/myWebLog.Data/User.fs | 7 +- src/myWebLog.Data/WebLog.fs | 21 ++- src/myWebLog.Resources/Resources.Designer.cs | 36 +++++ src/myWebLog.Resources/Resources.resx | 12 ++ src/myWebLog.Web/AdminModule.fs | 9 +- src/myWebLog.Web/PostModule.fs | 35 +++-- src/myWebLog.Web/UserModule.fs | 17 +-- src/myWebLog.Web/ViewModels.fs | 131 ++++++++++++++---- src/myWebLog/myWebLog.csproj | 1 + src/myWebLog/views/admin/admin-layout.html | 4 +- src/myWebLog/views/admin/category/list.html | 11 +- src/myWebLog/views/admin/dashboard.html | 2 +- src/myWebLog/views/admin/message.html | 18 +++ src/myWebLog/views/admin/page/list.html | 2 +- src/myWebLog/views/admin/post/list.html | 31 ++--- src/myWebLog/views/admin/user/logon.html | 2 +- .../views/themes/default/index-content.html | 15 +- .../views/themes/default/single-content.html | 4 +- 22 files changed, 282 insertions(+), 137 deletions(-) create mode 100644 src/myWebLog/views/admin/message.html diff --git a/src/myWebLog.Data/Category.fs b/src/myWebLog.Data/Category.fs index fd9ebd3..84b12e3 100644 --- a/src/myWebLog.Data/Category.fs +++ b/src/myWebLog.Data/Category.fs @@ -32,18 +32,11 @@ let getAllCategories conn (webLogId : string) = r.Table(Table.Category) .GetAll(webLogId).OptArg("index", "webLogId") .OrderBy("name") - .RunCursorAsync(conn) + .RunListAsync(conn) |> await |> Seq.toList |> sortCategories -/// Count categories for a web log -let countCategories conn (webLogId : string) = - r.Table(Table.Category) - .GetAll(webLogId).OptArg("index", "webLogId") - .Count() - .RunAtomAsync(conn) |> await - /// Get a specific category by its Id let tryFindCategory conn webLogId catId : Category option = match (category webLogId catId) diff --git a/src/myWebLog.Data/Page.fs b/src/myWebLog.Data/Page.fs index 8b31e56..7b09fe1 100644 --- a/src/myWebLog.Data/Page.fs +++ b/src/myWebLog.Data/Page.fs @@ -37,20 +37,13 @@ let tryFindPageByPermalink conn (webLogId : string) (permalink : string) = |> await |> Seq.tryHead -/// Count pages for a web log -let countPages conn (webLogId : string) = - r.Table(Table.Page) - .GetAll(webLogId).OptArg("index", "webLogId") - .Count() - .RunAtomAsync(conn) |> await - /// Get a list of all pages (excludes page text and revisions) let findAllPages conn (webLogId : string) = r.Table(Table.Page) - .GetAll(webLogId) + .GetAll(webLogId).OptArg("index", "webLogId") .OrderBy("title") .Without("text", "revisions") - .RunCursorAsync(conn) + .RunListAsync(conn) |> await |> Seq.toList diff --git a/src/myWebLog.Data/Post.fs b/src/myWebLog.Data/Post.fs index e64c73a..bb523da 100644 --- a/src/myWebLog.Data/Post.fs +++ b/src/myWebLog.Data/Post.fs @@ -25,7 +25,7 @@ let private toPostList conn pageNbr nbrPerPage (filter : ReqlExpr) = /// Shorthand to get a newer or older post // TODO: older posts need to sort by published on DESC //let private adjacentPost conn post (theFilter : ReqlExpr -> ReqlExpr) (sort :ReqlExpr) : Post option = -let private adjacentPost conn post (theFilter : obj) (sort : obj) : Post option = +let private adjacentPost conn post (theFilter : ReqlExpr -> obj) (sort : obj) : Post option = (publishedPosts post.webLogId) .Filter(theFilter) .OrderBy(sort) @@ -58,36 +58,37 @@ let findPageOfTaggedPosts conn webLogId (tag : string) pageNbr nbrPerPage = |> toPostList conn pageNbr nbrPerPage /// Try to get the next newest post from the given post -let tryFindNewerPost conn post = newerPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Gt(post.publishedOn)) +let tryFindNewerPost conn post = newerPost conn post (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn)) /// Try to get the next newest post assigned to the given category let tryFindNewerCategorizedPost conn (categoryId : string) post = - newerPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Gt(post.publishedOn) - .And(p.["categoryIds"].Contains(categoryId))) + newerPost conn post (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn) + .And(p.["categoryIds"].Contains(categoryId))) /// Try to get the next newest tagged post from the given tagged post let tryFindNewerTaggedPost conn (tag : string) post = - newerPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Gt(post.publishedOn).And(p.["tags"].Contains(tag))) + newerPost conn post (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn).And(p.["tags"].Contains(tag))) /// Try to get the next oldest post from the given post -let tryFindOlderPost conn post = olderPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Lt(post.publishedOn)) +let tryFindOlderPost conn post = olderPost conn post (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn)) /// Try to get the next oldest post assigned to the given category let tryFindOlderCategorizedPost conn (categoryId : string) post = - olderPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Lt(post.publishedOn) - .And(p.["categoryIds"].Contains(categoryId))) + olderPost conn post (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn) + .And(p.["categoryIds"].Contains(categoryId))) /// Try to get the next oldest tagged post from the given tagged post let tryFindOlderTaggedPost conn (tag : string) post = - olderPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Lt(post.publishedOn).And(p.["tags"].Contains(tag))) + olderPost conn post (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn).And(p.["tags"].Contains(tag))) /// Get a page of all posts in all statuses let findPageOfAllPosts conn (webLogId : string) pageNbr nbrPerPage = + // FIXME: sort unpublished posts by their last updated date r.Table(Table.Post) .GetAll(webLogId).OptArg("index", "webLogId") - .OrderBy(fun p -> r.Desc(r.Branch(p.["publishedOn"].Eq(int64 0), p.["lastUpdatedOn"], p.["publishedOn"]))) + .OrderBy(r.Desc("publishedOn")) .Slice((pageNbr - 1) * nbrPerPage, pageNbr * nbrPerPage) - .RunCursorAsync(conn) + .RunListAsync(conn) |> await |> Seq.toList @@ -107,15 +108,15 @@ let tryFindPostByPermalink conn webLogId permalink = .GetAll(r.Array(webLogId, permalink)).OptArg("index", "permalink") .Filter(fun p -> p.["status"].Eq(PostStatus.Published)) .Without("revisions") - .Merge(fun post -> ExpandoObject()?categories <- + .Merge(fun post -> r.HashMap("categories", post.["categoryIds"] .Map(ReqlFunction1(fun cat -> upcast r.Table(Table.Category).Get(cat).Without("children"))) - .CoerceTo("array")) - .Merge(fun post -> ExpandoObject()?comments <- + .CoerceTo("array"))) + .Merge(fun post -> r.HashMap("comments", r.Table(Table.Comment) .GetAll(post.["id"]).OptArg("index", "postId") .OrderBy("postedOn") - .CoerceTo("array")) + .CoerceTo("array"))) .RunCursorAsync(conn) |> await |> Seq.tryHead @@ -145,11 +146,3 @@ let savePost conn post = .RunResultAsync(conn) |> ignore post.id - -/// Count posts for a web log -let countPosts conn (webLogId : string) = - r.Table(Table.Post) - .GetAll(webLogId).OptArg("index", "webLogId") - .Count() - .RunAtomAsync(conn) - |> await diff --git a/src/myWebLog.Data/SetUp.fs b/src/myWebLog.Data/SetUp.fs index c61c347..f48c8d1 100644 --- a/src/myWebLog.Data/SetUp.fs +++ b/src/myWebLog.Data/SetUp.fs @@ -80,7 +80,7 @@ let checkIndexes cfg = "webLogAndStatus", webLogField "status" "permalink", webLogField "permalink" ] - Table.User, [ "logOn", Some <| fun row -> upcast r.Array(row.["userName"], row.["passwordHash"]) + Table.User, [ "userName", None ] Table.WebLog, [ "urlBase", None ] diff --git a/src/myWebLog.Data/User.fs b/src/myWebLog.Data/User.fs index d618f49..d1fa356 100644 --- a/src/myWebLog.Data/User.fs +++ b/src/myWebLog.Data/User.fs @@ -6,10 +6,13 @@ open Rethink let private r = RethinkDb.Driver.RethinkDB.R /// Log on a user -// FIXME: the password hash may be longer than the significant size of a RethinkDB index +// NOTE: The significant length of a RethinkDB index is 238 - [PK size]; as we're storing 1,024 characters of password, +// including it in an index does not get any performance gain, and would unnecessarily bloat the index. See +// http://rethinkdb.com/docs/secondary-indexes/java/ for more information. let tryUserLogOn conn (email : string) (passwordHash : string) = r.Table(Table.User) - .GetAll(email, passwordHash).OptArg("index", "logOn") + .GetAll(email).OptArg("index", "userName") + .Filter(fun u -> u.["passwordHash"].Eq(passwordHash)) .RunCursorAsync(conn) |> await |> Seq.tryHead diff --git a/src/myWebLog.Data/WebLog.fs b/src/myWebLog.Data/WebLog.fs index 62a5992..0fd4ada 100644 --- a/src/myWebLog.Data/WebLog.fs +++ b/src/myWebLog.Data/WebLog.fs @@ -1,12 +1,20 @@ module myWebLog.Data.WebLog -open FSharp.Interop.Dynamic open myWebLog.Entities open Rethink -open System.Dynamic let private r = RethinkDb.Driver.RethinkDB.R +/// Counts of items displayed on the admin dashboard +type DashboardCounts = { + /// The number of pages for the web log + pages : int + /// The number of pages for the web log + posts : int + /// The number of categories for the web log + categories : int + } + /// Detemine the web log by the URL base // TODO: see if we can make .Merge work for page list even though the attribute is ignored // (needs to be ignored for serialization, but included for deserialization) @@ -24,3 +32,12 @@ let tryFindWebLogByUrlBase conn (urlBase : string) = .Pluck("title", "permalink") .RunListAsync(conn) |> await |> Seq.toList } | None -> None + +/// Get counts for the admin dashboard +let findDashboardCounts conn (webLogId : string) = + r.Expr( r.HashMap("pages", r.Table(Table.Page ).GetAll(webLogId).OptArg("index", "webLogId").Count())) + .Merge(r.HashMap("posts", r.Table(Table.Post ).GetAll(webLogId).OptArg("index", "webLogId").Count())) + .Merge(r.HashMap("categories", r.Table(Table.Category).GetAll(webLogId).OptArg("index", "webLogId").Count())) + .RunAtomAsync(conn) + |> await + \ No newline at end of file diff --git a/src/myWebLog.Resources/Resources.Designer.cs b/src/myWebLog.Resources/Resources.Designer.cs index 4b1c60b..597499f 100644 --- a/src/myWebLog.Resources/Resources.Designer.cs +++ b/src/myWebLog.Resources/Resources.Designer.cs @@ -123,6 +123,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to and {0} more.... + /// + public static string andXMore { + get { + return ResourceManager.GetString("andXMore", resourceCulture); + } + } + /// /// Looks up a localized string similar to Categories. /// @@ -150,6 +159,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Close. + /// + public static string Close { + get { + return ResourceManager.GetString("Close", resourceCulture); + } + } + /// /// Looks up a localized string similar to Dashboard. /// @@ -249,6 +267,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Error. + /// + public static string Error { + get { + return ResourceManager.GetString("Error", resourceCulture); + } + } + /// /// Looks up a localized string similar to Last Updated. /// @@ -626,5 +653,14 @@ namespace myWebLog { return ResourceManager.GetString("View", resourceCulture); } } + + /// + /// Looks up a localized string similar to Warning. + /// + public static string Warning { + get { + return ResourceManager.GetString("Warning", resourceCulture); + } + } } } diff --git a/src/myWebLog.Resources/Resources.resx b/src/myWebLog.Resources/Resources.resx index d1c13bd..29a636c 100644 --- a/src/myWebLog.Resources/Resources.resx +++ b/src/myWebLog.Resources/Resources.resx @@ -306,4 +306,16 @@ Show in Page List + + and {0} more... + + + Close + + + Error + + + Warning + \ No newline at end of file diff --git a/src/myWebLog.Web/AdminModule.fs b/src/myWebLog.Web/AdminModule.fs index 4dd0eea..f7ce295 100644 --- a/src/myWebLog.Web/AdminModule.fs +++ b/src/myWebLog.Web/AdminModule.fs @@ -1,8 +1,6 @@ namespace myWebLog -open myWebLog.Data.Category -open myWebLog.Data.Page -open myWebLog.Data.Post +open myWebLog.Data.WebLog open myWebLog.Entities open Nancy open RethinkDb.Driver.Net @@ -17,9 +15,6 @@ type AdminModule(conn : IConnection) as this = /// Admin dashboard member this.Dashboard () = this.RequiresAccessLevel AuthorizationLevel.Administrator - let model = DashboardModel(this.Context, this.WebLog) - model.posts <- countPosts conn this.WebLog.id - model.pages <- countPages conn this.WebLog.id - model.categories <- countCategories conn this.WebLog.id + let model = DashboardModel(this.Context, this.WebLog, findDashboardCounts conn this.WebLog.id) model.pageTitle <- Resources.Dashboard this.View.["admin/dashboard", model] diff --git a/src/myWebLog.Web/PostModule.fs b/src/myWebLog.Web/PostModule.fs index 023d744..8b5e2d4 100644 --- a/src/myWebLog.Web/PostModule.fs +++ b/src/myWebLog.Web/PostModule.fs @@ -18,7 +18,10 @@ type PostModule(conn : IConnection, clock : IClock) as this = /// Get the page number from the dictionary let getPage (parameters : DynamicDictionary) = - match parameters.ContainsKey "page" with | true -> downcast parameters.["page"] | _ -> 1 + match parameters.ContainsKey "page" with | true -> System.Int32.Parse (parameters.["page"].ToString ()) | _ -> 1 + + /// Convert a list of posts to a list of posts for display + let forDisplay posts = posts |> List.map (fun post -> PostForDisplay(this.WebLog, post)) do this.Get .["/" ] <- fun _ -> upcast this.HomePage () @@ -39,13 +42,15 @@ type PostModule(conn : IConnection, clock : IClock) as this = member this.PublishedPostsPage pageNbr = let model = PostsModel(this.Context, this.WebLog) model.pageNbr <- pageNbr - model.posts <- findPageOfPublishedPosts conn this.WebLog.id pageNbr 10 - model.hasNewer <- match List.isEmpty model.posts with - | true -> false - | _ -> Option.isSome <| tryFindNewerPost conn (List.last model.posts) + model.posts <- findPageOfPublishedPosts conn this.WebLog.id pageNbr 10 |> forDisplay + model.hasNewer <- match pageNbr with + | 1 -> false + | _ -> match List.isEmpty model.posts with + | true -> false + | _ -> Option.isSome <| tryFindNewerPost conn (List.last model.posts).post model.hasOlder <- match List.isEmpty model.posts with | true -> false - | _ -> Option.isSome <| tryFindOlderPost conn (List.head model.posts) + | _ -> Option.isSome <| tryFindOlderPost conn (List.head model.posts).post model.urlPrefix <- "/posts" model.pageTitle <- match pageNbr with | 1 -> "" @@ -93,15 +98,15 @@ type PostModule(conn : IConnection, clock : IClock) as this = | Some cat -> let pageNbr = getPage parameters let model = PostsModel(this.Context, this.WebLog) model.pageNbr <- pageNbr - model.posts <- findPageOfCategorizedPosts conn this.WebLog.id cat.id pageNbr 10 + model.posts <- findPageOfCategorizedPosts conn this.WebLog.id cat.id pageNbr 10 |> forDisplay model.hasNewer <- match List.isEmpty model.posts with | true -> false | _ -> Option.isSome <| tryFindNewerCategorizedPost conn cat.id - (List.last model.posts) + (List.last model.posts).post model.hasOlder <- match List.isEmpty model.posts with | true -> false | _ -> Option.isSome <| tryFindOlderCategorizedPost conn cat.id - (List.last model.posts) + (List.last model.posts).post model.urlPrefix <- sprintf "/category/%s" slug model.pageTitle <- sprintf "\"%s\" Category%s" cat.name (match pageNbr with | 1 -> "" | n -> sprintf " | Page %i" n) @@ -117,13 +122,13 @@ type PostModule(conn : IConnection, clock : IClock) as this = let pageNbr = getPage parameters let model = PostsModel(this.Context, this.WebLog) model.pageNbr <- pageNbr - model.posts <- findPageOfTaggedPosts conn this.WebLog.id tag pageNbr 10 + model.posts <- findPageOfTaggedPosts conn this.WebLog.id tag pageNbr 10 |> forDisplay model.hasNewer <- match List.isEmpty model.posts with | true -> false - | _ -> Option.isSome <| tryFindNewerTaggedPost conn tag (List.last model.posts) + | _ -> Option.isSome <| tryFindNewerTaggedPost conn tag (List.last model.posts).post model.hasOlder <- match List.isEmpty model.posts with | true -> false - | _ -> Option.isSome <| tryFindOlderTaggedPost conn tag (List.last model.posts) + | _ -> Option.isSome <| tryFindOlderTaggedPost conn tag (List.last model.posts).post model.urlPrefix <- sprintf "/tag/%s" tag model.pageTitle <- sprintf "\"%s\" Tag%s" tag (match pageNbr with | 1 -> "" | n -> sprintf " | Page %i" n) model.subtitle <- Some <| sprintf "Posts tagged \"%s\"" tag @@ -137,10 +142,10 @@ type PostModule(conn : IConnection, clock : IClock) as this = this.RequiresAccessLevel AuthorizationLevel.Administrator let model = PostsModel(this.Context, this.WebLog) model.pageNbr <- pageNbr - model.posts <- findPageOfAllPosts conn this.WebLog.id pageNbr 25 + model.posts <- findPageOfAllPosts conn this.WebLog.id pageNbr 25 |> forDisplay model.hasNewer <- pageNbr > 1 - model.hasOlder <- List.length model.posts < 25 - model.urlPrefix <- "/post/list" + model.hasOlder <- List.length model.posts > 24 + model.urlPrefix <- "/posts/list" model.pageTitle <- Resources.Posts this.View.["admin/post/list", model] diff --git a/src/myWebLog.Web/UserModule.fs b/src/myWebLog.Web/UserModule.fs index 91a6c50..e2986b2 100644 --- a/src/myWebLog.Web/UserModule.fs +++ b/src/myWebLog.Web/UserModule.fs @@ -18,7 +18,7 @@ type UserModule(conn : IConnection) as this = /// Hash the user's password let pbkdf2 (pw : string) = PassphraseKeyGenerator(pw, UTF8Encoding().GetBytes("// TODO: make this salt part of the config"), 4096).GetBytes 512 - |> Seq.fold (fun acc bit -> System.String.Format("{0}{1:x2}", acc, bit)) "" + |> Seq.fold (fun acc byt -> sprintf "%s%s" acc (byt.ToString "x2")) "" do this.Get .["/logon" ] <- fun parms -> upcast this.ShowLogOn (downcast parms) @@ -28,16 +28,17 @@ type UserModule(conn : IConnection) as this = /// Show the log on page member this.ShowLogOn (parameters : DynamicDictionary) = let model = LogOnModel(this.Context, this.WebLog) - model.returnUrl <- match parameters.ContainsKey "returnUrl" with - | true -> parameters.["returnUrl"].ToString () - | _ -> "" + model.form.returnUrl <- match parameters.ContainsKey "returnUrl" with + | true -> parameters.["returnUrl"].ToString () + | _ -> "" this.View.["admin/user/logon", model] /// Process a user log on member this.DoLogOn (parameters : DynamicDictionary) = this.ValidateCsrfToken () - let model = this.Bind () - match tryUserLogOn conn model.email (pbkdf2 model.password) with + let form = this.Bind () + let model = MyWebLogModel(this.Context, this.WebLog) + match tryUserLogOn conn form.email (pbkdf2 form.password) with | Some user -> this.Session.[Keys.User] <- user { level = Level.Info message = Resources.MsgLogOnSuccess @@ -46,14 +47,14 @@ type UserModule(conn : IConnection) as this = this.Redirect "" model |> ignore // Save the messages in the session before the Nancy redirect // TODO: investigate if addMessage should update the session when it's called this.LoginAndRedirect - (System.Guid.Parse user.id, fallbackRedirectUrl = defaultArg (Option.ofObj(model.returnUrl)) "/") + (System.Guid.Parse user.id, fallbackRedirectUrl = defaultArg (Option.ofObj(form.returnUrl)) "/") | None -> { level = Level.Error message = Resources.ErrBadLogOnAttempt details = None } |> model.addMessage this.Redirect "" model |> ignore // Save the messages in the session before the Nancy redirect // Can't redirect with a negotiator when the other leg uses a straight response... :/ - this.Response.AsRedirect((sprintf "/user/logon?returnUrl=%s" model.returnUrl), + this.Response.AsRedirect((sprintf "/user/logon?returnUrl=%s" form.returnUrl), Responses.RedirectResponse.RedirectType.SeeOther) /// Log a user off diff --git a/src/myWebLog.Web/ViewModels.fs b/src/myWebLog.Web/ViewModels.fs index 4c2c7b3..d25bbcf 100644 --- a/src/myWebLog.Web/ViewModels.fs +++ b/src/myWebLog.Web/ViewModels.fs @@ -1,8 +1,10 @@ namespace myWebLog +open myWebLog.Data.WebLog open myWebLog.Entities open Nancy open Nancy.Session.Persistable +open Newtonsoft.Json open NodaTime open NodaTime.Text @@ -10,10 +12,13 @@ open NodaTime.Text /// Levels for a user message module Level = /// An informational message + [] let Info = "Info" /// A message regarding a non-fatal but non-optimal condition + [] let Warning = "WARNING" /// A message regarding a failure of the expected result + [] let Error = "ERROR" @@ -28,11 +33,63 @@ type UserMessage = { } with /// An empty message - static member empty = - { level = Level.Info - message = "" - details = None } + static member empty = { + level = Level.Info + message = "" + details = None + } + /// Display version + [] + member this.toDisplay = + let classAndLabel = + dict [ + Level.Error, ("danger", Resources.Error) + Level.Warning, ("warning", Resources.Warning) + Level.Info, ("info", "") + ] + seq { + yield "
" + match snd classAndLabel.[this.level] with + | "" -> () + | lbl -> yield lbl.ToUpper () + yield " » " + yield this.message + yield "" + match this.details with + | Some d -> yield "
" + yield d + | None -> () + yield "
" + } + |> Seq.reduce (fun acc x -> acc + x) + + +/// Helpers to format local date/time using NodaTime +module FormatDateTime = + + /// Convert ticks to a zoned date/time + let zonedTime timeZone ticks = Instant(ticks).InZone(DateTimeZoneProviders.Tzdb.[timeZone]) + + /// Display a long date + let longDate timeZone ticks = + zonedTime timeZone ticks + |> ZonedDateTimePattern.CreateWithCurrentCulture("MMMM d',' yyyy", DateTimeZoneProviders.Tzdb).Format + + /// Display a short date + let shortDate timeZone ticks = + zonedTime timeZone ticks + |> ZonedDateTimePattern.CreateWithCurrentCulture("MMM d',' yyyy", DateTimeZoneProviders.Tzdb).Format + + /// Display the time + let time timeZone ticks = + (zonedTime timeZone ticks + |> ZonedDateTimePattern.CreateWithCurrentCulture("h':'mmtt", DateTimeZoneProviders.Tzdb).Format).ToLower() + /// Parent view model for all myWebLog views type MyWebLogModel(ctx : NancyContext, webLog : WebLog) = @@ -64,36 +121,25 @@ type MyWebLogModel(ctx : NancyContext, webLog : WebLog) = /// Add a message to the output member this.addMessage message = this.messages <- message :: this.messages - /// Convert ticks to a zoned date/time for the current web log - member this.zonedTime ticks = Instant(ticks).InZone(DateTimeZoneProviders.Tzdb.[this.webLog.timeZone]) - /// Display a long date - member this.displayLongDate ticks = - this.zonedTime ticks - |> ZonedDateTimePattern.CreateWithCurrentCulture("MMMM d',' yyyy", DateTimeZoneProviders.Tzdb).Format - + member this.displayLongDate ticks = FormatDateTime.longDate this.webLog.timeZone ticks /// Display a short date - member this.displayShortDate ticks = - this.zonedTime ticks - |> ZonedDateTimePattern.CreateWithCurrentCulture("MMM d',' yyyy", DateTimeZoneProviders.Tzdb).Format - + member this.displayShortDate ticks = FormatDateTime.shortDate this.webLog.timeZone ticks /// Display the time - member this.displayTime ticks = - (this.zonedTime ticks - |> ZonedDateTimePattern.CreateWithCurrentCulture("h':'mmtt", DateTimeZoneProviders.Tzdb).Format).ToLower() + member this.displayTime ticks = FormatDateTime.time this.webLog.timeZone ticks // ---- Admin models ---- /// Admin Dashboard view model -type DashboardModel(ctx, webLog) = +type DashboardModel(ctx, webLog, counts : DashboardCounts) = inherit MyWebLogModel(ctx, webLog) /// The number of posts for the current web log - member val posts = 0 with get, set + member val posts = counts.posts with get, set /// The number of pages for the current web log - member val pages = 0 with get, set + member val pages = counts.pages with get, set /// The number of categories for the current web log - member val categories = 0 with get, set + member val categories = counts.categories with get, set // ---- Category models ---- @@ -110,7 +156,7 @@ with indent = snd cat selected = isSelected (fst cat).id } /// Display name for a category on the list page, complete with indents - member this.listName = sprintf "%s%s" (String.replicate this.indent " ઻   ") this.category.name + member this.listName = sprintf "%s%s" (String.replicate this.indent " »   ") this.category.name /// Display for this category as an option within a select box member this.option = seq { @@ -121,6 +167,9 @@ with yield "" } |> String.concat "" + /// Does the category have a description? + member this.hasDescription = this.category.description.IsSome + /// Model for the list of categories type CategoryListModel(ctx, webLog, categories) = @@ -237,6 +286,28 @@ type PostModel(ctx, webLog, post) = |> List.sort |> List.map (fun tag -> tag, tag.Replace(' ', '+')) + +/// Wrapper for a post with additional properties +type PostForDisplay(webLog : WebLog, post : Post) = + /// Turn tags into a pipe-delimited string of tags + let pipedTags tags = tags |> List.reduce (fun acc x -> sprintf "%s | %s" acc x) + /// The actual post + member this.post = post + /// The time zone for the web log to which this post belongs + member this.timeZone = webLog.timeZone + /// The date the post was published + member this.publishedDate = FormatDateTime.longDate this.timeZone this.post.publishedOn + /// The time the post was published + member this.publishedTime = FormatDateTime.time this.timeZone this.post.publishedOn + /// Tags + member this.tags = + match List.length this.post.tags with + | 0 -> "" + | 1 | 2 | 3 | 4 | 5 -> this.post.tags |> pipedTags + | count -> sprintf "%s %s" (this.post.tags |> List.take 3 |> pipedTags) + (System.String.Format(Resources.andXMore, count - 3)) + + /// Model for all page-of-posts pages type PostsModel(ctx, webLog) = inherit MyWebLogModel(ctx, webLog) @@ -245,7 +316,7 @@ type PostsModel(ctx, webLog) = member val subtitle = Option.None with get, set /// The posts to display - member val posts = List.empty with get, set + member val posts = List.empty with get, set /// The page number of the post list member val pageNbr = 0 with get, set @@ -320,12 +391,18 @@ type EditPostModel(ctx, webLog, post, revision) = // ---- User models ---- -/// Model to support the user log on page -type LogOnModel(ctx, webLog) = - inherit MyWebLogModel(ctx, webLog) +/// Form for the log on page +type LogOnForm() = /// The URL to which the user will be directed upon successful log on member val returnUrl = "" with get, set /// The e-mail address member val email = "" with get, set /// The user's passwor member val password = "" with get, set + + +/// Model to support the user log on page +type LogOnModel(ctx, webLog) = + inherit MyWebLogModel(ctx, webLog) + /// The log on form + member val form = LogOnForm() with get, set diff --git a/src/myWebLog/myWebLog.csproj b/src/myWebLog/myWebLog.csproj index d184d20..6807cef 100644 --- a/src/myWebLog/myWebLog.csproj +++ b/src/myWebLog/myWebLog.csproj @@ -51,6 +51,7 @@ Always + Always diff --git a/src/myWebLog/views/admin/admin-layout.html b/src/myWebLog/views/admin/admin-layout.html index 71316a7..8d96785 100644 --- a/src/myWebLog/views/admin/admin-layout.html +++ b/src/myWebLog/views/admin/admin-layout.html @@ -32,7 +32,9 @@
- + @Each.messages + @Current.toDisplay + @EndEach @Section['Content'];