diff --git a/src/myWebLog.Data/Page.fs b/src/myWebLog.Data/Page.fs index 904b0ff..6fdb455 100644 --- a/src/myWebLog.Data/Page.fs +++ b/src/myWebLog.Data/Page.fs @@ -3,6 +3,7 @@ open FSharp.Interop.Dynamic open myWebLog.Entities open Rethink +open RethinkDb.Driver.Ast open System.Dynamic let private r = RethinkDb.Driver.RethinkDB.R @@ -11,14 +12,18 @@ let private r = RethinkDb.Driver.RethinkDB.R let private page (webLogId : string) (pageId : string) = r.Table(Table.Page) .Get(pageId) - .Filter(fun p -> p.["webLogId"].Eq(webLogId)) + .Filter(ReqlFunction1(fun p -> upcast p.["webLogId"].Eq(webLogId))) /// Get a page by its Id -let tryFindPage conn webLogId pageId : Page option = - match (page webLogId pageId) +let tryFindPage conn webLogId pageId = + match r.Table(Table.Page) + .Get(pageId) .RunAtomAsync(conn) |> await |> box with | null -> None - | page -> Some <| unbox page + | page -> let pg : Page = unbox page + match pg.webLogId = webLogId with + | true -> Some pg + | _ -> None /// Get a page by its Id (excluding revisions) let tryFindPageWithoutRevisions conn webLogId pageId : Page option = diff --git a/src/myWebLog.Data/myWebLog.Data.fsproj b/src/myWebLog.Data/myWebLog.Data.fsproj index 8593331..4e52d36 100644 --- a/src/myWebLog.Data/myWebLog.Data.fsproj +++ b/src/myWebLog.Data/myWebLog.Data.fsproj @@ -91,7 +91,7 @@ True - ..\packages\RethinkDb.Driver.2.3.8\lib\net45\RethinkDb.Driver.dll + ..\packages\RethinkDb.Driver.2.3.9\lib\net45\RethinkDb.Driver.dll True diff --git a/src/myWebLog.Data/packages.config b/src/myWebLog.Data/packages.config index 7219fd6..16d155d 100644 --- a/src/myWebLog.Data/packages.config +++ b/src/myWebLog.Data/packages.config @@ -6,5 +6,5 @@ - + \ No newline at end of file diff --git a/src/myWebLog.Web/PageModule.fs b/src/myWebLog.Web/PageModule.fs index c12950d..9992b36 100644 --- a/src/myWebLog.Web/PageModule.fs +++ b/src/myWebLog.Web/PageModule.fs @@ -22,7 +22,8 @@ type PageModule(conn : IConnection, clock : IClock) as this = /// List all pages member this.PageList () = this.RequiresAccessLevel AuthorizationLevel.Administrator - let model = PagesModel(this.Context, this.WebLog, findAllPages conn this.WebLog.id) + let model = PagesModel(this.Context, this.WebLog, (findAllPages conn this.WebLog.id + |> List.map (fun p -> PageForDisplay(this.WebLog, p)))) model.pageTitle <- Resources.Pages upcast this.View.["admin/page/list", model] @@ -42,7 +43,7 @@ type PageModule(conn : IConnection, clock : IClock) as this = model.pageTitle <- match pageId with | "new" -> Resources.AddNewPage | _ -> Resources.EditPage - upcast this.View.["admin/page/edit"] + upcast this.View.["admin/page/edit", model] | None -> this.NotFound () /// Save a page diff --git a/src/myWebLog.Web/PostModule.fs b/src/myWebLog.Web/PostModule.fs index 5d24dfb..162158a 100644 --- a/src/myWebLog.Web/PostModule.fs +++ b/src/myWebLog.Web/PostModule.fs @@ -25,6 +25,37 @@ type PostModule(conn : IConnection, clock : IClock) as this = /// Convert a list of posts to a list of posts for display let forDisplay posts = posts |> List.map (fun post -> PostForDisplay(this.WebLog, post)) + /// Generate an RSS/Atom feed of the latest posts + let generateFeed format : obj = + let posts = findFeedPosts conn this.WebLog.id 10 + let feed = + SyndicationFeed( + this.WebLog.name, defaultArg this.WebLog.subtitle null, + Uri(sprintf "%s://%s" this.Request.Url.Scheme this.WebLog.urlBase), null, + (match posts |> List.tryHead with + | Some (post, _) -> Instant(post.updatedOn).ToDateTimeOffset () + | _ -> System.DateTimeOffset(System.DateTime.MinValue)), + posts + |> List.map (fun (post, user) -> + let item = + SyndicationItem( + BaseUri = Uri(sprintf "%s://%s/%s" this.Request.Url.Scheme this.WebLog.urlBase post.permalink), + PublishDate = Instant(post.publishedOn).ToDateTimeOffset (), + LastUpdatedTime = Instant(post.updatedOn).ToDateTimeOffset (), + Title = TextSyndicationContent(post.title), + Content = TextSyndicationContent(post.text, TextSyndicationContentKind.Html)) + user + |> Option.iter (fun u -> item.Authors.Add + (SyndicationPerson(u.userName, u.preferredName, defaultArg u.url null))) + post.categories + |> List.iter (fun c -> item.Categories.Add(SyndicationCategory(c.name))) + item)) + let stream = new IO.MemoryStream() + Xml.XmlWriter.Create(stream) + |> match format with | "atom" -> feed.SaveAsAtom10 | _ -> feed.SaveAsRss20 + stream.Position <- int64 0 + upcast this.Response.FromStream(stream, sprintf "application/%s+xml" format) + do this.Get .["/" ] <- fun _ -> this.HomePage () this.Get .["/{permalink*}" ] <- fun parms -> this.CatchAll (downcast parms) @@ -33,7 +64,7 @@ type PostModule(conn : IConnection, clock : IClock) as this = this.Get .["/category/{slug}/page/{page:int}"] <- fun parms -> this.CategorizedPosts (downcast parms) this.Get .["/tag/{tag}" ] <- fun parms -> this.TaggedPosts (downcast parms) this.Get .["/tag/{tag}/page/{page:int}" ] <- fun parms -> this.TaggedPosts (downcast parms) - this.Get .["/feed" ] <- fun parms -> this.GenerateFeed (downcast parms) + this.Get .["/feed" ] <- fun _ -> this.Feed () this.Get .["/posts/list" ] <- fun _ -> this.PostList 1 this.Get .["/posts/list/page/{page:int}" ] <- fun parms -> this.PostList (getPage <| downcast parms) this.Get .["/post/{postId}/edit" ] <- fun parms -> this.EditPost (downcast parms) @@ -137,38 +168,14 @@ type PostModule(conn : IConnection, clock : IClock) as this = this.ThemedView "index" model /// Generate an RSS feed - member this.GenerateFeed (parameters : DynamicDictionary) = - let format = match parameters.ContainsKey "format" with // FIXME: format not coming through on query string - | true -> parameters.["format"].ToString () - | _ -> "rss" - let posts = findFeedPosts conn this.WebLog.id 10 - let feed = - SyndicationFeed( - this.WebLog.name, defaultArg this.WebLog.subtitle null, - Uri(sprintf "%s://%s" this.Request.Url.Scheme this.WebLog.urlBase), null, - (match posts |> List.tryHead with - | Some (post, _) -> Instant(post.updatedOn).ToDateTimeOffset () - | _ -> System.DateTimeOffset(System.DateTime.MinValue)), - posts - |> List.map (fun (post, user) -> - let item = - SyndicationItem( - BaseUri = Uri(sprintf "%s://%s/%s" this.Request.Url.Scheme this.WebLog.urlBase post.permalink), - PublishDate = Instant(post.publishedOn).ToDateTimeOffset (), - LastUpdatedTime = Instant(post.updatedOn).ToDateTimeOffset (), - Title = TextSyndicationContent(post.title), - Content = TextSyndicationContent(post.text, TextSyndicationContentKind.Html)) - user - |> Option.iter (fun u -> item.Authors.Add - (SyndicationPerson(u.userName, u.preferredName, defaultArg u.url null))) - post.categories - |> List.iter (fun c -> item.Categories.Add(SyndicationCategory(c.name))) - item)) - let stream = new IO.MemoryStream() - Xml.XmlWriter.Create(stream) - |> match format with | "atom" -> feed.SaveAsAtom10 | _ -> feed.SaveAsRss20 - stream.Position <- int64 0 - upcast this.Response.FromStream(stream, sprintf "application/%s+xml" format) + member this.Feed () = + let query = this.Request.Query :?> DynamicDictionary + match query.ContainsKey "format" with + | true -> match query.["format"].ToString () with + | x when x = "atom" || x = "rss" -> generateFeed x + | x when x = "rss2" -> generateFeed "rss" + | _ -> this.Redirect "/feed" (MyWebLogModel(this.Context, this.WebLog)) + | _ -> generateFeed "rss" // ---- Administer posts ---- diff --git a/src/myWebLog.Web/ViewModels.fs b/src/myWebLog.Web/ViewModels.fs index 4e3c772..3210117 100644 --- a/src/myWebLog.Web/ViewModels.fs +++ b/src/myWebLog.Web/ViewModels.fs @@ -228,11 +228,23 @@ type PageModel(ctx, webLog, page) = member this.page : Page = page +/// Wrapper for a page with additional properties +type PageForDisplay(webLog, page) = + /// The page + member this.page : Page = page + /// The time zone of the web log + member this.timeZone = webLog.timeZone + /// The date the page was last updated + member this.updatedDate = FormatDateTime.longDate this.timeZone page.updatedOn + /// The time the page was last updated + member this.updatedTime = FormatDateTime.time this.timeZone page.updatedOn + + /// Model for page list display type PagesModel(ctx, webLog, pages) = inherit MyWebLogModel(ctx, webLog) /// The pages - member this.pages : Page list = pages + member this.pages : PageForDisplay list = pages /// Form used to edit a page diff --git a/src/myWebLog.Web/myWebLog.Web.fsproj b/src/myWebLog.Web/myWebLog.Web.fsproj index 79d71a0..14dea9a 100644 --- a/src/myWebLog.Web/myWebLog.Web.fsproj +++ b/src/myWebLog.Web/myWebLog.Web.fsproj @@ -75,6 +75,10 @@ ..\packages\FSharp.Formatting.2.14.4\lib\net40\CSharpFormat.dll True + + ..\packages\Dynamitey.1.0.2.0\lib\net40\Dynamitey.dll + True + ..\packages\FSharp.Formatting.2.14.4\lib\net40\FSharp.CodeFormat.dll True @@ -91,6 +95,10 @@ ..\packages\FSharp.Formatting.2.14.4\lib\net40\FSharp.Formatting.Common.dll True + + ..\packages\FSharp.Interop.Dynamic.3.0.0.0\lib\portable-net45+sl50+win\FSharp.Interop.Dynamic.dll + True + ..\packages\FSharp.Formatting.2.14.4\lib\net40\FSharp.Literate.dll True @@ -137,7 +145,7 @@ True - ..\packages\RethinkDb.Driver.2.3.8\lib\net45\RethinkDb.Driver.dll + ..\packages\RethinkDb.Driver.2.3.9\lib\net45\RethinkDb.Driver.dll True diff --git a/src/myWebLog.Web/packages.config b/src/myWebLog.Web/packages.config index 5bcf0fd..ec73544 100644 --- a/src/myWebLog.Web/packages.config +++ b/src/myWebLog.Web/packages.config @@ -2,9 +2,11 @@ + + @@ -12,6 +14,6 @@ - + \ No newline at end of file diff --git a/src/myWebLog/views/admin/page/list.html b/src/myWebLog/views/admin/page/list.html index fd3e71d..b20085f 100644 --- a/src/myWebLog/views/admin/page/list.html +++ b/src/myWebLog/views/admin/page/list.html @@ -13,17 +13,12 @@ @Each.pages - @Current.title
- @Translate.View   - @Translate.Edit   - @Translate.Delete - - - + @Current.page.title
+ @Translate.View   + @Translate.Edit   + @Translate.Delete + @Current.updatedDate
@Translate.at @Current.updatedTime @EndEach