Misc changes over the past month or so

- RSS feeds partially done
- All three initial target themes, as well as the default theme, display
properly

.gitignore

@@ -252,3 +252,8 @@ paket-files/
 # JetBrains Rider
 .idea/
 *.sln.iml
+
+# Personal themes used to test initial release
+src/MyWebLog/views/themes/daniel-j-summers
+src/MyWebLog/views/themes/daniels-weekly-devotions
+src/MyWebLog/views/themes/djs-consulting

src/MyWebLog.App/App.fs

@@ -155,9 +155,10 @@ type Startup() =
 
 
 let Run () =
+  use host = 
     WebHostBuilder()
       .UseContentRoot(System.IO.Directory.GetCurrentDirectory())
       .UseKestrel()
       .UseStartup<Startup>()
       .Build()
-    .Run()
+  host.Run()

src/MyWebLog.App/PostModule.fs

@@ -13,7 +13,14 @@ open Nancy.Session.Persistable
 open NodaTime
 open RethinkDb.Driver.Net
 open System
-//open System.ServiceModel.Syndication
+open System.Xml.Linq
+
+type NewsItem =
+  { Title : string 
+    Link : string
+    ReleaseDate : DateTime 
+    Description : string
+  }
 
 /// Routes dealing with posts (including the home page, /tag, /category, RSS, and catch-all routes)
 type PostModule(data : IMyWebLogData, clock : IClock) as this =
@@ -28,8 +35,45 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
 
   /// Generate an RSS/Atom feed of the latest posts
   let generateFeed format : obj =
