single post page / admin dashboard

need to go back and revisit dynamic interop and the admin dashboard to
see if that can be one query instead of 3

src/myWebLog.Data/Category.fs

@@ -26,3 +26,11 @@ let getAllCategories conn webLogId =
   |> runCursorAsync<Category> conn
   |> Seq.toList
   |> sortCategories
+
+/// Count categories for a web log
+let countCategories conn webLogId =
+  table Table.Category
+  |> getAll [| webLogId |]
+  |> optArg "index" "webLogId"
+  |> count
+  |> runAtomAsync<int> conn

src/myWebLog.Data/Page.fs

@@ -23,3 +23,20 @@ let tryFindPageWithoutRevisions conn webLogId pageId : Page option =
         |> box with
   | null -> None
   | 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<Page> conn
+  |> Seq.tryHead
+
+/// Count pages for a web log
+let countPages conn webLogId =
+  table Table.Page
+  |> getAll [| webLogId |]
+  |> optArg "index" "webLogId"
+  |> count
+  |> runAtomAsync<int> conn

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<Post> 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<Post> 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<int> conn

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

src/myWebLog.Data/myWebLog.Data.fsproj

@@ -64,17 +64,26 @@
   </ItemGroup>
   <ItemGroup>
     <Reference Include="Common.Logging">
-      <HintPath>..\packages\Common.Logging.3.3.0\lib\net40\Common.Logging.dll</HintPath>
+      <HintPath>..\packages\Common.Logging.3.3.1\lib\net40\Common.Logging.dll</HintPath>
       <Private>True</Private>
     </Reference>
     <Reference Include="Common.Logging.Core">
-      <HintPath>..\packages\Common.Logging.Core.3.3.0\lib\net40\Common.Logging.Core.dll</HintPath>
+      <HintPath>..\packages\Common.Logging.Core.3.3.1\lib\net40\Common.Logging.Core.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="Dynamitey">
+      <HintPath>..\packages\Dynamitey.1.0.2.0\lib\net40\Dynamitey.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="FSharp.Core">
+      <HintPath>..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="FSharp.Interop.Dynamic">
+      <HintPath>..\packages\FSharp.Interop.Dynamic.3.0.0.0\lib\portable-net45+sl50+win\FSharp.Interop.Dynamic.dll</HintPath>
       <Private>True</Private>
     </Reference>
     <Reference Include="mscorlib" />
-    <Reference Include="FSharp.Core, Version=$(TargetFSharpCoreVersion), Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
-      <Private>True</Private>
-    </Reference>
     <Reference Include="Newtonsoft.Json">
       <HintPath>..\packages\Newtonsoft.Json.9.0.1\lib\net45\Newtonsoft.Json.dll</HintPath>
       <Private>True</Private>

src/myWebLog.Data/packages.config

@@ -1,7 +1,10 @@
 <?xml version="1.0" encoding="utf-8"?>
 <packages>
-  <package id="Common.Logging" version="3.3.0" targetFramework="net452" />
+  <package id="Common.Logging" version="3.3.1" targetFramework="net452" />
-  <package id="Common.Logging.Core" version="3.3.0" targetFramework="net452" />
+  <package id="Common.Logging.Core" version="3.3.1" targetFramework="net452" />
+  <package id="Dynamitey" version="1.0.2.0" targetFramework="net452" />
+  <package id="FSharp.Core" version="4.0.0.1" targetFramework="net452" />
+  <package id="FSharp.Interop.Dynamic" version="3.0.0.0" targetFramework="net452" />
   <package id="Newtonsoft.Json" version="9.0.1" targetFramework="net452" />
   <package id="RethinkDb.Driver" version="2.3.8" targetFramework="net452" />
 </packages>

src/myWebLog.Resources/Resources.Designer.cs

@@ -177,6 +177,15 @@ namespace myWebLog {
             }
         }
         
+        /// <summary>
+        ///   Looks up a localized string similar to List All.
+        /// </summary>
+        public static string ListAll {
+            get {
+                return ResourceManager.GetString("ListAll", resourceCulture);
+            }
+        }
+        
         /// <summary>
         ///   Looks up a localized string similar to Log Off.
         /// </summary>
@@ -213,6 +222,15 @@ namespace myWebLog {
             }
         }
         
