page list

The page list is now populated
This commit is contained in:
Daniel J. Summers 2016-07-21 08:05:07 -05:00
parent 1a83727bc7
commit 197a19d339
5 changed files with 50 additions and 33 deletions

View File

@ -90,6 +90,12 @@ with
}
/// An entry in the list of pages displayed as part of the web log (derived via query)
type PageListEntry = {
permalink : string
title : string
}
/// A web log
type WebLog = {
/// The Id
@ -100,7 +106,7 @@ type WebLog = {
subtitle : string option
/// The default page ("posts" or a page Id)
defaultPage : string
/// The path of the theme (within /views)
/// The path of the theme (within /views/themes)
themePath : string
/// The URL base
urlBase : string
@ -108,7 +114,7 @@ type WebLog = {
timeZone : string
/// A list of pages to be rendered as part of the site navigation
[<JsonIgnore>]
pageList : Page list
pageList : PageListEntry list
}
with
/// An empty web log

View File

@ -37,46 +37,52 @@ let checkTables cfg =
let tbl cfg table = r.Db(cfg.database).Table(table)
/// Create the given index
let createIndex cfg table (index : string * obj) =
logStepStart (sprintf """ Creating index "%s" on table %s""" (fst index) table)
(tbl cfg table).IndexCreate(fst index, snd index).RunResultAsync(cfg.conn) |> await |> ignore
(tbl cfg table).IndexWait(fst index).RunAtomAsync(cfg.conn) |> await |> ignore
let createIndex cfg table (index : string * (ReqlExpr -> obj) option) =
let idxName, idxFunc = index
logStepStart (sprintf """ Creating index "%s" on table %s""" idxName table)
match idxFunc with
| Some f -> (tbl cfg table).IndexCreate(idxName, f).RunResultAsync(cfg.conn)
| None -> (tbl cfg table).IndexCreate(idxName ).RunResultAsync(cfg.conn)
|> await |> ignore
(tbl cfg table).IndexWait(idxName).RunAtomAsync(cfg.conn) |> await |> ignore
logStepDone ()
/// Ensure that the given indexes exist, and create them if required
let ensureIndexes cfg (indexes : (string * (string * obj) list) list) =
indexes
|> List.iter (fun tabl -> let idx = (tbl cfg (fst tabl)).IndexList().RunListAsync<string>(cfg.conn) |> await
let ensureIndexes cfg (indexes : (string * (string * (ReqlExpr -> obj) option) list) list) =
let ensureForTable tabl =
let idx = (tbl cfg (fst tabl)).IndexList().RunListAsync<string>(cfg.conn) |> await
snd tabl
|> List.iter (fun index -> match idx.Contains (fst index) with
| true -> ()
| _ -> createIndex cfg (fst tabl) index))
| _ -> createIndex cfg (fst tabl) index)
indexes
|> List.iter ensureForTable
/// Create an index on a single field
let singleField (name : string) : obj = upcast (fun row -> (row :> ReqlExpr).[name])
/// Create an index on web log Id and the given field
let webLogField (name : string) : obj = upcast (fun row -> r.Array((row :> ReqlExpr).["webLogId"], row.[name]))
let webLogField (name : string) : (ReqlExpr -> obj) option =
Some <| fun row -> upcast r.Array(row.["webLogId"], row.[name])
/// Ensure all the required indexes exist
let checkIndexes cfg =
logStep "|> Checking indexes"
[ Table.Category, [ "webLogId", singleField "webLogId"
[ Table.Category, [ "webLogId", None
"slug", webLogField "slug"
]
Table.Comment, [ "postId", singleField "postId"
Table.Comment, [ "postId", None
]
Table.Page, [ "webLogId", singleField "webLogId"
Table.Page, [ "webLogId", None
"permalink", webLogField "permalink"
"pageList", webLogField "showInPageList"
]
Table.Post, [ "webLogId", singleField "webLogId"
Table.Post, [ "webLogId", None
"webLogAndStatus", webLogField "status"
"permalink", webLogField "permalink"
]
Table.User, [ "logOn", upcast (fun row -> r.Array((row :> ReqlExpr).["userName"], row.["passwordHash"]))
Table.User, [ "logOn", Some <| fun row -> upcast r.Array(row.["userName"], row.["passwordHash"])
]
Table.WebLog, [ "urlBase", singleField "urlBase"
Table.WebLog, [ "urlBase", None
]
]
|> ensureIndexes cfg

View File

@ -7,18 +7,20 @@ open System.Dynamic
let private r = RethinkDb.Driver.RethinkDB.R
type PageList = { pageList : obj }
/// 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)
let tryFindWebLogByUrlBase conn (urlBase : string) =
r.Table(Table.WebLog)
let webLog = r.Table(Table.WebLog)
.GetAll(urlBase).OptArg("index", "urlBase")
.Merge(fun webLog -> { pageList =
r.Table(Table.Page)
.GetAll(webLog.["id"], true).OptArg("index", "pageList")
.OrderBy("title")
.Pluck("title", "permalink")
.CoerceTo("array") })
.RunCursorAsync<WebLog>(conn)
|> await
|> Seq.tryHead
match webLog with
| Some w -> Some { w with pageList = r.Table(Table.Page)
.GetAll(w.id).OptArg("index", "webLogId")
.Filter(fun pg -> pg.["showInPageList"].Eq(true))
.OrderBy("title")
.Pluck("title", "permalink")
.RunListAsync<PageListEntry>(conn) |> await |> Seq.toList }
| None -> None

View File

@ -55,6 +55,8 @@ type MyWebLogModel(ctx : NancyContext, webLog : WebLog) =
member this.user = ctx.Request.PersistableSession.GetOrDefault<User>(Keys.User, User.empty)
/// The title of the page
member val pageTitle = "" with get, set
/// The name and version of the application
member this.generator = sprintf "myWebLog %s" (ctx.Items.[Keys.Version].ToString ())
/// The request start time
member this.requestStart = ctx.Items.[Keys.RequestStart] :?> int64
/// Is a user authenticated for this request?

View File

@ -1,6 +1,7 @@
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8"/>
<meta name="viewport" content="width=device-width" />
<meta name="generator" content="@Model.generator" />
<title>@Model.pageTitle | @Model.webLog.name</title>