-    this.NotFound ()
+    let myChannelFeed channelTitle channelLink channelDescription (items : NewsItem list) =
-    (* let posts  = findFeedPosts data this.WebLog.Id 10
+      let xn = XName.Get
+      let elem name (valu:string) = XElement(xn name, valu)
+      let elems =
+        items
+        |> List.sortBy (fun i -> i.ReleaseDate) 
+        |> List.map (fun i ->
+            XElement
+              (xn "item",
+               elem "title" (System.Net.WebUtility.HtmlEncode i.Title),
+               elem "link" i.Link,
+               elem "guid" i.Link,
+               elem "pubDate" (i.ReleaseDate.ToString "r"),
+               elem "description" (System.Net.WebUtility.HtmlEncode i.Description)
+            ))
+      XDocument(
+        XDeclaration("1.0", "utf-8", "yes"),
+        XElement
+          (xn "rss",
+           XAttribute(xn "version", "2.0"),
+           elem "title" channelTitle,
+           elem "link" channelLink,
+           elem "description" (defaultArg channelDescription ""),
+           elem "language" "en-us",
+           XElement(xn "channel", elems))
+        |> box)
+      |> box
+    let schemeAndUrl = sprintf "%s://%s" this.Request.Url.Scheme this.WebLog.UrlBase
+    findFeedPosts data this.WebLog.Id 10
+    |> List.map (fun (post, _) ->
+        { Title       = post.Title
+          Link        = sprintf "%s/%s" schemeAndUrl post.Permalink
+          ReleaseDate = Instant.FromUnixTimeTicks(post.PublishedOn).ToDateTimeOffset().DateTime
+          Description = post.Text
+          })
+    |> myChannelFeed this.WebLog.Name schemeAndUrl this.WebLog.Subtitle
+    // TODO: how to return this?
+
+    (* 
     let feed   =
       SyndicationFeed(
         this.WebLog.Name, defaultArg this.WebLog.Subtitle null,

src/MyWebLog.Data.RethinkDB/Category.fs

@@ -13,25 +13,32 @@ let private category (webLogId : string) (catId : string) =
 
 /// Get all categories for a web log
 let getAllCategories conn (webLogId : string) =
-  r.Table(Table.Category)
+  async {
+    return! r.Table(Table.Category)
               .GetAll(webLogId).OptArg("index", "WebLogId")
               .OrderBy("Name")
-    .RunResultAsync<Category list>(conn)
+              .RunResultAsync<Category list> conn
-  |> await
+    }
+  |> Async.RunSynchronously
 
 /// Get a specific category by its Id
 let tryFindCategory conn webLogId catId : Category option =
-  (category webLogId catId)
+  async {
-    .RunResultAsync<Category>(conn)
+    let! catt = (category webLogId catId).RunResultAsync<Category> conn
-  |> await
+    return catt
     |> box
     |> function null -> None | cat -> Some <| unbox cat
+    }
+  |> Async.RunSynchronously
 
 /// Add a category
 let addCategory conn (cat : Category) =
-  r.Table(Table.Category)
+  async {
+    do! r.Table(Table.Category)
           .Insert(cat)
-    .RunResultAsync(conn) |> await |> ignore
+          .RunResultAsync conn
+    }
+  |> Async.RunSynchronously
 
 type CategoryUpdateRecord =
   { Name : string
@@ -39,23 +46,29 @@ type CategoryUpdateRecord =
     Description : string option
     ParentId : string option
   }
-
 /// Update a category
 let updateCategory conn (cat : Category) =
-  (category cat.WebLogId cat.Id)
+  async {
+    do! (category cat.WebLogId cat.Id)
           .Update({ CategoryUpdateRecord.Name = cat.Name
                     Slug        = cat.Slug
                     Description = cat.Description
-              ParentId    = cat.ParentId })
+                    ParentId    = cat.ParentId
-    .RunResultAsync(conn) |> await |> ignore
+                    })
+          .RunResultAsync conn
+    }
+  |> Async.RunSynchronously
 
 type CategoryChildrenUpdateRecord =
   { Children : string list }
 /// Update a category's children
 let updateChildren conn webLogId parentId (children : string list) =
-  (category webLogId parentId)
+  async {
+    do! (category webLogId parentId)
           .Update({ CategoryChildrenUpdateRecord.Children = children })
-    .RunResultAsync(conn) |> await |> ignore
+          .RunResultAsync conn
+    }
+  |> Async.RunSynchronously
 
 type CategoryParentUpdateRecord =
   { ParentId : string option }
@@ -63,6 +76,7 @@ type PostCategoriesUpdateRecord =
   { CategoryIds : string list }
 /// Delete a category
 let deleteCategory conn (cat : Category) =
+  async {
     // Remove the category from its parent
     match cat.ParentId with
     | Some parentId -> match tryFindCategory conn cat.WebLogId parentId with
@@ -74,32 +88,47 @@ let deleteCategory conn (cat : Category) =
     // Move this category's children to its parent
     let newParent = { CategoryParentUpdateRecord.ParentId = cat.ParentId }
     cat.Children
-  |> List.iter (fun childId -> (category cat.WebLogId childId)
+    |> List.map  (fun childId ->
+        async {
+          do! (category cat.WebLogId childId)
                 .Update(newParent)
-                                 .RunResultAsync(conn) |> await |> ignore)
+                .RunResultAsync conn
+          })
+    |> List.iter Async.RunSynchronously
     // Remove the category from posts where it is assigned
+    let! posts =
       r.Table(Table.Post)
         .GetAll(cat.WebLogId).OptArg("index", "WebLogId")
         .Filter(ReqlFunction1(fun p -> upcast p.["CategoryIds"].Contains(cat.Id)))
-    .RunResultAsync<Post list>(conn)
+        .RunResultAsync<Post list> conn
-  |> await
+      |> Async.AwaitTask
-  |> List.iter (fun post -> let newCats = 
+    posts
+    |> List.map (fun post ->
+        async {
+          let newCats = 
             { PostCategoriesUpdateRecord.CategoryIds = post.CategoryIds
-                                                                         |> List.filter (fun c -> c <> cat.Id) }
+                                                       |> List.filter (fun c -> c <> cat.Id)
-                            r.Table(Table.Post)
+            }
+          do! r.Table(Table.Post)
                 .Get(post.Id)
                 .Update(newCats)
-                              .RunResultAsync(conn) |> await |> ignore)
+                .RunResultAsync conn
+          })
+    |> List.iter Async.RunSynchronously
     // Now, delete the category
-  r.Table(Table.Category)
+    do! r.Table(Table.Category)
           .Get(cat.Id)
           .Delete()
-    .RunResultAsync(conn) |> await |> ignore
+          .RunResultAsync(conn)
+    }
+  |> Async.RunSynchronously
 
 /// Get a category by its slug
 let tryFindCategoryBySlug conn (webLogId : string) (slug : string) =
