diff --git a/src/myWebLog.Data/Category.fs b/src/myWebLog.Data/Category.fs index 567ca2f..3f7bdcf 100644 --- a/src/myWebLog.Data/Category.fs +++ b/src/myWebLog.Data/Category.fs @@ -26,3 +26,11 @@ let getAllCategories conn webLogId = |> runCursorAsync conn |> Seq.toList |> sortCategories + +/// Count categories for a web log +let countCategories conn webLogId = + table Table.Category + |> getAll [| webLogId |] + |> optArg "index" "webLogId" + |> count + |> runAtomAsync conn diff --git a/src/myWebLog.Data/Page.fs b/src/myWebLog.Data/Page.fs index db585ec..f28b048 100644 --- a/src/myWebLog.Data/Page.fs +++ b/src/myWebLog.Data/Page.fs @@ -22,4 +22,21 @@ let tryFindPageWithoutRevisions conn webLogId pageId : Page option = |> runAtomAsync conn |> box with | null -> None - | page -> Some <| unbox page \ No newline at end of file + | page -> Some <| unbox page + +/// Find a page by its permalink +let tryFindPageByPermalink conn webLogId permalink = + table Table.Page + |> getAll [| webLogId, permalink |] + |> optArg "index" "permalink" + |> without [| "revisions" |] + |> runCursorAsync conn + |> Seq.tryHead + +/// Count pages for a web log +let countPages conn webLogId = + table Table.Page + |> getAll [| webLogId |] + |> optArg "index" "webLogId" + |> count + |> runAtomAsync conn diff --git a/src/myWebLog.Data/Post.fs b/src/myWebLog.Data/Post.fs index 8231f15..d73f7b3 100644 --- a/src/myWebLog.Data/Post.fs +++ b/src/myWebLog.Data/Post.fs @@ -1,8 +1,11 @@ module myWebLog.Data.Post +open FSharp.Interop.Dynamic open myWebLog.Entities open Rethink open RethinkDb.Driver +open RethinkDb.Driver.Ast +open System.Dynamic let private r = RethinkDB.R @@ -58,6 +61,34 @@ let tryFindPost conn webLogId postId : Post option = | null -> None | post -> Some <| unbox post +/// Try to find a post by its permalink +let tryFindPostByPermalink conn webLogId permalink = + (table Table.Post + |> getAll [| webLogId, permalink |] + |> optArg "index" "permalink" + |> without [| "revisions" |]) + .Merge(fun post -> ExpandoObject()?categories <- + post.["categoryIds"] + .Map(ReqlFunction1(fun cat -> upcast r.Table(Table.Category).Get(cat).Without("children"))) + .CoerceTo("array")) + .Merge(fun post -> ExpandoObject()?comments <- + r.Table(Table.Comment) + .GetAll(post.["id"]).OptArg("index", "postId") + .OrderBy("postedOn") + .CoerceTo("array")) + |> runCursorAsync conn + |> Seq.tryHead + +/// Try to find a post by its prior permalink +let tryFindPostByPriorPermalink conn webLogId permalink = + (table Table.Post + |> getAll [| webLogId |] + |> optArg "index" "webLogId") + .Filter(fun post -> post.["priorPermalinks"].Contains(permalink :> obj)) + |> without [| "revisions" |] + |> runCursorAsync conn + |> Seq.tryHead + /// Save a post let savePost conn post = match post.id with @@ -73,3 +104,11 @@ let savePost conn post = |> runResultAsync conn |> ignore post.id + +/// Count posts for a web log +let countPosts conn webLogId = + table Table.Post + |> getAll [| webLogId |] + |> optArg "index" "webLogId" + |> count + |> runAtomAsync conn diff --git a/src/myWebLog.Data/Rethink.fs b/src/myWebLog.Data/Rethink.fs index c4a4486..5244836 100644 --- a/src/myWebLog.Data/Rethink.fs +++ b/src/myWebLog.Data/Rethink.fs @@ -6,6 +6,7 @@ open RethinkDb.Driver.Net let private r = RethinkDb.Driver.RethinkDB.R let private await task = task |> Async.AwaitTask |> Async.RunSynchronously +let count (expr : ReqlExpr) = expr.Count () let delete (expr : ReqlExpr) = expr.Delete () let filter (expr : ReqlExpr -> ReqlExpr) (table : ReqlExpr) = table.Filter expr let get (expr : obj) (table : Table) = table.Get expr diff --git a/src/myWebLog.Data/myWebLog.Data.fsproj b/src/myWebLog.Data/myWebLog.Data.fsproj index 5aade4d..ba49719 100644 --- a/src/myWebLog.Data/myWebLog.Data.fsproj +++ b/src/myWebLog.Data/myWebLog.Data.fsproj @@ -64,17 +64,26 @@ - ..\packages\Common.Logging.3.3.0\lib\net40\Common.Logging.dll + ..\packages\Common.Logging.3.3.1\lib\net40\Common.Logging.dll True - ..\packages\Common.Logging.Core.3.3.0\lib\net40\Common.Logging.Core.dll + ..\packages\Common.Logging.Core.3.3.1\lib\net40\Common.Logging.Core.dll + True + + + ..\packages\Dynamitey.1.0.2.0\lib\net40\Dynamitey.dll + True + + + ..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll + True + + + ..\packages\FSharp.Interop.Dynamic.3.0.0.0\lib\portable-net45+sl50+win\FSharp.Interop.Dynamic.dll True - - True - ..\packages\Newtonsoft.Json.9.0.1\lib\net45\Newtonsoft.Json.dll True diff --git a/src/myWebLog.Data/packages.config b/src/myWebLog.Data/packages.config index 8639c4f..7219fd6 100644 --- a/src/myWebLog.Data/packages.config +++ b/src/myWebLog.Data/packages.config @@ -1,7 +1,10 @@  - - + + + + + \ No newline at end of file diff --git a/src/myWebLog.Resources/Resources.Designer.cs b/src/myWebLog.Resources/Resources.Designer.cs index e22aa74..33654fa 100644 --- a/src/myWebLog.Resources/Resources.Designer.cs +++ b/src/myWebLog.Resources/Resources.Designer.cs @@ -177,6 +177,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to List All. + /// + public static string ListAll { + get { + return ResourceManager.GetString("ListAll", resourceCulture); + } + } + /// /// Looks up a localized string similar to Log Off. /// @@ -213,6 +222,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Next Post. + /// + public static string NextPost { + get { + return ResourceManager.GetString("NextPost", resourceCulture); + } + } + /// /// Looks up a localized string similar to Older Posts. /// @@ -231,6 +249,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Pages. + /// + public static string Pages { + get { + return ResourceManager.GetString("Pages", resourceCulture); + } + } + /// /// Looks up a localized string similar to Permalink. /// @@ -267,6 +294,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Posts tagged. + /// + public static string PostsTagged { + get { + return ResourceManager.GetString("PostsTagged", resourceCulture); + } + } + /// /// Looks up a localized string similar to Post Status. /// @@ -276,6 +312,15 @@ namespace myWebLog { } } + /// + /// Looks up a localized string similar to Previous Post. + /// + public static string PreviousPost { + get { + return ResourceManager.GetString("PreviousPost", resourceCulture); + } + } + /// /// Looks up a localized string similar to PublishedDate. /// diff --git a/src/myWebLog.Resources/Resources.resx b/src/myWebLog.Resources/Resources.resx index fd9397a..075e497 100644 --- a/src/myWebLog.Resources/Resources.resx +++ b/src/myWebLog.Resources/Resources.resx @@ -156,6 +156,9 @@ is not properly configured for myWebLog + + List All + Log Off @@ -168,12 +171,18 @@ Newer Posts + + Next Post + Older Posts Page # + + Pages + Permalink @@ -186,9 +195,15 @@ Posts + + Posts tagged + Post Status + + Previous Post + PublishedDate diff --git a/src/myWebLog.Web/AdminModule.fs b/src/myWebLog.Web/AdminModule.fs new file mode 100644 index 0000000..4dd0eea --- /dev/null +++ b/src/myWebLog.Web/AdminModule.fs @@ -0,0 +1,25 @@ +namespace myWebLog + +open myWebLog.Data.Category +open myWebLog.Data.Page +open myWebLog.Data.Post +open myWebLog.Entities +open Nancy +open RethinkDb.Driver.Net + +/// Handle /admin routes +type AdminModule(conn : IConnection) as this = + inherit NancyModule("/admin") + + do + this.Get.["/"] <- fun _ -> upcast this.Dashboard () + + /// 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 + model.pageTitle <- Resources.Dashboard + this.View.["admin/dashboard", model] diff --git a/src/myWebLog.Web/PostModule.fs b/src/myWebLog.Web/PostModule.fs index 803fab0..eb45248 100644 --- a/src/myWebLog.Web/PostModule.fs +++ b/src/myWebLog.Web/PostModule.fs @@ -6,14 +6,13 @@ open myWebLog.Data.Page open myWebLog.Data.Post open myWebLog.Entities open Nancy -open Nancy.Authentication.Forms open Nancy.ModelBinding open Nancy.Security open Nancy.Session.Persistable open NodaTime open RethinkDb.Driver.Net -/// Routes dealing with posts (including the home page) +/// Routes dealing with posts (including the home page and catch-all routes) type PostModule(conn : IConnection, clock : IClock) as this = inherit NancyModule() @@ -21,6 +20,7 @@ type PostModule(conn : IConnection, clock : IClock) as this = do this.Get .["/" ] <- fun _ -> upcast this.HomePage () + this.Get .["/{permalink*}" ] <- fun parms -> upcast this.CatchAll (downcast parms) this.Get .["/posts/page/{page:int}" ] <- fun parms -> upcast this.DisplayPageOfPublishedPosts (getPage parms) this.Get .["/posts/list" ] <- fun _ -> upcast this.PostList 1 this.Get .["/posts/list/page/{page:int}"] <- fun parms -> upcast this.PostList (getPage parms) @@ -56,6 +56,31 @@ type PostModule(conn : IConnection, clock : IClock) as this = this.ThemedView "page" model | None -> this.NotFound () + /// Derive a post or page from the URL, or redirect from a prior URL to the current one + member this.CatchAll (parameters : DynamicDictionary) = + let url : string = downcast parameters.["permalink"] + match tryFindPostByPermalink conn this.WebLog.id url with + | Some post -> // Hopefully the most common result; the permalink is a permalink! + let model = PostModel(this.Context, this.WebLog, post) + model.newerPost <- tryFindNewerPost conn post + model.olderPost <- tryFindOlderPost conn post + model.pageTitle <- post.title + this.ThemedView "single" model + | None -> // Maybe it's a page permalink instead... + match tryFindPageByPermalink conn this.WebLog.id url with + | Some page -> // ...and it is! + let model = PageModel(this.Context, this.WebLog, page) + model.pageTitle <- page.title + this.ThemedView "page" model + | None -> // Maybe it's an old permalink for a post + match tryFindPostByPriorPermalink conn this.WebLog.id url with + | Some post -> // Redirect them to the proper permalink + this.Negotiate + .WithHeader("Location", sprintf "/%s" post.permalink) + .WithStatusCode(HttpStatusCode.MovedPermanently) + | None -> this.NotFound () + + // ---- Administer posts ---- /// Display a page of posts in the admin area diff --git a/src/myWebLog.Web/ViewModels.fs b/src/myWebLog.Web/ViewModels.fs index e83278f..520c166 100644 --- a/src/myWebLog.Web/ViewModels.fs +++ b/src/myWebLog.Web/ViewModels.fs @@ -78,6 +78,52 @@ type MyWebLogModel(ctx : NancyContext, webLog : WebLog) = (this.zonedTime ticks |> ZonedDateTimePattern.CreateWithCurrentCulture("h':'mmtt", DateTimeZoneProviders.Tzdb).Format).ToLower() + +// ---- Admin models ---- + +/// Admin Dashboard view model +type DashboardModel(ctx, webLog) = + inherit MyWebLogModel(ctx, webLog) + /// The number of posts for the current web log + member val posts = 0 with get, set + /// The number of pages for the current web log + member val pages = 0 with get, set + /// The number of categories for the current web log + member val categories = 0 with get, set + + +// ---- Page models ---- + +/// Model for page display +type PageModel(ctx, webLog, page) = + inherit MyWebLogModel(ctx, webLog) + + /// The page to be displayed + member this.page : Page = page + + +// ---- Post models ---- + +/// Model for post display +type PostModel(ctx, webLog, post) = + inherit MyWebLogModel(ctx, webLog) + /// The post being displayed + member this.post : Post = post + /// The next newer post + member val newerPost = Option.None with get, set + /// The next older post + member val olderPost = Option.None with get, set + /// The date the post was published + member this.publishedDate = this.displayLongDate this.post.publishedOn + /// The time the post was published + member this.publishedTime = this.displayTime this.post.publishedOn + /// Does the post have tags? + member this.hasTags = List.length post.tags > 0 + /// Get the tags sorted + member this.tags = post.tags + |> List.sort + |> List.map (fun tag -> tag, tag.Replace(' ', '+')) + /// Model for all page-of-posts pages type PostsModel(ctx, webLog) = inherit MyWebLogModel(ctx, webLog) @@ -107,14 +153,6 @@ type PostsModel(ctx, webLog) = member this.olderLink = sprintf "%s/page/%i" this.urlPrefix (this.pageNbr + 1) -/// Model for page display -type PageModel(ctx, webLog, page) = - inherit MyWebLogModel(ctx, webLog) - - /// The page to be displayed - member this.page : Page = page - - /// Form for editing a post type EditPostForm() = /// The title of the post diff --git a/src/myWebLog.Web/myWebLog.Web.fsproj b/src/myWebLog.Web/myWebLog.Web.fsproj index 845781a..8146ae8 100644 --- a/src/myWebLog.Web/myWebLog.Web.fsproj +++ b/src/myWebLog.Web/myWebLog.Web.fsproj @@ -54,6 +54,7 @@ + diff --git a/src/myWebLog/myWebLog.csproj b/src/myWebLog/myWebLog.csproj index f87e3a1..6569d51 100644 --- a/src/myWebLog/myWebLog.csproj +++ b/src/myWebLog/myWebLog.csproj @@ -69,6 +69,7 @@ + @@ -76,6 +77,8 @@ + + + @Current.name     + @EndEach + + + +
+
@Model.post.text
+
+ @If.hasTags +
+
+ @Each.tags + + @Current.Item1 +     + @EndEach +
+
+ @EndIf + +
+
+
+ + +
+
+
+
+
+ @If.newerPost.IsSome + + «  @Model.newerPost.Value.title + + @EndIf +
+
+ @If.olderPost.IsSome + + @Model.olderPost.Value.title  » + + @EndIf +
+
\ No newline at end of file diff --git a/src/myWebLog/views/default/single.html b/src/myWebLog/views/default/single.html new file mode 100644 index 0000000..8dceb73 --- /dev/null +++ b/src/myWebLog/views/default/single.html @@ -0,0 +1,5 @@ +@Master['default/layout'] + +@Section['Content'] + @Partial['default/single-content', Model] +@EndSection \ No newline at end of file