+        /// <summary>
+        ///   Looks up a localized string similar to Next Post.
+        /// </summary>
+        public static string NextPost {
+            get {
+                return ResourceManager.GetString("NextPost", resourceCulture);
+            }
+        }
+        
         /// <summary>
         ///   Looks up a localized string similar to Older Posts.
         /// </summary>
@@ -231,6 +249,15 @@ namespace myWebLog {
             }
         }
         
+        /// <summary>
+        ///   Looks up a localized string similar to Pages.
+        /// </summary>
+        public static string Pages {
+            get {
+                return ResourceManager.GetString("Pages", resourceCulture);
+            }
+        }
+        
         /// <summary>
         ///   Looks up a localized string similar to Permalink.
         /// </summary>
@@ -267,6 +294,15 @@ namespace myWebLog {
             }
         }
         
+        /// <summary>
+        ///   Looks up a localized string similar to Posts tagged.
+        /// </summary>
+        public static string PostsTagged {
+            get {
+                return ResourceManager.GetString("PostsTagged", resourceCulture);
+            }
+        }
+        
         /// <summary>
         ///   Looks up a localized string similar to Post Status.
         /// </summary>
@@ -276,6 +312,15 @@ namespace myWebLog {
             }
         }
         
+        /// <summary>
+        ///   Looks up a localized string similar to Previous Post.
+        /// </summary>
+        public static string PreviousPost {
+            get {
+                return ResourceManager.GetString("PreviousPost", resourceCulture);
+            }
+        }
+        
         /// <summary>
         ///   Looks up a localized string similar to PublishedDate.
         /// </summary>

src/myWebLog.Resources/Resources.resx

@@ -156,6 +156,9 @@
   <data name="ErrNotConfigured" xml:space="preserve">
     <value>is not properly configured for myWebLog</value>
   </data>
+  <data name="ListAll" xml:space="preserve">
+    <value>List All</value>
+  </data>
   <data name="LogOff" xml:space="preserve">
     <value>Log Off</value>
   </data>
@@ -168,12 +171,18 @@
   <data name="NewerPosts" xml:space="preserve">
     <value>Newer Posts</value>
   </data>
+  <data name="NextPost" xml:space="preserve">
+    <value>Next Post</value>
+  </data>
   <data name="OlderPosts" xml:space="preserve">
     <value>Older Posts</value>
   </data>
   <data name="PageHash" xml:space="preserve">
     <value>Page #</value>
   </data>
+  <data name="Pages" xml:space="preserve">
+    <value>Pages</value>
+  </data>
   <data name="Permalink" xml:space="preserve">
     <value>Permalink</value>
   </data>
@@ -186,9 +195,15 @@
   <data name="Posts" xml:space="preserve">
     <value>Posts</value>
   </data>
+  <data name="PostsTagged" xml:space="preserve">
+    <value>Posts tagged</value>
+  </data>
   <data name="PostStatus" xml:space="preserve">
     <value>Post Status</value>
   </data>
+  <data name="PreviousPost" xml:space="preserve">
+    <value>Previous Post</value>
+  </data>
   <data name="PublishedDate" xml:space="preserve">
     <value>PublishedDate</value>
   </data>

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]

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

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<Post>.None with get, set
+  /// The next older post
+  member val olderPost = Option<Post>.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

src/myWebLog.Web/myWebLog.Web.fsproj

@@ -54,6 +54,7 @@
     <Compile Include="Keys.fs" />
     <Compile Include="ViewModels.fs" />
     <Compile Include="ModuleExtensions.fs" />
+    <Compile Include="AdminModule.fs" />
     <Compile Include="PostModule.fs" />
     <Compile Include="App.fs" />
     <Content Include="packages.config" />

src/myWebLog/myWebLog.csproj

@@ -69,6 +69,7 @@
     <Content Include="content\scripts\tinymce-init.js" />
     <Content Include="content\styles\admin.css" />
     <Content Include="views\admin\admin-layout.html" />
+    <Content Include="views\admin\dashboard.html" />
     <Content Include="views\admin\post\edit.html" />
     <Content Include="views\admin\post\list.html" />
     <Content Include="views\default\index-content.html" />
@@ -76,6 +77,8 @@
     <Content Include="views\default\layout.html" />
     <Content Include="views\default\page-content.html" />
     <Content Include="views\default\page.html" />
+    <Content Include="views\default\single-content.html" />
+    <Content Include="views\default\single.html" />
   </ItemGroup>
   <Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />
   <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 

src/myWebLog/views/admin/dashboard.html