-  r.Table(Table.Category)
+  async {
+    let! cat = r.Table(Table.Category)
                 .GetAll(r.Array(webLogId, slug)).OptArg("index", "Slug")
-    .RunResultAsync<Category list>(conn)
+                .RunResultAsync<Category list> conn
-  |> await
+    return cat |> List.tryHead
-  |> List.tryHead
+    }
+  |> Async.RunSynchronously

src/MyWebLog.Data.RethinkDB/Extensions.fs

@@ -1,7 +1,18 @@
 [<AutoOpen>]
 module MyWebLog.Data.RethinkDB.Extensions
 
-open RethinkDb.Driver.Ast
+open System.Threading.Tasks
-open RethinkDb.Driver.Net
 
 let await task = task |> Async.AwaitTask |> Async.RunSynchronously
+
+// H/T: Suave
+type AsyncBuilder with
+  /// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
+  /// a standard .NET task
+  member x.Bind(t : Task<'T>, f:'T -> Async<'R>) : Async<'R> = async.Bind(Async.AwaitTask t, f)
+
+  /// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
+  /// a standard .NET task which does not commpute a value
+  member x.Bind(t : Task, f : unit -> Async<'R>) : Async<'R> = async.Bind(Async.AwaitTask t, f)
+
+  member x.ReturnFrom(t : Task<'T>) = Async.AwaitTask t

src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs

@@ -6,42 +6,42 @@ open RethinkDb.Driver.Net
 /// RethinkDB implementation of myWebLog data persistence
 type RethinkMyWebLogData(conn : IConnection, cfg : DataConfig) =
   interface IMyWebLogData with
-    member this.SetUp = fun () -> SetUp.startUpCheck cfg
+    member __.SetUp = fun () -> SetUp.startUpCheck cfg
     
-    member this.AllCategories  = Category.getAllCategories         conn
+    member __.AllCategories  = Category.getAllCategories         conn
-    member this.CategoryById   = Category.tryFindCategory          conn
+    member __.CategoryById   = Category.tryFindCategory          conn
-    member this.CategoryBySlug = Category.tryFindCategoryBySlug    conn
+    member __.CategoryBySlug = Category.tryFindCategoryBySlug    conn
-    member this.AddCategory    = Category.addCategory              conn
+    member __.AddCategory    = Category.addCategory              conn
-    member this.UpdateCategory = Category.updateCategory           conn
+    member __.UpdateCategory = Category.updateCategory           conn
-    member this.UpdateChildren = Category.updateChildren           conn
+    member __.UpdateChildren = Category.updateChildren           conn
-    member this.DeleteCategory = Category.deleteCategory           conn
+    member __.DeleteCategory = Category.deleteCategory           conn
 
-    member this.PageById        = Page.tryFindPageById             conn
+    member __.PageById        = Page.tryFindPageById             conn
-    member this.PageByPermalink = Page.tryFindPageByPermalink      conn
+    member __.PageByPermalink = Page.tryFindPageByPermalink      conn
-    member this.AllPages        = Page.findAllPages                conn
+    member __.AllPages        = Page.findAllPages                conn
-    member this.AddPage         = Page.addPage                     conn
+    member __.AddPage         = Page.addPage                     conn
-    member this.UpdatePage      = Page.updatePage                  conn
+    member __.UpdatePage      = Page.updatePage                  conn
-    member this.DeletePage      = Page.deletePage                  conn
+    member __.DeletePage      = Page.deletePage                  conn
 
-    member this.PageOfPublishedPosts   = Post.findPageOfPublishedPosts    conn
+    member __.PageOfPublishedPosts   = Post.findPageOfPublishedPosts    conn
-    member this.PageOfCategorizedPosts = Post.findPageOfCategorizedPosts  conn
+    member __.PageOfCategorizedPosts = Post.findPageOfCategorizedPosts  conn
-    member this.PageOfTaggedPosts      = Post.findPageOfTaggedPosts       conn
+    member __.PageOfTaggedPosts      = Post.findPageOfTaggedPosts       conn
-    member this.NewerPost              = Post.tryFindNewerPost            conn
+    member __.NewerPost              = Post.tryFindNewerPost            conn
-    member this.NewerCategorizedPost   = Post.tryFindNewerCategorizedPost conn
+    member __.NewerCategorizedPost   = Post.tryFindNewerCategorizedPost conn
-    member this.NewerTaggedPost        = Post.tryFindNewerTaggedPost      conn
+    member __.NewerTaggedPost        = Post.tryFindNewerTaggedPost      conn
-    member this.OlderPost              = Post.tryFindOlderPost            conn
+    member __.OlderPost              = Post.tryFindOlderPost            conn
-    member this.OlderCategorizedPost   = Post.tryFindOlderCategorizedPost conn
+    member __.OlderCategorizedPost   = Post.tryFindOlderCategorizedPost conn
-    member this.OlderTaggedPost        = Post.tryFindOlderTaggedPost      conn
+    member __.OlderTaggedPost        = Post.tryFindOlderTaggedPost      conn
-    member this.PageOfAllPosts         = Post.findPageOfAllPosts          conn
+    member __.PageOfAllPosts         = Post.findPageOfAllPosts          conn
-    member this.PostById               = Post.tryFindPost                 conn
+    member __.PostById               = Post.tryFindPost                 conn
-    member this.PostByPermalink        = Post.tryFindPostByPermalink      conn
+    member __.PostByPermalink        = Post.tryFindPostByPermalink      conn
-    member this.PostByPriorPermalink   = Post.tryFindPostByPriorPermalink conn
+    member __.PostByPriorPermalink   = Post.tryFindPostByPriorPermalink conn
-    member this.FeedPosts              = Post.findFeedPosts               conn
+    member __.FeedPosts              = Post.findFeedPosts               conn
-    member this.AddPost                = Post.addPost                     conn
+    member __.AddPost                = Post.addPost                     conn
-    member this.UpdatePost             = Post.updatePost                  conn
+    member __.UpdatePost             = Post.updatePost                  conn
 
-    member this.LogOn = User.tryUserLogOn conn
+    member __.LogOn = User.tryUserLogOn conn
 
-    member this.WebLogByUrlBase = WebLog.tryFindWebLogByUrlBase conn
+    member __.WebLogByUrlBase = WebLog.tryFindWebLogByUrlBase conn
-    member this.DashboardCounts = WebLog.findDashboardCounts    conn
+    member __.DashboardCounts = WebLog.findDashboardCounts    conn
     

src/MyWebLog.Data.RethinkDB/SetUp.fs

@@ -10,45 +10,56 @@ let private logStepDone  ()   = Console.Out.WriteLine (" done.")
 
 /// Ensure the myWebLog database exists
 let private checkDatabase (cfg : DataConfig) =
+  async {
     logStep "|> Checking database"
-  let dbs = r.DbList().RunResultAsync<string list>(cfg.Conn) |> await
+    let! dbs = r.DbList().RunResultAsync<string list> cfg.Conn
     match List.contains cfg.Database dbs with
     | true -> ()
     | _ -> logStepStart (sprintf "  %s database not found - creating" cfg.Database)
-         r.DbCreate(cfg.Database).RunResultAsync(cfg.Conn) |> await |> ignore
+           do! r.DbCreate(cfg.Database).RunResultAsync cfg.Conn
            logStepDone ()
+    }
+    
 
 /// Ensure all required tables exist
 let private checkTables cfg =
+  async {
     logStep "|> Checking tables"
-  let tables = r.Db(cfg.Database).TableList().RunResultAsync<string list>(cfg.Conn) |> await
+    let! tables = r.Db(cfg.Database).TableList().RunResultAsync<string list> cfg.Conn
     [ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
     |> List.filter (fun tbl -> not (List.contains tbl tables))
     |> List.iter   (fun tbl -> logStepStart (sprintf "  Creating table %s" tbl)
-                             (r.TableCreate tbl).RunResultAsync(cfg.Conn) |> await |> ignore
+                               async { do! (r.TableCreate tbl).RunResultAsync cfg.Conn } |> Async.RunSynchronously
                                logStepDone ())
+    }
 
 /// Shorthand to get the table
-let private tbl cfg table = r.Db(cfg.Database).Table(table)
+let private tbl cfg table = r.Db(cfg.Database).Table table
 
 /// Create the given index
 let private createIndex cfg table (index : string * (ReqlExpr -> obj) option) =
+  async {
     let idxName, idxFunc = index
     logStepStart (sprintf """  Creating index "%s" on table %s""" idxName table)
-  (match idxFunc with
+    do! (match idxFunc with
          | Some f -> (tbl cfg table).IndexCreate(idxName, f)
          | None -> (tbl cfg table).IndexCreate(idxName))
-    .RunResultAsync(cfg.Conn)
+           .RunResultAsync cfg.Conn
-  |> await |> ignore
+    do! (tbl cfg table).IndexWait(idxName).RunResultAsync cfg.Conn
-  (tbl cfg table).IndexWait(idxName).RunResultAsync(cfg.Conn) |> await |> ignore
     logStepDone ()
+    }
 
 /// Ensure that the given indexes exist, and create them if required
 let private ensureIndexes cfg (indexes : (string * (string * (ReqlExpr -> obj) option) list) list) =
   let ensureForTable (tblName, idxs) =
-    let idx = (tbl cfg tblName).IndexList().RunResultAsync<string list>(cfg.Conn) |> await
+    async {
+      let! idx = (tbl cfg tblName).IndexList().RunResultAsync<string list> cfg.Conn
       idxs
-    |> List.iter (fun index -> match List.contains (fst index) idx with true -> () | _ -> createIndex cfg tblName index)
+      |> List.filter (fun (idxName, _) -> not (List.contains idxName idx))
+      |> List.map    (fun index -> createIndex cfg tblName index)
+      |> List.iter   Async.RunSynchronously
+      }
+    |> Async.RunSynchronously
   indexes
   |> List.iter ensureForTable
 
@@ -80,8 +91,11 @@ let private checkIndexes cfg =
 
 /// Start up checks to ensure the database, tables, and indexes exist
 let startUpCheck cfg =
+  async {
     logStep "Database Start Up Checks Starting"
-  checkDatabase cfg
+    do! checkDatabase cfg
-  checkTables   cfg
+    do! checkTables   cfg
     checkIndexes cfg
     logStep "Database Start Up Checks Complete"
+    }
+  |> Async.RunSynchronously

src/MyWebLog.Data.RethinkDB/User.fs

@@ -10,9 +10,12 @@ let private r = RethinkDb.Driver.RethinkDB.R
 //       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) =
+  async {
+    let! user =
       r.Table(Table.User)
         .GetAll(email).OptArg("index", "UserName")
         .Filter(ReqlFunction1(fun u -> upcast u.["PasswordHash"].Eq(passwordHash)))
-    .RunResultAsync<User list>(conn)
+        .RunResultAsync<User list> conn
-  |> await
+    return user |> List.tryHead
-  |> List.tryHead
+    }
+  |> Async.RunSynchronously

src/MyWebLog.Data.RethinkDB/WebLog.fs

@@ -7,6 +7,8 @@ let private r = RethinkDb.Driver.RethinkDB.R
 
 /// Detemine the web log by the URL base
 let tryFindWebLogByUrlBase conn (urlBase : string) =
+  async {
+    let! cursor = 
       r.Table(Table.WebLog)
         .GetAll(urlBase).OptArg("index", "UrlBase")
         .Merge(ReqlFunction1(fun w ->
@@ -16,15 +18,19 @@ let tryFindWebLogByUrlBase conn (urlBase : string) =
                                         .OrderBy("Title")
                                         .Pluck("Title", "Permalink")
                                         .CoerceTo("array"))))
-    .RunResultAsync<WebLog list>(conn)
+        .RunCursorAsync<WebLog> conn
-  |> await
+    return cursor |> Seq.tryHead
-  |> List.tryHead
+    }
+  |> Async.RunSynchronously
   
 /// Get counts for the admin dashboard
 let findDashboardCounts conn (webLogId : string) =
+  async {
+    return!
       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()))
-    .RunResultAsync<DashboardCounts>(conn)
+        .RunResultAsync<DashboardCounts> conn
-  |> await
+    }
+  |> Async.RunSynchronously
     

src/MyWebLog.Logic/Page.fs

@@ -19,7 +19,7 @@ let findAllPages (data : IMyWebLogData) webLogId = data.AllPages webLogId
 /// Save a page
 let savePage (data : IMyWebLogData) (page : Page) =
   match page.Id with
-  | "new" -> let newPg = { page with Id = string <| System.Guid.NewGuid() }
+  | "new" -> let newPg = { page with Id = string <| System.Guid.NewGuid () }
              data.AddPage newPg
              newPg.Id
   | _ -> data.UpdatePage page