Version 3 #67
@ -99,12 +99,14 @@ module Startup =
|
||||
[<AutoOpen>]
|
||||
module private Helpers =
|
||||
|
||||
/// Async wrapper around a LiteDB query that returns multiple results
|
||||
let doListQuery<'T> (q : ILiteQueryable<'T>) =
|
||||
q.ToList () |> Task.FromResult
|
||||
open System.Linq
|
||||
|
||||
/// Async wrapper around a LiteDB query that returns 0 or 1 results
|
||||
let doSingleQuery<'T> (q : ILiteQueryable<'T>) =
|
||||
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
|
||||
let toListAsync<'T> (q : 'T seq) =
|
||||
(q.ToList >> Task.FromResult) ()
|
||||
|
||||
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
|
||||
let firstAsync<'T> (q : 'T seq) =
|
||||
q.FirstOrDefault () |> Task.FromResult
|
||||
|
||||
/// Async wrapper around a request update
|
||||
@ -142,8 +144,8 @@ module private Helpers =
|
||||
|
||||
/// Retrieve a request, including its history and notes, by its ID and user ID
|
||||
let tryFullRequestById reqId userId (db : LiteDatabase) = task {
|
||||
let! req = doSingleQuery (db.requests.Query().Where (fun it -> it.id = reqId && it.userId = userId))
|
||||
return match box req with null -> None | _ -> Some req
|
||||
let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId |> BsonValue)) |> firstAsync
|
||||
return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None
|
||||
}
|
||||
|
||||
/// Add a history entry
|
||||
@ -166,7 +168,7 @@ let addRequest (req : Request) (db : LiteDatabase) =
|
||||
|
||||
/// Retrieve all answered requests for the given user
|
||||
let answeredRequests userId (db : LiteDatabase) = task {
|
||||
let! reqs = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
|
||||
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync
|
||||
return
|
||||
reqs
|
||||
|> Seq.map toJournalFull
|
||||
@ -177,7 +179,7 @@ let answeredRequests userId (db : LiteDatabase) = task {
|
||||
|
||||
/// Retrieve the user's current journal
|
||||
let journalByUserId userId (db : LiteDatabase) = task {
|
||||
let! jrnl = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
|
||||
let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync
|
||||
return
|
||||
jrnl
|
||||
|> Seq.map toJournalLite
|
||||
|
@ -61,7 +61,6 @@ module Error =
|
||||
open Cuid
|
||||
open LiteDB
|
||||
open System.Security.Claims
|
||||
open Microsoft.Extensions.Logging
|
||||
|
||||
/// Handler helpers
|
||||
[<AutoOpen>]
|
||||
@ -188,7 +187,6 @@ module Components =
|
||||
authorize
|
||||
>=> fun next ctx -> task {
|
||||
let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
|
||||
do! System.Threading.Tasks.Task.Delay (TimeSpan.FromSeconds 5.)
|
||||
return! renderComponent [ Views.Journal.journalItems jrnl ] next ctx
|
||||
}
|
||||
|
||||
@ -201,19 +199,11 @@ module Home =
|
||||
withMenuRefresh >=> partialIfNotRefresh Views.Home.home
|
||||
|
||||
|
||||
/// /api/journal and /journal URLs
|
||||
/// /journal URL
|
||||
module Journal =
|
||||
|
||||
/// GET /api/journal
|
||||
let journal : HttpHandler =
|
||||
authorize
|
||||
>=> fun next ctx -> task {
|
||||
let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
|
||||
return! json jrnl next ctx
|
||||
}
|
||||
|
||||
// GET /journal
|
||||
let journalPage : HttpHandler =
|
||||
let journal : HttpHandler =
|
||||
authorize
|
||||
>=> withMenuRefresh
|
||||
>=> fun next ctx -> task {
|
||||
@ -222,18 +212,19 @@ module Journal =
|
||||
}
|
||||
|
||||
|
||||
/// Legalese
|
||||
/// /legal URLs
|
||||
module Legal =
|
||||
|
||||
// GET /legal/privacy-policy
|
||||
let privacyPolicy : HttpHandler =
|
||||
withMenuRefresh >=> partialIfNotRefresh Views.Legal.privacyPolicy
|
||||
|
||||
// GET /legal/terms-of-service
|
||||
let termsOfService : HttpHandler =
|
||||
withMenuRefresh >=> partialIfNotRefresh Views.Legal.termsOfService
|
||||
|
||||
|
||||
/// /api/request URLs
|
||||
/// /api/request and /request(s) URLs
|
||||
module Request =
|
||||
|
||||
/// POST /api/request
|
||||
@ -311,12 +302,22 @@ module Request =
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// GET /api/requests/answered
|
||||
/// GET /requests/active
|
||||
let active : HttpHandler =
|
||||
authorize
|
||||
>=> withMenuRefresh
|
||||
>=> fun next ctx -> task {
|
||||
let! reqs = Data.journalByUserId (userId ctx) (db ctx)
|
||||
return! partialIfNotRefresh (Views.Request.active reqs) next ctx
|
||||
}
|
||||
|
||||
/// GET /requests/answered
|
||||
let answered : HttpHandler =
|
||||
authorize
|
||||
>=> withMenuRefresh
|
||||
>=> fun next ctx -> task {
|
||||
let! reqs = Data.answeredRequests (userId ctx) (db ctx)
|
||||
return! json reqs next ctx
|
||||
return! partialIfNotRefresh (Views.Request.answered reqs) next ctx
|
||||
}
|
||||
|
||||
/// GET /api/request/[req-id]
|
||||
@ -396,6 +397,7 @@ module Request =
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
|
||||
open Giraffe.EndpointRouting
|
||||
|
||||
/// The routes for myPrayerJournal
|
||||
@ -405,16 +407,18 @@ let routes =
|
||||
route "journal-items" Components.journalItems
|
||||
route "nav-items" Components.navItems
|
||||
]
|
||||
route "/journal" Journal.journalPage
|
||||
route "/journal" Journal.journal
|
||||
subRoute "/legal/" [
|
||||
route "privacy-policy" Legal.privacyPolicy
|
||||
route "terms-of-service" Legal.termsOfService
|
||||
]
|
||||
subRoute "/request" [
|
||||
route "s/active" Request.active
|
||||
route "s/answered" Request.answered
|
||||
]
|
||||
subRoute "/api/" [
|
||||
GET [
|
||||
route "journal" Journal.journal
|
||||
subRoute "request" [
|
||||
route "s/answered" Request.answered
|
||||
routef "/%s/full" Request.getFull
|
||||
routef "/%s/notes" Request.getNotes
|
||||
routef "/%s" Request.get
|
||||
|
@ -4,8 +4,24 @@ open Giraffe.ViewEngine
|
||||
open Giraffe.ViewEngine.Htmx
|
||||
open System
|
||||
|
||||
/// Target the `main` tag with boosted links
|
||||
let toMain = _hxTarget "main"
|
||||
[<AutoOpen>]
|
||||
module Helpers =
|
||||
/// Target the `main` tag with boosted links
|
||||
let toMain = _hxTarget "main"
|
||||
|
||||
/// Create a Material icon
|
||||
let icon name = span [ _class "material-icons" ] [ str name ]
|
||||
|
||||
/// Create a card when there are no results found
|
||||
let noResults heading link buttonText text =
|
||||
div [ _class "card" ] [
|
||||
h5 [ _class "card-header"] [ str heading ]
|
||||
div [ _class "card-body text-center" ] [
|
||||
p [ _class "card-text" ] text
|
||||
a [ _class "btn btn-primary"; _href link; _hxBoost; toMain ] [ str buttonText ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
/// View for home page
|
||||
module Home =
|
||||
@ -227,23 +243,97 @@ module Journal =
|
||||
let journalItems items =
|
||||
match items |> List.isEmpty with
|
||||
| true ->
|
||||
div [ _class "card no-requests" ] [
|
||||
h5 [ _class "card-header"] [ str "No Active Requests" ]
|
||||
div [ _class "card-body text-center" ] [
|
||||
p [ _class "card-text" ] [
|
||||
rawText "You have no requests to be shown; see the “Active” link above for snoozed or "
|
||||
rawText "deferred requests, and the “Answered” link for answered requests"
|
||||
]
|
||||
a [
|
||||
_class "btn btn-primary"
|
||||
_href "/request/new/edit"
|
||||
_hxBoost; toMain
|
||||
] [ str "Add a Request" ]
|
||||
]
|
||||
noResults "No Active Requests" "/request/new/edit" "Add a Request" [
|
||||
rawText "You have no requests to be shown; see the “Active” link above for snoozed or "
|
||||
rawText "deferred requests, and the “Answered” link for answered requests"
|
||||
]
|
||||
| false -> p [] [ str "There are requests" ]
|
||||
|
||||
|
||||
/// Views for request pages and components
|
||||
module Request =
|
||||
|
||||
/// Create a request within the list
|
||||
let reqListItem req =
|
||||
let jsNow = int64 (DateTime.UtcNow - DateTime.UnixEpoch).TotalMilliseconds
|
||||
let reqId = RequestId.toString req.requestId
|
||||
let isAnswered = req.lastStatus = Answered
|
||||
let isSnoozed = Ticks.toLong req.snoozedUntil > jsNow
|
||||
let isPending = (not isSnoozed) && Ticks.toLong req.showAfter > jsNow
|
||||
let btnClass = _class "btn btn-light"
|
||||
tr [] [
|
||||
td [ _class "action-cell" ] [
|
||||
div [ _class "btn-group btn-group-sm"; Accessibility._roleGroup ] [
|
||||
a [ btnClass; _href $"/request/{reqId}/full"; _title "View Full Request" ] [ icon "description" ]
|
||||
if not isAnswered then
|
||||
a [ btnClass; _href $"/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ]
|
||||
// TODO: these next two should use hx-patch, targeting replacement of this tr when complete
|
||||
if isSnoozed then
|
||||
a [ btnClass; _href $"/request/{reqId}/cancel-snooze"; _title "Cancel Snooze" ] [ icon "restore" ]
|
||||
if isPending then
|
||||
a [ btnClass; _href $"/request/{reqId}/show-now"; _title "Show Now" ] [ icon "restore" ]
|
||||
]
|
||||
]
|
||||
td [] [
|
||||
p [ _class "mpj-request-text mb-0" ] [
|
||||
str req.text
|
||||
if isSnoozed || isPending || isAnswered then
|
||||
br []
|
||||
small [ _class "text-muted" ] [
|
||||
em [] [
|
||||
if isSnoozed then str "Snooze expires date-from-now(value='request.snoozedUntil')"
|
||||
if isPending then str "Request appears next date-from-now(:value='request.showAfter')"
|
||||
if isAnswered then str "Answered date-from-now(:value='request.asOf')"
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
/// Create a list of requests
|
||||
let reqList reqs =
|
||||
table [ _class "table table-hover table-sm align-top" ] [
|
||||
thead [] [
|
||||
tr [] [
|
||||
th [ _scope "col" ] [ str "Actions" ]
|
||||
th [ _scope "col" ] [ str "Request" ]
|
||||
]
|
||||
]
|
||||
reqs
|
||||
|> List.map reqListItem
|
||||
|> tbody []
|
||||
]
|
||||
|
||||
/// View for Active Requests page
|
||||
let active reqs = article [] [
|
||||
h2 [] [ str "Active Requests" ]
|
||||
match reqs |> List.isEmpty with
|
||||
| true ->
|
||||
noResults "No Active Requests" "/journal" "Return to your journal"
|
||||
[ str "Your prayer journal has no active requests" ]
|
||||
| false -> reqList reqs
|
||||
]
|
||||
|
||||
/// View for Answered Requests page
|
||||
let answered reqs = article [] [
|
||||
h2 [] [ str "Answered Requests" ]
|
||||
match reqs |> List.isEmpty with
|
||||
| true ->
|
||||
noResults "No Active Requests" "/journal" "Return to your journal" [
|
||||
rawText "Your prayer journal has no answered requests; once you have marked one as “Answered”, "
|
||||
str "it will appear here"
|
||||
]
|
||||
| false -> reqList reqs
|
||||
]
|
||||
|
||||
/// View for Snoozed Requests page
|
||||
let snoozed reqs = article [] [
|
||||
h2 [] [ str "Snoozed Requests" ]
|
||||
reqList reqs
|
||||
]
|
||||
|
||||
|
||||
|
||||
/// Layout views
|
||||
module Layout =
|
||||
|
||||
@ -255,7 +345,8 @@ module Layout =
|
||||
_integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC"
|
||||
_crossorigin "anonymous"
|
||||
]
|
||||
link [ _href "/style/style.css"; _rel "stylesheet" ]
|
||||
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
|
||||
link [ _href "/style/style.css"; _rel "stylesheet" ]
|
||||
script [
|
||||
_src "https://unpkg.com/htmx.org@1.5.0"
|
||||
_integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"
|
||||
|
@ -26,6 +26,9 @@ nav .j {
|
||||
.navbar-nav .is-active-route {
|
||||
background-color: rgba(255, 255, 255, .2);
|
||||
}
|
||||
.action-cell .material-icons {
|
||||
font-size: 1.1rem ;
|
||||
}
|
||||
|
||||
footer {
|
||||
border-top: solid 1px lightgray;
|
||||
|
Loading…
Reference in New Issue
Block a user