@@ -0,0 +1,32 @@
+@Master['admin/admin-layout']
+
+@Section['Content']
+  <div class="row">
+    <div class="col-xs-6">
+      <h3>@Translate.Posts &nbsp;<span class="badge">@Model.posts</span></h3>
+      <p>
+        <a href="/posts/list"><i class="fa fa-list-ul"></i> @Translate.ListAll</a>
+        &nbsp; &nbsp;
+        <a href="/post/new/edit"><i class="fa fa-plus"></i> @Translate.AddNew</a>
+      </p>
+    </div>
+    <div class="col-xs-6">
+      <h3>@Translate.Pages &nbsp;<span class="badge">@Model.pages</span></h3>
+      <p>
+        <a href="/pages/list"><i class="fa fa-list-ul"></i> @Translate.ListAll</a>
+        &nbsp; &nbsp;
+        <a href="/page/new/edit"><i class="fa fa-plus"></i> @Translate.AddNew</a>
+      </p>
+    </div>
+  </div>
+  <div class="row">
+    <div class="col-xs-6">
+      <h3>@Translate.Categories &nbsp;<span class="badge">@Model.categories</span></h3>
+      <p>
+        <a href="/categories/list"><i class="fa fa-list.ul"></i> @Translate.ListAll</a>
+        &nbsp; &nbsp;
+        <a href="/category/new/edit"><i class="fa fa-plus"></i> @Translate.AddNew</a>
+      </p>
+    </div>
+  </div>
+@EndSection

src/myWebLog/views/default/single-content.html

@@ -0,0 +1,69 @@
+<article>
+  <div class="row">
+    <div class="col-xs-12"><h1>@Model.post.title</h1></div>
+  </div>
+  <div class="row">
+    <div class="col-xs-12">
+      <h4>
+        <i class="fa fa-calendar" title="@Translate.Date"></i> &nbsp;@Model.publishedDate
+        <i class="fa fa-clock-o" title="@Translate.Time"></i> &nbsp;@Model.publishedTime &nbsp; &nbsp; &nbsp;
+        @Each.post.categories
+          <i class="fa fa-folder-open-o" title="@Translate.Category"></i> &nbsp;
+          <!-- <a href="/category/@Current.slug" title=__("Categorized under %s", category.name)) -->
+          @Current.name &nbsp; &nbsp;
+        @EndEach
+      </h4>
+    </div>
+  </div>
+  <div class="row">
+    <div class="col-xs-12">@Model.post.text</div>
+  </div>
+  @If.hasTags
+    <div class="row">
+      <div class="col-xs-12">
+        @Each.tags
+          <a href="/tag/@Current.Item2" title="@Translate.PostsTagged &quot;@Current.Item1&quot;">
+            <i class="fa fa-tag"></i> @Current.Item1
+          </a> &nbsp; &nbsp;
+        @EndEach
+      </div>
+    </div>
+  @EndIf
+</article>
+<div class="row">
+  <div class="col-xs-12"><hr /></div>
+</div>
+<!-- // TODO: format comments -->
+<!-- .row
+  .col-xs-12
+    each comment in post.comments
+      if 'Approved' == comment.status
+        h4
+          if comment.url
+            a(href=comment.url)= comment.name
+          else
+            = comment.name
+          | &nbsp; &nbsp;
+          small
+            =moment(comment.postedDate).format('MMMM Do, YYYY / h:mma')
+        != comment.text -->
+<div class="row">
+  <div class="col-xs-12"><hr /></div>
+</div>
+<div class="row">
+  <div class="col-xs-6">
+    @If.newerPost.IsSome
+      <a href="/@Model.newerPost.Value.permalink" title="@Translate.NextPost - &quot;@Model.newerPost.Value.title&quot;">
+        &#xab;&nbsp; @Model.newerPost.Value.title
+      </a>
+    @EndIf
+  </div>
+  <div class="col-xs-6 text-right">
+    @If.olderPost.IsSome
+      <a href="/@Model.olderPost.Value.permalink"
+         title="@Translate.PreviousPost - &quot;@Model.olderPost.Value.title&quot;">
+        @Model.olderPost.Value.title &nbsp;&#xbb;
+      </a>
+    @EndIf
+  </div>
+</div>

src/myWebLog/views/default/single.html

@@ -0,0 +1,5 @@
+@Master['default/layout']
+
+@Section['Content']
+  @Partial['default/single-content', Model]
+@EndSection